From 67e2743ddedada1853b9fda9ac7005bb421c64b8 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Sat, 22 Jun 2019 22:00:49 -0400 Subject: [PATCH 001/102] Add and use `ChunkFn_t` and `ChunkFnPtr_t` typedefs --- include/c-chunk.h | 2 +- include/c-common.h | 7 ++++++- mlton/codegen/c-codegen/c-codegen.fun | 6 +++--- mlton/codegen/llvm-codegen/llvm-codegen.fun | 4 ++-- 4 files changed, 12 insertions(+), 7 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index b47528f0b0..9e3eb4e0a2 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -45,7 +45,7 @@ /* ------------------------------------------------- */ #define Chunk(n) \ - DeclareChunk(n) { \ + DefineChunk(n) { \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: Chunk%d(nextBlock = %d)\n", \ __FILE__, __LINE__, n, (int)nextBlock); diff --git a/include/c-common.h b/include/c-common.h index 227709fcbf..2914c1ea21 100644 --- a/include/c-common.h +++ b/include/c-common.h @@ -16,9 +16,14 @@ #include "export.h" +typedef uintptr_t ChunkFn_t (CPointer, CPointer, CPointer, uintptr_t); +typedef ChunkFn_t *ChunkFnPtr_t; + #define ChunkName(n) Chunk ## n -#define DeclareChunk(n) \ +#define DeclareChunk(n) PRIVATE extern ChunkFn_t ChunkName(n); + +#define DefineChunk(n) \ PRIVATE uintptr_t ChunkName(n)(CPointer gcState, CPointer stackTop, CPointer frontier, uintptr_t nextBlock) #define Chunkp(n) &(ChunkName(n)) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 81b96280d2..3eb3ef9c81 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -632,9 +632,9 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, fun defineNextChunks print = (List.foreach (chunks, fn Chunk.T {chunkLabel, ...} => declareChunk (chunkLabel, print)) - ; print "PRIVATE uintptr_t (*nextChunks[" + ; print "PRIVATE ChunkFnPtr_t nextChunks[" ; print (C.int (Vector.length nextChunks)) - ; print "]) (CPointer, CPointer, CPointer, uintptr_t) = {\n" + ; print "] = {\n" ; Vector.foreachi (nextChunks, fn (i, label) => let @@ -675,7 +675,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, Transfer.Call {label, ...} => declareChunk (labelChunk label) | _ => ()))) - ; print "PRIVATE extern uintptr_t (*nextChunks[]) (CPointer, CPointer, CPointer, uintptr_t);\n" + ; print "PRIVATE extern ChunkFnPtr_t nextChunks[];\n" end val handleMisaligned = diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 8a676e8200..8a2e6cf79e 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -1424,9 +1424,9 @@ fun transC (cxt, outputC) = C.call ("DeclareChunk", [chunkLabelIndexAsString chunkLabel], print)) - ; print "PRIVATE uintptr_t (*nextChunks[" + ; print "PRIVATE ChunkFnPtr_t nextChunks[" ; print (C.int (Vector.length nextChunks)) - ; print "]) (CPointer, CPointer, CPointer, uintptr_t) = {\n" + ; print "] = {\n" ; Vector.foreachi (nextChunks, fn (i, label) => (print "\t" From 8eca49d47e0cd4caa60c3d1c3c777e7a129b33b9 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 25 Jun 2019 06:28:19 -0400 Subject: [PATCH 002/102] Simplify passing of `Control.chunkTailCall` to `c-chunk.h` --- include/c-chunk.h | 8 ++++---- mlton/codegen/c-codegen/c-codegen.fun | 10 ++++++---- 2 files changed, 10 insertions(+), 8 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 9e3eb4e0a2..a3760b764f 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -63,13 +63,13 @@ goto doLeaveChunk; \ } /* end switch (nextBlock) */ -#define EndChunk(n, tail) \ +#define EndChunk(n) \ /* interchunk return */ \ doLeaveChunk: \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: EndChunk%d(nextBlock = %d)\n", \ __FILE__, __LINE__, n, (int)nextBlock); \ - if (tail) { \ + if (TailCall) { \ return (*(nextChunks[nextBlock]))(gcState, stackTop, frontier, nextBlock); \ } else { \ FlushFrontier(); \ @@ -149,12 +149,12 @@ #define NearCall(l) \ goto l -#define FarCall(n, l, tail) \ +#define FarCall(n, l) \ do { \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: FarCall(%d, %s)\n", \ __FILE__, __LINE__, (int)n, #l); \ - if (tail) { \ + if (TailCall) { \ return ChunkName(n)(gcState, stackTop, frontier, l); \ } else { \ FlushFrontier(); \ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 3eb3ef9c81..08d19f63b6 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -983,8 +983,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, print) else C.call ("\tFarCall", [chunkLabelIndexAsString dstChunk, - labelIndexAsString (label, {pretty = true}), - C.bool (!Control.chunkTailCall)], + labelIndexAsString (label, {pretty = true})], print) end | Goto dst => gotoLabel (dst, {tab = true}) @@ -1121,7 +1120,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, else ()) ; print "EndChunkSwitch\n\n" ; List.foreach (List.rev (!dfsBlocks), outputBlock) - ; C.callNoSemi ("EndChunk", [chunkLabelIndexAsString chunkLabel, C.bool (!Control.chunkTailCall)], print); print "\n\n" + ; C.callNoSemi ("EndChunk", [chunkLabelIndexAsString chunkLabel], print); print "\n\n" end fun outputChunks chunks = @@ -1137,7 +1136,10 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, print (concat ["#define ", name, " ", Bytes.toString (GCField.offset f), "\n"])) in - outputIncludes (["c-chunk.h"], print); print "\n" + (print "#define TailCall " + ; print (C.bool (!Control.chunkTailCall)) + ; print "\n") + ; outputIncludes (["c-chunk.h"], print); print "\n" ; outputOffsets (); print "\n" ; declareGlobals ("PRIVATE extern ", print); print "\n" ; declareNextChunks (chunks, print); print "\n" From 654c557d6b7981b9191bf10dd9e39071e64574a7 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 25 Jun 2019 14:00:56 -0400 Subject: [PATCH 003/102] Add `Machine.Program.rflow` for `{returns,raises}To` control flow --- mlton/backend/rssa-tree.fun | 49 +++++++++++++++++++++++++++++++++++++ mlton/backend/rssa-tree.sig | 2 ++ 2 files changed, 51 insertions(+) diff --git a/mlton/backend/rssa-tree.fun b/mlton/backend/rssa-tree.fun index c20438f8bb..3587485365 100644 --- a/mlton/backend/rssa-tree.fun +++ b/mlton/backend/rssa-tree.fun @@ -1002,6 +1002,55 @@ structure Program = () end + structure Labels = PowerSetLattice_ListSet(structure Element = Label) + fun rflow (T {functions, main, ...}) = + let + val functions = main :: functions + val table = HashTable.new {equals = Func.equals, hash = Func.hash} + fun get f = + HashTable.lookupOrInsert (table, f, fn () => + {raisesTo = Labels.empty (), + returnsTo = Labels.empty ()}) + val raisesTo = #raisesTo o get + val returnsTo = #returnsTo o get + val empty = Labels.empty () + val _ = + List.foreach + (functions, fn f => + let + val {name, blocks, ...} = Function.dest f + in + Vector.foreach + (blocks, fn Block.T {transfer, ...} => + case transfer of + Transfer.Call {func, return, ...} => + let + val (returns, raises) = + case return of + Return.Dead => (empty, empty) + | Return.NonTail {cont, handler, ...} => + (Labels.singleton cont, + case handler of + Handler.Caller => raisesTo name + | Handler.Dead => empty + | Handler.Handle hand => Labels.singleton hand) + | Return.Tail => (returnsTo name, raisesTo name) + in + Labels.<= (returns, returnsTo func) + ; Labels.<= (raises, raisesTo func) + end + | _ => ()) + end) + in + fn f => + let + val {raisesTo, returnsTo} = get f + in + {raisesTo = Labels.getElements raisesTo, + returnsTo = Labels.getElements returnsTo} + end + end + fun orderFunctions (p as T {handlesSignals, objectTypes, profileInfo, ...}) = let val functions = ref [] diff --git a/mlton/backend/rssa-tree.sig b/mlton/backend/rssa-tree.sig index fd61d542d4..9a879d0984 100644 --- a/mlton/backend/rssa-tree.sig +++ b/mlton/backend/rssa-tree.sig @@ -209,6 +209,8 @@ signature RSSA_TREE = val layouts: t * (Layout.t -> unit) -> unit val layoutStats: t -> Layout.t val orderFunctions: t -> t + val rflow: t -> (Func.t -> {raisesTo: Label.t list, + returnsTo: Label.t list}) val shrink: t -> t val shuffle: t -> t val toFile: {display: t Control.display, style: Control.style, suffix: string} From 1b3b7b88d10fc1e34b6128244a1c378db91a6129 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 25 Jun 2019 14:03:12 -0400 Subject: [PATCH 004/102] Use `Machine.Program.rflow` in `functor Chunkify` --- mlton/backend/chunkify.fun | 42 ++------------------------------------ 1 file changed, 2 insertions(+), 40 deletions(-) diff --git a/mlton/backend/chunkify.fun b/mlton/backend/chunkify.fun index f72c4b9854..e890e327df 100644 --- a/mlton/backend/chunkify.fun +++ b/mlton/backend/chunkify.fun @@ -54,44 +54,6 @@ fun blockSize (Block.T {statements, transfer, ...}): int = statementsSize + transferSize end -(* Compute the list of functions that each function returns to *) -structure Labels = PowerSetLattice_ListSet(structure Element = Label) -fun returnsTo (Program.T {functions, main, ...}) = - let - val functions = main :: functions - val {get: Func.t -> {returnsTo: Labels.t}, - rem, ...} = - Property.get (Func.plist, - Property.initFun (fn _ => - {returnsTo = Labels.empty ()})) - val returnsTo = #returnsTo o get - val empty = Labels.empty () - val _ = - List.foreach - (functions, fn f => - let - val {name, blocks, ...} = Function.dest f - in - Vector.foreach - (blocks, fn Block.T {transfer, ...} => - case transfer of - Call {func, return, ...} => - let - val returns = - case return of - Return.Dead => empty - | Return.NonTail {cont, ...} => Labels.singleton cont - | Return.Tail => returnsTo name - in - Labels.<= (returns, returnsTo func) - end - | _ => ()) - end) - in - {rem = rem, - returnsTo = Labels.getElements o returnsTo} - end - structure Graph = EquivalenceGraph structure Class = Graph.Class fun coalesce (program as Program.T {functions, main, ...}, limit) = @@ -138,7 +100,8 @@ fun coalesce (program as Program.T {functions, main, ...}, limit) = in () end) - val {returnsTo, rem = remReturnsTo} = returnsTo program + val rflow = Program.rflow program + val returnsTo = #returnsTo o rflow (* Add edges, and then coalesce the graph. *) val _ = List.foreach @@ -209,7 +172,6 @@ fun coalesce (program as Program.T {functions, main, ...}, limit) = let val {blocks, name, ...} = Function.dest f val _ = remFuncClass name - val _ = remReturnsTo name val _ = Vector.foreach (blocks, remLabelClass o Block.label) in () From cf8e487a298c2521e5105278b1b7f53bcedc3e86 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 25 Jun 2019 14:17:35 -0400 Subject: [PATCH 005/102] Add `{raises,returns}To` information to Machine IL `Raise/Return` transfers --- mlton/backend/backend.fun | 9 ++++++--- mlton/backend/machine.fun | 16 ++++++++++------ mlton/backend/machine.sig | 4 ++-- mlton/codegen/amd64-codegen/amd64-translate.fun | 4 ++-- mlton/codegen/c-codegen/c-codegen.fun | 8 ++++---- mlton/codegen/llvm-codegen/llvm-codegen.fun | 4 ++-- mlton/codegen/x86-codegen/x86-translate.fun | 4 ++-- 7 files changed, 28 insertions(+), 21 deletions(-) diff --git a/mlton/backend/backend.fun b/mlton/backend/backend.fun index 245889d1ec..faa4e099dc 100644 --- a/mlton/backend/backend.fun +++ b/mlton/backend/backend.fun @@ -134,6 +134,8 @@ fun eliminateDeadCode (f: R.Function.t): R.Function.t = fun toMachine (rssa: Rssa.Program.t) = let val R.Program.T {functions, handlesSignals, main, objectTypes, profileInfo} = rssa + (* returnsTo and raisesTo info *) + val rflow = R.Program.rflow rssa (* Chunk info *) val {get = labelChunk, set = setLabelChunk, ...} = Property.getSetOnce (Label.plist, @@ -603,6 +605,7 @@ fun toMachine (rssa: Rssa.Program.t) = val f = eliminateDeadCode f val {args, blocks, name, raises, returns, start, ...} = Function.dest f + val {raisesTo, returnsTo} = rflow name val (returnLives, returnOperands) = case returns of NONE => (NONE, NONE) @@ -859,7 +862,7 @@ fun toMachine (rssa: Rssa.Program.t) = ty = ty}) in if Vector.isEmpty srcs - then (Vector.new0 (), M.Transfer.Raise) + then (Vector.new0 (), M.Transfer.Raise {raisesTo = raisesTo}) else (Vector.concat [Vector.new1 (M.Statement.PrimApp @@ -868,12 +871,12 @@ fun toMachine (rssa: Rssa.Program.t) = prim = Prim.cpointerAdd}), parallelMove {dsts = dsts, srcs = translateOperands srcs}], - M.Transfer.Raise) + M.Transfer.Raise {raisesTo = raisesTo}) end | R.Transfer.Return xs => (parallelMove {dsts = valOf returnOperands, srcs = translateOperands xs}, - M.Transfer.Return) + M.Transfer.Return {returnsTo = returnsTo}) | R.Transfer.Switch switch => let val R.Switch.T {cases, default, size, test} = diff --git a/mlton/backend/machine.fun b/mlton/backend/machine.fun index 43ef3543ea..3ba08ae90a 100644 --- a/mlton/backend/machine.fun +++ b/mlton/backend/machine.fun @@ -453,8 +453,8 @@ structure Transfer = handler: Label.t option, size: Bytes.t} option} | Goto of Label.t - | Raise - | Return + | Raise of {raisesTo: Label.t list} + | Return of {returnsTo: Label.t list} | Switch of Switch.t fun layout t = @@ -484,8 +484,12 @@ structure Transfer = ("size", Bytes.layout size)]) return)]] | Goto l => seq [str "Goto ", Label.layout l] - | Raise => str "Raise" - | Return => str "Return " + | Raise {raisesTo} => + seq [str "Raise ", + record [("raisesTo", List.layout Label.layout raisesTo)]] + | Return {returnsTo} => + seq [str "Return ", + record [("returnsTo", List.layout Label.layout returnsTo)]] | Switch s => Switch.layout s end @@ -1452,11 +1456,11 @@ structure Program = return = return, returns = returns} | Goto l => jump l - | Raise => + | Raise _ => (case raises of NONE => false | SOME live => liveIsOk (live, alloc)) - | Return => + | Return _ => (case returns of NONE => false | SOME live => liveIsOk (live, alloc)) diff --git a/mlton/backend/machine.sig b/mlton/backend/machine.sig index ede0f25368..4276dcfd01 100644 --- a/mlton/backend/machine.sig +++ b/mlton/backend/machine.sig @@ -142,8 +142,8 @@ signature MACHINE = handler: Label.t option (* must be kind Handler*), size: Bytes.t} option} | Goto of Label.t (* must be kind Jump *) - | Raise - | Return + | Raise of {raisesTo: Label.t list} + | Return of {returnsTo: Label.t list} | Switch of Switch.t val foldOperands: t * 'a * (Operand.t * 'a -> 'a) -> 'a diff --git a/mlton/codegen/amd64-codegen/amd64-translate.fun b/mlton/codegen/amd64-codegen/amd64-translate.fun index e11b0ee051..96b5ba44fe 100644 --- a/mlton/codegen/amd64-codegen/amd64-translate.fun +++ b/mlton/codegen/amd64-codegen/amd64-translate.fun @@ -611,7 +611,7 @@ struct size = Option.map (size, Bytes.toInt)}), transInfo = transInfo}) end - | Return + | Return _ => AppendList.append (comments transfer, AppendList.single @@ -633,7 +633,7 @@ struct case amd64.Operand.deMemloc operand of SOME memloc => amd64.MemLocSet.add(live, memloc) | NONE => live))})})) - | Raise + | Raise _ => AppendList.append (comments transfer, AppendList.single diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 08d19f63b6..5611891153 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -987,8 +987,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, print) end | Goto dst => gotoLabel (dst, {tab = true}) - | Raise => C.call ("\tRaise", [], print) - | Return => C.call ("\tReturn", [], print) + | Raise _ => C.call ("\tRaise", [], print) + | Return _ => C.call ("\tReturn", [], print) | Switch switch => let val Switch.T {cases, default, test, ...} = switch @@ -1084,8 +1084,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, Option.app (return, visit o #return) | Call _ => () | Goto dst => visit dst - | Raise => () - | Return => () + | Raise _ => () + | Return _ => () | Switch (Switch.T {cases, default, ...}) => (Vector.foreach (cases, visit o #2); Option.app (default, visit))) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 8a2e6cf79e..8acca7a93d 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -1093,7 +1093,7 @@ fun outputTransfer (cxt, transfer, sourceLabel) = in concat [comment, goto] end - | Transfer.Raise => + | Transfer.Raise _ => let val comment = "\t; Raise\n" (* StackTop = StackBottom + ExnStack *) @@ -1110,7 +1110,7 @@ fun outputTransfer (cxt, transfer, sourceLabel) = concat [comment, sbpre, loadStackBottom, espre, loadExnStack, gep, store, callReturn()] end - | Transfer.Return => concat ["\t; Return\n", callReturn ()] + | Transfer.Return _ => concat ["\t; Return\n", callReturn ()] | Transfer.Switch switch => let val Switch.T {cases, default, test, ...} = switch diff --git a/mlton/codegen/x86-codegen/x86-translate.fun b/mlton/codegen/x86-codegen/x86-translate.fun index b3102d654f..ad64451149 100644 --- a/mlton/codegen/x86-codegen/x86-translate.fun +++ b/mlton/codegen/x86-codegen/x86-translate.fun @@ -623,7 +623,7 @@ struct size = Option.map (size, Bytes.toInt)}), transInfo = transInfo}) end - | Return + | Return _ => AppendList.append (comments transfer, AppendList.single @@ -645,7 +645,7 @@ struct case x86.Operand.deMemloc operand of SOME memloc => x86.MemLocSet.add(live, memloc) | NONE => live))})})) - | Raise + | Raise _ => AppendList.append (comments transfer, AppendList.single From 793afa222c20558602aaf1155947548ab9866124 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 25 Jun 2019 15:19:57 -0400 Subject: [PATCH 006/102] Avoid `doSwitchNextBlock` when `Raise/Return` must be inter-chunk --- include/c-chunk.h | 12 +++++--- mlton/codegen/c-codegen/c-codegen.fun | 44 +++++++++++++++++++++++++-- 2 files changed, 49 insertions(+), 7 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index a3760b764f..a096bec157 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -163,22 +163,26 @@ } \ } while (0) -#define Return() \ +#define Return(mayReturnToSelf) \ do { \ nextBlock = *(uintptr_t*)(StackTop - sizeof(uintptr_t)); \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: Return() nextBlock = %d\n", \ __FILE__, __LINE__, (int)nextBlock); \ - goto doSwitchNextBlock; \ + if (mayReturnToSelf) { \ + goto doSwitchNextBlock; \ + } else { \ + goto doLeaveChunk; \ + } \ } while (0) -#define Raise() \ +#define Raise(mayRaiseToSelf) \ do { \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: Raise()\n", \ __FILE__, __LINE__); \ StackTop = StackBottom + ExnStack; \ - Return(); \ + Return(mayRaiseToSelf); \ } while (0) \ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 5611891153..58a07750f7 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -961,7 +961,9 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, else () val _ = if CFunction.maySwitchThreadsFrom func - then print "\tReturn();\n" + then C.call ("\tReturn", + [C.truee], + print) else (case return of NONE => print "\tUnreachable ();\n" | SOME {return, ...} => gotoLabel (return, {tab = true})) @@ -987,8 +989,44 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, print) end | Goto dst => gotoLabel (dst, {tab = true}) - | Raise _ => C.call ("\tRaise", [], print) - | Return _ => C.call ("\tReturn", [], print) + | Raise {raisesTo} => + let + val raisesTo = + List.fold + (raisesTo, [], fn (l, cs) => + let + val c = labelChunk l + in + if List.exists (cs, fn c' => ChunkLabel.equals (c, c')) + then cs + else c::cs + end) + val mayRaiseToSelf = + List.exists (raisesTo, fn c => ChunkLabel.equals (chunkLabel, c)) + in + C.call ("\tRaise", + [C.bool mayRaiseToSelf], + print) + end + | Return {returnsTo} => + let + val returnsTo = + List.fold + (returnsTo, [], fn (l, cs) => + let + val c = labelChunk l + in + if List.exists (cs, fn c' => ChunkLabel.equals (c, c')) + then cs + else c::cs + end) + val mayReturnToSelf = + List.exists (returnsTo, fn c => ChunkLabel.equals (chunkLabel, c)) + in + C.call ("\tReturn", + [C.bool mayReturnToSelf], + print) + end | Switch switch => let val Switch.T {cases, default, test, ...} = switch From b9bdff12828e24bb12b4bb5537d9ea92eebeaba8 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 25 Jun 2019 16:28:28 -0400 Subject: [PATCH 007/102] Simplify `c-chunk.h` macros --- include/c-chunk.h | 12 ++++++------ mlton/codegen/c-codegen/c-codegen.fun | 4 ++-- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index a096bec157..100fded59d 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -50,12 +50,12 @@ fprintf (stderr, "%s:%d: Chunk%d(nextBlock = %d)\n", \ __FILE__, __LINE__, n, (int)nextBlock); -#define ChunkSwitch(n) \ +#define ChunkSwitch \ goto doSwitchNextBlock; \ doSwitchNextBlock: \ if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: ChunkSwitch%d(nextBlock = %d)\n", \ - __FILE__, __LINE__, n, (int)nextBlock); \ + fprintf (stderr, "%s:%d: ChunkSwitch(nextBlock = %d)\n", \ + __FILE__, __LINE__, (int)nextBlock); \ switch (nextBlock) { #define EndChunkSwitch \ @@ -63,12 +63,12 @@ goto doLeaveChunk; \ } /* end switch (nextBlock) */ -#define EndChunk(n) \ +#define EndChunk \ /* interchunk return */ \ doLeaveChunk: \ if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: EndChunk%d(nextBlock = %d)\n", \ - __FILE__, __LINE__, n, (int)nextBlock); \ + fprintf (stderr, "%s:%d: EndChunk(nextBlock = %d)\n", \ + __FILE__, __LINE__,(int)nextBlock); \ if (TailCall) { \ return (*(nextChunks[nextBlock]))(gcState, stackTop, frontier, nextBlock); \ } else { \ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 58a07750f7..607abe90ad 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1147,7 +1147,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, ; C.callNoSemi ("Chunk", [chunkLabelIndexAsString chunkLabel], print); print "\n" ; declareCReturns (); print "\n" ; declareRegisters (); print "\n" - ; C.callNoSemi ("ChunkSwitch", [chunkLabelIndexAsString chunkLabel], print); print "\n" + ; print "ChunkSwitch\n" ; Vector.foreach (blocks, fn Block.T {kind, label, ...} => if Kind.isEntry kind then (print "case " @@ -1158,7 +1158,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, else ()) ; print "EndChunkSwitch\n\n" ; List.foreach (List.rev (!dfsBlocks), outputBlock) - ; C.callNoSemi ("EndChunk", [chunkLabelIndexAsString chunkLabel], print); print "\n\n" + ; print "EndChunk\n\n" end fun outputChunks chunks = From 423b9ada59e5dae75a538bb71af97c6f05f34add Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 25 Jun 2019 16:30:20 -0400 Subject: [PATCH 008/102] Use more descriptive parameters in `FarCall` macro in `c-chunk.h` --- include/c-chunk.h | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 100fded59d..212e2e3a14 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -149,17 +149,17 @@ #define NearCall(l) \ goto l -#define FarCall(n, l) \ +#define FarCall(nextChunk, nextBlock) \ do { \ if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: FarCall(%d, %s)\n", \ - __FILE__, __LINE__, (int)n, #l); \ + fprintf (stderr, "%s:%d: FarCall(%d, %d)\n", \ + __FILE__, __LINE__, (int)nextChunk, (int)nextBlock); \ if (TailCall) { \ - return ChunkName(n)(gcState, stackTop, frontier, l); \ + return ChunkName(nextChunk)(gcState, stackTop, frontier, nextBlock); \ } else { \ FlushFrontier(); \ FlushStackTop(); \ - return l; \ + return nextBlock; \ } \ } while (0) From 677145eceb648b70328662a0936534e60afa03f7 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 25 Jun 2019 16:40:04 -0400 Subject: [PATCH 009/102] Move `goto doSwitchBlock;` from `ChunkSwitch` to `Chunk` macro in `c-chunk.h` --- include/c-chunk.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 212e2e3a14..122e33956d 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -48,10 +48,10 @@ DefineChunk(n) { \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: Chunk%d(nextBlock = %d)\n", \ - __FILE__, __LINE__, n, (int)nextBlock); + __FILE__, __LINE__, n, (int)nextBlock); \ + goto doSwitchNextBlock; #define ChunkSwitch \ - goto doSwitchNextBlock; \ doSwitchNextBlock: \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: ChunkSwitch(nextBlock = %d)\n", \ From df561505e6271c350841583b210ca23f53c133b6 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 25 Jun 2019 16:41:33 -0400 Subject: [PATCH 010/102] Add and use `LeaveChunk` macro in `c-chunk.h` --- include/c-chunk.h | 20 +++++++++++--------- 1 file changed, 11 insertions(+), 9 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 122e33956d..bf637474f8 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -69,14 +69,22 @@ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: EndChunk(nextBlock = %d)\n", \ __FILE__, __LINE__,(int)nextBlock); \ + LeaveChunk((*(nextChunks[nextBlock])), nextBlock); \ + } /* end chunk */ + +#define LeaveChunk(nextChunk, nextBlock) \ + do { \ + if (DEBUG_CCODEGEN) \ + fprintf (stderr, "%s:%d: LeaveChunk(nextChunk = \"%s\", nextBlock = %d)\n", \ + __FILE__, __LINE__, #nextChunk, (int)nextBlock); \ if (TailCall) { \ - return (*(nextChunks[nextBlock]))(gcState, stackTop, frontier, nextBlock); \ + return nextChunk(gcState, stackTop, frontier, nextBlock); \ } else { \ FlushFrontier(); \ FlushStackTop(); \ return nextBlock; \ } \ - } /* end chunk */ + } while (0) /* ------------------------------------------------- */ @@ -154,13 +162,7 @@ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: FarCall(%d, %d)\n", \ __FILE__, __LINE__, (int)nextChunk, (int)nextBlock); \ - if (TailCall) { \ - return ChunkName(nextChunk)(gcState, stackTop, frontier, nextBlock); \ - } else { \ - FlushFrontier(); \ - FlushStackTop(); \ - return nextBlock; \ - } \ + LeaveChunk(ChunkName(nextChunk), nextBlock); \ } while (0) #define Return(mayReturnToSelf) \ From eb9c62abe1ae00c92f96abdde33d43903131cb90 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 25 Jun 2019 17:14:26 -0400 Subject: [PATCH 011/102] Use `LeaveChunk` macro in `Return` in `c-chunk.h` Rather than using `goto doLeaveChunk;`. --- include/c-chunk.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index bf637474f8..987c7d737c 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -174,7 +174,7 @@ if (mayReturnToSelf) { \ goto doSwitchNextBlock; \ } else { \ - goto doLeaveChunk; \ + LeaveChunk ((*nextChunks[nextBlock]), nextBlock); \ } \ } while (0) From bf9fe5989876678c3ba6095cad1f4142159a9b42 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 25 Jun 2019 22:31:15 -0400 Subject: [PATCH 012/102] Make `ChunkSwitch` exhaustive On `Return`, use mustReturnToSelf || (mayReturnToSelf && (nextChunks[nextBlock] == selfChunk)) to guard `goto doSwitchNextBlock`; this guarantees that the `ChunkSwitch` will only be entered with a block found in the chunk. --- include/c-chunk.h | 24 +++++++++++------------- mlton/codegen/c-codegen/c-codegen.fun | 19 ++++++++++++------- 2 files changed, 23 insertions(+), 20 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 987c7d737c..263a613948 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -46,6 +46,7 @@ #define Chunk(n) \ DefineChunk(n) { \ + const ChunkFnPtr_t selfChunk = Chunkp(n); \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: Chunk%d(nextBlock = %d)\n", \ __FILE__, __LINE__, n, (int)nextBlock); \ @@ -60,20 +61,15 @@ #define EndChunkSwitch \ default: \ - goto doLeaveChunk; \ + Unreachable(); \ } /* end switch (nextBlock) */ #define EndChunk \ - /* interchunk return */ \ - doLeaveChunk: \ - if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: EndChunk(nextBlock = %d)\n", \ - __FILE__, __LINE__,(int)nextBlock); \ - LeaveChunk((*(nextChunks[nextBlock])), nextBlock); \ } /* end chunk */ #define LeaveChunk(nextChunk, nextBlock) \ do { \ + /* interchunk return */ \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: LeaveChunk(nextChunk = \"%s\", nextBlock = %d)\n", \ __FILE__, __LINE__, #nextChunk, (int)nextBlock); \ @@ -165,27 +161,29 @@ LeaveChunk(ChunkName(nextChunk), nextBlock); \ } while (0) -#define Return(mayReturnToSelf) \ +#define Return(mustReturnToSelf,mayReturnToSelf) \ do { \ nextBlock = *(uintptr_t*)(StackTop - sizeof(uintptr_t)); \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: Return() nextBlock = %d\n", \ __FILE__, __LINE__, (int)nextBlock); \ - if (mayReturnToSelf) { \ + ChunkFnPtr_t nextChunk = nextChunks[nextBlock]; \ + if (mustReturnToSelf \ + || (mayReturnToSelf && (nextChunk == selfChunk))) { \ goto doSwitchNextBlock; \ } else { \ - LeaveChunk ((*nextChunks[nextBlock]), nextBlock); \ + LeaveChunk ((*nextChunk), nextBlock); \ } \ } while (0) -#define Raise(mayRaiseToSelf) \ +#define Raise(mustRaiseToSelf,mayRaiseToSelf) \ do { \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: Raise()\n", \ __FILE__, __LINE__); \ StackTop = StackBottom + ExnStack; \ - Return(mayRaiseToSelf); \ - } while (0) \ + Return(mustRaiseToSelf,mayRaiseToSelf); \ + } while (0) /* ------------------------------------------------- */ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 607abe90ad..6da0b4c93e 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -962,7 +962,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, val _ = if CFunction.maySwitchThreadsFrom func then C.call ("\tReturn", - [C.truee], + [C.falsee, + C.truee], print) else (case return of NONE => print "\tUnreachable ();\n" @@ -991,6 +992,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, | Goto dst => gotoLabel (dst, {tab = true}) | Raise {raisesTo} => let + fun isSelf c = ChunkLabel.equals (chunkLabel, c) val raisesTo = List.fold (raisesTo, [], fn (l, cs) => @@ -1001,15 +1003,17 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, then cs else c::cs end) - val mayRaiseToSelf = - List.exists (raisesTo, fn c => ChunkLabel.equals (chunkLabel, c)) + val mayRaiseToSelf = List.exists (raisesTo, isSelf) + val mustRaiseToSelf = List.forall (raisesTo, isSelf) in C.call ("\tRaise", - [C.bool mayRaiseToSelf], + [C.bool mustRaiseToSelf, + C.bool mayRaiseToSelf], print) end | Return {returnsTo} => let + fun isSelf c = ChunkLabel.equals (chunkLabel, c) val returnsTo = List.fold (returnsTo, [], fn (l, cs) => @@ -1020,11 +1024,12 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, then cs else c::cs end) - val mayReturnToSelf = - List.exists (returnsTo, fn c => ChunkLabel.equals (chunkLabel, c)) + val mayReturnToSelf = List.exists (returnsTo, isSelf) + val mustReturnToSelf = List.forall (returnsTo, isSelf) in C.call ("\tReturn", - [C.bool mayReturnToSelf], + [C.bool mustReturnToSelf, + C.bool mayReturnToSelf], print) end | Switch switch => From 7c10c7071cd44ddd36b7cda831e447207799192e Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 25 Jun 2019 22:38:17 -0400 Subject: [PATCH 013/102] Use direct call in `Return` when exactly one non-self target chunk --- include/c-chunk.h | 8 +++-- mlton/codegen/c-codegen/c-codegen.fun | 47 ++++++++++++++++++++++++--- 2 files changed, 47 insertions(+), 8 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 263a613948..87cf20100f 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -161,7 +161,7 @@ LeaveChunk(ChunkName(nextChunk), nextBlock); \ } while (0) -#define Return(mustReturnToSelf,mayReturnToSelf) \ +#define Return(mustReturnToSelf,mayReturnToSelf,mustReturnToOther) \ do { \ nextBlock = *(uintptr_t*)(StackTop - sizeof(uintptr_t)); \ if (DEBUG_CCODEGEN) \ @@ -171,18 +171,20 @@ if (mustReturnToSelf \ || (mayReturnToSelf && (nextChunk == selfChunk))) { \ goto doSwitchNextBlock; \ + } else if (mustReturnToOther) { \ + LeaveChunk ((*mustReturnToOther), nextBlock); \ } else { \ LeaveChunk ((*nextChunk), nextBlock); \ } \ } while (0) -#define Raise(mustRaiseToSelf,mayRaiseToSelf) \ +#define Raise(mustRaiseToSelf,mayRaiseToSelf,mustRaiseToOther) \ do { \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: Raise()\n", \ __FILE__, __LINE__); \ StackTop = StackBottom + ExnStack; \ - Return(mustRaiseToSelf,mayRaiseToSelf); \ + Return(mustRaiseToSelf,mayRaiseToSelf,mustRaiseToOther); \ } while (0) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 6da0b4c93e..f9e22a2bfe 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -674,6 +674,10 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, case transfer of Transfer.Call {label, ...} => declareChunk (labelChunk label) + | Transfer.Raise {raisesTo, ...} => + List.foreach (raisesTo, declareChunk o labelChunk) + | Transfer.Return {returnsTo, ...} => + List.foreach (returnsTo, declareChunk o labelChunk) | _ => ()))) ; print "PRIVATE extern ChunkFnPtr_t nextChunks[];\n" end @@ -963,7 +967,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, if CFunction.maySwitchThreadsFrom func then C.call ("\tReturn", [C.falsee, - C.truee], + C.truee, + "(ChunkFnPtr_t)NULL"], print) else (case return of NONE => print "\tUnreachable ();\n" @@ -1004,11 +1009,27 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, else c::cs end) val mayRaiseToSelf = List.exists (raisesTo, isSelf) - val mustRaiseToSelf = List.forall (raisesTo, isSelf) + val (mustRaiseToSelf, mustRaiseToOther) = + case List.revKeepAll (raisesTo, not o isSelf) of + [] => (true, NONE) + | c::raisesTo => + (false, + List.fold (raisesTo, SOME c, fn (c', co) => + case co of + NONE => NONE + | SOME c => if ChunkLabel.equals (c, c') + then SOME c + else NONE)) in C.call ("\tRaise", [C.bool mustRaiseToSelf, - C.bool mayRaiseToSelf], + C.bool mayRaiseToSelf, + case mustRaiseToOther of + NONE => "(ChunkFnPtr_t)NULL" + | SOME otherChunk => + concat ["Chunkp (", + chunkLabelIndexAsString otherChunk, + ")"]], print) end | Return {returnsTo} => @@ -1025,11 +1046,27 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, else c::cs end) val mayReturnToSelf = List.exists (returnsTo, isSelf) - val mustReturnToSelf = List.forall (returnsTo, isSelf) + val (mustReturnToSelf, mustReturnToOther) = + case List.revKeepAll (returnsTo, not o isSelf) of + [] => (true, NONE) + | c::returnsTo => + (false, + List.fold (returnsTo, SOME c, fn (c', co) => + case co of + NONE => NONE + | SOME c => if ChunkLabel.equals (c, c') + then SOME c + else NONE)) in C.call ("\tReturn", [C.bool mustReturnToSelf, - C.bool mayReturnToSelf], + C.bool mayReturnToSelf, + case mustReturnToOther of + NONE => "(ChunkFnPtr_t)NULL" + | SOME otherChunk => + concat ["Chunkp (", + chunkLabelIndexAsString otherChunk, + ")"]], print) end | Switch switch => From e232b8ac6a93338cca011c149810cec253b87c34 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 26 Jun 2019 12:28:40 -0400 Subject: [PATCH 014/102] Remove `DefineChunk` macro from `c-common.h` --- include/c-chunk.h | 4 ++-- include/c-common.h | 3 --- 2 files changed, 2 insertions(+), 5 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 87cf20100f..f8c230f9b3 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -45,8 +45,8 @@ /* ------------------------------------------------- */ #define Chunk(n) \ - DefineChunk(n) { \ - const ChunkFnPtr_t selfChunk = Chunkp(n); \ + PRIVATE uintptr_t ChunkName(n)(CPointer gcState, CPointer stackTop, CPointer frontier, uintptr_t nextBlock) { \ + const ChunkFnPtr_t selfChunk = Chunkp(n); \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: Chunk%d(nextBlock = %d)\n", \ __FILE__, __LINE__, n, (int)nextBlock); \ diff --git a/include/c-common.h b/include/c-common.h index 2914c1ea21..fdc6b0fca6 100644 --- a/include/c-common.h +++ b/include/c-common.h @@ -23,9 +23,6 @@ typedef ChunkFn_t *ChunkFnPtr_t; #define DeclareChunk(n) PRIVATE extern ChunkFn_t ChunkName(n); -#define DefineChunk(n) \ - PRIVATE uintptr_t ChunkName(n)(CPointer gcState, CPointer stackTop, CPointer frontier, uintptr_t nextBlock) - #define Chunkp(n) &(ChunkName(n)) #endif /* #ifndef _C_COMMON_H_ */ From b45e5ef333434ed5c2f69c6d3a1e7b736a754003 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 26 Jun 2019 15:41:15 -0400 Subject: [PATCH 015/102] Add and use `SwitchNextBlock` macro in `c-chunk.h` --- include/c-chunk.h | 17 ++++++++++------- 1 file changed, 10 insertions(+), 7 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index f8c230f9b3..a9125c8533 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -50,13 +50,16 @@ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: Chunk%d(nextBlock = %d)\n", \ __FILE__, __LINE__, n, (int)nextBlock); \ - goto doSwitchNextBlock; + SwitchNextBlock(); -#define ChunkSwitch \ - doSwitchNextBlock: \ +#define SwitchNextBlock() \ if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: ChunkSwitch(nextBlock = %d)\n", \ + fprintf (stderr, "%s:%d: SwitchNextBlock(nextBlock = %d)\n", \ __FILE__, __LINE__, (int)nextBlock); \ + goto doSwitchNextBlock + +#define ChunkSwitch \ + doSwitchNextBlock: \ switch (nextBlock) { #define EndChunkSwitch \ @@ -170,11 +173,11 @@ ChunkFnPtr_t nextChunk = nextChunks[nextBlock]; \ if (mustReturnToSelf \ || (mayReturnToSelf && (nextChunk == selfChunk))) { \ - goto doSwitchNextBlock; \ + SwitchNextBlock(); \ } else if (mustReturnToOther) { \ - LeaveChunk ((*mustReturnToOther), nextBlock); \ + LeaveChunk((*mustReturnToOther), nextBlock); \ } else { \ - LeaveChunk ((*nextChunk), nextBlock); \ + LeaveChunk((*nextChunk), nextBlock); \ } \ } while (0) From dcb28738bbbbaaeee23a2bdf18f0f46bd0579628 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 26 Jun 2019 15:44:04 -0400 Subject: [PATCH 016/102] Add `ChunkSwitchCase` to `c-chunk.h` --- include/c-chunk.h | 3 +++ mlton/codegen/c-codegen/c-codegen.fun | 9 +++++---- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index a9125c8533..69a3ad8692 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -62,6 +62,9 @@ doSwitchNextBlock: \ switch (nextBlock) { +#define ChunkSwitchCase(index, label) \ + case index: goto label; + #define EndChunkSwitch \ default: \ Unreachable(); \ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index f9e22a2bfe..5ffc6876a2 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1192,10 +1192,11 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, ; print "ChunkSwitch\n" ; Vector.foreach (blocks, fn Block.T {kind, label, ...} => if Kind.isEntry kind - then (print "case " - ; print (labelIndexAsString (label, {pretty = false})) - ; print ": " - ; gotoLabel (label, {tab = false}) + then (C.callNoSemi ("ChunkSwitchCase", + [labelIndexAsString (label, {pretty = false}), + Label.toString label], + print) + ; print "\n" ; visit label) else ()) ; print "EndChunkSwitch\n\n" From 8e0dd2dc08c5b658a85040118d2ef92eeab5896c Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 26 Jun 2019 15:47:30 -0400 Subject: [PATCH 017/102] Add `-chunk-jump-table {false|true}` compile-time option --- mlton/control/control-flags.sig | 1 + mlton/control/control-flags.sml | 3 +++ mlton/main/main.fun | 3 +++ 3 files changed, 7 insertions(+) diff --git a/mlton/control/control-flags.sig b/mlton/control/control-flags.sig index 76537a588d..959a08863d 100644 --- a/mlton/control/control-flags.sig +++ b/mlton/control/control-flags.sig @@ -42,6 +42,7 @@ signature CONTROL_FLAGS = end val chunkify: Chunkify.t ref + val chunkJumpTable: bool ref val chunkTailCall: bool ref val closureConvertGlobalize: bool ref diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index d6685d71c2..d8e458bbd7 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -78,6 +78,9 @@ val chunkify = control {name = "chunkify", default = Chunkify.Coalesce {limit = 4096}, toString = Chunkify.toString} +val chunkJumpTable = control {name = "chunkJumpTable", + default = false, + toString = Bool.toString} val chunkTailCall = control {name = "chunkTailCall", default = true, toString = Bool.toString} diff --git a/mlton/main/main.fun b/mlton/main/main.fun index c5454e41ee..da8b4acbf5 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -301,6 +301,9 @@ fun makeOptions {usage} = end))), (Expert, "chunk-batch", " ", "batch c files at size ~n", Int (fn n => chunkBatch := n)), + (Expert, "chunk-jump-table", " {false|true}", + "whether to use explicit jump table for chunk entry switch", + Bool (fn b => chunkJumpTable := b)), (Expert, "chunk-tail-call", " {false|true}", "whether to use tail calls for interchunk transfers", Bool (fn b => chunkTailCall := b)), From b3a3ab0064220f3935ba40a8da5491565826a78d Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 26 Jun 2019 15:51:57 -0400 Subject: [PATCH 018/102] Reorganize `c-chunk.h` --- include/c-chunk.h | 39 +++++++++++++++++++++------------------ 1 file changed, 21 insertions(+), 18 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 69a3ad8692..b6c0746c20 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -52,24 +52,6 @@ __FILE__, __LINE__, n, (int)nextBlock); \ SwitchNextBlock(); -#define SwitchNextBlock() \ - if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: SwitchNextBlock(nextBlock = %d)\n", \ - __FILE__, __LINE__, (int)nextBlock); \ - goto doSwitchNextBlock - -#define ChunkSwitch \ - doSwitchNextBlock: \ - switch (nextBlock) { - -#define ChunkSwitchCase(index, label) \ - case index: goto label; - -#define EndChunkSwitch \ - default: \ - Unreachable(); \ - } /* end switch (nextBlock) */ - #define EndChunk \ } /* end chunk */ @@ -88,6 +70,27 @@ } \ } while (0) +/* ------------------------------------------------- */ +/* ChunkSwitch */ +/* ------------------------------------------------- */ + +#define ChunkSwitch \ + doSwitchNextBlock: \ + switch (nextBlock) { + +#define ChunkSwitchCase(index, label) \ + case index: goto label; + +#define EndChunkSwitch \ + default: \ + Unreachable(); \ + } /* end switch (nextBlock) */ + +#define SwitchNextBlock() \ + if (DEBUG_CCODEGEN) \ + fprintf (stderr, "%s:%d: SwitchNextBlock(nextBlock = %d)\n", \ + __FILE__, __LINE__, (int)nextBlock); \ + goto doSwitchNextBlock /* ------------------------------------------------- */ /* Operands */ From f29a65fcd793f0c23742d7105cd83c11a88b5a2b Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 27 Jun 2019 09:35:20 -0400 Subject: [PATCH 019/102] Silence C compiler warnings about unused parameters/variables Some chunk functions may not use `gcState`, `stackTop`, `frontier`, or `selfChunk`. --- include/c-chunk.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index b6c0746c20..771354bb38 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -45,8 +45,8 @@ /* ------------------------------------------------- */ #define Chunk(n) \ - PRIVATE uintptr_t ChunkName(n)(CPointer gcState, CPointer stackTop, CPointer frontier, uintptr_t nextBlock) { \ - const ChunkFnPtr_t selfChunk = Chunkp(n); \ + PRIVATE uintptr_t ChunkName(n)(UNUSED CPointer gcState, UNUSED CPointer stackTop, UNUSED CPointer frontier, uintptr_t nextBlock) { \ + UNUSED static const ChunkFnPtr_t selfChunk = Chunkp(n); \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: Chunk%d(nextBlock = %d)\n", \ __FILE__, __LINE__, n, (int)nextBlock); \ From 5b6439b73b9eb0ae35a5d33fe80154f516729d36 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 27 Jun 2019 09:46:40 -0400 Subject: [PATCH 020/102] Experiment with forcing jump table for C codegen Using GCC's label address and computed goto features (https://gcc.gnu.org/onlinedocs/gcc/Labels-as-Values.html#Labels-as-Values), one can force the generation of a jump table for the chunk switch. Although GCC and clang will typically implement dense `switch` statements into a jump table, consider the following: switch (nextBlock) { case 5: goto L_5; case 6: goto L_6; ... case 29: goto L_29; default: __builtin_unreachable(); } GCC-7 (and earlier) and clang appear to implement this as: int t = nextBlock - 5 if (t > 24) goto L_29; else goto *jumpTable[i]; That is, it still performs a range comparison. With an explicit jump table, GCC and clang will implement this as: goto *jumpTable[nextBlock - 5]; (where the -5 can be incorporated into the address computation). Unfortunately, the performance impact seems negligible. --- include/c-chunk.h | 20 +++++++++++- mlton/codegen/c-codegen/c-codegen.fun | 46 +++++++++++++++++++-------- 2 files changed, 51 insertions(+), 15 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 771354bb38..139073c96c 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -74,7 +74,23 @@ /* ChunkSwitch */ /* ------------------------------------------------- */ -#define ChunkSwitch \ +#if JumpTable + +#define ChunkSwitch(firstIndex, length) \ + static const uintptr_t nextLabelsBias = firstIndex; \ + static const void* nextLabels[length] = { + +#define ChunkSwitchCase(index, label) \ + &&label, + +#define EndChunkSwitch \ + }; \ + doSwitchNextBlock: \ + goto *nextLabels[nextBlock - nextLabelsBias]; + +#else + +#define ChunkSwitch(firstIndex, length) \ doSwitchNextBlock: \ switch (nextBlock) { @@ -86,6 +102,8 @@ Unreachable(); \ } /* end switch (nextBlock) */ +#endif + #define SwitchNextBlock() \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: SwitchNextBlock(nextBlock = %d)\n", \ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 5ffc6876a2..94b8d27b1a 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1189,17 +1189,32 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, ; C.callNoSemi ("Chunk", [chunkLabelIndexAsString chunkLabel], print); print "\n" ; declareCReturns (); print "\n" ; declareRegisters (); print "\n" - ; print "ChunkSwitch\n" - ; Vector.foreach (blocks, fn Block.T {kind, label, ...} => - if Kind.isEntry kind - then (C.callNoSemi ("ChunkSwitchCase", - [labelIndexAsString (label, {pretty = false}), - Label.toString label], - print) - ; print "\n" - ; visit label) - else ()) - ; print "EndChunkSwitch\n\n" + ; let + val entries = ref [] + val () = + Vector.foreach + (blocks, fn Block.T {kind, label, ...} => + if Kind.isEntry kind + then (List.push (entries, (label, valOf (labelIndex label))) + ; visit label) + else ()) + val entries = List.insertionSort (!entries, fn ((_, i1), (_, i2)) => i1 <= i2) + in + C.callNoSemi ("ChunkSwitch", + [C.int (#2 (List.first entries)), + C.int (List.length entries)], + print) + ; print "\n" + ; List.foreach + (entries, fn (label, index) => + (C.callNoSemi ("ChunkSwitchCase", + [C.int index, + Label.toString label], + print) + ; print "\n" + ; visit label)) + ; print "EndChunkSwitch\n\n" + end ; List.foreach (List.rev (!dfsBlocks), outputBlock) ; print "EndChunk\n\n" end @@ -1217,9 +1232,12 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, print (concat ["#define ", name, " ", Bytes.toString (GCField.offset f), "\n"])) in - (print "#define TailCall " - ; print (C.bool (!Control.chunkTailCall)) - ; print "\n") + print "#define JumpTable " + ; print (C.bool (!Control.chunkJumpTable)) + ; print "\n" + ; print "#define TailCall " + ; print (C.bool (!Control.chunkTailCall)) + ; print "\n" ; outputIncludes (["c-chunk.h"], print); print "\n" ; outputOffsets (); print "\n" ; declareGlobals ("PRIVATE extern ", print); print "\n" From 62f07c513cd378c2bffb0fa658c317b93cb2eaa7 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 27 Jun 2019 10:33:30 -0400 Subject: [PATCH 021/102] Silence C compiler warning about addresses always evaluating to `true` --- include/c-chunk.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 139073c96c..e543800749 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -198,7 +198,7 @@ if (mustReturnToSelf \ || (mayReturnToSelf && (nextChunk == selfChunk))) { \ SwitchNextBlock(); \ - } else if (mustReturnToOther) { \ + } else if ((void*)mustReturnToOther != NULL) { \ LeaveChunk((*mustReturnToOther), nextBlock); \ } else { \ LeaveChunk((*nextChunk), nextBlock); \ From b6456a2262d5bf26fbae5d7d5308d0feec0699f2 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 27 Jun 2019 22:19:16 -0400 Subject: [PATCH 022/102] Add and use `%ChunkFn{,Ptr{,Arr}}_t` typedefs in LLVM codegen --- mlton/codegen/llvm-codegen/llvm-codegen.fun | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 8acca7a93d..5e3f718b62 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -51,6 +51,11 @@ val mltypes = \%CPointer = type i8*\n\ \%Objptr = type i8*\n" +val chunkfntypes = "\ +\%ChunkFn_t = type %uintptr_t(%CPointer,%CPointer,%CPointer,%uintptr_t)\n\ +\%ChunkFnPtr_t = type %ChunkFn_t*\n\ +\%ChunkFnPtrArr_t = type [0 x %ChunkFnPtr_t]\n" + val llvmIntrinsics = "declare float @llvm.sqrt.f32(float %Val)\n\ \declare double @llvm.sqrt.f64(double %Val)\n\ @@ -1195,6 +1200,7 @@ fun outputLLVMDeclarations print = end)) in print (concat [llvmIntrinsics, "\n", mltypes, "\n", ctypes (), + "\n", chunkfntypes, "\n", globals, "\n"]) end @@ -1250,12 +1256,12 @@ fun outputChunkFn (cxt, chunk, print) = then let val chkFnPtrPtrReg = nextLLVMReg () val () = print (concat ["\t", chkFnPtrPtrReg, " = getelementptr inbounds ", - "[0 x %uintptr_t(%CPointer,%CPointer,%CPointer,%uintptr_t)*], ", - "[0 x %uintptr_t(%CPointer,%CPointer,%CPointer,%uintptr_t)*]* @nextChunks, ", + "%ChunkFnPtrArr_t, ", + "%ChunkFnPtrArr_t* @nextChunks, ", "i64 0, ", "%uintptr_t ", nextBlockReg, "\n"]) val chkFnPtrReg = nextLLVMReg () - val () = print (mkload (chkFnPtrReg, "%uintptr_t(%CPointer,%CPointer,%CPointer,%uintptr_t)**", chkFnPtrPtrReg)) + val () = print (mkload (chkFnPtrReg, "%ChunkFnPtr_t*", chkFnPtrPtrReg)) val stackTopArg = nextLLVMReg () val frontierArg = nextLLVMReg () val () = print (mkload (stackTopArg, "%CPointer*", "%stackTop")) @@ -1305,7 +1311,7 @@ fun outputChunks (cxt, chunks, val Program.T {chunks, ...} = program in List.foreach (chunks, declareChunk) - ; print "@nextChunks = external hidden global [0 x %uintptr_t(%CPointer,%CPointer,%CPointer,%uintptr_t)*]\n" + ; print "@nextChunks = external hidden global %ChunkFnPtrArr_t\n" ; print "\n\n" end val () = List.foreach (chunks, fn chunk => outputChunkFn (cxt, chunk, print)) From 1ea83b587a1d2d986beed61a9c7224081bcbc715 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 28 Jun 2019 11:13:24 -0400 Subject: [PATCH 023/102] Share code for `Raise` and `Return` in C codegen --- mlton/codegen/c-codegen/c-codegen.fun | 114 +++++++++----------------- 1 file changed, 40 insertions(+), 74 deletions(-) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 94b8d27b1a..4fdfeda987 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -894,6 +894,44 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, fun outputTransfer t = let datatype z = datatype Transfer.t + fun rtrans (name, rsTo) = + let + fun isSelf c = ChunkLabel.equals (chunkLabel, c) + val rsTo = + List.fold + (rsTo, [], fn (l, cs) => + let + val c = labelChunk l + in + if List.exists (cs, fn c' => ChunkLabel.equals (c, c')) + then cs + else c::cs + end) + val mayRToSelf = List.exists (rsTo, isSelf) + val (mustRToSelf, mustRToOther) = + case List.revKeepAll (rsTo, not o isSelf) of + [] => (true, NONE) + | c::rsTo => + (false, + List.fold (rsTo, SOME c, fn (c', co) => + case co of + NONE => NONE + | SOME c => if ChunkLabel.equals (c, c') + then SOME c + else NONE)) + in + print "\t" + ; C.call (name, + [C.bool mustRToSelf, + C.bool mayRToSelf, + case mustRToOther of + NONE => "(ChunkFnPtr_t)NULL" + | SOME otherChunk => + concat ["Chunkp (", + chunkLabelIndexAsString otherChunk, + ")"]], + print) + end in case t of CCall {func = @@ -995,80 +1033,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, print) end | Goto dst => gotoLabel (dst, {tab = true}) - | Raise {raisesTo} => - let - fun isSelf c = ChunkLabel.equals (chunkLabel, c) - val raisesTo = - List.fold - (raisesTo, [], fn (l, cs) => - let - val c = labelChunk l - in - if List.exists (cs, fn c' => ChunkLabel.equals (c, c')) - then cs - else c::cs - end) - val mayRaiseToSelf = List.exists (raisesTo, isSelf) - val (mustRaiseToSelf, mustRaiseToOther) = - case List.revKeepAll (raisesTo, not o isSelf) of - [] => (true, NONE) - | c::raisesTo => - (false, - List.fold (raisesTo, SOME c, fn (c', co) => - case co of - NONE => NONE - | SOME c => if ChunkLabel.equals (c, c') - then SOME c - else NONE)) - in - C.call ("\tRaise", - [C.bool mustRaiseToSelf, - C.bool mayRaiseToSelf, - case mustRaiseToOther of - NONE => "(ChunkFnPtr_t)NULL" - | SOME otherChunk => - concat ["Chunkp (", - chunkLabelIndexAsString otherChunk, - ")"]], - print) - end - | Return {returnsTo} => - let - fun isSelf c = ChunkLabel.equals (chunkLabel, c) - val returnsTo = - List.fold - (returnsTo, [], fn (l, cs) => - let - val c = labelChunk l - in - if List.exists (cs, fn c' => ChunkLabel.equals (c, c')) - then cs - else c::cs - end) - val mayReturnToSelf = List.exists (returnsTo, isSelf) - val (mustReturnToSelf, mustReturnToOther) = - case List.revKeepAll (returnsTo, not o isSelf) of - [] => (true, NONE) - | c::returnsTo => - (false, - List.fold (returnsTo, SOME c, fn (c', co) => - case co of - NONE => NONE - | SOME c => if ChunkLabel.equals (c, c') - then SOME c - else NONE)) - in - C.call ("\tReturn", - [C.bool mustReturnToSelf, - C.bool mayReturnToSelf, - case mustReturnToOther of - NONE => "(ChunkFnPtr_t)NULL" - | SOME otherChunk => - concat ["Chunkp (", - chunkLabelIndexAsString otherChunk, - ")"]], - print) - end + | Raise {raisesTo} => rtrans ("Raise", raisesTo) + | Return {returnsTo} => rtrans ("Return", returnsTo) | Switch switch => let val Switch.T {cases, default, test, ...} = switch From edbf6c9b079dc8903b6670f7d4393e1787632b47 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 1 Jul 2019 09:30:47 -0400 Subject: [PATCH 024/102] Eliminate `DeclareChunk` macro --- include/c-common.h | 2 -- mlton/codegen/c-codegen/c-codegen.fun | 8 +++++--- mlton/codegen/llvm-codegen/llvm-codegen.fun | 8 +++++--- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/include/c-common.h b/include/c-common.h index fdc6b0fca6..f5ef7cfe07 100644 --- a/include/c-common.h +++ b/include/c-common.h @@ -21,8 +21,6 @@ typedef ChunkFn_t *ChunkFnPtr_t; #define ChunkName(n) Chunk ## n -#define DeclareChunk(n) PRIVATE extern ChunkFn_t ChunkName(n); - #define Chunkp(n) &(ChunkName(n)) #endif /* #ifndef _C_COMMON_H_ */ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 4fdfeda987..fac65fa3c8 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -626,9 +626,11 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, val chunkLabelIndexAsString = C.int o chunkLabelIndex fun declareChunk (chunkLabel, print) = - C.call ("DeclareChunk", - [chunkLabelIndexAsString chunkLabel], - print) + (print "PRIVATE extern ChunkFn_t " + ; C.callNoSemi ("ChunkName", + [chunkLabelIndexAsString chunkLabel], + print) + ; print ";\n") fun defineNextChunks print = (List.foreach (chunks, fn Chunk.T {chunkLabel, ...} => declareChunk (chunkLabel, print)) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 5e3f718b62..90be076c95 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -1427,9 +1427,11 @@ fun transC (cxt, outputC) = fun defineNextChunks print = (List.foreach (chunks, fn Chunk.T {chunkLabel, ...} => - C.call ("DeclareChunk", - [chunkLabelIndexAsString chunkLabel], - print)) + (print "PRIVATE extern ChunkFn_t " + ; C.callNoSemi ("ChunkName", + [chunkLabelIndexAsString chunkLabel], + print) + ; print ";\n")) ; print "PRIVATE ChunkFnPtr_t nextChunks[" ; print (C.int (Vector.length nextChunks)) ; print "] = {\n" From 25138bcb7573686d98700813cd383e4bf02ce512 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 1 Jul 2019 09:56:47 -0400 Subject: [PATCH 025/102] Eliminate `ChunkName` and `Chunkp` macros --- include/c-chunk.h | 18 ++++----- include/c-common.h | 4 -- mlton/codegen/c-codegen/c-codegen.fun | 41 ++++++++------------- mlton/codegen/llvm-codegen/llvm-codegen.fun | 33 +++++++---------- 4 files changed, 39 insertions(+), 57 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index e543800749..a030528e0c 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -44,15 +44,15 @@ /* Chunk */ /* ------------------------------------------------- */ -#define Chunk(n) \ - PRIVATE uintptr_t ChunkName(n)(UNUSED CPointer gcState, UNUSED CPointer stackTop, UNUSED CPointer frontier, uintptr_t nextBlock) { \ - UNUSED static const ChunkFnPtr_t selfChunk = Chunkp(n); \ +#define DefineChunk(chunkName) \ + PRIVATE uintptr_t chunkName(UNUSED CPointer gcState, UNUSED CPointer stackTop, UNUSED CPointer frontier, uintptr_t nextBlock) { \ + UNUSED static const ChunkFnPtr_t selfChunk = &(chunkName); \ if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: Chunk%d(nextBlock = %d)\n", \ - __FILE__, __LINE__, n, (int)nextBlock); \ + fprintf (stderr, "%s:%d: %s(nextBlock = %d)\n", \ + __FILE__, __LINE__, #chunkName, (int)nextBlock); \ SwitchNextBlock(); -#define EndChunk \ +#define EndDefineChunk \ } /* end chunk */ #define LeaveChunk(nextChunk, nextBlock) \ @@ -183,9 +183,9 @@ #define FarCall(nextChunk, nextBlock) \ do { \ if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: FarCall(%d, %d)\n", \ - __FILE__, __LINE__, (int)nextChunk, (int)nextBlock); \ - LeaveChunk(ChunkName(nextChunk), nextBlock); \ + fprintf (stderr, "%s:%d: FarCall(%s, %d)\n", \ + __FILE__, __LINE__, #nextChunk, (int)nextBlock); \ + LeaveChunk(nextChunk, nextBlock); \ } while (0) #define Return(mustReturnToSelf,mayReturnToSelf,mustReturnToOther) \ diff --git a/include/c-common.h b/include/c-common.h index f5ef7cfe07..e8d6be8de8 100644 --- a/include/c-common.h +++ b/include/c-common.h @@ -19,8 +19,4 @@ typedef uintptr_t ChunkFn_t (CPointer, CPointer, CPointer, uintptr_t); typedef ChunkFn_t *ChunkFnPtr_t; -#define ChunkName(n) Chunk ## n - -#define Chunkp(n) &(ChunkName(n)) - #endif /* #ifndef _C_COMMON_H_ */ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index fac65fa3c8..b90d8179fe 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -624,12 +624,11 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, end val chunkLabelIndex = #index o chunkLabelInfo val chunkLabelIndexAsString = C.int o chunkLabelIndex + fun chunkName c = concat ["Chunk", chunkLabelIndexAsString c] - fun declareChunk (chunkLabel, print) = + fun declareChunk (chunkLabel, print: string -> unit) = (print "PRIVATE extern ChunkFn_t " - ; C.callNoSemi ("ChunkName", - [chunkLabelIndexAsString chunkLabel], - print) + ; print (chunkName chunkLabel) ; print ";\n") fun defineNextChunks print = (List.foreach (chunks, fn Chunk.T {chunkLabel, ...} => @@ -639,21 +638,15 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, ; print "] = {\n" ; Vector.foreachi (nextChunks, fn (i, label) => - let - val {chunkLabel, ...} = labelInfo label - in - print "\t" - ; print "/* " - ; print (C.int i) - ; print ": */ " - ; print "/* " - ; print (Label.toString label) - ; print " */ " - ; C.callNoSemi ("Chunkp", - [chunkLabelIndexAsString chunkLabel], - print) - ; print ",\n" - end) + (print "\t" + ; print "/* " + ; print (C.int i) + ; print ": */ " + ; print "/* " + ; print (Label.toString label) + ; print " */ &(" + ; print (chunkName (labelChunk label)) + ; print "),\n")) ; print "};\n") fun declareNextChunks (chunks, print) = let @@ -929,9 +922,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, case mustRToOther of NONE => "(ChunkFnPtr_t)NULL" | SOME otherChunk => - concat ["Chunkp (", - chunkLabelIndexAsString otherChunk, - ")"]], + concat ["&(", chunkName otherChunk, ")"]], print) end in @@ -1030,7 +1021,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, [Label.toString label], print) else C.call ("\tFarCall", - [chunkLabelIndexAsString dstChunk, + [chunkName dstChunk, labelIndexAsString (label, {pretty = true})], print) end @@ -1154,7 +1145,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, end in declareProfileLabels () - ; C.callNoSemi ("Chunk", [chunkLabelIndexAsString chunkLabel], print); print "\n" + ; C.callNoSemi ("DefineChunk", [chunkName chunkLabel], print); print "\n" ; declareCReturns (); print "\n" ; declareRegisters (); print "\n" ; let @@ -1184,7 +1175,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, ; print "EndChunkSwitch\n\n" end ; List.foreach (List.rev (!dfsBlocks), outputBlock) - ; print "EndChunk\n\n" + ; print "EndDefineChunk\n\n" end fun outputChunks chunks = diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 90be076c95..9cad61c9cb 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -25,8 +25,7 @@ datatype z = datatype WordSize.prim be shared amongst all codegen functions. *) datatype Context = Context of { program: Program.t, - chunkLabelIndex: ChunkLabel.t -> int, - chunkLabelIndexAsString: ChunkLabel.t -> string, + chunkName: ChunkLabel.t -> string, labelChunk: Label.t -> ChunkLabel.t, labelIndexAsString: Label.t -> string, nextChunks: Label.t vector @@ -921,7 +920,7 @@ fun outputStatement (cxt: Context, stmt: Statement.t): string = fun outputTransfer (cxt, transfer, sourceLabel) = let val comment = concat ["\t; ", Layout.toString (Transfer.layout transfer), "\n"] - val Context { chunkLabelIndexAsString, labelChunk, labelIndexAsString, ... } = cxt + val Context { chunkName, labelChunk, labelIndexAsString, ... } = cxt fun transferPush (return, size) = let val offset = llbytes (Bytes.- (size, Runtime.labelSize ())) @@ -1073,7 +1072,7 @@ fun outputTransfer (cxt, transfer, sourceLabel) = val resReg = nextLLVMReg () val call = concat ["\t", resReg, " = musttail call ", "%uintptr_t ", - "@Chunk", chunkLabelIndexAsString dstChunk, "(", + "@", chunkName dstChunk, "(", "%CPointer ", "%gcState", ", ", "%CPointer ", stackTopArg, ", ", "%CPointer ", frontierArg, ", ", @@ -1207,10 +1206,10 @@ fun outputLLVMDeclarations print = fun outputChunkFn (cxt, chunk, print) = let val () = resetLLVMReg () - val Context { chunkLabelIndexAsString, labelIndexAsString, ... } = cxt + val Context { chunkName, labelIndexAsString, ... } = cxt val Chunk.T {blocks, chunkLabel, regMax} = chunk val () = print (concat ["define hidden %uintptr_t @", - "Chunk" ^ chunkLabelIndexAsString chunkLabel, + chunkName chunkLabel, "(%CPointer %gcState, %CPointer %stackTopArg, %CPointer %frontierArg, %uintptr_t %nextBlockArg) {\nentry:\n"]) val () = print "\t%stackTop = alloca %CPointer\n" val () = print "\t%frontier = alloca %CPointer\n" @@ -1294,7 +1293,7 @@ fun outputChunks (cxt, chunks, print: string -> unit, done: unit -> unit}) = let - val Context { chunkLabelIndexAsString, program, ... } = cxt + val Context { chunkName, program, ... } = cxt val () = cFunctions := [] val () = ffiSymbols := [] val { done, print, file=_ } = outputLL () @@ -1306,7 +1305,7 @@ fun outputChunks (cxt, chunks, ChunkLabel.equals (chunkLabel, Chunk.chunkLabel chunk)) then () else print (concat ["declare hidden %uintptr_t @", - "Chunk" ^ chunkLabelIndexAsString chunkLabel, + chunkName chunkLabel, "(%CPointer,%CPointer,%CPointer,%uintptr_t)\n"]) val Program.T {chunks, ...} = program in @@ -1379,11 +1378,11 @@ fun makeContext program = fun labelIndexAsString (l: Label.t): string = llint (labelIndex l) val chunkLabelIndex = #index o chunkLabelInfo val chunkLabelIndexAsString = llint o chunkLabelIndex + fun chunkName c = concat ["Chunk", chunkLabelIndexAsString c] in Context { program = program, labelIndexAsString = labelIndexAsString, - chunkLabelIndex = chunkLabelIndex, - chunkLabelIndexAsString = chunkLabelIndexAsString, + chunkName = chunkName, labelChunk = labelChunk, nextChunks = nextChunks } @@ -1422,15 +1421,13 @@ fun transC (cxt, outputC) = let val Context { program, ... } = cxt val Program.T {main = main, chunks = chunks, ... } = program - val Context { chunkLabelIndexAsString, labelChunk, labelIndexAsString, nextChunks, ... } = cxt + val Context { chunkName, labelChunk, labelIndexAsString, nextChunks, ... } = cxt fun defineNextChunks print = (List.foreach (chunks, fn Chunk.T {chunkLabel, ...} => (print "PRIVATE extern ChunkFn_t " - ; C.callNoSemi ("ChunkName", - [chunkLabelIndexAsString chunkLabel], - print) + ; print (chunkName chunkLabel) ; print ";\n")) ; print "PRIVATE ChunkFnPtr_t nextChunks[" ; print (C.int (Vector.length nextChunks)) @@ -1443,11 +1440,9 @@ fun transC (cxt, outputC) = ; print ": */ " ; print "/* " ; print (Label.toString label) - ; print " */ " - ; C.callNoSemi ("Chunkp", - [chunkLabelIndexAsString (labelChunk label)], - print) - ; print ",\n")) + ; print " */ &(" + ; print (chunkName (labelChunk label)) + ; print "),\n")) ; print "};\n") val {print, done, file = _} = outputC () From 69d4444dda46fb6c7043072672d6ebe97f202553 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 12 Jul 2019 16:26:39 -0400 Subject: [PATCH 026/102] Update LLVM codegen to match C codegen * Make `ChunkSwitch` exhaustive * Use direct call in `Return` when exactly one non-self target chunk --- mlton/codegen/llvm-codegen/llvm-codegen.fun | 266 ++++++++++++-------- 1 file changed, 161 insertions(+), 105 deletions(-) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 9cad61c9cb..2ee232bfda 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -369,26 +369,6 @@ fun cacheStackTop () = concat [comment, pre, load, store] end -(* nextBlock = *(uintptr_t* )(StackTop - sizeof(void* )); - goto doSwitchNextBlock; - *) -fun callReturn () = - let - val stacktop = nextLLVMReg () - val loadst = mkload (stacktop, "%CPointer*", "%stackTop") - val ptrsize = (llbytes o Bits.toBytes o Control.Target.Size.cpointer) () - val ptr = nextLLVMReg () - val gep = mkgep (ptr, "%CPointer", stacktop, [("i32", "-" ^ ptrsize)]) - val castreg = nextLLVMReg () - val cast = mkconv (castreg, "bitcast", "%CPointer", ptr, "%uintptr_t*") - val loadreg = nextLLVMReg () - val loadofs = mkload (loadreg, "%uintptr_t*", castreg) - val store = mkstore ("%uintptr_t", loadreg, "%nextBlock") - val br = "\tbr label %doSwitchNextBlock\n" - in - concat [loadst, gep, cast, loadofs, store, br] - end - fun stackPush amt = let val stacktop = nextLLVMReg () @@ -917,7 +897,103 @@ fun outputStatement (cxt: Context, stmt: Statement.t): string = concat [comment, stmtcode] end -fun outputTransfer (cxt, transfer, sourceLabel) = +(* LeaveChunk(nextChunk, nextBlock) + + if (TailCall) { + return nextChunk(gcState, stackTop, frontier, nextBlock); + } else { + FlushFrontier(); + FlushStackTop(); + return nextBlock; + } +*) +fun leaveChunk (nextChunk, nextBlock) = + if !Control.chunkTailCall + then let + val stackTopArg = nextLLVMReg () + val frontierArg = nextLLVMReg () + val resReg = nextLLVMReg () + in + concat + [mkload (stackTopArg, "%CPointer*", "%stackTop"), + mkload (frontierArg, "%CPointer*", "%frontier"), + "\t", resReg, " = musttail call %uintptr_t ", + nextChunk, "(", + "%CPointer ", "%gcState", ", ", + "%CPointer ", stackTopArg, ", ", + "%CPointer ", frontierArg, ", ", + "%uintptr_t ", nextBlock, ")\n", + "\tret %uintptr_t ", resReg, "\n"] + end + else concat [flushFrontier (), + flushStackTop (), + "\tret %uintptr_t ", nextBlock, "\n"] + +(* Return(mustReturnToSelf, mayReturnToSelf, mustReturnToOther) + + nextBlock = *(uintptr_t* )(StackTop - sizeof(uintptr_t)); + ChunkFnPtr_t nextChunk = nextChunks[nextBlock]; + if (mustReturnToSelf || (mayReturnToSelf && (nextChunk == selfChunk))) { + goto doSwitchNextBlock; + } else if (mustReturnToOther != NULL) { + LeaveChunk( *mustReturnToOther, nextBlock); + } else { + LeaveChunk( *nextChunk, nextBlock); + } +*) +fun callReturn (cxt, selfChunk, mustReturnToSelf, mayReturnToSelf, mustReturnToOther) = + let + val Context { chunkName, ... } = cxt + val stackTop = nextLLVMReg () + val loadStackTop = mkload (stackTop, "%CPointer*", "%stackTop") + val nextBlock = nextLLVMReg () + val loadNextBlockFromStackTop = + let + val tmp1 = nextLLVMReg () + val tmp2 = nextLLVMReg () + in + concat + [mkgep (tmp1, "%CPointer", stackTop, [("i32", "-" ^ (llbytes (Runtime.labelSize ())))]), + mkconv (tmp2, "bitcast", "%CPointer", tmp1, "%uintptr_t*"), + mkload (nextBlock, "%uintptr_t*", tmp2)] + end + val storeNextBlock = mkstore ("%uintptr_t", nextBlock, "%nextBlock") + val nextChunk = nextLLVMReg () + val loadNextChunk = + let + val tmp = nextLLVMReg () + in + concat + [mkgep (tmp, "%ChunkFnPtrArr_t*", "@nextChunks", + [("i32", "0"), ("%uintptr_t", nextBlock)]), + mkload (nextChunk, "%ChunkFnPtr_t*", tmp)] + end + val returnToSelf = nextLLVMReg () + val computeReturnToSelf = + let + val tmp1 = nextLLVMReg () + val tmp2 = nextLLVMReg () + in + concat + [mkinst (tmp1, "icmp eq", "%ChunkFnPtr_t", nextChunk, concat ["@", chunkName selfChunk]), + mkinst (tmp2, "and", "i1", if mayReturnToSelf then "1" else "0", tmp1), + mkinst (returnToSelf, "or", "i1", if mustReturnToSelf then "1" else "0", tmp2)] + end + val returnToSelfLabel = Label.toString (Label.newNoname ()) + val leaveChunkLabel = Label.toString (Label.newNoname ()) + in + concat + [loadStackTop, loadNextBlockFromStackTop, storeNextBlock, loadNextChunk, computeReturnToSelf, + "\tbr i1 ", returnToSelf, ", label %", returnToSelfLabel, ", label %", leaveChunkLabel, "\n", + returnToSelfLabel, ":\n", + "\tbr label %doSwitchNextBlock\n", + leaveChunkLabel, ":\n", + case mustReturnToOther of + NONE => leaveChunk (nextChunk, nextBlock) + | SOME dstChunk => leaveChunk (concat ["@", chunkName dstChunk], nextBlock)] + end + +fun outputTransfer (cxt, chunkLabel, transfer) = let val comment = concat ["\t; ", Layout.toString (Transfer.layout transfer), "\n"] val Context { chunkName, labelChunk, labelIndexAsString, ... } = cxt @@ -936,6 +1012,34 @@ fun outputTransfer (cxt, transfer, sourceLabel) = in concat [load, gep, cast, storeIndex, pushcode] end + fun rtrans rsTo = + let + fun isSelf c = ChunkLabel.equals (chunkLabel, c) + val rsTo = + List.fold + (rsTo, [], fn (l, cs) => + let + val c = labelChunk l + in + if List.exists (cs, fn c' => ChunkLabel.equals (c, c')) + then cs + else c::cs + end) + val mayRToSelf = List.exists (rsTo, isSelf) + val (mustRToSelf, mustRToOther) = + case List.revKeepAll (rsTo, not o isSelf) of + [] => (true, NONE) + | c::rsTo => + (false, + List.fold (rsTo, SOME c, fn (c', co) => + case co of + NONE => NONE + | SOME c => if ChunkLabel.equals (c, c') + then SOME c + else NONE)) + in + callReturn (cxt, chunkLabel, mustRToSelf, mayRToSelf, mustRToOther) + end in case transfer of Transfer.CCall {func = @@ -1035,7 +1139,7 @@ fun outputTransfer (cxt, transfer, sourceLabel) = val cacheStackTopCode = if CFunction.writesStackTop func then cacheStackTop () else "" val br = if CFunction.maySwitchThreadsFrom func - then callReturn () + then callReturn (cxt, chunkLabel, false, true, NONE) else concat ["\tbr label %", Label.toString return, "\n"] in concat [cacheFrontierCode, cacheStackTopCode, br] @@ -1055,66 +1159,54 @@ fun outputTransfer (cxt, transfer, sourceLabel) = end | Transfer.Call {label, return, ...} => let - val labelstr = Label.toString label val dstChunk = labelChunk label val push = case return of NONE => "" | SOME {return, size, ...} => transferPush (return, size) - val goto = if ChunkLabel.equals (labelChunk sourceLabel, dstChunk) - then concat ["\t; NearCall\n\tbr label %", labelstr, "\n"] - else if !Control.chunkTailCall - then let - val comment = "\t; FarCall\n" - val stackTopArg = nextLLVMReg () - val frontierArg = nextLLVMReg () - val loadStackTop = mkload (stackTopArg, "%CPointer*", "%stackTop") - val loadFrontier = mkload (frontierArg, "%CPointer*", "%frontier") - val resReg = nextLLVMReg () - val call = concat ["\t", resReg, " = musttail call ", - "%uintptr_t ", - "@", chunkName dstChunk, "(", - "%CPointer ", "%gcState", ", ", - "%CPointer ", stackTopArg, ", ", - "%CPointer ", frontierArg, ", ", - "%uintptr_t ", labelIndexAsString label, ")\n"] - val ret = concat ["\tret %uintptr_t ", resReg, "\n"] - in - concat [comment, loadStackTop, loadFrontier, call, ret] - end - else let - val comment = "\t; FarCall\n" - val ret = concat ["\tret %uintptr_t ", labelIndexAsString label, "\n"] - in - concat [comment, flushFrontier (), flushStackTop (), ret] - end + val call = if ChunkLabel.equals (chunkLabel, dstChunk) + then concat ["\t; NearCall\n", + "\tbr label %", Label.toString label, "\n"] + else concat ["\t; FarCall\n", + leaveChunk (concat ["@", chunkName dstChunk], + labelIndexAsString label)] in - concat [push, goto] + concat [push, call] end | Transfer.Goto label => let - val labelString = Label.toString label - val goto = concat ["\tbr label %", labelString, "\n"] + val goto = concat ["\tbr label %", Label.toString label, "\n"] in concat [comment, goto] end - | Transfer.Raise _ => + | Transfer.Raise {raisesTo} => let val comment = "\t; Raise\n" (* StackTop = StackBottom + ExnStack *) val (sbpre, sbreg) = offsetGCState (GCField.StackBottom, "%CPointer*") val stackBottom = nextLLVMReg () val loadStackBottom = mkload (stackBottom, "%CPointer*", sbreg) - val (espre, esreg) = offsetGCState (GCField.ExnStack, "i32*") + val exnStackTy = llty (Type.exnStack ()) + val (espre, esreg) = offsetGCState (GCField.ExnStack, exnStackTy ^ "*") val exnStack = nextLLVMReg () - val loadExnStack = mkload (exnStack, "i32*", esreg) - val sum = nextLLVMReg () - val gep = mkgep (sum, "%CPointer", stackBottom, [("i32", exnStack)]) - val store = mkstore ("%CPointer", sum, "%stackTop") + val loadExnStack = mkload (exnStack, exnStackTy ^ "*", esreg) + val sumReg = nextLLVMReg () + val sum = mkgep (sumReg, "%CPointer", stackBottom, [(exnStackTy, exnStack)]) + val storeStackTop = mkstore ("%CPointer", sumReg, "%stackTop") in - concat [comment, sbpre, loadStackBottom, espre, loadExnStack, gep, store, - callReturn()] + concat [comment, + sbpre, loadStackBottom, + espre, loadExnStack, + sum, + storeStackTop, + rtrans raisesTo] + end + | Transfer.Return {returnsTo} => + let + val comment = "\t; Return\n" + in + concat [comment, + rtrans returnsTo] end - | Transfer.Return _ => concat ["\t; Return\n", callReturn ()] | Transfer.Switch switch => let val Switch.T {cases, default, test, ...} = switch @@ -1126,8 +1218,7 @@ fun outputTransfer (cxt, transfer, sourceLabel) = val d = Label.newNoname () in (d, - concat ["\n", - Label.toString d, ":\n", + concat [Label.toString d, ":\n", "\tunreachable\n"]) end in @@ -1143,7 +1234,7 @@ fun outputTransfer (cxt, transfer, sourceLabel) = end end -fun outputBlock (cxt, block) = +fun outputBlock (cxt, chunkLabel, block) = let val Block.T {kind, label, statements, transfer, ...} = block val labelstr = Label.toString label @@ -1180,7 +1271,7 @@ fun outputBlock (cxt, block) = | _ => "" val outputStatementWithCxt = fn s => outputStatement (cxt, s) val blockBody = String.concatV (Vector.map (statements, outputStatementWithCxt)) - val blockTransfer = outputTransfer (cxt, transfer, label) + val blockTransfer = outputTransfer (cxt, chunkLabel, transfer) in concat [blockLabel, dopop, blockBody, blockTransfer, "\n"] end @@ -1235,7 +1326,7 @@ fun outputChunkFn (cxt, chunk, print) = val tmp = nextLLVMReg () val () = print (mkload (tmp, "%uintptr_t*", "%nextBlock")) val () = print (concat ["\tswitch %uintptr_t ", tmp, - ", label %doSwitchNextBlockDefault [\n"]) + ", label %switchNextBlockDefault [\n"]) val () = Vector.foreach (blocks, fn Block.T {kind, label, ...} => if Kind.isEntry kind then print (concat ["\t\t%uintptr_t ", @@ -1245,44 +1336,9 @@ fun outputChunkFn (cxt, chunk, print) = "\n"]) else ()) val () = print "\t]\n\n" - val () = print (String.concatV (Vector.map (blocks, fn b => outputBlock (cxt, b)))) - val () = print "doSwitchNextBlockDefault:\n" - val () = print "\tbr label %doLeaveChunk\n\n" - val () = print "doLeaveChunk:\n" - val nextBlockReg = nextLLVMReg () - val () = print (mkload (nextBlockReg, "%uintptr_t*", "%nextBlock")) - val resReg = if !Control.chunkTailCall - then let - val chkFnPtrPtrReg = nextLLVMReg () - val () = print (concat ["\t", chkFnPtrPtrReg, " = getelementptr inbounds ", - "%ChunkFnPtrArr_t, ", - "%ChunkFnPtrArr_t* @nextChunks, ", - "i64 0, ", - "%uintptr_t ", nextBlockReg, "\n"]) - val chkFnPtrReg = nextLLVMReg () - val () = print (mkload (chkFnPtrReg, "%ChunkFnPtr_t*", chkFnPtrPtrReg)) - val stackTopArg = nextLLVMReg () - val frontierArg = nextLLVMReg () - val () = print (mkload (stackTopArg, "%CPointer*", "%stackTop")) - val () = print (mkload (frontierArg, "%CPointer*", "%frontier")) - val resReg = nextLLVMReg () - val () = print (concat ["\t", resReg, " = musttail call ", - "%uintptr_t ", - chkFnPtrReg, "(", - "%CPointer ", "%gcState", ", ", - "%CPointer ", stackTopArg, ", ", - "%CPointer ", frontierArg, ", ", - "%uintptr_t ", nextBlockReg, ")\n"]) - in - resReg - end - else let - val () = print (flushFrontier ()) - val () = print (flushStackTop ()) - in - nextBlockReg - end - val () = print (concat ["\tret %uintptr_t ", resReg, "\n"]) + val () = print "switchNextBlockDefault:\n" + val () = print "\tunreachable\n\n" + val () = print (String.concatV (Vector.map (blocks, fn b => outputBlock (cxt, chunkLabel, b)))) val () = print "}\n\n" in () From 25b1991c67fc5d30597a2d6021a22d3c11bace10 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 12 Jul 2019 16:53:42 -0400 Subject: [PATCH 027/102] Add and use `Machine.Operand.gcField` --- mlton/backend/backend.fun | 5 +---- mlton/backend/machine.fun | 5 +++++ mlton/backend/machine.sig | 1 + 3 files changed, 7 insertions(+), 4 deletions(-) diff --git a/mlton/backend/backend.fun b/mlton/backend/backend.fun index faa4e099dc..150cb627c5 100644 --- a/mlton/backend/backend.fun +++ b/mlton/backend/backend.fun @@ -405,10 +405,7 @@ fun toMachine (rssa: Rssa.Program.t) = case field of GCField.Frontier => M.Operand.Frontier | GCField.StackTop => M.Operand.StackTop - | _ => - M.Operand.Offset {base = M.Operand.GCState, - offset = GCField.offset field, - ty = Type.ofGCField field} + | _ => M.Operand.gcField field val exnStackOp = runtimeOp GCField.ExnStack val stackBottomOp = runtimeOp GCField.StackBottom val stackTopOp = runtimeOp GCField.StackTop diff --git a/mlton/backend/machine.fun b/mlton/backend/machine.fun index 3ba08ae90a..44ca91e66d 100644 --- a/mlton/backend/machine.fun +++ b/mlton/backend/machine.fun @@ -257,6 +257,11 @@ structure Operand = | (Word w, Word w') => WordX.equals (w, w') | _ => false + fun gcField field = + Offset {base = GCState, + offset = Runtime.GCField.offset field, + ty = Type.ofGCField field} + val stackOffset = StackOffset o StackOffset.T fun interfere (write: t, read: t): bool = diff --git a/mlton/backend/machine.sig b/mlton/backend/machine.sig index 4276dcfd01..239f206e72 100644 --- a/mlton/backend/machine.sig +++ b/mlton/backend/machine.sig @@ -86,6 +86,7 @@ signature MACHINE = val isLocation: t -> bool val layout: t -> Layout.t val stackOffset: {offset: Bytes.t, ty: Type.t} -> t + val gcField: Runtime.GCField.t -> t val toString: t -> string val ty: t -> Type.t end From 869c4a2bd860b16cd33e62e36bcc88d0dfa7c411 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 12 Jul 2019 16:54:09 -0400 Subject: [PATCH 028/102] Perform `StackTop = StackBottom + ExnStack` in C codegen --- include/c-chunk.h | 12 ------------ mlton/codegen/c-codegen/c-codegen.fun | 13 +++++++++---- 2 files changed, 9 insertions(+), 16 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index a030528e0c..ccd5d2a99a 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -124,9 +124,7 @@ #define Frontier frontier #define StackTop stackTop -#define ExnStack *(size_t*)(GCState + ExnStackOffset) #define FrontierMem *(Pointer*)(GCState + FrontierOffset) -#define StackBottom *(Pointer*)(GCState + StackBottomOffset) #define StackTopMem *(Pointer*)(GCState + StackTopOffset) /* ------------------------------------------------- */ @@ -205,16 +203,6 @@ } \ } while (0) -#define Raise(mustRaiseToSelf,mayRaiseToSelf,mustRaiseToOther) \ - do { \ - if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: Raise()\n", \ - __FILE__, __LINE__); \ - StackTop = StackBottom + ExnStack; \ - Return(mustRaiseToSelf,mayRaiseToSelf,mustRaiseToOther); \ - } while (0) - - /* ------------------------------------------------- */ /* Calling SML from C */ /* ------------------------------------------------- */ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index b90d8179fe..85e9e53195 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1026,7 +1026,14 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, print) end | Goto dst => gotoLabel (dst, {tab = true}) - | Raise {raisesTo} => rtrans ("Raise", raisesTo) + | Raise {raisesTo} => + (outputStatement (Statement.PrimApp + {args = Vector.new2 + (Operand.gcField GCField.StackBottom, + Operand.gcField GCField.ExnStack), + dst = SOME Operand.StackTop, + prim = Prim.cpointerAdd}) + ; rtrans ("Return", raisesTo)) | Return {returnsTo} => rtrans ("Return", returnsTo) | Switch switch => let @@ -1183,9 +1190,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, val {done, print, ...} = outputC () fun outputOffsets () = List.foreach - ([("ExnStackOffset", GCField.ExnStack), - ("FrontierOffset", GCField.Frontier), - ("StackBottomOffset", GCField.StackBottom), + ([("FrontierOffset", GCField.Frontier), ("StackTopOffset", GCField.StackTop)], fn (name, f) => print (concat ["#define ", name, " ", From 8212ae35721713e17d9477a409e6c6fdcee961a9 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 12 Jul 2019 16:58:21 -0400 Subject: [PATCH 029/102] "%Pointer" type defn is not used by LLVM codegen --- mlton/codegen/llvm-codegen/llvm-codegen.fun | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 2ee232bfda..47a4d85b6b 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -36,7 +36,6 @@ fun ctypes () = val mltypes = "; ML types\n\ -\%Pointer = type i8*\n\ \%Int8 = type i8\n\ \%Int16 = type i16\n\ \%Int32 = type i32\n\ @@ -221,8 +220,7 @@ fun typeOfGlobal global = fun getTypeFromPointer (typ: string):string = case typ of - "%Pointer" => "i8" - | "%CPointer" => "i8" + "%CPointer" => "i8" | "%Objptr" => "i8" | t => let From fb54dcfba8ed2ed5cf0ad43b7898810c98ead851 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 12 Jul 2019 22:28:39 -0400 Subject: [PATCH 030/102] Eliminate unnecessary cast in translation of SetExnStackLocal --- mlton/backend/backend.fun | 20 +++++++------------- 1 file changed, 7 insertions(+), 13 deletions(-) diff --git a/mlton/backend/backend.fun b/mlton/backend/backend.fun index 150cb627c5..c25ca6e7fc 100644 --- a/mlton/backend/backend.fun +++ b/mlton/backend/backend.fun @@ -488,14 +488,11 @@ fun toMachine (rssa: Rssa.Program.t) = | SetExnStackLocal => (* ExnStack = stackTop + (handlerOffset + LABEL_SIZE) - StackBottom; *) let - val tmp1 = + val tmp = M.Operand.Register (Register.new (Type.cpointer (), NONE)) - val tmp2 = - M.Operand.Register - (Register.new (Type.csize (), NONE)) in - Vector.new3 + Vector.new2 (M.Statement.PrimApp {args = (Vector.new2 (stackTopOp, @@ -504,16 +501,13 @@ fun toMachine (rssa: Rssa.Program.t) = (Int.toIntInf (Bytes.toInt (Bytes.+ (handlerOffset (), Runtime.labelSize ()))), - WordSize.cpointer ())))), - dst = SOME tmp1, + WordSize.cptrdiff ())))), + dst = SOME tmp, prim = Prim.cpointerAdd}, M.Statement.PrimApp - {args = Vector.new2 (tmp1, stackBottomOp), - dst = SOME tmp2, - prim = Prim.cpointerDiff}, - M.Statement.move - {dst = exnStackOp, - src = M.Operand.Cast (tmp2, Type.exnStack ())}) + {args = Vector.new2 (tmp, stackBottomOp), + dst = SOME exnStackOp, + prim = Prim.cpointerDiff}) end | SetExnStackSlot => (* ExnStack = *(size_t* )(stackTop + linkOffset); *) From 91feb4fe55a28019a12c213e3e13d37578eb953c Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 12 Jul 2019 22:34:50 -0400 Subject: [PATCH 031/102] Change `exnStack` field from `size_t` to `ptrdiff_t` The `exnStack` field stores the difference between `stackTop` and `stackBottom`. --- mlton/backend/backend.fun | 4 ++-- mlton/backend/rep-type.fun | 4 +++- runtime/gc/gc_state.h | 2 +- runtime/gc/thread.c | 6 +++--- runtime/gc/thread.h | 13 +++++++------ 5 files changed, 16 insertions(+), 13 deletions(-) diff --git a/mlton/backend/backend.fun b/mlton/backend/backend.fun index c25ca6e7fc..9b1485b094 100644 --- a/mlton/backend/backend.fun +++ b/mlton/backend/backend.fun @@ -510,7 +510,7 @@ fun toMachine (rssa: Rssa.Program.t) = prim = Prim.cpointerDiff}) end | SetExnStackSlot => - (* ExnStack = *(size_t* )(stackTop + linkOffset); *) + (* ExnStack = *(ptrdiff_t* )(stackTop + linkOffset); *) Vector.new1 (M.Statement.move {dst = exnStackOp, @@ -524,7 +524,7 @@ fun toMachine (rssa: Rssa.Program.t) = ty = Type.label h}, src = M.Operand.Label h}) | SetSlotExnStack => - (* *(size_t* )(stackTop + linkOffset) = ExnStack; *) + (* *(ptrdiff_t* )(stackTop + linkOffset) = ExnStack; *) Vector.new1 (M.Statement.move {dst = M.Operand.stackOffset {offset = linkOffset (), diff --git a/mlton/backend/rep-type.fun b/mlton/backend/rep-type.fun index 1358138890..74106731e1 100644 --- a/mlton/backend/rep-type.fun +++ b/mlton/backend/rep-type.fun @@ -96,9 +96,11 @@ structure Type = val compareRes = word WordSize.compareRes + val cptrdiff: unit -> t = word o WordSize.cptrdiff + val csize: unit -> t = word o WordSize.csize - val exnStack: unit -> t = csize + val exnStack: unit -> t = cptrdiff val gcState: unit -> t = cpointer diff --git a/runtime/gc/gc_state.h b/runtime/gc/gc_state.h index c9adc7ad94..678a7c4c2c 100644 --- a/runtime/gc/gc_state.h +++ b/runtime/gc/gc_state.h @@ -18,7 +18,7 @@ struct GC_state { pointer limit; /* limit = heap.start + heap.size */ pointer stackTop; /* Top of stack in current thread. */ pointer stackLimit; /* stackBottom + stackSize - maxFrameSize */ - size_t exnStack; + ptrdiff_t exnStack; /* Alphabetized fields follow. */ size_t alignment; /* */ bool amInGC; diff --git a/runtime/gc/thread.c b/runtime/gc/thread.c index d9edcaaf2f..cc960ee7db 100644 --- a/runtime/gc/thread.c +++ b/runtime/gc/thread.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2016 Matthew Fluet. +/* Copyright (C) 2016,2019 Matthew Fluet. * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. @@ -11,10 +11,10 @@ void displayThread (GC_state s, GC_thread thread, FILE *stream) { fprintf(stream, - "\t\texnStack = %"PRIuMAX"\n" + "\t\texnStack = %"PRIiMAX"\n" "\t\tbytesNeeded = %"PRIuMAX"\n" "\t\tstack = "FMTOBJPTR"\n", - (uintmax_t)thread->exnStack, + (intmax_t)thread->exnStack, (uintmax_t)thread->bytesNeeded, thread->stack); displayStack (s, (GC_stack)(objptrToPointer (thread->stack, s->heap.start)), diff --git a/runtime/gc/thread.h b/runtime/gc/thread.h index fbace261af..4fdc226fc2 100644 --- a/runtime/gc/thread.h +++ b/runtime/gc/thread.h @@ -1,4 +1,5 @@ -/* Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh +/* Copyright (C) 2019 Matthew Fluet. + * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. * @@ -14,7 +15,7 @@ * header :: * padding :: * bytesNeeded (size_t) :: - * exnStack (size_t) :: + * exnStack (ptrdiff_t) :: * stack (object-pointer) * * There may be zero or more bytes of padding for alignment purposes. @@ -22,7 +23,7 @@ * The bytesNeeded size_t is the number of bytes needed when returning * to this thread. * - * The exnStack size_t is an offset added to stackBottom that + * The exnStack ptrdiff_t is an offset added to stackBottom that * specifies the top of the exnStack. * * The final component is the stack object-pointer. @@ -33,17 +34,17 @@ */ typedef struct GC_thread { size_t bytesNeeded; - size_t exnStack; + ptrdiff_t exnStack; objptr stack; } __attribute__ ((packed)) *GC_thread; COMPILE_TIME_ASSERT(GC_thread__packed, sizeof(struct GC_thread) == sizeof(size_t) - + sizeof(size_t) + + sizeof(ptrdiff_t) + sizeof(objptr)); -#define BOGUS_EXN_STACK ((size_t)(-1)) +#define BOGUS_EXN_STACK ((ptrdiff_t)(-1)) #else From 40de2c413782ca8aef5b23cbb73b8e9424227d29 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Sat, 13 Jul 2019 08:31:39 -0400 Subject: [PATCH 032/102] Add and use `WordX.fromBytes` --- mlton/atoms/word-x.fun | 2 ++ mlton/atoms/word-x.sig | 1 + mlton/backend/limit-check.fun | 19 +++++-------------- mlton/backend/machine.fun | 2 +- mlton/backend/packed-representation.fun | 4 ++-- 5 files changed, 11 insertions(+), 17 deletions(-) diff --git a/mlton/atoms/word-x.fun b/mlton/atoms/word-x.fun index 9fcd8584d8..dfd440cd45 100644 --- a/mlton/atoms/word-x.fun +++ b/mlton/atoms/word-x.fun @@ -100,6 +100,8 @@ end fun equals (w, w') = WordSize.equals (size w, size w') andalso value w = value w' +fun fromBytes (b, ws) = make (Bytes.toIntInf b, ws) + fun fromChar (c: Char.t) = make (Int.toIntInf (Char.toInt c), WordSize.byte) val fromIntInf = make diff --git a/mlton/atoms/word-x.sig b/mlton/atoms/word-x.sig index 371bbab96c..0322be72bc 100644 --- a/mlton/atoms/word-x.sig +++ b/mlton/atoms/word-x.sig @@ -24,6 +24,7 @@ signature WORD_X = val compare: t * t * {signed: bool} -> order val div: t * t * {signed: bool} -> t val equals: t * t -> bool + val fromBytes: Bytes.t * WordSize.t -> t val fromChar: char -> t (* returns a word of size 8 *) val fromIntInf: IntInf.t * WordSize.t -> t val ge: t * t * {signed: bool} -> bool diff --git a/mlton/backend/limit-check.fun b/mlton/backend/limit-check.fun index 828a6003b8..52c1795089 100644 --- a/mlton/backend/limit-check.fun +++ b/mlton/backend/limit-check.fun @@ -217,9 +217,8 @@ fun insertFunction (f: Function.t, (args, fn (j, arg) => if i = j then Operand.word - (WordX.fromIntInf - (Bytes.toIntInf - (ensureFree (valOf return)), + (WordX.fromBytes + (ensureFree (valOf return), WordSize.csize ())) else arg), func = func, @@ -420,14 +419,8 @@ fun insertFunction (f: Function.t, else let val bytes = - let - val bytes = - WordX.fromIntInf - (Bytes.toIntInf bytes, - WordSize.csize ()) - in - SOME bytes - end handle Overflow => NONE + SOME (WordX.fromBytes (bytes, WordSize.csize ())) + handle Overflow => NONE in case bytes of NONE => gotoHeapCheckTooLarge () @@ -461,9 +454,7 @@ fun insertFunction (f: Function.t, val extraBytes = let val extraBytes = - WordX.fromIntInf - (Bytes.toIntInf extraBytes, - WordSize.csize ()) + WordX.fromBytes (extraBytes, WordSize.csize ()) in SOME extraBytes end handle Overflow => NONE diff --git a/mlton/backend/machine.fun b/mlton/backend/machine.fun index 44ca91e66d..49c5ec276d 100644 --- a/mlton/backend/machine.fun +++ b/mlton/backend/machine.fun @@ -357,7 +357,7 @@ structure Statement = let datatype z = datatype Operand.t fun bytes (b: Bytes.t): Operand.t = - Word (WordX.fromIntInf (Bytes.toIntInf b, WordSize.csize ())) + Word (WordX.fromBytes (b, WordSize.csize ())) val temp = Register (Register.new (Type.cpointer (), NONE)) in Vector.new4 diff --git a/mlton/backend/packed-representation.fun b/mlton/backend/packed-representation.fun index ede8640380..1d25c2241f 100644 --- a/mlton/backend/packed-representation.fun +++ b/mlton/backend/packed-representation.fun @@ -582,8 +582,8 @@ structure Base = PrimApp {args = (Vector.new2 (index, Operand.word - (WordX.fromIntInf - (Bytes.toIntInf eltWidth, + (WordX.fromBytes + (eltWidth, seqIndexSize)))), dst = SOME (prod, seqIndexTy), prim = (Prim.wordMul From 867f66578e3a9e0672ffcda70fc8019012400f17 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Sat, 13 Jul 2019 08:40:47 -0400 Subject: [PATCH 033/102] Perform `StackTop += (bytes)` in C codegen --- include/c-chunk.h | 12 --------- mlton/codegen/c-codegen/c-codegen.fun | 38 +++++++++++++-------------- 2 files changed, 19 insertions(+), 31 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index ccd5d2a99a..ef0cd0ce4c 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -151,18 +151,6 @@ StackTopMem = StackTop; \ } while (0) -/* ------------------------------------------------- */ -/* Stack */ -/* ------------------------------------------------- */ - -#define Push(bytes) \ - do { \ - if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: Push (%d)\n", \ - __FILE__, __LINE__, bytes); \ - StackTop += (bytes); \ - } while (0) - /* ------------------------------------------------- */ /* Transfers */ /* ------------------------------------------------- */ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 85e9e53195..efce11dcaa 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -52,9 +52,6 @@ structure C = end fun word (w: Word.t) = "0x" ^ Word.toString w - - fun push (size: Bytes.t, print) = - call ("\tPush", [bytes size], print) end structure RealX = @@ -778,11 +775,6 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, Int.for (0, 1 + regMax t, fn i => print (concat [pre, C.int i, ";\n"])) end) - fun pop (fi: FrameInfo.t) = - (C.push (Bytes.~ (FrameInfo.size fi), print) - ; if amTimeProfiling - then print "\tFlushStackTop();\n" - else ()) fun outputStatement s = let datatype z = datatype Statement.t @@ -825,20 +817,28 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, (print "\t" ; C.call ("ProfileLabel", [ProfileLabel.toString l], print)) end - fun push (return: Label.t, size: Bytes.t) = - (print "\t" - ; print (move {dst = (StackOffset.toString - (StackOffset.T - {offset = Bytes.- (size, Runtime.labelSize ()), - ty = Type.label return})), - dstIsMem = true, - src = labelIndexAsString (return, {pretty = true}), - srcIsMem = false, - ty = Type.label return}) - ; C.push (size, print) + fun adjStackTop (size: Bytes.t) = + (outputStatement (Statement.PrimApp + {args = Vector.new2 + (Operand.StackTop, + Operand.Word + (WordX.fromBytes + (size, + WordSize.cptrdiff ()))), + dst = SOME Operand.StackTop, + prim = Prim.cpointerAdd}) ; if amTimeProfiling then print "\tFlushStackTop();\n" else ()) + fun pop (fi: FrameInfo.t) = + adjStackTop (Bytes.~ (FrameInfo.size fi)) + fun push (return: Label.t, size: Bytes.t) = + (outputStatement (Statement.Move + {dst = Operand.stackOffset + {offset = Bytes.- (size, Runtime.labelSize ()), + ty = Type.label return}, + src = Operand.Label return}) + ; adjStackTop size) fun copyArgs (args: Operand.t vector): string list * (unit -> unit) = let fun usesStack z = From edc684a51ef67c70d30a8f23ba3220a048e0a668 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Sun, 14 Jul 2019 10:19:25 -0400 Subject: [PATCH 034/102] Simplify LLVM codegen by translating via Machine IR Statements --- mlton/codegen/llvm-codegen/llvm-codegen.fun | 210 ++++++++------------ 1 file changed, 81 insertions(+), 129 deletions(-) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 47a4d85b6b..6175e35b7b 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -24,6 +24,7 @@ datatype z = datatype WordSize.prim (* LLVM codegen context. Contains various values/functions that should be shared amongst all codegen functions. *) datatype Context = Context of { + amTimeProfiling: bool, program: Program.t, chunkName: ChunkLabel.t -> string, labelChunk: Label.t -> ChunkLabel.t, @@ -309,76 +310,6 @@ fun addFfiSymbol s = if not (List.contains (!ffiSymbols, s, fn ({name=n1, ...}, then ffiSymbols := List.cons (s, !ffiSymbols) else () -fun offsetGCState (gcfield, ty) = - let - val ptr1 = nextLLVMReg () - val gep = mkgep (ptr1, "%CPointer", "%gcState", [("i32", llbytes (GCField.offset gcfield))]) - val ptr2 = nextLLVMReg () - val cast = mkconv (ptr2, "bitcast", "%CPointer", ptr1, ty) - in - (concat [gep, cast], ptr2) - end - -(* FrontierMem = Frontier *) -fun flushFrontier () = - let - val comment = "\t; FlushFrontier\n" - val (pre, reg) = offsetGCState (GCField.Frontier, "%CPointer*") - val frontier = nextLLVMReg () - val load = mkload (frontier, "%CPointer*", "%frontier") - val store = mkstore ("%CPointer", frontier, reg) - in - concat [comment, pre, load, store] - end - -(* StackTopMem = StackTop *) -fun flushStackTop () = - let - val comment = "\t; FlushStackTop\n" - val (pre, reg) = offsetGCState (GCField.StackTop, "%CPointer*") - val stacktop = nextLLVMReg () - val load = mkload (stacktop, "%CPointer*", "%stackTop") - val store = mkstore ("%CPointer", stacktop, reg) - in - concat [comment, pre, load, store] - end - -(* Frontier = FrontierMem *) -fun cacheFrontier () = - let - val comment = "\t; CacheFrontier\n" - val (pre, reg) = offsetGCState (GCField.Frontier, "%CPointer*") - val frontier = nextLLVMReg () - val load = mkload (frontier, "%CPointer*", reg) - val store = mkstore ("%CPointer", frontier, "%frontier") - in - concat [comment, pre, load, store] - end - -(* StackTop = StackTopMem *) -fun cacheStackTop () = - let - val comment = "\t; CacheStackTop\n" - val (pre, reg) = offsetGCState (GCField.StackTop, "%CPointer*") - val stacktop = nextLLVMReg () - val load = mkload (stacktop, "%CPointer*", reg) - val store = mkstore ("%CPointer", stacktop, "%stackTop") - in - concat [comment, pre, load, store] - end - -fun stackPush amt = - let - val stacktop = nextLLVMReg () - val load = mkload (stacktop, "%CPointer*", "%stackTop") - val ptr = nextLLVMReg () - val gep = mkgep (ptr, "%CPointer", stacktop, [("i32", amt)]) - val store = mkstore ("%CPointer", ptr, "%stackTop") - val comment = concat ["\t; Push(", amt, ")\n"] - in - concat [comment, load, gep, store] - end - (* argv - vector of (pre, ty, addr) triples i - index of argv returns: (pre, type, reg) @@ -895,6 +826,20 @@ fun outputStatement (cxt: Context, stmt: Statement.t): string = concat [comment, stmtcode] end +local + fun mk (dst, src) cxt = + outputStatement (cxt, Statement.Move {dst = dst (), src = src ()}) + fun stackTop () = Operand.StackTop + fun gcStateStackTop () = Operand.gcField GCField.StackTop + fun frontier () = Operand.Frontier + fun gcStateFrontier () = Operand.gcField GCField.Frontier +in + val cacheStackTop = mk (stackTop, gcStateStackTop) + val flushStackTop = mk (gcStateStackTop, stackTop) + val cacheFrontier = mk (frontier, gcStateFrontier) + val flushFrontier = mk (gcStateFrontier, frontier) +end + (* LeaveChunk(nextChunk, nextBlock) if (TailCall) { @@ -905,7 +850,7 @@ fun outputStatement (cxt: Context, stmt: Statement.t): string = return nextBlock; } *) -fun leaveChunk (nextChunk, nextBlock) = +fun leaveChunk (cxt, nextChunk, nextBlock) = if !Control.chunkTailCall then let val stackTopArg = nextLLVMReg () @@ -923,8 +868,8 @@ fun leaveChunk (nextChunk, nextBlock) = "%uintptr_t ", nextBlock, ")\n", "\tret %uintptr_t ", resReg, "\n"] end - else concat [flushFrontier (), - flushStackTop (), + else concat [flushFrontier cxt, + flushStackTop cxt, "\tret %uintptr_t ", nextBlock, "\n"] (* Return(mustReturnToSelf, mayReturnToSelf, mustReturnToOther) @@ -987,29 +932,45 @@ fun callReturn (cxt, selfChunk, mustReturnToSelf, mayReturnToSelf, mustReturnToO "\tbr label %doSwitchNextBlock\n", leaveChunkLabel, ":\n", case mustReturnToOther of - NONE => leaveChunk (nextChunk, nextBlock) - | SOME dstChunk => leaveChunk (concat ["@", chunkName dstChunk], nextBlock)] + NONE => leaveChunk (cxt, nextChunk, nextBlock) + | SOME dstChunk => leaveChunk (cxt, concat ["@", chunkName dstChunk], nextBlock)] end +fun adjStackTop (cxt, size: Bytes.t) = + concat + [outputStatement (cxt, + Statement.PrimApp + {args = Vector.new2 + (Operand.StackTop, + Operand.Word + (WordX.fromBytes + (size, + WordSize.cptrdiff ()))), + dst = SOME Operand.StackTop, + prim = Prim.cpointerAdd}), + let + val Context { amTimeProfiling, ... } = cxt + in + if amTimeProfiling + then flushStackTop cxt + else "" + end] +fun pop (cxt, fi: FrameInfo.t) = + adjStackTop (cxt, Bytes.~ (FrameInfo.size fi)) +fun push (cxt, return: Label.t, size: Bytes.t) = + concat + [outputStatement (cxt, + Statement.Move + {dst = Operand.stackOffset + {offset = Bytes.- (size, Runtime.labelSize ()), + ty = Type.label return}, + src = Operand.Label return}), + adjStackTop (cxt, size)] + fun outputTransfer (cxt, chunkLabel, transfer) = let val comment = concat ["\t; ", Layout.toString (Transfer.layout transfer), "\n"] val Context { chunkName, labelChunk, labelIndexAsString, ... } = cxt - fun transferPush (return, size) = - let - val offset = llbytes (Bytes.- (size, Runtime.labelSize ())) - val frameIndex = labelIndexAsString return - val stackTop = nextLLVMReg () - val load = mkload (stackTop, "%CPointer*", "%stackTop") - val gepReg = nextLLVMReg () - val gep = mkgep (gepReg, "%CPointer", stackTop, [("i32", offset)]) - val castreg = nextLLVMReg () - val cast = mkconv (castreg, "bitcast", "%CPointer", gepReg, "%uintptr_t*") - val storeIndex = mkstore ("%uintptr_t", frameIndex, castreg) - val pushcode = stackPush (llbytes size) - in - concat [load, gep, cast, storeIndex, pushcode] - end fun rtrans rsTo = let fun isSelf c = ChunkLabel.equals (chunkLabel, c) @@ -1045,9 +1006,9 @@ fun outputTransfer (cxt, chunkLabel, transfer) = {target = CFunction.Target.Direct "Thread_returnToC", ...}, return = SOME {return, size = SOME size}, ...} => concat [comment, - transferPush (return, size), - flushFrontier (), - flushStackTop (), + push (cxt, return, size), + flushFrontier cxt, + flushStackTop cxt, "\tret %uintptr_t -1\n"] | Transfer.CCall {args, func, return} => let @@ -1063,9 +1024,9 @@ fun outputTransfer (cxt, chunkLabel, transfer) = case return of NONE => "" | SOME {size = NONE, ...} => "" - | SOME {return, size = SOME size} => transferPush (return, size) - val flushFrontierCode = if CFunction.modifiesFrontier func then flushFrontier () else "" - val flushStackTopCode = if CFunction.readsStackTop func then flushStackTop () else "" + | SOME {return, size = SOME size} => push (cxt, return, size) + val flushFrontierCode = if CFunction.modifiesFrontier func then flushFrontier cxt else "" + val flushStackTopCode = if CFunction.readsStackTop func then flushStackTop cxt else "" val (callLHS, callType, afterCall) = if Type.isUnit returnTy then ("\t", "void", "") @@ -1133,9 +1094,9 @@ fun outputTransfer (cxt, chunkLabel, transfer) = | SOME {return, ...} => let val cacheFrontierCode = - if CFunction.modifiesFrontier func then cacheFrontier () else "" + if CFunction.modifiesFrontier func then cacheFrontier cxt else "" val cacheStackTopCode = - if CFunction.writesStackTop func then cacheStackTop () else "" + if CFunction.writesStackTop func then cacheStackTop cxt else "" val br = if CFunction.maySwitchThreadsFrom func then callReturn (cxt, chunkLabel, false, true, NONE) else concat ["\tbr label %", Label.toString return, "\n"] @@ -1160,12 +1121,13 @@ fun outputTransfer (cxt, chunkLabel, transfer) = val dstChunk = labelChunk label val push = case return of NONE => "" - | SOME {return, size, ...} => transferPush (return, size) + | SOME {return, size, ...} => push (cxt, return, size) val call = if ChunkLabel.equals (chunkLabel, dstChunk) then concat ["\t; NearCall\n", "\tbr label %", Label.toString label, "\n"] else concat ["\t; FarCall\n", - leaveChunk (concat ["@", chunkName dstChunk], + leaveChunk (cxt, + concat ["@", chunkName dstChunk], labelIndexAsString label)] in concat [push, call] @@ -1178,33 +1140,20 @@ fun outputTransfer (cxt, chunkLabel, transfer) = end | Transfer.Raise {raisesTo} => let - val comment = "\t; Raise\n" - (* StackTop = StackBottom + ExnStack *) - val (sbpre, sbreg) = offsetGCState (GCField.StackBottom, "%CPointer*") - val stackBottom = nextLLVMReg () - val loadStackBottom = mkload (stackBottom, "%CPointer*", sbreg) - val exnStackTy = llty (Type.exnStack ()) - val (espre, esreg) = offsetGCState (GCField.ExnStack, exnStackTy ^ "*") - val exnStack = nextLLVMReg () - val loadExnStack = mkload (exnStack, exnStackTy ^ "*", esreg) - val sumReg = nextLLVMReg () - val sum = mkgep (sumReg, "%CPointer", stackBottom, [(exnStackTy, exnStack)]) - val storeStackTop = mkstore ("%CPointer", sumReg, "%stackTop") + (* StackTop = StackBottom + ExnStack *) + val cutStack = + outputStatement (cxt, + Statement.PrimApp + {args = Vector.new2 + (Operand.gcField GCField.StackBottom, + Operand.gcField GCField.ExnStack), + dst = SOME Operand.StackTop, + prim = Prim.cpointerAdd}) in - concat [comment, - sbpre, loadStackBottom, - espre, loadExnStack, - sum, - storeStackTop, - rtrans raisesTo] + concat [comment, cutStack, rtrans raisesTo] end | Transfer.Return {returnsTo} => - let - val comment = "\t; Return\n" - in - concat [comment, - rtrans returnsTo] - end + concat [comment, rtrans returnsTo] | Transfer.Switch switch => let val Switch.T {cases, default, test, ...} = switch @@ -1237,14 +1186,13 @@ fun outputBlock (cxt, chunkLabel, block) = val Block.T {kind, label, statements, transfer, ...} = block val labelstr = Label.toString label val blockLabel = labelstr ^ ":\n" - fun pop fi = (stackPush o llbytes o Bytes.~ o FrameInfo.size) fi val dopop = case kind of - Kind.Cont {frameInfo, ...} => pop frameInfo + Kind.Cont {frameInfo, ...} => pop (cxt, frameInfo) | Kind.CReturn {dst, frameInfo, ...} => let val popfi = case frameInfo of NONE => "" - | SOME fi => pop fi + | SOME fi => pop (cxt, fi) val move = case dst of NONE => "" | SOME x => @@ -1265,7 +1213,7 @@ fun outputBlock (cxt, chunkLabel, block) = in concat [popfi, move] end - | Kind.Handler {frameInfo, ...} => pop frameInfo + | Kind.Handler {frameInfo, ...} => pop (cxt, frameInfo) | _ => "" val outputStatementWithCxt = fn s => outputStatement (cxt, s) val blockBody = String.concatV (Vector.map (statements, outputStatementWithCxt)) @@ -1433,8 +1381,12 @@ fun makeContext program = val chunkLabelIndex = #index o chunkLabelInfo val chunkLabelIndexAsString = llint o chunkLabelIndex fun chunkName c = concat ["Chunk", chunkLabelIndexAsString c] + val amTimeProfiling = + !Control.profile = Control.ProfileTimeField + orelse !Control.profile = Control.ProfileTimeLabel in - Context { program = program, + Context { amTimeProfiling = amTimeProfiling, + program = program, labelIndexAsString = labelIndexAsString, chunkName = chunkName, labelChunk = labelChunk, From a03514280b4bb580b8fdd3451820fc6a93010b2f Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Sun, 14 Jul 2019 21:11:55 -0400 Subject: [PATCH 035/102] Disable `mustReturnToOther` opt in LLVM codegen LLVM will erroneously optimize something like: define i64 @foo (i64 %x) { entry: %ret = musttail call i64 @bar(i64 %x) ret i64 %ret } define i64 @bar (i64 %x) { entry: call void @baz(i64 0) noreturn unreachable } declare void @baz (i64) noreturn to define i64 @foo (i64 %x) noreturn { entry: %ret = musttail call i64 @bar(i64 undef) unreachable } define i64 @bar (i64 %x) noreturn { entry: tail call void @baz(i64 0) noreturn unreachable } declare void @baz (i64) noreturn and then die with musttail call must precede a ret with an optional bitcast %ret = musttail call i64 @bar(i64 undef) in function foo This can occur with `Raise` transfers to the top-level handler that does not return. --- mlton/codegen/llvm-codegen/llvm-codegen.fun | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 6175e35b7b..218cda176a 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -931,7 +931,7 @@ fun callReturn (cxt, selfChunk, mustReturnToSelf, mayReturnToSelf, mustReturnToO returnToSelfLabel, ":\n", "\tbr label %doSwitchNextBlock\n", leaveChunkLabel, ":\n", - case mustReturnToOther of + case NONE (* mustReturnToOther *) of NONE => leaveChunk (cxt, nextChunk, nextBlock) | SOME dstChunk => leaveChunk (cxt, concat ["@", chunkName dstChunk], nextBlock)] end From 4d5abde95cdcf6c538f8ef6b844d8c4f1cafa0a6 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 15 Jul 2019 22:33:48 -0400 Subject: [PATCH 036/102] Add and use `-chunk-{{must,may}-rto-self,must-rto-other}-opt` flags --- mlton/codegen/c-codegen/c-codegen.fun | 9 ++++++--- mlton/codegen/llvm-codegen/llvm-codegen.fun | 10 ++++++++-- mlton/control/control-flags.sig | 3 +++ mlton/control/control-flags.sml | 9 +++++++++ mlton/main/main.fun | 9 +++++++++ 5 files changed, 35 insertions(+), 5 deletions(-) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index efce11dcaa..6564c54688 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -917,9 +917,12 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, in print "\t" ; C.call (name, - [C.bool mustRToSelf, - C.bool mayRToSelf, - case mustRToOther of + [C.bool (!Control.chunkMustRToSelfOpt andalso mustRToSelf), + C.bool (!Control.chunkMayRToSelfOpt andalso mayRToSelf), + case (if (!Control.chunkMustRToOtherOpt andalso + (!Control.chunkMayRToSelfOpt orelse not mayRToSelf)) + then mustRToOther + else NONE) of NONE => "(ChunkFnPtr_t)NULL" | SOME otherChunk => concat ["&(", chunkName otherChunk, ")"]], diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 218cda176a..bb27559526 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -931,7 +931,7 @@ fun callReturn (cxt, selfChunk, mustReturnToSelf, mayReturnToSelf, mustReturnToO returnToSelfLabel, ":\n", "\tbr label %doSwitchNextBlock\n", leaveChunkLabel, ":\n", - case NONE (* mustReturnToOther *) of + case mustReturnToOther of NONE => leaveChunk (cxt, nextChunk, nextBlock) | SOME dstChunk => leaveChunk (cxt, concat ["@", chunkName dstChunk], nextBlock)] end @@ -997,7 +997,13 @@ fun outputTransfer (cxt, chunkLabel, transfer) = then SOME c else NONE)) in - callReturn (cxt, chunkLabel, mustRToSelf, mayRToSelf, mustRToOther) + callReturn (cxt, chunkLabel, + !Control.chunkMustRToSelfOpt andalso mustRToSelf, + !Control.chunkMayRToSelfOpt andalso mayRToSelf, + if (!Control.chunkMustRToOtherOpt andalso + (!Control.chunkMayRToSelfOpt orelse not mayRToSelf)) + then mustRToOther + else NONE) end in case transfer of diff --git a/mlton/control/control-flags.sig b/mlton/control/control-flags.sig index 959a08863d..4b33556310 100644 --- a/mlton/control/control-flags.sig +++ b/mlton/control/control-flags.sig @@ -43,6 +43,9 @@ signature CONTROL_FLAGS = val chunkify: Chunkify.t ref val chunkJumpTable: bool ref + val chunkMayRToSelfOpt: bool ref + val chunkMustRToOtherOpt: bool ref + val chunkMustRToSelfOpt: bool ref val chunkTailCall: bool ref val closureConvertGlobalize: bool ref diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index d8e458bbd7..c87540c6e3 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -81,6 +81,15 @@ val chunkify = control {name = "chunkify", val chunkJumpTable = control {name = "chunkJumpTable", default = false, toString = Bool.toString} +val chunkMayRToSelfOpt = control {name = "chunkMayRToSelfOpt", + default = false, + toString = Bool.toString} +val chunkMustRToOtherOpt = control {name = "chunkMustRToOtherOpt", + default = false, + toString = Bool.toString} +val chunkMustRToSelfOpt = control {name = "chunkMustRToSelfOpt", + default = false, + toString = Bool.toString} val chunkTailCall = control {name = "chunkTailCall", default = true, toString = Bool.toString} diff --git a/mlton/main/main.fun b/mlton/main/main.fun index da8b4acbf5..447a695dee 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -304,6 +304,15 @@ fun makeOptions {usage} = (Expert, "chunk-jump-table", " {false|true}", "whether to use explicit jump table for chunk entry switch", Bool (fn b => chunkJumpTable := b)), + (Expert, "chunk-may-rto-self-opt", " {false|true}", + "whether to optimize return/raise that may transfer to self chunk", + Bool (fn b => chunkMayRToSelfOpt := b)), + (Expert, "chunk-must-rto-other-opt", " {false|true}", + "whether to optimize return/raise that must transfer to one other chunk", + Bool (fn b => chunkMustRToOtherOpt := b)), + (Expert, "chunk-must-rto-self-opt", " {false|true}", + "whether to optimize return/raise that must transfer to self chunk", + Bool (fn b => chunkMustRToSelfOpt := b)), (Expert, "chunk-tail-call", " {false|true}", "whether to use tail calls for interchunk transfers", Bool (fn b => chunkTailCall := b)), From 4b7c6490f6aee989f6b247ea04ac170217763539 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 16 Jul 2019 10:30:53 -0400 Subject: [PATCH 037/102] Change default for `-chunk-{must,may}-rto-self-opt` --- mlton/control/control-flags.sml | 4 ++-- mlton/main/main.fun | 4 ++-- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index c87540c6e3..3591a93d91 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -82,13 +82,13 @@ val chunkJumpTable = control {name = "chunkJumpTable", default = false, toString = Bool.toString} val chunkMayRToSelfOpt = control {name = "chunkMayRToSelfOpt", - default = false, + default = true, toString = Bool.toString} val chunkMustRToOtherOpt = control {name = "chunkMustRToOtherOpt", default = false, toString = Bool.toString} val chunkMustRToSelfOpt = control {name = "chunkMustRToSelfOpt", - default = false, + default = true, toString = Bool.toString} val chunkTailCall = control {name = "chunkTailCall", default = true, diff --git a/mlton/main/main.fun b/mlton/main/main.fun index 447a695dee..c10ddae07b 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -304,13 +304,13 @@ fun makeOptions {usage} = (Expert, "chunk-jump-table", " {false|true}", "whether to use explicit jump table for chunk entry switch", Bool (fn b => chunkJumpTable := b)), - (Expert, "chunk-may-rto-self-opt", " {false|true}", + (Expert, "chunk-may-rto-self-opt", " {true|false}", "whether to optimize return/raise that may transfer to self chunk", Bool (fn b => chunkMayRToSelfOpt := b)), (Expert, "chunk-must-rto-other-opt", " {false|true}", "whether to optimize return/raise that must transfer to one other chunk", Bool (fn b => chunkMustRToOtherOpt := b)), - (Expert, "chunk-must-rto-self-opt", " {false|true}", + (Expert, "chunk-must-rto-self-opt", " {true|false}", "whether to optimize return/raise that must transfer to self chunk", Bool (fn b => chunkMustRToSelfOpt := b)), (Expert, "chunk-tail-call", " {false|true}", From 4cd0111db3c02bcba41cb1040e92b4d31b9dfa78 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 16 Jul 2019 11:53:28 -0400 Subject: [PATCH 038/102] Share and simplify code in `-main.h` --- include/amd64-main.h | 26 +++++++++++++------------- include/c-main.h | 38 ++++++++++++++++++++------------------ include/x86-main.h | 26 +++++++++++++------------- 3 files changed, 46 insertions(+), 44 deletions(-) diff --git a/include/amd64-main.h b/include/amd64-main.h index 34c677b8cb..1b52946d6c 100644 --- a/include/amd64-main.h +++ b/include/amd64-main.h @@ -40,7 +40,11 @@ PRIVATE GC_state MLton_gcState() { } static GC_frameIndex returnAddressToFrameIndex (GC_returnAddress ra) { - return *((GC_frameIndex*)(ra - sizeof(GC_frameIndex))); + return *((GC_frameIndex*)(ra - sizeof(GC_frameIndex))); +} + +static inline pointer getJumpFromStackTop (GC_state s) { + return *(pointer*)(s->stackTop - GC_RETURNADDRESS_SIZE); } PRIVATE void MLton_jumpToSML (pointer jump); @@ -49,7 +53,6 @@ PRIVATE void MLton_jumpToSML (pointer jump); static void MLton_callFromC (CPointer localOpArgsResPtr) { \ pointer jump; \ GC_state s = MLton_gcState(); \ - \ if (DEBUG_AMD64CODEGEN) \ fprintf (stderr, "MLton_callFromC() starting\n"); \ s->callFromCOpArgsResPtr = localOpArgsResPtr; \ @@ -59,8 +62,8 @@ static void MLton_callFromC (CPointer localOpArgsResPtr) { \ s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP; \ /* Return to the C Handler thread. */ \ GC_switchToThread (s, GC_getCallFromCHandlerThread (s), 0); \ - jump = *(pointer*)(s->stackTop - GC_RETURNADDRESS_SIZE); \ - MLton_jumpToSML(jump); \ + jump = getJumpFromStackTop (s); \ + MLton_jumpToSML (jump); \ s->atomicState += 1; \ GC_switchToThread (s, GC_getSavedThread (s), 0); \ s->atomicState -= 1; \ @@ -73,41 +76,38 @@ static void MLton_callFromC (CPointer localOpArgsResPtr) { \ #define MLtonMain(al, mg, mfs, mmc, pk, ps, ml) \ PUBLIC int MLton_main (int argc, char* argv[]) { \ - pointer jump; \ extern unsigned char ml; \ + pointer jump; \ GC_state s = MLton_gcState(); \ - \ Initialize (s, al, mg, mfs, mmc, pk, ps); \ if (s->amOriginal) { \ real_Init(); \ jump = (pointer)&ml; \ } else { \ - jump = *(pointer*)(s->stackTop - GC_RETURNADDRESS_SIZE); \ + jump = getJumpFromStackTop (s); \ } \ - MLton_jumpToSML(jump); \ + MLton_jumpToSML (jump); \ return 1; \ } #define MLtonLibrary(al, mg, mfs, mmc, pk, ps, ml) \ PUBLIC void LIB_OPEN(LIBNAME) (int argc, char* argv[]) { \ + extern unsigned char ml; \ pointer jump; \ GC_state s = MLton_gcState(); \ - extern unsigned char ml; \ - \ Initialize (s, al, mg, mfs, mmc, pk, ps); \ if (s->amOriginal) { \ real_Init(); \ jump = (pointer)&ml; \ } else { \ - jump = *(pointer*)(s->stackTop - GC_RETURNADDRESS_SIZE); \ + jump = getJumpFromStackTop (s); \ } \ MLton_jumpToSML(jump); \ } \ PUBLIC void LIB_CLOSE(LIBNAME) () { \ pointer jump; \ GC_state s = MLton_gcState(); \ - \ - jump = *(pointer*)(s->stackTop - GC_RETURNADDRESS_SIZE); \ + jump = getJumpFromStackTop (s); \ MLton_jumpToSML(jump); \ GC_done(s); \ } diff --git a/include/c-main.h b/include/c-main.h index 5d7da70eb1..e416353fca 100644 --- a/include/c-main.h +++ b/include/c-main.h @@ -22,6 +22,18 @@ static GC_frameIndex returnAddressToFrameIndex (GC_returnAddress ra) { return (GC_frameIndex)ra; } +static inline uintptr_t getNextBlockFromStackTop (GC_state s) { + return *(uintptr_t*)(s->stackTop - GC_RETURNADDRESS_SIZE); +} + +PRIVATE extern ChunkFnPtr_t nextChunks[]; + +static inline void MLton_trampoline (GC_state s, uintptr_t nextBlock, bool mayReturnToC) { + do { + nextBlock = (*(nextChunks[nextBlock]))(s, s->stackTop, s->frontier, nextBlock); + } while (!mayReturnToC || nextBlock != (uintptr_t)-1); +} + #define MLtonCallFromC() \ static void MLton_callFromC (CPointer localOpArgsResPtr) { \ uintptr_t nextBlock; \ @@ -35,10 +47,8 @@ static void MLton_callFromC (CPointer localOpArgsResPtr) { \ s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP; \ /* Switch to the C Handler thread. */ \ GC_switchToThread (s, GC_getCallFromCHandlerThread (s), 0); \ - nextBlock = *(uintptr_t*)(s->stackTop - GC_RETURNADDRESS_SIZE); \ - do { \ - nextBlock = (*(nextChunks[nextBlock]))(s, s->stackTop, s->frontier, nextBlock); \ - } while (nextBlock != (uintptr_t)-1); \ + nextBlock = getNextBlockFromStackTop (s); \ + MLton_trampoline (s, nextBlock, TRUE); \ s->atomicState += 1; \ GC_switchToThread (s, GC_getSavedThread (s), 0); \ s->atomicState -= 1; \ @@ -59,12 +69,9 @@ PUBLIC int MLton_main (int argc, char* argv[]) { \ nextBlock = ml; \ } else { \ /* Return to the saved world */ \ - nextBlock = *(uintptr_t*)(s->stackTop - GC_RETURNADDRESS_SIZE); \ + nextBlock = getNextBlockFromStackTop (s); \ } \ - /* Trampoline */ \ - do { \ - nextBlock = (*(nextChunks[nextBlock]))(s, s->stackTop, s->frontier, nextBlock); \ - } while (1); \ + MLton_trampoline (s, nextBlock, FALSE); \ return 1; \ } @@ -78,20 +85,15 @@ PUBLIC void LIB_OPEN(LIBNAME) (int argc, char* argv[]) { \ nextBlock = ml; \ } else { \ /* Return to the saved world */ \ - nextBlock = *(uintptr_t*)(s->stackTop - GC_RETURNADDRESS_SIZE); \ + nextBlock = getNextBlockFromStackTop (s); \ } \ - /* Trampoline */ \ - do { \ - nextBlock = (*(nextChunks[nextBlock]))(s, s->stackTop, s->frontier, nextBlock); \ - } while (nextBlock != (uintptr_t)-1); \ + MLton_trampoline (s, nextBlock, TRUE); \ } \ PUBLIC void LIB_CLOSE(LIBNAME) () { \ uintptr_t nextBlock; \ GC_state s = MLton_gcState(); \ - nextBlock = *(uintptr_t*)(s->stackTop - GC_RETURNADDRESS_SIZE); \ - do { \ - nextBlock = (*(nextChunks[nextBlock]))(s, s->stackTop, s->frontier, nextBlock); \ - } while (nextBlock != (uintptr_t)-1); \ + nextBlock = getNextBlockFromStackTop (s); \ + MLton_trampoline (s, nextBlock, TRUE); \ GC_done(s); \ } diff --git a/include/x86-main.h b/include/x86-main.h index adcd4ee76f..6feda87b89 100644 --- a/include/x86-main.h +++ b/include/x86-main.h @@ -45,7 +45,11 @@ PRIVATE GC_state MLton_gcState() { } static GC_frameIndex returnAddressToFrameIndex (GC_returnAddress ra) { - return *((GC_frameIndex*)(ra - sizeof(GC_frameIndex))); + return *((GC_frameIndex*)(ra - sizeof(GC_frameIndex))); +} + +static inline pointer getJumpFromStackTop (GC_state s) { + return *(pointer*)(s->stackTop - GC_RETURNADDRESS_SIZE); } PRIVATE void MLton_jumpToSML (pointer jump); @@ -54,7 +58,6 @@ PRIVATE void MLton_jumpToSML (pointer jump); static void MLton_callFromC (CPointer localOpArgsResPtr) { \ pointer jump; \ GC_state s = MLton_gcState(); \ - \ if (DEBUG_X86CODEGEN) \ fprintf (stderr, "MLton_callFromC() starting\n"); \ s->callFromCOpArgsResPtr = localOpArgsResPtr; \ @@ -64,8 +67,8 @@ static void MLton_callFromC (CPointer localOpArgsResPtr) { \ s->limit = s->limitPlusSlop - GC_HEAP_LIMIT_SLOP; \ /* Return to the C Handler thread. */ \ GC_switchToThread (s, GC_getCallFromCHandlerThread (s), 0); \ - jump = *(pointer*)(s->stackTop - GC_RETURNADDRESS_SIZE); \ - MLton_jumpToSML(jump); \ + jump = getJumpFromStackTop (s); \ + MLton_jumpToSML (jump); \ s->atomicState += 1; \ GC_switchToThread (s, GC_getSavedThread (s), 0); \ s->atomicState -= 1; \ @@ -78,41 +81,38 @@ static void MLton_callFromC (CPointer localOpArgsResPtr) { \ #define MLtonMain(al, mg, mfs, mmc, pk, ps, ml) \ PUBLIC int MLton_main (int argc, char* argv[]) { \ - pointer jump; \ extern unsigned char ml; \ + pointer jump; \ GC_state s = MLton_gcState(); \ - \ Initialize (s, al, mg, mfs, mmc, pk, ps); \ if (s->amOriginal) { \ real_Init(); \ jump = (pointer)&ml; \ } else { \ - jump = *(pointer*)(s->stackTop - GC_RETURNADDRESS_SIZE); \ + jump = getJumpFromStackTop (s); \ } \ - MLton_jumpToSML(jump); \ + MLton_jumpToSML (jump); \ return 1; \ } #define MLtonLibrary(al, mg, mfs, mmc, pk, ps, ml) \ PUBLIC void LIB_OPEN(LIBNAME) (int argc, char* argv[]) { \ + extern unsigned char ml; \ pointer jump; \ GC_state s = MLton_gcState(); \ - extern unsigned char ml; \ - \ Initialize (s, al, mg, mfs, mmc, pk, ps); \ if (s->amOriginal) { \ real_Init(); \ jump = (pointer)&ml; \ } else { \ - jump = *(pointer*)(s->stackTop - GC_RETURNADDRESS_SIZE); \ + jump = getJumpFromStackTop (s); \ } \ MLton_jumpToSML(jump); \ } \ PUBLIC void LIB_CLOSE(LIBNAME) () { \ pointer jump; \ GC_state s = MLton_gcState(); \ - \ - jump = *(pointer*)(s->stackTop - GC_RETURNADDRESS_SIZE); \ + jump = getJumpFromStackTop (s); \ MLton_jumpToSML(jump); \ GC_done(s); \ } From 087a5b1f937333112192fac479521a174c0e32b5 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 16 Jul 2019 12:14:34 -0400 Subject: [PATCH 039/102] Experiment with forcing jump table for LLVM codegen See 5b6439b73. --- mlton/codegen/llvm-codegen/llvm-codegen.fun | 92 +++++++++++++++++---- 1 file changed, 76 insertions(+), 16 deletions(-) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index bb27559526..06978466f9 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -28,6 +28,7 @@ datatype Context = Context of { program: Program.t, chunkName: ChunkLabel.t -> string, labelChunk: Label.t -> ChunkLabel.t, + labelIndex: Label.t -> int, labelIndexAsString: Label.t -> string, nextChunks: Label.t vector } @@ -1249,8 +1250,38 @@ fun outputLLVMDeclarations print = fun outputChunkFn (cxt, chunk, print) = let val () = resetLLVMReg () - val Context { chunkName, labelIndexAsString, ... } = cxt + val Context { chunkName, labelIndex, ... } = cxt val Chunk.T {blocks, chunkLabel, regMax} = chunk + val entries = + let + val entries = ref [] + val () = + Vector.foreach + (blocks, fn Block.T {kind, label, ...} => + if Kind.isEntry kind + then List.push (entries, (label, labelIndex label)) + else ()) + in + List.insertionSort (!entries, fn ((_, i1), (_, i2)) => i1 <= i2) + end + val numEntries = List.length entries + val () = if !Control.chunkJumpTable + then let + val () = print (concat ["@", chunkName chunkLabel, ".nextLabels ", + "= internal constant ", + "[", llint numEntries, " x i8*] ", + "[\n"]) + val () = List.foreachi (entries, fn (i, (label, _)) => + print (concat ["\t\ti8* blockaddress(", + "@", chunkName chunkLabel, ", ", + "%", Label.toString label, ")", + if i < numEntries - 1 + then ",\n" + else " ]\n"])) + in + () + end + else () val () = print (concat ["define hidden %uintptr_t @", chunkName chunkLabel, "(%CPointer %gcState, %CPointer %stackTopArg, %CPointer %frontierArg, %uintptr_t %nextBlockArg) {\nentry:\n"]) @@ -1275,21 +1306,49 @@ fun outputChunkFn (cxt, chunk, print) = val () = print (mkstore ("%uintptr_t", "%nextBlockArg", "%nextBlock")) val () = print "\tbr label %doSwitchNextBlock\n\n" val () = print "doSwitchNextBlock:\n" - val tmp = nextLLVMReg () - val () = print (mkload (tmp, "%uintptr_t*", "%nextBlock")) - val () = print (concat ["\tswitch %uintptr_t ", tmp, - ", label %switchNextBlockDefault [\n"]) - val () = Vector.foreach (blocks, fn Block.T {kind, label, ...} => - if Kind.isEntry kind - then print (concat ["\t\t%uintptr_t ", - labelIndexAsString label, - ", label %", - Label.toString label, - "\n"]) - else ()) - val () = print "\t]\n\n" - val () = print "switchNextBlockDefault:\n" - val () = print "\tunreachable\n\n" + val () = + if !Control.chunkJumpTable + then let + val tmp1 = nextLLVMReg () + val tmp2 = nextLLVMReg () + val tmp3 = nextLLVMReg () + val tmp4 = nextLLVMReg () + val () = print (mkload (tmp1, "%uintptr_t*", "%nextBlock")) + val () = print (mkinst (tmp2, "sub", "i64", tmp1, llint (#2 (List.first entries)))) + val () = print (mkgep (tmp3, + concat ["[", llint numEntries, " x i8*]*"], + concat ["@", chunkName chunkLabel, ".nextLabels"], + [("i64", "0"), ("%uintptr_t", tmp2)])) + val () = print (mkload (tmp4, "i8**", tmp3)) + val () = print (concat ["\tindirectbr i8* ", tmp4, + ", [\n"]) + val () = List.foreachi (entries, fn (i, (label, _)) => + print (concat ["\t\t label %", + Label.toString label, + if i < numEntries - 1 + then ",\n" + else " ]\n"])) + in + () + end + else let + val tmp = nextLLVMReg () + val () = print (mkload (tmp, "%uintptr_t*", "%nextBlock")) + val () = print (concat ["\tswitch %uintptr_t ", tmp, + ", label %switchNextBlockDefault [\n"]) + val () = List.foreach (entries, fn (label, index) => + print (concat ["\t\t%uintptr_t ", + llint index, + ", label %", + Label.toString label, + "\n"])) + val () = print "\t]\n\n" + val () = print "switchNextBlockDefault:\n" + val () = print "\tunreachable\n" + in + () + end + val () = print "\n" val () = print (String.concatV (Vector.map (blocks, fn b => outputBlock (cxt, chunkLabel, b)))) val () = print "}\n\n" in @@ -1393,6 +1452,7 @@ fun makeContext program = in Context { amTimeProfiling = amTimeProfiling, program = program, + labelIndex = labelIndex, labelIndexAsString = labelIndexAsString, chunkName = chunkName, labelChunk = labelChunk, From c019ac7efefe3b9b7036bf6d5ec08a46a57129f9 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 16 Jul 2019 12:49:34 -0400 Subject: [PATCH 040/102] Use `ChunkLabel.toString` for chunk names --- mlton/backend/machine.fun | 2 +- mlton/codegen/c-codegen/c-codegen.fun | 76 +++++++++---------- mlton/codegen/llvm-codegen/llvm-codegen.fun | 83 +++++++++------------ 3 files changed, 71 insertions(+), 90 deletions(-) diff --git a/mlton/backend/machine.fun b/mlton/backend/machine.fun index 49c5ec276d..4b8c09666d 100644 --- a/mlton/backend/machine.fun +++ b/mlton/backend/machine.fun @@ -12,7 +12,7 @@ struct open S -structure ChunkLabel = Id (val noname = "ChunkLabel") +structure ChunkLabel = Id (val noname = "Chunk") structure Register = struct diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 6564c54688..5afb1ae895 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -570,11 +570,6 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, print: string -> unit, done: unit -> unit}} = let - val numChunks = List.length chunks - val {get = chunkLabelInfo: ChunkLabel.t -> {index: int}, - set = setChunkLabelInfo, ...} = - Property.getSetOnce - (ChunkLabel.plist, Property.initRaise ("CCodegen.chunkLabelInfo", ChunkLabel.layout)) val {get = labelInfo: Label.t -> {block: Block.t, chunkLabel: ChunkLabel.t, index: int option, @@ -584,30 +579,29 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, (Label.plist, Property.initRaise ("CCodeGen.labelInfo", Label.layout)) val nextChunks = Array.new (Vector.length frameInfos, NONE) val _ = - List.foreachi - (chunks, fn (i, Chunk.T {blocks, chunkLabel, ...}) => - (setChunkLabelInfo (chunkLabel, {index = i}); - Vector.foreach - (blocks, fn block as Block.T {kind, label, ...} => - let - val index = - case Kind.frameInfoOpt kind of - NONE => NONE - | SOME fi => - let - val index = FrameInfo.index fi - in - if Kind.isEntry kind - then Array.update (nextChunks, index, SOME label) - else () - ; SOME index - end - in - setLabelInfo (label, {block = block, - chunkLabel = chunkLabel, - index = index, - marked = ref false}) - end))) + List.foreach + (chunks, fn Chunk.T {blocks, chunkLabel, ...} => + Vector.foreach + (blocks, fn block as Block.T {kind, label, ...} => + let + val index = + case Kind.frameInfoOpt kind of + NONE => NONE + | SOME fi => + let + val index = FrameInfo.index fi + in + if Kind.isEntry kind + then Array.update (nextChunks, index, SOME label) + else () + ; SOME index + end + in + setLabelInfo (label, {block = block, + chunkLabel = chunkLabel, + index = index, + marked = ref false}) + end)) val nextChunks = Vector.keepAllMap (Vector.fromArray nextChunks, fn lo => lo) val labelChunk = #chunkLabel o labelInfo val labelIndex = #index o labelInfo @@ -619,13 +613,10 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, then concat ["/* ", Label.toString l, " */ ", s] else s end - val chunkLabelIndex = #index o chunkLabelInfo - val chunkLabelIndexAsString = C.int o chunkLabelIndex - fun chunkName c = concat ["Chunk", chunkLabelIndexAsString c] fun declareChunk (chunkLabel, print: string -> unit) = (print "PRIVATE extern ChunkFn_t " - ; print (chunkName chunkLabel) + ; print (ChunkLabel.toString chunkLabel) ; print ";\n") fun defineNextChunks print = (List.foreach (chunks, fn Chunk.T {chunkLabel, ...} => @@ -642,19 +633,21 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, ; print "/* " ; print (Label.toString label) ; print " */ &(" - ; print (chunkName (labelChunk label)) + ; print (ChunkLabel.toString (labelChunk label)) ; print "),\n")) ; print "};\n") fun declareNextChunks (chunks, print) = let - val seen = Array.new (numChunks, false) + val {destroy, get} = + Property.destGet + (ChunkLabel.plist, Property.initFun (fn _ => ref false)) val declareChunk = fn chunkLabel => let - val index = chunkLabelIndex chunkLabel + val seen = get chunkLabel in - if Array.sub (seen, index) + if !seen then () - else (Array.update (seen, index, true) + else (seen := true ; declareChunk (chunkLabel, print)) end in @@ -671,6 +664,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, | Transfer.Return {returnsTo, ...} => List.foreach (returnsTo, declareChunk o labelChunk) | _ => ()))) + ; destroy () ; print "PRIVATE extern ChunkFnPtr_t nextChunks[];\n" end @@ -925,7 +919,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, else NONE) of NONE => "(ChunkFnPtr_t)NULL" | SOME otherChunk => - concat ["&(", chunkName otherChunk, ")"]], + concat ["&(", ChunkLabel.toString otherChunk, ")"]], print) end in @@ -1024,7 +1018,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, [Label.toString label], print) else C.call ("\tFarCall", - [chunkName dstChunk, + [ChunkLabel.toString dstChunk, labelIndexAsString (label, {pretty = true})], print) end @@ -1155,7 +1149,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, end in declareProfileLabels () - ; C.callNoSemi ("DefineChunk", [chunkName chunkLabel], print); print "\n" + ; C.callNoSemi ("DefineChunk", [ChunkLabel.toString chunkLabel], print); print "\n" ; declareCReturns (); print "\n" ; declareRegisters (); print "\n" ; let diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 06978466f9..b4926b6bfb 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -26,7 +26,6 @@ datatype z = datatype WordSize.prim datatype Context = Context of { amTimeProfiling: bool, program: Program.t, - chunkName: ChunkLabel.t -> string, labelChunk: Label.t -> ChunkLabel.t, labelIndex: Label.t -> int, labelIndexAsString: Label.t -> string, @@ -887,7 +886,6 @@ fun leaveChunk (cxt, nextChunk, nextBlock) = *) fun callReturn (cxt, selfChunk, mustReturnToSelf, mayReturnToSelf, mustReturnToOther) = let - val Context { chunkName, ... } = cxt val stackTop = nextLLVMReg () val loadStackTop = mkload (stackTop, "%CPointer*", "%stackTop") val nextBlock = nextLLVMReg () @@ -919,7 +917,7 @@ fun callReturn (cxt, selfChunk, mustReturnToSelf, mayReturnToSelf, mustReturnToO val tmp2 = nextLLVMReg () in concat - [mkinst (tmp1, "icmp eq", "%ChunkFnPtr_t", nextChunk, concat ["@", chunkName selfChunk]), + [mkinst (tmp1, "icmp eq", "%ChunkFnPtr_t", nextChunk, concat ["@", ChunkLabel.toString selfChunk]), mkinst (tmp2, "and", "i1", if mayReturnToSelf then "1" else "0", tmp1), mkinst (returnToSelf, "or", "i1", if mustReturnToSelf then "1" else "0", tmp2)] end @@ -934,7 +932,7 @@ fun callReturn (cxt, selfChunk, mustReturnToSelf, mayReturnToSelf, mustReturnToO leaveChunkLabel, ":\n", case mustReturnToOther of NONE => leaveChunk (cxt, nextChunk, nextBlock) - | SOME dstChunk => leaveChunk (cxt, concat ["@", chunkName dstChunk], nextBlock)] + | SOME dstChunk => leaveChunk (cxt, concat ["@", ChunkLabel.toString dstChunk], nextBlock)] end fun adjStackTop (cxt, size: Bytes.t) = @@ -971,7 +969,7 @@ fun push (cxt, return: Label.t, size: Bytes.t) = fun outputTransfer (cxt, chunkLabel, transfer) = let val comment = concat ["\t; ", Layout.toString (Transfer.layout transfer), "\n"] - val Context { chunkName, labelChunk, labelIndexAsString, ... } = cxt + val Context { labelChunk, labelIndexAsString, ... } = cxt fun rtrans rsTo = let fun isSelf c = ChunkLabel.equals (chunkLabel, c) @@ -1134,7 +1132,7 @@ fun outputTransfer (cxt, chunkLabel, transfer) = "\tbr label %", Label.toString label, "\n"] else concat ["\t; FarCall\n", leaveChunk (cxt, - concat ["@", chunkName dstChunk], + concat ["@", ChunkLabel.toString dstChunk], labelIndexAsString label)] in concat [push, call] @@ -1250,7 +1248,7 @@ fun outputLLVMDeclarations print = fun outputChunkFn (cxt, chunk, print) = let val () = resetLLVMReg () - val Context { chunkName, labelIndex, ... } = cxt + val Context { labelIndex, ... } = cxt val Chunk.T {blocks, chunkLabel, regMax} = chunk val entries = let @@ -1267,13 +1265,13 @@ fun outputChunkFn (cxt, chunk, print) = val numEntries = List.length entries val () = if !Control.chunkJumpTable then let - val () = print (concat ["@", chunkName chunkLabel, ".nextLabels ", + val () = print (concat ["@", ChunkLabel.toString chunkLabel, ".nextLabels ", "= internal constant ", "[", llint numEntries, " x i8*] ", "[\n"]) val () = List.foreachi (entries, fn (i, (label, _)) => print (concat ["\t\ti8* blockaddress(", - "@", chunkName chunkLabel, ", ", + "@", ChunkLabel.toString chunkLabel, ", ", "%", Label.toString label, ")", if i < numEntries - 1 then ",\n" @@ -1283,7 +1281,7 @@ fun outputChunkFn (cxt, chunk, print) = end else () val () = print (concat ["define hidden %uintptr_t @", - chunkName chunkLabel, + ChunkLabel.toString chunkLabel, "(%CPointer %gcState, %CPointer %stackTopArg, %CPointer %frontierArg, %uintptr_t %nextBlockArg) {\nentry:\n"]) val () = print "\t%stackTop = alloca %CPointer\n" val () = print "\t%frontier = alloca %CPointer\n" @@ -1317,7 +1315,7 @@ fun outputChunkFn (cxt, chunk, print) = val () = print (mkinst (tmp2, "sub", "i64", tmp1, llint (#2 (List.first entries)))) val () = print (mkgep (tmp3, concat ["[", llint numEntries, " x i8*]*"], - concat ["@", chunkName chunkLabel, ".nextLabels"], + concat ["@", ChunkLabel.toString chunkLabel, ".nextLabels"], [("i64", "0"), ("%uintptr_t", tmp2)])) val () = print (mkload (tmp4, "i8**", tmp3)) val () = print (concat ["\tindirectbr i8* ", tmp4, @@ -1360,7 +1358,7 @@ fun outputChunks (cxt, chunks, print: string -> unit, done: unit -> unit}) = let - val Context { chunkName, program, ... } = cxt + val Context { program, ... } = cxt val () = cFunctions := [] val () = ffiSymbols := [] val { done, print, file=_ } = outputLL () @@ -1372,7 +1370,7 @@ fun outputChunks (cxt, chunks, ChunkLabel.equals (chunkLabel, Chunk.chunkLabel chunk)) then () else print (concat ["declare hidden %uintptr_t @", - chunkName chunkLabel, + ChunkLabel.toString chunkLabel, "(%CPointer,%CPointer,%CPointer,%uintptr_t)\n"]) val Program.T {chunks, ...} = program in @@ -1404,10 +1402,6 @@ fun outputChunks (cxt, chunks, fun makeContext program = let val Program.T { chunks, frameInfos, ...} = program - val {get = chunkLabelInfo: ChunkLabel.t -> {index: int}, - set = setChunkLabelInfo, ...} = - Property.getSetOnce - (ChunkLabel.plist, Property.initRaise ("LLVMCodegen.chunkLabelInfo", ChunkLabel.layout)) val {get = labelInfo: Label.t -> {chunkLabel: ChunkLabel.t, index: int option}, set = setLabelInfo, ...} = @@ -1415,37 +1409,31 @@ fun makeContext program = (Label.plist, Property.initRaise ("LLVMCodeGen.labelInfo", Label.layout)) val nextChunks = Array.new (Vector.length frameInfos, NONE) val _ = - List.foreachi - (chunks, fn (i, Chunk.T {blocks, chunkLabel, ...}) => - (setChunkLabelInfo (chunkLabel, {index = i}); - Vector.foreach - (blocks, fn Block.T {kind, label, ...} => - let - val index = - case Kind.frameInfoOpt kind of - NONE => NONE - | SOME fi => - let - val index = FrameInfo.index fi - in - if Kind.isEntry kind - then (Assert.assert ("LLVMCodegen.nextChunks", fn () => - Option.isNone (Array.sub (nextChunks, index))) - ; Array.update (nextChunks, index, SOME label)) - else () - ; SOME index - end - in - setLabelInfo (label, {chunkLabel = chunkLabel, - index = index}) - end))) + List.foreach + (chunks, fn Chunk.T {blocks, chunkLabel, ...} => + Vector.foreach + (blocks, fn Block.T {kind, label, ...} => + let + val index = + case Kind.frameInfoOpt kind of + NONE => NONE + | SOME fi => + let + val index = FrameInfo.index fi + in + if Kind.isEntry kind + then Array.update (nextChunks, index, SOME label) + else () + ; SOME index + end + in + setLabelInfo (label, {chunkLabel = chunkLabel, + index = index}) + end)) val nextChunks = Vector.keepAllMap (Vector.fromArray nextChunks, fn lo => lo) val labelChunk = #chunkLabel o labelInfo val labelIndex = valOf o #index o labelInfo fun labelIndexAsString (l: Label.t): string = llint (labelIndex l) - val chunkLabelIndex = #index o chunkLabelInfo - val chunkLabelIndexAsString = llint o chunkLabelIndex - fun chunkName c = concat ["Chunk", chunkLabelIndexAsString c] val amTimeProfiling = !Control.profile = Control.ProfileTimeField orelse !Control.profile = Control.ProfileTimeLabel @@ -1454,7 +1442,6 @@ fun makeContext program = program = program, labelIndex = labelIndex, labelIndexAsString = labelIndexAsString, - chunkName = chunkName, labelChunk = labelChunk, nextChunks = nextChunks } @@ -1493,13 +1480,13 @@ fun transC (cxt, outputC) = let val Context { program, ... } = cxt val Program.T {main = main, chunks = chunks, ... } = program - val Context { chunkName, labelChunk, labelIndexAsString, nextChunks, ... } = cxt + val Context { labelChunk, labelIndexAsString, nextChunks, ... } = cxt fun defineNextChunks print = (List.foreach (chunks, fn Chunk.T {chunkLabel, ...} => (print "PRIVATE extern ChunkFn_t " - ; print (chunkName chunkLabel) + ; print (ChunkLabel.toString chunkLabel) ; print ";\n")) ; print "PRIVATE ChunkFnPtr_t nextChunks[" ; print (C.int (Vector.length nextChunks)) @@ -1513,7 +1500,7 @@ fun transC (cxt, outputC) = ; print "/* " ; print (Label.toString label) ; print " */ &(" - ; print (chunkName (labelChunk label)) + ; print (ChunkLabel.toString (labelChunk label)) ; print "),\n")) ; print "};\n") From 2e26ebd7f80bb5425c502c65b91cb05ebd19d170 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 16 Jul 2019 15:02:02 -0400 Subject: [PATCH 041/102] Experiment using LLVM 'cc10' (aka, 'ghccc') The 'cc10' (aka, 'ghccc') calling convention has no callee-save registers. For chunks that want to use many registers, this avoids the save and restore of callee-save registers on entry and exit of the chunk. A simple "shim" function coordinates between the 'ccc' calling convention and the 'cc10' calling convention for the dispatch from `c-main.h`; with `-chunk-tail-call true`, this is the only time that a shim function is called. --- mlton/codegen/llvm-codegen/llvm-codegen.fun | 65 ++++++++++++++++----- mlton/control/control-flags.sig | 2 + mlton/control/control-flags.sml | 4 ++ mlton/main/main.fun | 2 + 4 files changed, 59 insertions(+), 14 deletions(-) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index b4926b6bfb..c3e4f4ec4c 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -12,6 +12,16 @@ open S open Machine +structure ChunkLabel = + struct + open ChunkLabel + fun toStringX cl = "X" ^ toString cl + fun toString' cl = + if !Control.llvmCC10 + then toStringX cl + else toString cl + end + local open Runtime in @@ -860,7 +870,11 @@ fun leaveChunk (cxt, nextChunk, nextBlock) = concat [mkload (stackTopArg, "%CPointer*", "%stackTop"), mkload (frontierArg, "%CPointer*", "%frontier"), - "\t", resReg, " = musttail call %uintptr_t ", + "\t", resReg, " = musttail call ", + if !Control.llvmCC10 + then "cc10 " + else "", + "%uintptr_t ", nextChunk, "(", "%CPointer ", "%gcState", ", ", "%CPointer ", stackTopArg, ", ", @@ -906,7 +920,10 @@ fun callReturn (cxt, selfChunk, mustReturnToSelf, mayReturnToSelf, mustReturnToO val tmp = nextLLVMReg () in concat - [mkgep (tmp, "%ChunkFnPtrArr_t*", "@nextChunks", + [mkgep (tmp, "%ChunkFnPtrArr_t*", + if !Control.llvmCC10 + then "@nextXChunks" + else "@nextChunks", [("i32", "0"), ("%uintptr_t", nextBlock)]), mkload (nextChunk, "%ChunkFnPtr_t*", tmp)] end @@ -917,7 +934,7 @@ fun callReturn (cxt, selfChunk, mustReturnToSelf, mayReturnToSelf, mustReturnToO val tmp2 = nextLLVMReg () in concat - [mkinst (tmp1, "icmp eq", "%ChunkFnPtr_t", nextChunk, concat ["@", ChunkLabel.toString selfChunk]), + [mkinst (tmp1, "icmp eq", "%ChunkFnPtr_t", nextChunk, concat ["@", ChunkLabel.toString' selfChunk]), mkinst (tmp2, "and", "i1", if mayReturnToSelf then "1" else "0", tmp1), mkinst (returnToSelf, "or", "i1", if mustReturnToSelf then "1" else "0", tmp2)] end @@ -932,7 +949,7 @@ fun callReturn (cxt, selfChunk, mustReturnToSelf, mayReturnToSelf, mustReturnToO leaveChunkLabel, ":\n", case mustReturnToOther of NONE => leaveChunk (cxt, nextChunk, nextBlock) - | SOME dstChunk => leaveChunk (cxt, concat ["@", ChunkLabel.toString dstChunk], nextBlock)] + | SOME dstChunk => leaveChunk (cxt, concat ["@", ChunkLabel.toString' dstChunk], nextBlock)] end fun adjStackTop (cxt, size: Bytes.t) = @@ -1132,7 +1149,7 @@ fun outputTransfer (cxt, chunkLabel, transfer) = "\tbr label %", Label.toString label, "\n"] else concat ["\t; FarCall\n", leaveChunk (cxt, - concat ["@", ChunkLabel.toString dstChunk], + concat ["@", ChunkLabel.toString' dstChunk], labelIndexAsString label)] in concat [push, call] @@ -1265,13 +1282,15 @@ fun outputChunkFn (cxt, chunk, print) = val numEntries = List.length entries val () = if !Control.chunkJumpTable then let - val () = print (concat ["@", ChunkLabel.toString chunkLabel, ".nextLabels ", + val () = print (concat ["@", ChunkLabel.toString' chunkLabel, ".nextLabels ", "= internal constant ", "[", llint numEntries, " x i8*] ", "[\n"]) val () = List.foreachi (entries, fn (i, (label, _)) => print (concat ["\t\ti8* blockaddress(", - "@", ChunkLabel.toString chunkLabel, ", ", + "@", + ChunkLabel.toString' chunkLabel, + ", ", "%", Label.toString label, ")", if i < numEntries - 1 then ",\n" @@ -1283,6 +1302,16 @@ fun outputChunkFn (cxt, chunk, print) = val () = print (concat ["define hidden %uintptr_t @", ChunkLabel.toString chunkLabel, "(%CPointer %gcState, %CPointer %stackTopArg, %CPointer %frontierArg, %uintptr_t %nextBlockArg) {\nentry:\n"]) + val () = + if !Control.llvmCC10 + then (print (concat ["\t%res = call cc10 %uintptr_t @", + ChunkLabel.toStringX chunkLabel, + "(%CPointer %gcState, %CPointer %stackTopArg, %CPointer %frontierArg, %uintptr_t %nextBlockArg)\n", + "\tret %uintptr_t %res\n}\n"]) + ; print (concat ["define hidden cc10 %uintptr_t @", + ChunkLabel.toStringX chunkLabel, + "(%CPointer %gcState, %CPointer %stackTopArg, %CPointer %frontierArg, %uintptr_t %nextBlockArg) {\nentry:\n"])) + else () val () = print "\t%stackTop = alloca %CPointer\n" val () = print "\t%frontier = alloca %CPointer\n" val () = print "\t%nextBlock = alloca %uintptr_t\n" @@ -1315,7 +1344,7 @@ fun outputChunkFn (cxt, chunk, print) = val () = print (mkinst (tmp2, "sub", "i64", tmp1, llint (#2 (List.first entries)))) val () = print (mkgep (tmp3, concat ["[", llint numEntries, " x i8*]*"], - concat ["@", ChunkLabel.toString chunkLabel, ".nextLabels"], + concat ["@", ChunkLabel.toString' chunkLabel, ".nextLabels"], [("i64", "0"), ("%uintptr_t", tmp2)])) val () = print (mkload (tmp4, "i8**", tmp3)) val () = print (concat ["\tindirectbr i8* ", tmp4, @@ -1370,12 +1399,13 @@ fun outputChunks (cxt, chunks, ChunkLabel.equals (chunkLabel, Chunk.chunkLabel chunk)) then () else print (concat ["declare hidden %uintptr_t @", - ChunkLabel.toString chunkLabel, + ChunkLabel.toString' chunkLabel, "(%CPointer,%CPointer,%CPointer,%uintptr_t)\n"]) val Program.T {chunks, ...} = program in List.foreach (chunks, declareChunk) - ; print "@nextChunks = external hidden global %ChunkFnPtrArr_t\n" + ; print (if !Control.llvmCC10 then "@nextXChunks" else "@nextChunks") + ; print " = external hidden global %ChunkFnPtrArr_t\n" ; print "\n\n" end val () = List.foreach (chunks, fn chunk => outputChunkFn (cxt, chunk, print)) @@ -1482,13 +1512,15 @@ fun transC (cxt, outputC) = val Program.T {main = main, chunks = chunks, ... } = program val Context { labelChunk, labelIndexAsString, nextChunks, ... } = cxt - fun defineNextChunks print = + fun defineNextChunks (print, nextChunksName, chunkName) = (List.foreach (chunks, fn Chunk.T {chunkLabel, ...} => (print "PRIVATE extern ChunkFn_t " - ; print (ChunkLabel.toString chunkLabel) + ; print (chunkName chunkLabel) ; print ";\n")) - ; print "PRIVATE ChunkFnPtr_t nextChunks[" + ; print "PRIVATE ChunkFnPtr_t " + ; print nextChunksName + ; print "[" ; print (C.int (Vector.length nextChunks)) ; print "] = {\n" ; Vector.foreachi @@ -1500,9 +1532,14 @@ fun transC (cxt, outputC) = ; print "/* " ; print (Label.toString label) ; print " */ &(" - ; print (ChunkLabel.toString (labelChunk label)) + ; print (chunkName (labelChunk label)) ; print "),\n")) ; print "};\n") + val defineNextChunks = fn print => + (defineNextChunks (print, "nextChunks", ChunkLabel.toString) + ; if !Control.llvmCC10 + then defineNextChunks (print, "nextXChunks", ChunkLabel.toStringX) + else ()) val {print, done, file = _} = outputC () val _ = diff --git a/mlton/control/control-flags.sig b/mlton/control/control-flags.sig index 4b33556310..484c0ecb21 100644 --- a/mlton/control/control-flags.sig +++ b/mlton/control/control-flags.sig @@ -267,6 +267,8 @@ signature CONTROL_FLAGS = (* name of the output library *) val libname : string ref + val llvmCC10: bool ref + (* Limit the code growth loop unrolling/unswitching will allow. *) val loopUnrollLimit: int ref val loopUnswitchLimit: int ref diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index 3591a93d91..45c720f08b 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -962,6 +962,10 @@ val libTargetDir = control {name = "lib target dir", val libname = ref "" +val llvmCC10 = control {name = "llvm 'cc10'", + default = false, + toString = Bool.toString} + val loopUnrollLimit = control {name = "loop unrolling limit", default = 150, toString = Int.toString} diff --git a/mlton/main/main.fun b/mlton/main/main.fun index c10ddae07b..c1e6b8a37a 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -588,6 +588,8 @@ fun makeOptions {usage} = (Expert, "llvm-as-opt-quote", " ", "pass (quoted) option to llvm assembler", SpaceString (fn s => List.push (llvm_asOpts, {opt = s, pred = OptPred.Yes}))), + (Expert, "llvm-cc10", " {false|true}", "use llvm 'cc10' for interchunk transfers", + boolRef llvmCC10), (Expert, "llvm-llc", " ", "path to llvm .bc -> .o compiler", SpaceString (fn s => llvm_llc := s)), (Normal, "llvm-llc-opt", " ", "pass option to llvm compiler", From 3330cbe759b81fddbb5f1b386f6fc70aa7db54ad Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 16 Jul 2019 16:59:13 -0400 Subject: [PATCH 042/102] Experiment with a new chunkify strategy --- mlton/backend/chunkify.fun | 172 ++++++++++++++++++++++++++++++++ mlton/control/control-flags.sig | 1 + mlton/control/control-flags.sml | 6 +- mlton/main/main.fun | 3 +- 4 files changed, 179 insertions(+), 3 deletions(-) diff --git a/mlton/backend/chunkify.fun b/mlton/backend/chunkify.fun index e890e327df..389dbbdc75 100644 --- a/mlton/backend/chunkify.fun +++ b/mlton/backend/chunkify.fun @@ -182,11 +182,183 @@ fun coalesce (program as Program.T {functions, main, ...}, limit) = labels = Vector.fromList (!labels)}) end +structure Class = + struct + type t = PropertyList.t DisjointSet.t + val new = DisjointSet.singleton o PropertyList.new + val plist = DisjointSet.! + val == = DisjointSet.union + end +structure Graph = DirectedGraph +structure Node = Graph.Node +fun simple (program as Program.T {functions, main, ...}) = + let + val functions = main :: functions + val {get = funcInfo: Func.t -> {class: Class.t, + function: Function.t, + node: unit Node.t}, + set = setFuncInfo, + rem = remFuncInfo, ...} = + Property.getSetOnce (Func.plist, + Property.initRaise ("Chunkify.simple.funcInfo", Func.layout)) + val funcClass = #class o funcInfo + val funcFunction = #function o funcInfo + val funcNode = #node o funcInfo + val {get = labelInfo: Label.t -> {class: Class.t, + func: Func.t}, + set = setLabelInfo, + rem = remLabelInfo, ...} = + Property.getSetOnce (Label.plist, + Property.initRaise ("Chunkify.simple.labelInfo", Label.layout)) + val labelClass = #class o labelInfo + val labelFunc = #func o labelInfo + val {get = nodeInfo: unit Node.t -> {func: Func.t}, + set = setNodeInfo, ...} = + Property.getSetOnce (Node.plist, + Property.initRaise ("Chunkify.simple.nodeInfo", Node.layout)) + val nodeFunc = #func o nodeInfo + val cgraph = Graph.new () + val _ = + List.foreach + (functions, fn f => + let + val {name, blocks, start, ...} = Function.dest f + val _ = + Vector.foreach + (blocks, fn Block.T {label, ...} => + setLabelInfo (label, {class = Class.new (), + func = name})) + val node = Graph.newNode cgraph + val _ = setNodeInfo (node, {func = name}) + val _ = setFuncInfo (name, {class = labelClass start, + function = f, + node = node}) + in + () + end) + (* Place src and dst blocks of intraprocedural transfers in same chunks. *) + val _ = + List.foreach + (functions, fn f => + Vector.foreach + (Function.blocks f, fn Block.T {label, transfer, ...} => + let + val c = labelClass label + fun same (j: Label.t): unit = + Class.== (c, labelClass j) + in + case transfer of + CCall {return, ...} => Option.app (return, same) + | Goto {dst, ...} => same dst + | Switch s => Switch.foreachLabel (s, same) + | _ => () + end)) + (* Build interprocedural call graph. *) + val _ = + List.foreach + (functions, fn f => + let + val {name, blocks, ...} = Function.dest f + val node = funcNode name + in + Vector.foreach + (blocks, fn Block.T {transfer, ...} => + case transfer of + Call {func, ...} => + (ignore o Graph.addEdge) + (cgraph, {from = node, to = funcNode func}) + | _ => ()) + end) + (* Compute rflow. *) + val rflow = Program.rflow program + val returnsTo = #returnsTo o rflow + val raisesTo = #raisesTo o rflow + (* Place src and dst blocks of SCC calls/raises/returns in same chunks. *) + val _ = + List.foreach + (Graph.stronglyConnectedComponents cgraph, fn nodes => + let + val funcs = List.map (nodes, nodeFunc) + fun funcInSCC f = + List.exists (funcs, fn f' => Func.equals (f, f')) + fun labelInSCC l = + funcInSCC (labelFunc l) + in + List.foreach + (funcs, fn f => + let + val {name, blocks, ...} = Function.dest (funcFunction f) + fun mkRTo rTo = List.revKeepAllMap (rTo name, fn l => + if labelInSCC l + then SOME (labelClass l) + else NONE) + val returnsTo = mkRTo returnsTo + val raisesTo = mkRTo raisesTo + fun eqRTo (l, rTo) = + let val lc = labelClass l + in List.foreach (rTo, fn rlc => Class.== (lc, rlc)) + end + in + Vector.foreach + (blocks, fn Block.T {label, transfer, ...} => + case transfer of + Call {func, ...} => + if funcInSCC func + then Class.== (labelClass label, funcClass func) + else () + | Raise _ => eqRTo (label, raisesTo) + | Return _ => eqRTo (label, returnsTo) + | _ => ()) + end) + end) + type chunk = {funcs: Func.t list ref, + labels: Label.t list ref} + val chunks: chunk list ref = ref [] + val {get = classChunk: Class.t -> chunk, ...} = + Property.get + (Class.plist, + Property.initFun (fn _ => + let + val c = {funcs = ref [], + labels = ref []} + val _ = List.push (chunks, c) + in + c + end)) + val _ = + let + fun 'a add (l: 'a, + get: 'a -> Class.t, + sel: chunk -> 'a list ref): unit = + List.push (sel (classChunk (get l)), l) + val _ = + List.foreach + (functions, fn f => + let + val {name, blocks, ...} = Function.dest f + val _ = add (name, funcClass, #funcs) + val _ = remFuncInfo name + val _ = + Vector.foreach + (blocks, fn Block.T {label, ...} => + (add (label, labelClass, #labels) + ; remLabelInfo label)) + in () + end) + in () + end + in + Vector.fromListMap (!chunks, fn {funcs, labels} => + {funcs = Vector.fromList (!funcs), + labels = Vector.fromList (!labels)}) + end + fun chunkify p = case !Control.chunkify of Control.Chunkify.Coalesce {limit} => coalesce (p, limit) | Control.Chunkify.One => one p | Control.Chunkify.PerFunc => perFunc p + | Control.Chunkify.Simple => simple p val chunkify = fn p => diff --git a/mlton/control/control-flags.sig b/mlton/control/control-flags.sig index 484c0ecb21..c14da9bb7a 100644 --- a/mlton/control/control-flags.sig +++ b/mlton/control/control-flags.sig @@ -39,6 +39,7 @@ signature CONTROL_FLAGS = datatype t = Coalesce of {limit: int} | One | PerFunc + | Simple end val chunkify: Chunkify.t ref diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index 45c720f08b..809274f5ea 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -67,11 +67,13 @@ structure Chunkify = Coalesce of {limit: int} | One | PerFunc + | Simple val toString = - fn One => "one" + fn Coalesce {limit} => concat ["coalesce ", Int.toString limit] + | One => "one" | PerFunc => "per function" - | Coalesce {limit} => concat ["coalesce ", Int.toString limit] + | Simple => "simple" end val chunkify = control {name = "chunkify", diff --git a/mlton/main/main.fun b/mlton/main/main.fun index c1e6b8a37a..f25e4aff29 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -275,12 +275,13 @@ fun makeOptions {usage} = (Expert, "cc-opt-quote", " ", "pass (quoted) option to C compiler", SpaceString (fn s => List.push (ccOpts, {opt = s, pred = OptPred.Yes}))), - (Expert, "chunkify", " {coalesce|func|one}", "set chunkify stategy", + (Expert, "chunkify", " {coalesce|func|one|simple}", "set chunkify stategy", SpaceString (fn s => explicitChunkify := SOME (case s of "func" => Chunkify.PerFunc | "one" => Chunkify.One + | "simple" => Chunkify.Simple | _ => let val usage = fn () => usage (concat ["invalid -chunkify flag: ", s]) From 8c5d09423f64282b3bd99f786ea8f3b07b7cd7a0 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 19 Jul 2019 14:11:34 -0400 Subject: [PATCH 043/102] Don't mark any functions as `noreturn` The only `noreturn` functions are `MLton_halt` and `MLton_bug`, which are only called at program termination, so there is no performance advantage to marking these functions as `noreturn`. As noted in a03514280, LLVM will erroneously optimize a `musttail call` to a `noreturn` function. For C calls that do not return, we simply leave the chunk with `return -2;`, much as `Thread_returnToC` does. --- include/c-chunk.h | 1 - mlton/codegen/c-codegen/c-codegen.fun | 12 +++++------- mlton/codegen/llvm-codegen/llvm-codegen.fun | 12 +++--------- 3 files changed, 8 insertions(+), 17 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index ef0cd0ce4c..6eef55b747 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -37,7 +37,6 @@ #endif #define UNUSED __attribute__ ((unused)) -#define NORETURN __attribute__ ((noreturn)) #define Unreachable() __builtin_unreachable() /* ------------------------------------------------- */ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 5afb1ae895..bb07951716 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -543,7 +543,7 @@ fun declareFFI (chunks, print) = | _ => ()) val _ = case transfer of - Transfer.CCall {func, return, ...} => + Transfer.CCall {func, ...} => let datatype z = datatype CFunction.Target.t val CFunction.T {target, ...} = func @@ -552,10 +552,7 @@ fun declareFFI (chunks, print) = Direct "Thread_returnToC" => () | Direct name => doit (name, fn () => - concat [case return of - NONE => "NORETURN " - | SOME _ => "", - CFunction.cPrototype func, ";\n"]) + concat [CFunction.cPrototype func, ";\n"]) | Indirect => () end | _ => () @@ -999,7 +996,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, "(ChunkFnPtr_t)NULL"], print) else (case return of - NONE => print "\tUnreachable ();\n" + NONE => print "\treturn (uintptr_t)-2;\n" | SOME {return, ...} => gotoLabel (return, {tab = true})) in () @@ -1049,7 +1046,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, ; gotoLabel (l, {tab = false}))) ; print "\tdefault: " ; (case default of - NONE => print "\tUnreachable();\n" + NONE => (print "\t" + ; C.call ("Unreachable", [], print)) | SOME default => gotoLabel (default, {tab = false})) ; print "\t}\n") in diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index c3e4f4ec4c..61216f049e 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -1060,10 +1060,6 @@ fun outputTransfer (cxt, chunkLabel, transfer) = mkstore (llty returnTy, resReg, "%CReturn" ^ CType.name (Type.toCType returnTy))) end - val callAttrs = - case return of - NONE => " noreturn" - | SOME _ => "" val (fnptrPre, fnptrVal, args) = case target of CFunction.Target.Direct name => @@ -1075,8 +1071,7 @@ fun outputTransfer (cxt, chunkLabel, transfer) = name, " (", String.concatWith (List.map (args, #1), - ", "), ")", - callAttrs]) + ", "), ")"]) in ("", name, args) end @@ -1108,11 +1103,10 @@ fun outputTransfer (cxt, chunkLabel, transfer) = String.concatWith (List.map (args, fn (ty, reg) => ty ^ " " ^ reg), - ", "), ")", - callAttrs] + ", "), ")"] val epilogue = case return of - NONE => "\tunreachable\n" + NONE => "\tret %uintptr_t -2\n" | SOME {return, ...} => let val cacheFrontierCode = From 0c2dabcc48a08f3c09fb91991a5aa91226aab6a6 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 19 Jul 2019 14:20:37 -0400 Subject: [PATCH 044/102] Remove `Thread_returnToC` from `c-chunk.h` --- include/c-chunk.h | 12 ------------ mlton/codegen/c-codegen/c-codegen.fun | 2 +- 2 files changed, 1 insertion(+), 13 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 6eef55b747..d4212a0005 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -190,18 +190,6 @@ } \ } while (0) -/* ------------------------------------------------- */ -/* Calling SML from C */ -/* ------------------------------------------------- */ - -#define Thread_returnToC() \ - do { \ - if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: Thread_returnToC()\n", \ - __FILE__, __LINE__); \ - return (uintptr_t)-1; \ - } while (0) - /* ------------------------------------------------- */ /* Primitives */ /* ------------------------------------------------- */ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 808a04ed49..cd0795dcb2 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -929,7 +929,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, (push (return, size); print "\tFlushFrontier ();\n"; print "\tFlushStackTop ();\n"; - print "\tThread_returnToC ();\n") + print "\treturn (uintptr_t)-1;\n") | CCall {args, func, return} => let val CFunction.T {return = returnTy, From 3d9c499316592ba0f49954916847d1e56f82f99d Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 19 Jul 2019 15:54:17 -0400 Subject: [PATCH 045/102] Perform more coalescing with `-chunkify simple` --- mlton/backend/chunkify.fun | 85 +++++++++++++++++++++++++++++++++++--- 1 file changed, 80 insertions(+), 5 deletions(-) diff --git a/mlton/backend/chunkify.fun b/mlton/backend/chunkify.fun index 389dbbdc75..834ab14e59 100644 --- a/mlton/backend/chunkify.fun +++ b/mlton/backend/chunkify.fun @@ -188,19 +188,34 @@ structure Class = val new = DisjointSet.singleton o PropertyList.new val plist = DisjointSet.! val == = DisjointSet.union + val equals = DisjointSet.equals end structure Graph = DirectedGraph structure Node = Graph.Node fun simple (program as Program.T {functions, main, ...}) = let val functions = main :: functions - val {get = funcInfo: Func.t -> {class: Class.t, + val mainFns = + let + val {name, blocks, ...} = Function.dest main + in + Vector.fold + (blocks, [name], fn (Block.T {transfer, ...}, mainFns) => + case transfer of + Call {func, ...} => func::mainFns + | _ => mainFns) + end + fun isMain f = + List.exists (mainFns, fn f' => Func.equals (f, f')) + val {get = funcInfo: Func.t -> {callSites: Label.t list ref, + class: Class.t, function: Function.t, node: unit Node.t}, set = setFuncInfo, rem = remFuncInfo, ...} = Property.getSetOnce (Func.plist, Property.initRaise ("Chunkify.simple.funcInfo", Func.layout)) + val funcCallSites = #callSites o funcInfo val funcClass = #class o funcInfo val funcFunction = #function o funcInfo val funcNode = #node o funcInfo @@ -230,7 +245,8 @@ fun simple (program as Program.T {functions, main, ...}) = func = name})) val node = Graph.newNode cgraph val _ = setNodeInfo (node, {func = name}) - val _ = setFuncInfo (name, {class = labelClass start, + val _ = setFuncInfo (name, {callSites = ref [], + class = labelClass start, function = f, node = node}) in @@ -262,11 +278,12 @@ fun simple (program as Program.T {functions, main, ...}) = val node = funcNode name in Vector.foreach - (blocks, fn Block.T {transfer, ...} => + (blocks, fn Block.T {label, transfer, ...} => case transfer of Call {func, ...} => - (ignore o Graph.addEdge) - (cgraph, {from = node, to = funcNode func}) + (List.push (funcCallSites func, label) + ; ignore (Graph.addEdge + (cgraph, {from = node, to = funcNode func}))) | _ => ()) end) (* Compute rflow. *) @@ -311,6 +328,64 @@ fun simple (program as Program.T {functions, main, ...}) = | _ => ()) end) end) + (* If all of a function's call sites are in the same (non-main) chunk, + * then place the function's entry block in the chunk. + * If all of a function's raise/return points are in the same (non-main) chunk, + * then place the function's raise/return blocks in the chunk. + *) + val _ = + let + val changed = ref false + fun loop () = + (List.foreach + (functions, fn f => + let + val {name, blocks, ...} = Function.dest f + val {callSites, class = funcClass, ...} = funcInfo name + fun oneClass ls = + case ls of + [] => NONE + | l::ls => + let + val c = labelClass l + in + if not (isMain (labelFunc l)) + andalso List.forall (ls, fn l => + not (isMain (labelFunc l)) + andalso Class.equals (c, labelClass l)) + then SOME (fn c' => + if not (Class.equals (c, c')) + then (Class.== (c, c') + ; changed := true) + else ()) + else NONE + end + val () = + Option.app + (oneClass (!callSites), fn f => f funcClass) + val () = + Option.app + (oneClass (returnsTo name @ raisesTo name), fn f => + Vector.foreach + (blocks, fn Block.T {label, transfer, ...} => + let + val f = fn () => f (labelClass label) + in + case transfer of + Raise _ => f () + | Return _ => f() + | _ => () + end)) + in + () + end) + ; if !changed + then (changed := false; loop ()) + else ()) + in + loop () + end + type chunk = {funcs: Func.t list ref, labels: Label.t list ref} val chunks: chunk list ref = ref [] From 138512f9e2fc59f3889d773a1fe41a54200bcf07 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 19 Jul 2019 15:54:42 -0400 Subject: [PATCH 046/102] Add and use `Control.Chunkify.fromString` --- mlton/backend/chunkify.fun | 4 ++-- mlton/control/control-flags.sig | 4 +++- mlton/control/control-flags.sml | 27 +++++++++++++++++++++++---- mlton/main/main.fun | 33 +++++++-------------------------- 4 files changed, 35 insertions(+), 33 deletions(-) diff --git a/mlton/backend/chunkify.fun b/mlton/backend/chunkify.fun index 834ab14e59..d8766de0e3 100644 --- a/mlton/backend/chunkify.fun +++ b/mlton/backend/chunkify.fun @@ -26,7 +26,7 @@ fun one (Program.T {functions, main, ...}) = end (* A chunkifier that puts each function in its own chunk. *) -fun perFunc (Program.T {functions, main, ...}) = +fun func (Program.T {functions, main, ...}) = Vector.fromListMap (main :: functions, fn f => let @@ -432,7 +432,7 @@ fun chunkify p = case !Control.chunkify of Control.Chunkify.Coalesce {limit} => coalesce (p, limit) | Control.Chunkify.One => one p - | Control.Chunkify.PerFunc => perFunc p + | Control.Chunkify.Func => func p | Control.Chunkify.Simple => simple p val chunkify = diff --git a/mlton/control/control-flags.sig b/mlton/control/control-flags.sig index 1d792b790c..2176d5db28 100644 --- a/mlton/control/control-flags.sig +++ b/mlton/control/control-flags.sig @@ -37,9 +37,11 @@ signature CONTROL_FLAGS = structure Chunkify: sig datatype t = Coalesce of {limit: int} + | Func | One - | PerFunc | Simple + val toString: t -> string + val fromString: string -> t option end val chunkify: Chunkify.t ref diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index 9858efe8aa..9a32a7809a 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -65,15 +65,34 @@ structure Chunkify = struct datatype t = Coalesce of {limit: int} + | Func | One - | PerFunc | Simple - val toString = - fn Coalesce {limit} => concat ["coalesce ", Int.toString limit] + fun toString c = + case c of + Coalesce {limit} => concat ["coalesce ", Int.toString limit] + | Func => "func" | One => "one" - | PerFunc => "per function" | Simple => "simple" + fun fromString s = + case s of + "func" => SOME Func + | "one" => SOME One + | "simple" => SOME Simple + | s => + if String.hasPrefix (s, {prefix = "coalesce"}) + then let + val s = String.dropPrefix (s, 8) + in + if String.forall (s, Char.isDigit) + then (case Int.fromString s of + NONE => NONE + | SOME limit => + SOME (Coalesce {limit = limit})) + else NONE + end + else NONE end val chunkify = control {name = "chunkify", diff --git a/mlton/main/main.fun b/mlton/main/main.fun index e5c9ccee7d..f396d8c38d 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -276,30 +276,11 @@ fun makeOptions {usage} = SpaceString (fn s => List.push (ccOpts, {opt = s, pred = OptPred.Yes}))), (Expert, "chunkify", " {coalesce|func|one|simple}", "set chunkify stategy", - SpaceString (fn s => - explicitChunkify - := SOME (case s of - "func" => Chunkify.PerFunc - | "one" => Chunkify.One - | "simple" => Chunkify.Simple - | _ => let - val usage = fn () => - usage (concat ["invalid -chunkify flag: ", s]) - in - if String.hasPrefix (s, {prefix = "coalesce"}) - then let - val s = String.dropPrefix (s, 8) - in - if String.forall (s, Char.isDigit) - then (case Int.fromString s of - NONE => usage () - | SOME n => - Chunkify.Coalesce - {limit = n}) - else usage () - end - else usage () - end))), + SpaceString + (fn s => + explicitChunkify := (case Chunkify.fromString s of + SOME chunkify => SOME chunkify + | NONE => usage (concat ["invalid -chunkify flag: ", s])))), (Expert, "chunk-batch", " ", "batch c files at size ~n", Int (fn n => chunkBatch := n)), (Expert, "chunk-jump-table", " {false|true}", @@ -1216,10 +1197,10 @@ fun commandLine (args: string list): unit = chunkify := (case !explicitChunkify of NONE => (case !codegen of - AMD64Codegen => Chunkify.PerFunc + AMD64Codegen => Chunkify.Func | CCodegen => Chunkify.Coalesce {limit = 4096} | LLVMCodegen => Chunkify.Coalesce {limit = 4096} - | X86Codegen => Chunkify.PerFunc + | X86Codegen => Chunkify.Func ) | SOME c => c) val _ = if not (!Control.codegen = X86Codegen) andalso !Native.IEEEFP From f8b171562cc6be0a8fc9eaf73b0a3162ac2463b5 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 19 Jul 2019 16:06:33 -0400 Subject: [PATCH 047/102] Name the RSSA function that initializes globals `globals` --- mlton/backend/ssa2-to-rssa.fun | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/mlton/backend/ssa2-to-rssa.fun b/mlton/backend/ssa2-to-rssa.fun index 39606c0fa4..c16760cda9 100644 --- a/mlton/backend/ssa2-to-rssa.fun +++ b/mlton/backend/ssa2-to-rssa.fun @@ -1669,7 +1669,7 @@ fun convert (program as S.Program.T {functions, globals, main, ...}, statements = Vector.new0 (), transfer = S.Transfer.Bug})), mayInline = false, (* doesn't matter *) - name = Func.newNoname (), + name = Func.newString "globals", raises = NONE, returns = NONE, start = start}, From faef16463d649d999a32e36ea806fb50e5152499 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 19 Jul 2019 16:47:49 -0400 Subject: [PATCH 048/102] Use `structure Parse` for `-chunkify` option and parameterize `Chunkify.Simple` --- mlton/backend/chunkify.fun | 41 ++++++++++++-------- mlton/control/control-flags.sig | 6 ++- mlton/control/control-flags.sml | 69 +++++++++++++++++++++++---------- 3 files changed, 78 insertions(+), 38 deletions(-) diff --git a/mlton/backend/chunkify.fun b/mlton/backend/chunkify.fun index d8766de0e3..c4327b52b5 100644 --- a/mlton/backend/chunkify.fun +++ b/mlton/backend/chunkify.fun @@ -192,19 +192,22 @@ structure Class = end structure Graph = DirectedGraph structure Node = Graph.Node -fun simple (program as Program.T {functions, main, ...}) = +fun simple (program as Program.T {functions, main, ...}, + {mainFns, sccC, sccR, singC, singR}) = let val functions = main :: functions val mainFns = - let - val {name, blocks, ...} = Function.dest main - in - Vector.fold - (blocks, [name], fn (Block.T {transfer, ...}, mainFns) => - case transfer of - Call {func, ...} => func::mainFns - | _ => mainFns) - end + if mainFns + then let + val {name, blocks, ...} = Function.dest main + in + Vector.fold + (blocks, [name], fn (Block.T {transfer, ...}, mainFns) => + case transfer of + Call {func, ...} => func::mainFns + | _ => mainFns) + end + else [] fun isMain f = List.exists (mainFns, fn f' => Func.equals (f, f')) val {get = funcInfo: Func.t -> {callSites: Label.t list ref, @@ -312,15 +315,17 @@ fun simple (program as Program.T {functions, main, ...}) = val returnsTo = mkRTo returnsTo val raisesTo = mkRTo raisesTo fun eqRTo (l, rTo) = - let val lc = labelClass l - in List.foreach (rTo, fn rlc => Class.== (lc, rlc)) - end + if sccR + then let val lc = labelClass l + in List.foreach (rTo, fn rlc => Class.== (lc, rlc)) + end + else () in Vector.foreach (blocks, fn Block.T {label, transfer, ...} => case transfer of Call {func, ...} => - if funcInSCC func + if sccC andalso funcInSCC func then Class.== (labelClass label, funcClass func) else () | Raise _ => eqRTo (label, raisesTo) @@ -360,10 +365,11 @@ fun simple (program as Program.T {functions, main, ...}) = else ()) else NONE end - val () = + fun doSingC () = Option.app (oneClass (!callSites), fn f => f funcClass) - val () = + val () = if singC then doSingC () else () + fun doSingR () = Option.app (oneClass (returnsTo name @ raisesTo name), fn f => Vector.foreach @@ -376,6 +382,7 @@ fun simple (program as Program.T {functions, main, ...}) = | Return _ => f() | _ => () end)) + val () = if singR then doSingR () else () in () end) @@ -433,7 +440,7 @@ fun chunkify p = Control.Chunkify.Coalesce {limit} => coalesce (p, limit) | Control.Chunkify.One => one p | Control.Chunkify.Func => func p - | Control.Chunkify.Simple => simple p + | Control.Chunkify.Simple opts => simple (p, opts) val chunkify = fn p => diff --git a/mlton/control/control-flags.sig b/mlton/control/control-flags.sig index 2176d5db28..eb817b9444 100644 --- a/mlton/control/control-flags.sig +++ b/mlton/control/control-flags.sig @@ -39,7 +39,11 @@ signature CONTROL_FLAGS = datatype t = Coalesce of {limit: int} | Func | One - | Simple + | Simple of {mainFns: bool, + sccC: bool, + sccR: bool, + singC: bool, + singR: bool} val toString: t -> string val fromString: string -> t option end diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index 9a32a7809a..1ac6c7a5ae 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -67,32 +67,61 @@ structure Chunkify = Coalesce of {limit: int} | Func | One - | Simple + | Simple of {mainFns: bool, + sccC: bool, + sccR: bool, + singC: bool, + singR: bool} fun toString c = case c of - Coalesce {limit} => concat ["coalesce ", Int.toString limit] + Coalesce {limit} => concat ["coalesce", Int.toString limit] | Func => "func" | One => "one" - | Simple => "simple" + | Simple {mainFns, sccC, sccR, singC, singR} => + let + open Layout + in + toString + (namedRecord + ("simple", + [("mainFns", Bool.layout mainFns), + ("sccC", Bool.layout sccC), + ("sccR", Bool.layout sccR), + ("singC", Bool.layout singC), + ("singR", Bool.layout singR)])) + end fun fromString s = - case s of - "func" => SOME Func - | "one" => SOME One - | "simple" => SOME Simple - | s => - if String.hasPrefix (s, {prefix = "coalesce"}) - then let - val s = String.dropPrefix (s, 8) - in - if String.forall (s, Char.isDigit) - then (case Int.fromString s of - NONE => NONE - | SOME limit => - SOME (Coalesce {limit = limit})) - else NONE - end - else NONE + let + open Parse + infix 1 <|> >>= + infix 3 <*> <* *> + infixr 4 <$> <$$> <$$$> <$$$$> <$ <$?> + val p = + any + [str "coalesce" *> + (peek (nextSat Char.isDigit) *> + fromScan (Function.curry Int.scan StringCvt.DEC)) >>= (fn limit => + pure (Coalesce {limit = limit})), + str "func" *> pure Func, + str "one" *> pure One, + str "simple" *> + cbrack (ffield ("mainFns", bool) >>= (fn mainFns => + nfield ("sccC", bool) >>= (fn sccC => + nfield ("sccR", bool) >>= (fn sccR => + nfield ("singC", bool) >>= (fn singC => + nfield ("singR", bool) >>= (fn singR => + pure (Simple {mainFns = mainFns, + sccC = sccC, + sccR = sccR, + singC = singC, + singR = singR})))))))] + <* failing next + in + case parseString (p, s) of + No _ => NONE + | Yes c => SOME c + end end val chunkify = control {name = "chunkify", From 911b5d480de60ee8011e7460900090d612a7e251 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Sat, 20 Jul 2019 10:07:28 -0400 Subject: [PATCH 049/102] Add `expect: WordX.t option` to RSSA and Machine `Switch.T` --- mlton/backend/backend.fun | 3 ++- mlton/backend/packed-representation.fun | 3 +++ mlton/backend/rssa-tree.fun | 5 ++++- mlton/backend/ssa2-to-rssa.fun | 1 + mlton/backend/switch.fun | 9 ++++++--- mlton/backend/switch.sig | 3 ++- 6 files changed, 18 insertions(+), 6 deletions(-) diff --git a/mlton/backend/backend.fun b/mlton/backend/backend.fun index d217bf8879..f000228554 100644 --- a/mlton/backend/backend.fun +++ b/mlton/backend/backend.fun @@ -870,7 +870,7 @@ fun toMachine (rssa: Rssa.Program.t) = M.Transfer.Return {returnsTo = returnsTo}) | R.Transfer.Switch switch => let - val R.Switch.T {cases, default, size, test} = + val R.Switch.T {cases, default, expect, size, test} = switch in simple @@ -884,6 +884,7 @@ fun toMachine (rssa: Rssa.Program.t) = (M.Switch.T {cases = cases, default = default, + expect = expect, size = size, test = translateOperand test})) end diff --git a/mlton/backend/packed-representation.fun b/mlton/backend/packed-representation.fun index 1d25c2241f..3a671738b2 100644 --- a/mlton/backend/packed-representation.fun +++ b/mlton/backend/packed-representation.fun @@ -1578,6 +1578,7 @@ structure Objptrs = in ([s], Switch (Switch.T {cases = cases, default = default, + expect = NONE, size = WordSize.objptrHeader (), test = tag})) end @@ -1677,6 +1678,7 @@ structure Small = {cases = Vector.new1 (WordX.zero testSize, notSmall), default = SOME smallDefault, + expect = NONE, size = testSize, test = test}) in @@ -1708,6 +1710,7 @@ structure Small = val transfer = Switch (Switch.T {cases = cases, default = default, + expect = NONE, size = testSize, test = tagOp}) in diff --git a/mlton/backend/rssa-tree.fun b/mlton/backend/rssa-tree.fun index 3587485365..a005ea1f63 100644 --- a/mlton/backend/rssa-tree.fun +++ b/mlton/backend/rssa-tree.fun @@ -161,9 +161,10 @@ structure Switch = open S end - fun replaceVar (T {cases, default, size, test}, f) = + fun replaceVar (T {cases, default, expect, size, test}, f) = T {cases = cases, default = default, + expect = expect, size = size, test = Operand.replaceVar (test, f)} end @@ -449,12 +450,14 @@ structure Transfer = Switch (Switch.T {cases = Vector.new2 ((make 0, falsee), (make 1, truee)), default = NONE, + expect = NONE, size = WordSize.bool, test = test}) fun ifZero (test, {falsee, truee}) = Switch (Switch.T {cases = Vector.new1 (make 0, truee), default = SOME falsee, + expect = NONE, size = WordSize.bool, test = test}) end diff --git a/mlton/backend/ssa2-to-rssa.fun b/mlton/backend/ssa2-to-rssa.fun index c16760cda9..d708acc03f 100644 --- a/mlton/backend/ssa2-to-rssa.fun +++ b/mlton/backend/ssa2-to-rssa.fun @@ -764,6 +764,7 @@ fun convert (program as S.Program.T {functions, globals, main, ...}, (Switch.T {cases = cases, default = default, + expect = NONE, size = convertWordSize s, test = varOp test})) end diff --git a/mlton/backend/switch.fun b/mlton/backend/switch.fun index d06be53cc9..abd9185ceb 100644 --- a/mlton/backend/switch.fun +++ b/mlton/backend/switch.fun @@ -34,22 +34,24 @@ fun isRedundant {cases: 'a vector, datatype t = T of {cases: (WordX.t * Label.t) vector, default: Label.t option, + expect: WordX.t option, size: WordSize.t, test: Use.t} -fun layout (T {cases, default, test, ...})= +fun layout (T {cases, default, expect, test, ...})= let open Layout in seq [str "switch ", record [("test", Use.layout test), ("default", Option.layout Label.layout default), + ("expect", Option.layout (fn w => WordX.layout (w, {suffix = true})) expect), ("cases", Vector.layout (Layout.tuple2 (fn w => WordX.layout (w, {suffix = true}), Label.layout)) cases)]] end -fun isOk (T {cases, default, size = _, test}, {checkUse, labelIsOk}): bool = +fun isOk (T {cases, default, test, ...}, {checkUse, labelIsOk}): bool = let val () = checkUse test val ty = Use.ty test @@ -91,8 +93,9 @@ fun foreachLabel (s, f) = foldLabelUse (s, (), {label = f o #1, use = fn _ => ()}) -fun replaceLabels (T {cases, default, size, test}, f) = +fun replaceLabels (T {cases, default, expect, size, test}, f) = T {cases = Vector.map (cases, (fn (w, l) => (w, f l))), default = Option.map (default, f), + expect = expect, size = size, test = test} end diff --git a/mlton/backend/switch.sig b/mlton/backend/switch.sig index c91cc290cc..18ae522a24 100644 --- a/mlton/backend/switch.sig +++ b/mlton/backend/switch.sig @@ -1,4 +1,4 @@ -(* Copyright (C) 2009 Matthew Fluet. +(* Copyright (C) 2009,2019 Matthew Fluet. * Copyright (C) 2002-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * @@ -30,6 +30,7 @@ signature SWITCH = T of {(* Cases are in increasing order of word. *) cases: (WordX.t * Label.t) vector, default: Label.t option, + expect: WordX.t option, size: WordSize.t, test: Use.t} From e2b27ab632f62fb97db9ad8f4cf82a182773c6cf Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Sat, 20 Jul 2019 10:07:48 -0400 Subject: [PATCH 050/102] Use `__builtin_expect` in C codegen for `Switch.T` with `expect` --- include/c-chunk.h | 1 + mlton/codegen/c-codegen/c-codegen.fun | 6 +++++- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index d4212a0005..09dfabc758 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -36,6 +36,7 @@ #define DEBUG_CCODEGEN FALSE #endif +#define Expect(x,c) __builtin_expect(x, c) #define UNUSED __attribute__ ((unused)) #define Unreachable() __builtin_unreachable() diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index cd0795dcb2..048654da6f 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1031,8 +1031,12 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, | Return {returnsTo} => rtrans ("Return", returnsTo) | Switch switch => let - val Switch.T {cases, default, test, ...} = switch + val Switch.T {cases, default, expect, test, ...} = switch val test = operandToString test + val test = + case expect of + NONE => test + | SOME w => concat ["Expect (", test, ", ", WordX.toC w, ")"] fun bnz (lnz, lz) = C.call ("\tBNZ", [test, Label.toString lnz, Label.toString lz], print) fun switch () = From 823815a740f4805c3b90c5a3176db45ac541a92d Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Sat, 20 Jul 2019 20:40:52 -0400 Subject: [PATCH 051/102] Add `-gc-expect {none|false|true}` compile-time option The option indicates the `expect` value of RSSA `Transfer.Switch`es that branch to a garbage collection. Using `gc-expect false` should indicate that performing a GC is a cold path. --- mlton/backend/limit-check.fun | 14 +++++++++----- mlton/backend/rssa-tree.fun | 5 +++-- mlton/backend/rssa-tree.sig | 1 + mlton/control/control-flags.sig | 2 ++ mlton/control/control-flags.sml | 4 ++++ mlton/main/main.fun | 8 ++++++++ 6 files changed, 27 insertions(+), 7 deletions(-) diff --git a/mlton/backend/limit-check.fun b/mlton/backend/limit-check.fun index 52c1795089..25e4a4a623 100644 --- a/mlton/backend/limit-check.fun +++ b/mlton/backend/limit-check.fun @@ -249,9 +249,11 @@ fun insertFunction (f: Function.t, label = dontCollect', statements = Vector.new0 (), transfer = - Transfer.ifBool - (global, {falsee = dontCollect, - truee = collect})}) + Transfer.ifBoolE + (global, + !Control.gcExpect, + {falsee = dontCollect, + truee = collect})}) in (dontCollect', Vector.new1 @@ -324,8 +326,9 @@ fun insertFunction (f: Function.t, dst = SOME (res, Type.bool), prim = prim} val transfer = - Transfer.ifBool + Transfer.ifBoolE (Operand.Var {var = res, ty = Type.bool}, + !Control.gcExpect, {falsee = dontCollect, truee = collect}) in @@ -479,8 +482,9 @@ fun insertFunction (f: Function.t, prim = Prim.wordAddCheckP (WordSize.csize (), {signed = false})}), - Transfer.ifBool + Transfer.ifBoolE (Operand.Var {var = test, ty = Type.bool}, + !Control.gcExpect, {falsee = heapCheck (false, Operand.Var {var = bytes, diff --git a/mlton/backend/rssa-tree.fun b/mlton/backend/rssa-tree.fun index a005ea1f63..011e19ed53 100644 --- a/mlton/backend/rssa-tree.fun +++ b/mlton/backend/rssa-tree.fun @@ -446,13 +446,14 @@ structure Transfer = local fun make i = WordX.fromIntInf (i, WordSize.bool) in - fun ifBool (test, {falsee, truee}) = + fun ifBoolE (test, expect, {falsee, truee}) = Switch (Switch.T {cases = Vector.new2 ((make 0, falsee), (make 1, truee)), default = NONE, - expect = NONE, + expect = Option.map (expect, fn expect => if expect then make 1 else make 0), size = WordSize.bool, test = test}) + fun ifBool (test, branches) = ifBoolE (test, NONE, branches) fun ifZero (test, {falsee, truee}) = Switch (Switch.T {cases = Vector.new1 (make 0, truee), diff --git a/mlton/backend/rssa-tree.sig b/mlton/backend/rssa-tree.sig index 9a879d0984..94d73ffade 100644 --- a/mlton/backend/rssa-tree.sig +++ b/mlton/backend/rssa-tree.sig @@ -117,6 +117,7 @@ signature RSSA_TREE = val foreachLabel: t * (Label.t -> unit) -> unit val foreachUse: t * (Var.t -> unit) -> unit val ifBool: Operand.t * {falsee: Label.t, truee: Label.t} -> t + val ifBoolE: Operand.t * bool option * {falsee: Label.t, truee: Label.t} -> t (* in ifZero, the operand should be of type defaultWord *) val ifZero: Operand.t * {falsee: Label.t, truee: Label.t} -> t val layout: t -> Layout.t diff --git a/mlton/control/control-flags.sig b/mlton/control/control-flags.sig index eb817b9444..c7f7391cfc 100644 --- a/mlton/control/control-flags.sig +++ b/mlton/control/control-flags.sig @@ -213,6 +213,8 @@ signature CONTROL_FLAGS = | Every val gcCheck: gcCheck ref + val gcExpect: bool option ref + val globalizeArrays: bool ref val globalizeRefs: bool ref diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index 1ac6c7a5ae..e5b342028e 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -890,6 +890,10 @@ val gcCheck = control {name = "gc check", default = Limit, toString = GcCheck.toString} +val gcExpect = control {name = "gc check expect", + default = NONE, + toString = Option.toString Bool.toString} + val globalizeArrays = control {name = "globalize arrays", default = false, toString = Bool.toString} diff --git a/mlton/main/main.fun b/mlton/main/main.fun index f396d8c38d..473aa4a351 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -451,6 +451,14 @@ fun makeOptions {usage} = | "first" => First | "every" => Every | _ => usage (concat ["invalid -gc-check flag: ", s])))), + (Expert, "gc-expect", " {none|false|true}", "GC expect", + SpaceString (fn s => + gcExpect := + (case s of + "false" => SOME false + | "none" => NONE + | "true" => SOME true + | _ => usage (concat ["invalid -gc-expect flag: ", s])))), (Expert, "globalize-arrays", " {false|true}", "globalize arrays", boolRef globalizeArrays), (Expert, "globalize-refs", " {true|false}", "globalize refs", From c3b99054c867b8416b8cd376759061069f78cbfc Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 22 Jul 2019 07:22:22 -0400 Subject: [PATCH 052/102] Change `-chunk-must-rto-other-opt` default to `true`. With 8c5d09423, the LLVM bug that erroneously optimizes a `musttail call` to a `noreturn` function is avoided. --- mlton/control/control-flags.sml | 2 +- mlton/main/main.fun | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index e5b342028e..0dbff76f71 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -135,7 +135,7 @@ val chunkMayRToSelfOpt = control {name = "chunkMayRToSelfOpt", default = true, toString = Bool.toString} val chunkMustRToOtherOpt = control {name = "chunkMustRToOtherOpt", - default = false, + default = true, toString = Bool.toString} val chunkMustRToSelfOpt = control {name = "chunkMustRToSelfOpt", default = true, diff --git a/mlton/main/main.fun b/mlton/main/main.fun index 473aa4a351..763fe71555 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -289,7 +289,7 @@ fun makeOptions {usage} = (Expert, "chunk-may-rto-self-opt", " {true|false}", "whether to optimize return/raise that may transfer to self chunk", Bool (fn b => chunkMayRToSelfOpt := b)), - (Expert, "chunk-must-rto-other-opt", " {false|true}", + (Expert, "chunk-must-rto-other-opt", " {true|false}", "whether to optimize return/raise that must transfer to one other chunk", Bool (fn b => chunkMustRToOtherOpt := b)), (Expert, "chunk-must-rto-self-opt", " {true|false}", From 473808f07dc0ea8150099a2ce79bf82b44c9e00e Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 22 Jul 2019 09:39:45 -0400 Subject: [PATCH 053/102] Add `-chunk-must-rto-sing-opt {true|false}` to optimize return/raise to a single label There are a few `Raise` transfers that can statically determine the handler label; typically, an otherwise uncaught exception can transfer directly to the top-level exception handler. --- include/c-chunk.h | 8 +-- mlton/codegen/c-codegen/c-codegen.fun | 80 +++++++++++---------- mlton/codegen/llvm-codegen/llvm-codegen.fun | 50 ++++++++----- mlton/control/control-flags.sig | 1 + mlton/control/control-flags.sml | 3 + mlton/main/main.fun | 3 + 6 files changed, 84 insertions(+), 61 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 09dfabc758..329f4558d8 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -163,18 +163,18 @@ if (x) goto lnz; else goto lz; \ } while (0) -#define NearCall(l) \ +#define NearJump(l) \ goto l -#define FarCall(nextChunk, nextBlock) \ +#define FarJump(nextChunk, nextBlock) \ do { \ if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: FarCall(%s, %d)\n", \ + fprintf (stderr, "%s:%d: FarJump(%s, %d)\n", \ __FILE__, __LINE__, #nextChunk, (int)nextBlock); \ LeaveChunk(nextChunk, nextBlock); \ } while (0) -#define Return(mustReturnToSelf,mayReturnToSelf,mustReturnToOther) \ +#define IndJump(mustReturnToSelf,mayReturnToSelf,mustReturnToOther) \ do { \ nextBlock = *(uintptr_t*)(StackTop - sizeof(uintptr_t)); \ if (DEBUG_CCODEGEN) \ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 048654da6f..5bb0f343c9 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -880,8 +880,28 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, fun outputTransfer t = let datatype z = datatype Transfer.t - fun rtrans (name, rsTo) = + fun jump label = let + val dstChunk = labelChunk label + in + if ChunkLabel.equals (chunkLabel, dstChunk) + then C.call ("\tNearJump", + [Label.toString label], + print) + else C.call ("\tFarJump", + [ChunkLabel.toString dstChunk, + labelIndexAsString (label, {pretty = true})], + print) + end + fun rtrans rsTo = + let + val mustRToOne = + case rsTo of + [] => NONE + | l::rsTo => + if List.forall (rsTo, fn l' => Label.equals (l, l')) + then SOME l + else NONE fun isSelf c = ChunkLabel.equals (chunkLabel, c) val rsTo = List.fold @@ -899,25 +919,24 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, [] => (true, NONE) | c::rsTo => (false, - List.fold (rsTo, SOME c, fn (c', co) => - case co of - NONE => NONE - | SOME c => if ChunkLabel.equals (c, c') - then SOME c - else NONE)) + if List.forall (rsTo, fn c' => ChunkLabel.equals (c, c')) + then SOME c + else NONE) in - print "\t" - ; C.call (name, - [C.bool (!Control.chunkMustRToSelfOpt andalso mustRToSelf), - C.bool (!Control.chunkMayRToSelfOpt andalso mayRToSelf), - case (if (!Control.chunkMustRToOtherOpt andalso - (!Control.chunkMayRToSelfOpt orelse not mayRToSelf)) - then mustRToOther - else NONE) of - NONE => "(ChunkFnPtr_t)NULL" - | SOME otherChunk => - concat ["&(", ChunkLabel.toString otherChunk, ")"]], - print) + case (!Control.chunkMustRToSingOpt, mustRToOne) of + (true, SOME dst) => jump dst + | _ => + C.call ("\tIndJump", + [C.bool (!Control.chunkMustRToSelfOpt andalso mustRToSelf), + C.bool (!Control.chunkMayRToSelfOpt andalso mayRToSelf), + case (if (!Control.chunkMustRToOtherOpt andalso + (!Control.chunkMayRToSelfOpt orelse not mayRToSelf)) + then mustRToOther + else NONE) of + NONE => "(ChunkFnPtr_t)NULL" + | SOME otherChunk => + concat ["&(", ChunkLabel.toString otherChunk, ")"]], + print) end in case t of @@ -1002,23 +1021,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, () end | Call {label, return, ...} => - let - val dstChunk = labelChunk label - val _ = - case return of - NONE => () - | SOME {return, size, ...} => - push (return, size) - in - if ChunkLabel.equals (chunkLabel, dstChunk) - then C.call ("\tNearCall", - [Label.toString label], - print) - else C.call ("\tFarCall", - [ChunkLabel.toString dstChunk, - labelIndexAsString (label, {pretty = true})], - print) - end + (Option.app (return, fn {return, size, ...} => push (return, size)) + ; jump label) | Goto dst => gotoLabel (dst, {tab = true}) | Raise {raisesTo} => (outputStatement (Statement.PrimApp @@ -1027,8 +1031,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, Operand.gcField GCField.ExnStack), dst = SOME Operand.StackTop, prim = Prim.cpointerAdd}) - ; rtrans ("Return", raisesTo)) - | Return {returnsTo} => rtrans ("Return", returnsTo) + ; rtrans raisesTo) + | Return {returnsTo} => rtrans returnsTo | Switch switch => let val Switch.T {cases, default, expect, test, ...} = switch diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 4f1c45269d..680b9964cb 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -961,7 +961,7 @@ fun leaveChunk (cxt, nextChunk, nextBlock) = flushStackTop cxt, "\tret %uintptr_t ", nextBlock, "\n"] -(* Return(mustReturnToSelf, mayReturnToSelf, mustReturnToOther) +(* IndJump(mustReturnToSelf, mayReturnToSelf, mustReturnToOther) nextBlock = *(uintptr_t* )(StackTop - sizeof(uintptr_t)); ChunkFnPtr_t nextChunk = nextChunks[nextBlock]; @@ -973,7 +973,7 @@ fun leaveChunk (cxt, nextChunk, nextBlock) = LeaveChunk( *nextChunk, nextBlock); } *) -fun callReturn (cxt, selfChunk, mustReturnToSelf, mayReturnToSelf, mustReturnToOther) = +fun indJump (cxt, selfChunk, mustReturnToSelf, mayReturnToSelf, mustReturnToOther) = let val stackTop = nextLLVMTemp () val loadStackTop = mkload (stackTop, "%CPointer*", "%stackTop", "") @@ -1062,8 +1062,25 @@ fun outputTransfer (cxt, chunkLabel, transfer) = let val comment = concat ["\t; ", Layout.toString (Transfer.layout transfer), "\n"] val Context { labelChunk, labelIndexAsString, ... } = cxt + fun jump label = + let + val dstChunk = labelChunk label + in + if ChunkLabel.equals (chunkLabel, dstChunk) + then concat ["\tbr label %", Label.toString label, "\n"] + else leaveChunk (cxt, + concat ["@", ChunkLabel.toString' dstChunk], + labelIndexAsString label) + end fun rtrans rsTo = let + val mustRToOne = + case rsTo of + [] => NONE + | l::rsTo => + if List.forall (rsTo, fn l' => Label.equals (l, l')) + then SOME l + else NONE fun isSelf c = ChunkLabel.equals (chunkLabel, c) val rsTo = List.fold @@ -1088,13 +1105,16 @@ fun outputTransfer (cxt, chunkLabel, transfer) = then SOME c else NONE)) in - callReturn (cxt, chunkLabel, - !Control.chunkMustRToSelfOpt andalso mustRToSelf, - !Control.chunkMayRToSelfOpt andalso mayRToSelf, - if (!Control.chunkMustRToOtherOpt andalso - (!Control.chunkMayRToSelfOpt orelse not mayRToSelf)) - then mustRToOther - else NONE) + case (!Control.chunkMustRToSingOpt, mustRToOne) of + (true, SOME dst) => jump dst + | _ => + indJump (cxt, chunkLabel, + !Control.chunkMustRToSelfOpt andalso mustRToSelf, + !Control.chunkMayRToSelfOpt andalso mayRToSelf, + if (!Control.chunkMustRToOtherOpt andalso + (!Control.chunkMayRToSelfOpt orelse not mayRToSelf)) + then mustRToOther + else NONE) end in case transfer of @@ -1189,7 +1209,7 @@ fun outputTransfer (cxt, chunkLabel, transfer) = val cacheStackTopCode = if CFunction.writesStackTop func then cacheStackTop cxt else "" val br = if CFunction.maySwitchThreadsFrom func - then callReturn (cxt, chunkLabel, false, true, NONE) + then indJump (cxt, chunkLabel, false, true, NONE) else concat ["\tbr label %", Label.toString return, "\n"] in concat [cacheFrontierCode, cacheStackTopCode, br] @@ -1209,19 +1229,11 @@ fun outputTransfer (cxt, chunkLabel, transfer) = end | Transfer.Call {label, return, ...} => let - val dstChunk = labelChunk label val push = case return of NONE => "" | SOME {return, size, ...} => push (cxt, return, size) - val call = if ChunkLabel.equals (chunkLabel, dstChunk) - then concat ["\t; NearCall\n", - "\tbr label %", Label.toString label, "\n"] - else concat ["\t; FarCall\n", - leaveChunk (cxt, - concat ["@", ChunkLabel.toString' dstChunk], - labelIndexAsString label)] in - concat [push, call] + concat [comment, push, jump label] end | Transfer.Goto label => let diff --git a/mlton/control/control-flags.sig b/mlton/control/control-flags.sig index c7f7391cfc..421d69d8bf 100644 --- a/mlton/control/control-flags.sig +++ b/mlton/control/control-flags.sig @@ -53,6 +53,7 @@ signature CONTROL_FLAGS = val chunkMayRToSelfOpt: bool ref val chunkMustRToOtherOpt: bool ref val chunkMustRToSelfOpt: bool ref + val chunkMustRToSingOpt: bool ref val chunkTailCall: bool ref val closureConvertGlobalize: bool ref diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index 0dbff76f71..07e0a51567 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -140,6 +140,9 @@ val chunkMustRToOtherOpt = control {name = "chunkMustRToOtherOpt", val chunkMustRToSelfOpt = control {name = "chunkMustRToSelfOpt", default = true, toString = Bool.toString} +val chunkMustRToSingOpt = control {name = "chunkMustRToSingOpt", + default = true, + toString = Bool.toString} val chunkTailCall = control {name = "chunkTailCall", default = true, toString = Bool.toString} diff --git a/mlton/main/main.fun b/mlton/main/main.fun index 763fe71555..70dfaacb7d 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -295,6 +295,9 @@ fun makeOptions {usage} = (Expert, "chunk-must-rto-self-opt", " {true|false}", "whether to optimize return/raise that must transfer to self chunk", Bool (fn b => chunkMustRToSelfOpt := b)), + (Expert, "chunk-must-rto-sing-opt", " {true|false}", + "whether to optimize return/raise that must transfer to a single label", + Bool (fn b => chunkMustRToSingOpt := b)), (Expert, "chunk-tail-call", " {false|true}", "whether to use tail calls for interchunk transfers", Bool (fn b => chunkTailCall := b)), From 26b47f870e9657c027f8a2c82ac4f861e419ba3a Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 22 Jul 2019 09:49:22 -0400 Subject: [PATCH 054/102] Rename `-native-commented ` to `-codegen-comments ` --- .../amd64-allocate-registers.fun | 24 +++++++++---------- .../amd64-generate-transfers.fun | 6 ++--- mlton/codegen/amd64-codegen/amd64-mlton.fun | 6 ++--- .../codegen/amd64-codegen/amd64-translate.fun | 6 ++--- .../x86-codegen/x86-allocate-registers.fun | 24 +++++++++---------- .../x86-codegen/x86-generate-transfers.fun | 6 ++--- mlton/codegen/x86-codegen/x86-mlton.fun | 6 ++--- mlton/codegen/x86-codegen/x86-translate.fun | 6 ++--- mlton/control/control-flags.sig | 6 ++--- mlton/control/control-flags.sml | 9 +++---- mlton/main/main.fun | 4 ++-- 11 files changed, 52 insertions(+), 51 deletions(-) diff --git a/mlton/codegen/amd64-codegen/amd64-allocate-registers.fun b/mlton/codegen/amd64-codegen/amd64-allocate-registers.fun index cd2cecb340..dc552bf760 100644 --- a/mlton/codegen/amd64-codegen/amd64-allocate-registers.fun +++ b/mlton/codegen/amd64-codegen/amd64-allocate-registers.fun @@ -4315,14 +4315,14 @@ struct registerAllocation = registerAllocation} in {assembly = AppendList.appends - [if !Control.Native.commented > 3 + [if !Control.codegenComments > 3 then AppendList.cons ((Assembly.comment "pre begin:"), (toComments ra)) else AppendList.empty, assembly_commit_xmmregisters, assembly_commit_registers, - if !Control.Native.commented > 3 + if !Control.codegenComments > 3 then AppendList.cons ((Assembly.comment "pre end:"), (toComments registerAllocation)) @@ -4610,7 +4610,7 @@ struct registerAllocation = registerAllocation} in {assembly = AppendList.appends - [if !Control.Native.commented > 3 + [if !Control.codegenComments > 3 then AppendList.cons ((Assembly.comment "post begin:"), (toComments ra)) @@ -4618,7 +4618,7 @@ struct assembly_commit_xmmregisters, assembly_commit_registers, assembly_dead_registers, - if !Control.Native.commented > 3 + if !Control.codegenComments > 3 then AppendList.cons ((Assembly.comment "post end:"), (toComments registerAllocation)) @@ -6380,7 +6380,7 @@ struct = let val _ = setRA(id, {registerAllocation = registerAllocation}) in - {assembly = if !Control.Native.commented > 2 + {assembly = if !Control.codegenComments > 2 then (toComments registerAllocation) else AppendList.empty, registerAllocation = registerAllocation} @@ -10313,19 +10313,19 @@ struct val assembly'' = AppendList.appends - [if !Control.Native.commented > 1 + [if !Control.codegenComments > 1 then AppendList.fromList [Assembly.comment (String.make (60, #"*")), (Assembly.comment (Directive.toString d))] else AppendList.empty, - if !Control.Native.commented > 4 + if !Control.codegenComments > 4 then AppendList.fromList (Liveness.toComments info) else AppendList.empty, assembly', - if !Control.Native.commented > 5 + if !Control.codegenComments > 5 then (RegisterAllocation.toComments registerAllocation) else AppendList.empty] @@ -10356,19 +10356,19 @@ struct val assembly'' = AppendList.appends - [if !Control.Native.commented > 1 + [if !Control.codegenComments > 1 then AppendList.fromList [Assembly.comment (String.make (60, #"*")), (Assembly.comment (Instruction.toString i))] else AppendList.empty, - if !Control.Native.commented > 4 + if !Control.codegenComments > 4 then AppendList.fromList (Liveness.toComments info) else AppendList.empty, assembly', - if !Control.Native.commented > 5 + if !Control.codegenComments > 5 then (RegisterAllocation.toComments registerAllocation) else AppendList.empty] @@ -10380,7 +10380,7 @@ struct end) val assembly = AppendList.toList assembly - val assembly = if !Control.Native.commented > 1 + val assembly = if !Control.codegenComments > 1 then (Assembly.comment (String.make (60, #"&")):: Assembly.comment diff --git a/mlton/codegen/amd64-codegen/amd64-generate-transfers.fun b/mlton/codegen/amd64-codegen/amd64-generate-transfers.fun index 9e8cce7d02..4072441cb6 100644 --- a/mlton/codegen/amd64-codegen/amd64-generate-transfers.fun +++ b/mlton/codegen/amd64-codegen/amd64-generate-transfers.fun @@ -745,11 +745,11 @@ struct end))] val pre = AppendList.appends - [if !Control.Native.commented > 1 + [if !Control.codegenComments > 1 then AppendList.single (Assembly.comment (Entry.toString entry)) else AppendList.empty, - if !Control.Native.commented > 2 + if !Control.codegenComments > 2 then AppendList.single (Assembly.comment (LiveSet.fold @@ -803,7 +803,7 @@ struct and effectDefault (gef as GEF {fall,...}) {label, transfer} : Assembly.t AppendList.t = AppendList.append - (if !Control.Native.commented > 1 + (if !Control.codegenComments > 1 then AppendList.single (Assembly.comment (Transfer.toString transfer)) diff --git a/mlton/codegen/amd64-codegen/amd64-mlton.fun b/mlton/codegen/amd64-codegen/amd64-mlton.fun index abd9bf02aa..1d7412b954 100644 --- a/mlton/codegen/amd64-codegen/amd64-mlton.fun +++ b/mlton/codegen/amd64-codegen/amd64-mlton.fun @@ -759,7 +759,7 @@ struct val (comment_begin, comment_end) - = if !Control.Native.commented > 0 + = if !Control.codegenComments > 0 then let val comment = primName in @@ -1277,7 +1277,7 @@ struct = let val CFunction.T {convention, target, ...} = func val comment_begin - = if !Control.Native.commented > 0 + = if !Control.codegenComments > 0 then AppendList.single (amd64.Block.mkBlock' {entry = NONE, @@ -1325,7 +1325,7 @@ struct transfer = NONE}) end val comment_end - = if !Control.Native.commented > 0 + = if !Control.codegenComments > 0 then AppendList.single (amd64.Block.mkBlock' {entry = NONE, diff --git a/mlton/codegen/amd64-codegen/amd64-translate.fun b/mlton/codegen/amd64-codegen/amd64-translate.fun index cb0fa6ce1c..d2ef9475ce 100644 --- a/mlton/codegen/amd64-codegen/amd64-translate.fun +++ b/mlton/codegen/amd64-codegen/amd64-translate.fun @@ -386,7 +386,7 @@ struct open Machine.Statement fun comments statement - = if !Control.Native.commented > 0 + = if !Control.codegenComments > 0 then let val comment = (Layout.toString o layout) statement in @@ -582,7 +582,7 @@ struct => switch(test, amd64.Transfer.Cases.word cases, l)) fun comments transfer - = if !Control.Native.commented > 0 + = if !Control.codegenComments > 0 then let val comment = (Layout.toString o layout) transfer in @@ -715,7 +715,7 @@ struct amd64.Block.mkBlock' {entry = NONE, statements - = if !Control.Native.commented > 0 + = if !Control.codegenComments > 0 then let val comment = concat ["Live: ", diff --git a/mlton/codegen/x86-codegen/x86-allocate-registers.fun b/mlton/codegen/x86-codegen/x86-allocate-registers.fun index 002001ff17..5228cf28e6 100644 --- a/mlton/codegen/x86-codegen/x86-allocate-registers.fun +++ b/mlton/codegen/x86-codegen/x86-allocate-registers.fun @@ -4007,14 +4007,14 @@ struct registerAllocation = registerAllocation} in {assembly = AppendList.appends - [if !Control.Native.commented > 3 + [if !Control.codegenComments > 3 then AppendList.cons ((Assembly.comment "pre begin:"), (toComments ra)) else AppendList.empty, assembly_commit_fltregisters, assembly_commit_registers, - if !Control.Native.commented > 3 + if !Control.codegenComments > 3 then AppendList.cons ((Assembly.comment "pre end:"), (toComments registerAllocation)) @@ -4306,7 +4306,7 @@ struct registerAllocation = registerAllocation} in {assembly = AppendList.appends - [if !Control.Native.commented > 3 + [if !Control.codegenComments > 3 then AppendList.cons ((Assembly.comment "post begin:"), (toComments ra)) @@ -4314,7 +4314,7 @@ struct assembly_commit_fltregisters, assembly_commit_registers, assembly_dead_registers, - if !Control.Native.commented > 3 + if !Control.codegenComments > 3 then AppendList.cons ((Assembly.comment "post end:"), (toComments registerAllocation)) @@ -6173,7 +6173,7 @@ struct = let val _ = setRA(id, {registerAllocation = registerAllocation}) in - {assembly = if !Control.Native.commented > 2 + {assembly = if !Control.codegenComments > 2 then (toComments registerAllocation) else AppendList.empty, registerAllocation = registerAllocation} @@ -10828,19 +10828,19 @@ struct val assembly'' = AppendList.appends - [if !Control.Native.commented > 1 + [if !Control.codegenComments > 1 then AppendList.fromList [Assembly.comment (String.make (60, #"*")), (Assembly.comment (Directive.toString d))] else AppendList.empty, - if !Control.Native.commented > 4 + if !Control.codegenComments > 4 then AppendList.fromList (Liveness.toComments info) else AppendList.empty, assembly', - if !Control.Native.commented > 5 + if !Control.codegenComments > 5 then (RegisterAllocation.toComments registerAllocation) else AppendList.empty] @@ -10871,19 +10871,19 @@ struct val assembly'' = AppendList.appends - [if !Control.Native.commented > 1 + [if !Control.codegenComments > 1 then AppendList.fromList [Assembly.comment (String.make (60, #"*")), (Assembly.comment (Instruction.toString i))] else AppendList.empty, - if !Control.Native.commented > 4 + if !Control.codegenComments > 4 then AppendList.fromList (Liveness.toComments info) else AppendList.empty, assembly', - if !Control.Native.commented > 5 + if !Control.codegenComments > 5 then (RegisterAllocation.toComments registerAllocation) else AppendList.empty] @@ -10895,7 +10895,7 @@ struct end) val assembly = AppendList.toList assembly - val assembly = if !Control.Native.commented > 1 + val assembly = if !Control.codegenComments > 1 then (Assembly.comment (String.make (60, #"&")):: Assembly.comment diff --git a/mlton/codegen/x86-codegen/x86-generate-transfers.fun b/mlton/codegen/x86-codegen/x86-generate-transfers.fun index 9b6867b2fc..e016c7a304 100644 --- a/mlton/codegen/x86-codegen/x86-generate-transfers.fun +++ b/mlton/codegen/x86-codegen/x86-generate-transfers.fun @@ -724,11 +724,11 @@ struct end))] val pre = AppendList.appends - [if !Control.Native.commented > 1 + [if !Control.codegenComments > 1 then AppendList.single (Assembly.comment (Entry.toString entry)) else AppendList.empty, - if !Control.Native.commented > 2 + if !Control.codegenComments > 2 then AppendList.single (Assembly.comment (LiveSet.fold @@ -782,7 +782,7 @@ struct and effectDefault (gef as GEF {fall,...}) {label, transfer} : Assembly.t AppendList.t = AppendList.append - (if !Control.Native.commented > 1 + (if !Control.codegenComments > 1 then AppendList.single (Assembly.comment (Transfer.toString transfer)) diff --git a/mlton/codegen/x86-codegen/x86-mlton.fun b/mlton/codegen/x86-codegen/x86-mlton.fun index 85b987b983..b3cc1879ea 100644 --- a/mlton/codegen/x86-codegen/x86-mlton.fun +++ b/mlton/codegen/x86-codegen/x86-mlton.fun @@ -878,7 +878,7 @@ struct val (comment_begin, comment_end) - = if !Control.Native.commented > 0 + = if !Control.codegenComments > 0 then let val comment = primName in @@ -1724,7 +1724,7 @@ struct = let val CFunction.T {convention, target, ...} = func val comment_begin - = if !Control.Native.commented > 0 + = if !Control.codegenComments > 0 then AppendList.single (x86.Block.mkBlock' {entry = NONE, @@ -1772,7 +1772,7 @@ struct transfer = NONE}) end val comment_end - = if !Control.Native.commented > 0 + = if !Control.codegenComments > 0 then AppendList.single (x86.Block.mkBlock' {entry = NONE, diff --git a/mlton/codegen/x86-codegen/x86-translate.fun b/mlton/codegen/x86-codegen/x86-translate.fun index 3260b107aa..1489d48acb 100644 --- a/mlton/codegen/x86-codegen/x86-translate.fun +++ b/mlton/codegen/x86-codegen/x86-translate.fun @@ -397,7 +397,7 @@ struct open Machine.Statement fun comments statement - = if !Control.Native.commented > 0 + = if !Control.codegenComments > 0 then let val comment = (Layout.toString o layout) statement in @@ -594,7 +594,7 @@ struct => switch(test, x86.Transfer.Cases.word cases, l)) fun comments transfer - = if !Control.Native.commented > 0 + = if !Control.codegenComments > 0 then let val comment = (Layout.toString o layout) transfer in @@ -727,7 +727,7 @@ struct x86.Block.mkBlock' {entry = NONE, statements - = if !Control.Native.commented > 0 + = if !Control.codegenComments > 0 then let val comment = concat ["Live: ", diff --git a/mlton/control/control-flags.sig b/mlton/control/control-flags.sig index 421d69d8bf..965e6937f3 100644 --- a/mlton/control/control-flags.sig +++ b/mlton/control/control-flags.sig @@ -74,6 +74,9 @@ signature CONTROL_FLAGS = val codegen: Codegen.t ref + (* whether or not to use comments in codegen *) + val codegenComments: int ref + val contifyIntoMain: bool ref (* Generate an executable with debugging info. *) @@ -303,9 +306,6 @@ signature CONTROL_FLAGS = structure Native: sig - (* whether or not to use comments in native codegen *) - val commented: int ref - (* whether to eliminate redundant AL ops in native codegen *) val elimALRedundant: bool ref diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index 07e0a51567..f5587049c1 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -178,6 +178,11 @@ val codegen = control {name = "codegen", default = Codegen.X86Codegen, toString = Codegen.toString} +val codegenComments = control {name = "codegen comments", + default = 0, + toString = Int.toString} + + val contifyIntoMain = control {name = "contifyIntoMain", default = false, toString = Bool.toString} @@ -1067,10 +1072,6 @@ val mlbPathVars = structure Native = struct - val commented = control {name = "native commented", - default = 0, - toString = Int.toString} - val elimALRedundant = control {name = "elim AL redundant", default = true, toString = Bool.toString} diff --git a/mlton/main/main.fun b/mlton/main/main.fun index 70dfaacb7d..f7b6e2ec62 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -330,6 +330,8 @@ fun makeOptions {usage} = s = Control.Codegen.toString cg) of SOME cg => Explicit cg | NONE => usage (concat ["invalid -codegen flag: ", s]))))), + (Expert, "codegen-comments", " ", "level of comments (0)", + intRef codegenComments), (Normal, "const", " ' '", "set compile-time constant", SpaceString (fn s => case String.tokens (s, Char.isSpace) of @@ -630,8 +632,6 @@ fun makeOptions {usage} = [case parseMlbPathVar s of NONE => Error.bug ("strange mlb path var: " ^ s) | SOME v => v])), - (Expert, "native-commented", " ", "level of comments (0)", - intRef Native.commented), (Expert, "native-al-redundant", "{true|false}", "eliminate redundant AL ops", boolRef Native.elimALRedundant), From efc2e64f0597225006751448faf99d0b91ff16a6 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 22 Jul 2019 10:01:32 -0400 Subject: [PATCH 055/102] Emit comments in generated C code. --- mlton/codegen/c-codegen/c-codegen.fun | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 5bb0f343c9..efead991eb 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -938,6 +938,12 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, concat ["&(", ChunkLabel.toString otherChunk, ")"]], print) end + val () = + if !Control.codegenComments > 0 + then (print "\t/* " + ; print (Layout.toString (Transfer.layout t)) + ; print " */\n") + else () in case t of CCall {func = @@ -1085,6 +1091,17 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, | _ => switch () end end + val outputStatement = fn s => + let + val () = + if !Control.codegenComments > 1 + then (print "\t/* " + ; print (Layout.toString (Statement.layout s)) + ; print " */\n") + else () + in + outputStatement s + end fun outputBlock (Block.T {kind, label, statements, transfer, ...}) = let val _ = print (concat [Label.toString label, ":\n"]) From c9394d8b7f060b973222cbe02fdc0289bb3a3f2a Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 22 Jul 2019 11:21:48 -0400 Subject: [PATCH 056/102] Use `T_` for temporaries in C and LLVM codegens --- include/c-chunk.h | 3 ++- mlton/codegen/c-codegen/c-codegen.fun | 12 +++++++----- mlton/codegen/llvm-codegen/llvm-codegen.fun | 18 ++++++++---------- 3 files changed, 17 insertions(+), 16 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 329f4558d8..0996e97296 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -117,8 +117,9 @@ #define C(ty, x) (*(ty*)(x)) #define G(ty, i) (global##ty [i]) #define O(ty, b, o) (*(ty*)((b) + (o))) -#define X(ty, b, i, s, o) (*(ty*)((b) + ((i) * (s)) + (o))) #define S(ty, i) (*(ty*)(StackTop + (i))) +#define T(ty, i) T ## ty ## _ ## i +#define X(ty, b, i, s, o) (*(ty*)((b) + ((i) * (s)) + (o))) #define GCState gcState #define Frontier frontier diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index efead991eb..9eb29b25ef 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -729,8 +729,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, | StackOffset s => StackOffset.toString s | StackTop => "StackTop" | Temporary t => - concat [Type.name (Temporary.ty t), "_", - Int.toString (Temporary.index t)] + concat ["T", C.args [Type.name (Temporary.ty t), + Int.toString (Temporary.index t)]] | Word w => WordX.toC w in val operandToString = toString @@ -760,11 +760,13 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, List.foreach (CType.all, fn t => let - val pre = concat ["\t", CType.toString t, " ", - CType.name t, "_"] + val pre = concat ["\t", CType.toString t, " "] in Int.for (0, 1 + tempsMax t, fn i => - print (concat [pre, C.int i, ";\n"])) + (print pre + ; print (concat ["T", C.args [CType.name t, + Int.toString i]]) + ; print ";\n")) end) fun outputStatement s = let diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 680b9964cb..6e1ac78486 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -373,7 +373,7 @@ fun resetLLVMTemp () = Counter.reset (tempCounter, 0) fun nextLLVMTemp () = concat ["%t", Int.toString (Counter.next tempCounter)] fun temporaryName (ty: CType.t, index: int): string = - concat ["%temp", CType.name ty, "_", Int.toString index] + concat ["%T", CType.name ty, "_", Int.toString index] val cFunctions : string list ref = ref [] @@ -1402,15 +1402,13 @@ fun outputChunkFn (cxt, chunk, print) = fn t => print (concat ["\t%CReturn", CType.name t, " = alloca %", CType.toString t, "\n"])) - val () = List.foreach (CType.all, - fn t => - let - val pre = concat ["\t%temp", CType.name t, "_"] - val post = concat [" = alloca %", CType.toString t, "\n"] - in - Int.for (0, 1 + tempsMax t, - fn i => print (concat [pre, llint i, post])) - end) + val () = List.foreach (CType.all, fn t => + Int.for (0, 1 + tempsMax t, fn i => + (print "\t" + ; print (temporaryName (t, i)) + ; print " = alloca %" + ; print (CType.toString t) + ; print "\n"))) val () = print (mkstore ("%CPointer", "%stackTopArg", "%stackTop", "")) val () = print (mkstore ("%CPointer", "%frontierArg", "%frontier", "")) val () = print (mkstore ("%uintptr_t", "%nextBlockArg", "%nextBlock", "")) From af9de6b4dcb3c655e909fa946858992068421889 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 22 Jul 2019 11:33:58 -0400 Subject: [PATCH 057/102] Eliminate `BNZ` from `c-chunk.h` --- include/c-chunk.h | 8 -------- mlton/codegen/c-codegen/c-codegen.fun | 8 +++++++- 2 files changed, 7 insertions(+), 9 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 0996e97296..ec2ca6f600 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -156,14 +156,6 @@ /* Transfers */ /* ------------------------------------------------- */ -#define BNZ(x, lnz, lz) \ - do { \ - if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: BNZ(%llu, %s, %s)\n", \ - __FILE__, __LINE__, ((unsigned long long)x), #lnz, #lz); \ - if (x) goto lnz; else goto lz; \ - } while (0) - #define NearJump(l) \ goto l diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 9eb29b25ef..2463d03055 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1050,7 +1050,13 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, NONE => test | SOME w => concat ["Expect (", test, ", ", WordX.toC w, ")"] fun bnz (lnz, lz) = - C.call ("\tBNZ", [test, Label.toString lnz, Label.toString lz], print) + (print "\tif (" + ; print test + ; print ") goto " + ; print (Label.toString lnz) + ; print "; else goto " + ; print (Label.toString lz) + ; print ";\n") fun switch () = (print "\tswitch (" ; print test From 21a245165a595c9b765eb6079ea35bcca4b15f03 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 22 Jul 2019 13:48:06 -0400 Subject: [PATCH 058/102] Eliminate more of `c-chunk.h` --- include/c-chunk.h | 84 +-------------- mlton/codegen/c-codegen/c-codegen.fun | 150 ++++++++++++++++++-------- 2 files changed, 106 insertions(+), 128 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index ec2ca6f600..20518fd2c5 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -46,30 +46,15 @@ #define DefineChunk(chunkName) \ PRIVATE uintptr_t chunkName(UNUSED CPointer gcState, UNUSED CPointer stackTop, UNUSED CPointer frontier, uintptr_t nextBlock) { \ - UNUSED static const ChunkFnPtr_t selfChunk = &(chunkName); \ + UNUSED ChunkFnPtr_t nextChunk; \ if (DEBUG_CCODEGEN) \ fprintf (stderr, "%s:%d: %s(nextBlock = %d)\n", \ __FILE__, __LINE__, #chunkName, (int)nextBlock); \ - SwitchNextBlock(); + goto doSwitchNextBlock; #define EndDefineChunk \ } /* end chunk */ -#define LeaveChunk(nextChunk, nextBlock) \ - do { \ - /* interchunk return */ \ - if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: LeaveChunk(nextChunk = \"%s\", nextBlock = %d)\n", \ - __FILE__, __LINE__, #nextChunk, (int)nextBlock); \ - if (TailCall) { \ - return nextChunk(gcState, stackTop, frontier, nextBlock); \ - } else { \ - FlushFrontier(); \ - FlushStackTop(); \ - return nextBlock; \ - } \ - } while (0) - /* ------------------------------------------------- */ /* ChunkSwitch */ /* ------------------------------------------------- */ @@ -104,12 +89,6 @@ #endif -#define SwitchNextBlock() \ - if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: SwitchNextBlock(nextBlock = %d)\n", \ - __FILE__, __LINE__, (int)nextBlock); \ - goto doSwitchNextBlock - /* ------------------------------------------------- */ /* Operands */ /* ------------------------------------------------- */ @@ -125,65 +104,6 @@ #define Frontier frontier #define StackTop stackTop -#define FrontierMem *(Pointer*)(GCState + FrontierOffset) -#define StackTopMem *(Pointer*)(GCState + StackTopOffset) - -/* ------------------------------------------------- */ -/* Cache and Flush */ -/* ------------------------------------------------- */ - -#define CacheFrontier() \ - do { \ - Frontier = FrontierMem; \ - } while (0) - -#define CacheStackTop() \ - do { \ - StackTop = StackTopMem; \ - } while (0) - -#define FlushFrontier() \ - do { \ - FrontierMem = Frontier; \ - } while (0) - -#define FlushStackTop() \ - do { \ - StackTopMem = StackTop; \ - } while (0) - -/* ------------------------------------------------- */ -/* Transfers */ -/* ------------------------------------------------- */ - -#define NearJump(l) \ - goto l - -#define FarJump(nextChunk, nextBlock) \ - do { \ - if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: FarJump(%s, %d)\n", \ - __FILE__, __LINE__, #nextChunk, (int)nextBlock); \ - LeaveChunk(nextChunk, nextBlock); \ - } while (0) - -#define IndJump(mustReturnToSelf,mayReturnToSelf,mustReturnToOther) \ - do { \ - nextBlock = *(uintptr_t*)(StackTop - sizeof(uintptr_t)); \ - if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: Return() nextBlock = %d\n", \ - __FILE__, __LINE__, (int)nextBlock); \ - ChunkFnPtr_t nextChunk = nextChunks[nextBlock]; \ - if (mustReturnToSelf \ - || (mayReturnToSelf && (nextChunk == selfChunk))) { \ - SwitchNextBlock(); \ - } else if ((void*)mustReturnToOther != NULL) { \ - LeaveChunk((*mustReturnToOther), nextBlock); \ - } else { \ - LeaveChunk((*nextChunk), nextBlock); \ - } \ - } while (0) - /* ------------------------------------------------- */ /* Primitives */ /* ------------------------------------------------- */ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 2463d03055..b5e62d34e7 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -748,6 +748,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, fun outputChunkFn (Chunk.T {chunkLabel, blocks, tempsMax, ...}, print) = let + val selfChunk = chunkLabel fun declareCReturns () = List.foreach (CType.all, fn t => @@ -810,6 +811,20 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, (print "\t" ; C.call ("ProfileLabel", [ProfileLabel.toString l], print)) end + local + fun mk (dst, src) () = + outputStatement (Statement.Move {dst = dst, src = src}) + val stackTop = Operand.StackTop + val gcStateStackTop = Operand.gcField GCField.StackTop + val frontier = Operand.Frontier + val gcStateFrontier = Operand.gcField GCField.Frontier + in + val cacheStackTop = mk (stackTop, gcStateStackTop) + val flushStackTop = mk (gcStateStackTop, stackTop) + val cacheFrontier = mk (frontier, gcStateFrontier) + val flushFrontier = mk (gcStateFrontier, frontier) + end + (* StackTop += size *) fun adjStackTop (size: Bytes.t) = (outputStatement (Statement.PrimApp {args = Vector.new2 @@ -821,7 +836,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, dst = SOME Operand.StackTop, prim = Prim.cpointerAdd}) ; if amTimeProfiling - then print "\tFlushStackTop();\n" + then flushStackTop () else ()) fun pop (fi: FrameInfo.t) = adjStackTop (Bytes.~ (FrameInfo.size fi)) @@ -879,6 +894,73 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, end fun gotoLabel (l, {tab}) = print (concat [if tab then "\tgoto " else "goto ", Label.toString l, ";\n"]) + (* LeaveChunk(nextChunk, nextBlock) + if (TailCall) { + return nextChunk(gcState, stackTop, frontier, nextBlock); + } else { + flushFrontier(); + flushStackTop(); + return nextBlock; + } + *) + fun leaveChunk (nextChunk, nextBlock) = + if !Control.chunkTailCall + then (print "\treturn " + ; C.call (nextChunk, + ["gcState", "stackTop", "frontier", nextBlock], + print)) + else (flushFrontier () + ; flushStackTop () + ; print "\treturn " + ; print nextBlock + ; print ";\n") + (* IndJump(mustReturnToSelf, mayReturnToSelf, mustReturnToOther) + nextBlock = *(uintptr_t* )(StackTop - sizeof(uintptr_t)); + if (mustReturnToSelf) { + goto doSwitchNextBlock; + } else { + ChunkFnPtr_t nextChunk = nextChunks[nextBlock]; + if (mayReturnToSelf && (nextChunk == selfChunk)) { + goto doSwitchNextBlock; + } + if (mustReturnToOther != NULL) { + LeaveChunk( *mustReturnToOther, nextBlock); + } else { + LeaveChunk( *nextChunk, nextBlock); + } + } + *) + fun indJump (mustReturnToSelf, mayReturnToSelf, mustReturnToOther) = + let + val _ = print "\tnextBlock = " + val _ = print (operandToString + (Operand.stackOffset + {offset = Bytes.~ (Runtime.labelSize ()), + ty = Type.label (Label.newNoname ())})) + val _ = print ";\n" + in + if mustReturnToSelf + then print "\tgoto doSwitchNextBlock;\n" + else let + val doNextChunk = + Promise.delay + (fn () => + print "\tnextChunk = nextChunks[nextBlock];\n") + val _ = + if mayReturnToSelf + then (Promise.force doNextChunk + ; print "\tif (nextChunk == &" + ; print (ChunkLabel.toString selfChunk) + ; print ") { goto doSwitchNextBlock; }\n") + else () + val _ = + case mustReturnToOther of + NONE => (Promise.force doNextChunk; leaveChunk ("(*nextChunk)", "nextBlock")) + | SOME dstChunk => leaveChunk (ChunkLabel.toString dstChunk, "nextBlock") + in + () + end + end fun outputTransfer t = let datatype z = datatype Transfer.t @@ -886,14 +968,10 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, let val dstChunk = labelChunk label in - if ChunkLabel.equals (chunkLabel, dstChunk) - then C.call ("\tNearJump", - [Label.toString label], - print) - else C.call ("\tFarJump", - [ChunkLabel.toString dstChunk, - labelIndexAsString (label, {pretty = true})], - print) + if ChunkLabel.equals (dstChunk, selfChunk) + then gotoLabel (label, {tab = true}) + else leaveChunk (ChunkLabel.toString dstChunk, + labelIndexAsString (label, {pretty = true})) end fun rtrans rsTo = let @@ -904,7 +982,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, if List.forall (rsTo, fn l' => Label.equals (l, l')) then SOME l else NONE - fun isSelf c = ChunkLabel.equals (chunkLabel, c) + fun isSelf c = ChunkLabel.equals (selfChunk, c) val rsTo = List.fold (rsTo, [], fn (l, cs) => @@ -928,17 +1006,12 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, case (!Control.chunkMustRToSingOpt, mustRToOne) of (true, SOME dst) => jump dst | _ => - C.call ("\tIndJump", - [C.bool (!Control.chunkMustRToSelfOpt andalso mustRToSelf), - C.bool (!Control.chunkMayRToSelfOpt andalso mayRToSelf), - case (if (!Control.chunkMustRToOtherOpt andalso - (!Control.chunkMayRToSelfOpt orelse not mayRToSelf)) - then mustRToOther - else NONE) of - NONE => "(ChunkFnPtr_t)NULL" - | SOME otherChunk => - concat ["&(", ChunkLabel.toString otherChunk, ")"]], - print) + indJump (!Control.chunkMustRToSelfOpt andalso mustRToSelf, + !Control.chunkMayRToSelfOpt andalso mayRToSelf, + if (!Control.chunkMustRToOtherOpt andalso + (!Control.chunkMayRToSelfOpt orelse not mayRToSelf)) + then mustRToOther + else NONE) end val () = if !Control.codegenComments > 0 @@ -954,8 +1027,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, CFunction.Target.Direct "Thread_returnToC", ...}, return = SOME {return, size = SOME size}, ...} => (push (return, size); - print "\tFlushFrontier ();\n"; - print "\tFlushStackTop ();\n"; + flushFrontier (); + flushStackTop (); print "\treturn (uintptr_t)-1;\n") | CCall {args, func, return} => let @@ -978,11 +1051,11 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, end val _ = if CFunction.modifiesFrontier func - then print "\tFlushFrontier ();\n" + then flushFrontier () else () val _ = if CFunction.readsStackTop func - then print "\tFlushStackTop ();\n" + then flushStackTop () else () val _ = print "\t" val _ = @@ -1009,22 +1082,18 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, val _ = afterCall () val _ = if CFunction.modifiesFrontier func - then print "\tCacheFrontier ();\n" + then cacheFrontier () else () val _ = if CFunction.writesStackTop func - then print "\tCacheStackTop ();\n" + then cacheStackTop () else () val _ = if CFunction.maySwitchThreadsFrom func - then C.call ("\tReturn", - [C.falsee, - C.truee, - "(ChunkFnPtr_t)NULL"], - print) - else (case return of - NONE => print "\treturn (uintptr_t)-2;\n" - | SOME {return, ...} => gotoLabel (return, {tab = true})) + then indJump (false, true, NONE) + else (case return of + NONE => print "\treturn (uintptr_t)-2;\n" + | SOME {return, ...} => gotoLabel (return, {tab = true})) in () end @@ -1216,22 +1285,11 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, fun outputChunks chunks = let val {done, print, ...} = outputC () - fun outputOffsets () = - List.foreach - ([("FrontierOffset", GCField.Frontier), - ("StackTopOffset", GCField.StackTop)], - fn (name, f) => - print (concat ["#define ", name, " ", - Bytes.toString (GCField.offset f), "\n"])) in print "#define JumpTable " ; print (C.bool (!Control.chunkJumpTable)) ; print "\n" - ; print "#define TailCall " - ; print (C.bool (!Control.chunkTailCall)) - ; print "\n" ; outputIncludes (["c-chunk.h"], print); print "\n" - ; outputOffsets (); print "\n" ; declareGlobals ("PRIVATE extern ", print); print "\n" ; declareNextChunks (chunks, print); print "\n" ; declareFFI (chunks, print) From 12ee2ceec1abd092489cb70146ac5f2479bd21df Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 22 Jul 2019 13:50:08 -0400 Subject: [PATCH 059/102] Only `#define DEBUG_CCODEGEN` in `c-common.h` --- include/c-chunk.h | 12 ------------ include/c-common.h | 8 ++++++++ 2 files changed, 8 insertions(+), 12 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 20518fd2c5..96e6bbf3e6 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -24,18 +24,6 @@ #include "c-types.h" #include "c-common.h" -#ifndef TRUE -#define TRUE 1 -#endif - -#ifndef FALSE -#define FALSE 0 -#endif - -#ifndef DEBUG_CCODEGEN -#define DEBUG_CCODEGEN FALSE -#endif - #define Expect(x,c) __builtin_expect(x, c) #define UNUSED __attribute__ ((unused)) #define Unreachable() __builtin_unreachable() diff --git a/include/c-common.h b/include/c-common.h index e8d6be8de8..753a746ba0 100644 --- a/include/c-common.h +++ b/include/c-common.h @@ -10,6 +10,14 @@ #ifndef _C_COMMON_H_ #define _C_COMMON_H_ +#ifndef TRUE +#define TRUE 1 +#endif + +#ifndef FALSE +#define FALSE 0 +#endif + #ifndef DEBUG_CCODEGEN #define DEBUG_CCODEGEN FALSE #endif From 27bd67c64dc4ea671d170148d5e4af31925089c1 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 22 Jul 2019 20:07:29 -0400 Subject: [PATCH 060/102] Fix formatting of `switch` with unreachable default in C codegen --- mlton/codegen/c-codegen/c-codegen.fun | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index b5e62d34e7..50a6d8cd70 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1137,8 +1137,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, ; gotoLabel (l, {tab = false}))) ; print "\tdefault: " ; (case default of - NONE => (print "\t" - ; C.call ("Unreachable", [], print)) + NONE => C.call ("Unreachable", [], print) | SOME default => gotoLabel (default, {tab = false})) ; print "\t}\n") in From f4fc31fa5c626ffe679f81b006079394f7a1ff8c Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 22 Jul 2019 20:08:00 -0400 Subject: [PATCH 061/102] Move chunk switch from `c-chunk.h` to C codegen --- include/c-chunk.h | 34 -------------------- mlton/codegen/c-codegen/c-codegen.fun | 46 ++++++++++++++++----------- 2 files changed, 28 insertions(+), 52 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 96e6bbf3e6..798dad6e08 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -43,40 +43,6 @@ #define EndDefineChunk \ } /* end chunk */ -/* ------------------------------------------------- */ -/* ChunkSwitch */ -/* ------------------------------------------------- */ - -#if JumpTable - -#define ChunkSwitch(firstIndex, length) \ - static const uintptr_t nextLabelsBias = firstIndex; \ - static const void* nextLabels[length] = { - -#define ChunkSwitchCase(index, label) \ - &&label, - -#define EndChunkSwitch \ - }; \ - doSwitchNextBlock: \ - goto *nextLabels[nextBlock - nextLabelsBias]; - -#else - -#define ChunkSwitch(firstIndex, length) \ - doSwitchNextBlock: \ - switch (nextBlock) { - -#define ChunkSwitchCase(index, label) \ - case index: goto label; - -#define EndChunkSwitch \ - default: \ - Unreachable(); \ - } /* end switch (nextBlock) */ - -#endif - /* ------------------------------------------------- */ /* Operands */ /* ------------------------------------------------- */ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 50a6d8cd70..74a3ee50e4 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1262,20 +1262,33 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, else ()) val entries = List.insertionSort (!entries, fn ((_, i1), (_, i2)) => i1 <= i2) in - C.callNoSemi ("ChunkSwitch", - [C.int (#2 (List.first entries)), - C.int (List.length entries)], - print) - ; print "\n" - ; List.foreach - (entries, fn (label, index) => - (C.callNoSemi ("ChunkSwitchCase", - [C.int index, - Label.toString label], - print) - ; print "\n" - ; visit label)) - ; print "EndChunkSwitch\n\n" + if !Control.chunkJumpTable + then (print "\tstatic const void* nextLabels[" + ; print (C.int (List.length entries)) + ; print "] = {\n" + ; List.foreach + (entries, fn (label, index) => + (print "\t/* " + ; print (C.int index) + ; print " */ &&" + ; print (Label.toString label) + ; print ",\n")) + ; print "\t};\n" + ; print "\tdoSwitchNextBlock:\n" + ; print "\tgoto *nextLabels[nextBlock - " + ; print (C.int (#2 (List.first entries))) + ; print "];\n\n") + else (print "\tdoSwitchNextBlock:\n" + ; print "\tswitch (nextBlock) {\n" + ; List.foreach + (entries, fn (label, index) => + (print "\tcase " + ; print (C.int index) + ; print ": goto " + ; print (Label.toString label) + ; print ";\n")) + ; print "\tdefault: Unreachable();\n" + ; print "\t}\n\n") end ; List.foreach (List.rev (!dfsBlocks), outputBlock) ; print "EndDefineChunk\n\n" @@ -1285,10 +1298,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, let val {done, print, ...} = outputC () in - print "#define JumpTable " - ; print (C.bool (!Control.chunkJumpTable)) - ; print "\n" - ; outputIncludes (["c-chunk.h"], print); print "\n" + outputIncludes (["c-chunk.h"], print); print "\n" ; declareGlobals ("PRIVATE extern ", print); print "\n" ; declareNextChunks (chunks, print); print "\n" ; declareFFI (chunks, print) From 787b3f7ebe23a6a4bc2db8d79206228021c3d9f4 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 23 Jul 2019 15:32:03 -0400 Subject: [PATCH 062/102] Eliminate remainder of `c-chunk.h` --- include/c-chunk.h | 19 ------------------- mlton/codegen/c-codegen/c-codegen.fun | 21 ++++++++++++++++++--- 2 files changed, 18 insertions(+), 22 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 798dad6e08..0f7dadec98 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -28,21 +28,6 @@ #define UNUSED __attribute__ ((unused)) #define Unreachable() __builtin_unreachable() -/* ------------------------------------------------- */ -/* Chunk */ -/* ------------------------------------------------- */ - -#define DefineChunk(chunkName) \ - PRIVATE uintptr_t chunkName(UNUSED CPointer gcState, UNUSED CPointer stackTop, UNUSED CPointer frontier, uintptr_t nextBlock) { \ - UNUSED ChunkFnPtr_t nextChunk; \ - if (DEBUG_CCODEGEN) \ - fprintf (stderr, "%s:%d: %s(nextBlock = %d)\n", \ - __FILE__, __LINE__, #chunkName, (int)nextBlock); \ - goto doSwitchNextBlock; - -#define EndDefineChunk \ - } /* end chunk */ - /* ------------------------------------------------- */ /* Operands */ /* ------------------------------------------------- */ @@ -54,10 +39,6 @@ #define T(ty, i) T ## ty ## _ ## i #define X(ty, b, i, s, o) (*(ty*)((b) + ((i) * (s)) + (o))) -#define GCState gcState -#define Frontier frontier -#define StackTop stackTop - /* ------------------------------------------------- */ /* Primitives */ /* ------------------------------------------------- */ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 74a3ee50e4..acd0d6d5c7 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -735,6 +735,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, in val operandToString = toString end + val chunkArgs = [Operand.GCState, Operand.StackTop, Operand.Frontier] fun fetchOperand (z: Operand.t): string = if handleMisaligned (Operand.ty z) andalso Operand.isMem z then fetch (operandToString z, Operand.ty z) @@ -907,7 +908,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, if !Control.chunkTailCall then (print "\treturn " ; C.call (nextChunk, - ["gcState", "stackTop", "frontier", nextBlock], + List.map (chunkArgs, operandToString) + @ [nextBlock], print)) else (flushFrontier () ; flushStackTop () @@ -1248,7 +1250,18 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, end in declareProfileLabels () - ; C.callNoSemi ("DefineChunk", [ChunkLabel.toString chunkLabel], print); print "\n" + ; print "PRIVATE uintptr_t " + ; C.callNoSemi (ChunkLabel.toString chunkLabel, + List.map + (chunkArgs, fn oper => + concat ["UNUSED ", + CType.toString (Type.toCType (Operand.ty oper)), + " ", + operandToString oper]) + @ ["uintptr_t nextBlock"], + print) + ; print " {\n\n" + ; print "\tUNUSED ChunkFnPtr_t nextChunk;\n" ; declareCReturns (); print "\n" ; declareTemporaries (); print "\n" ; let @@ -1291,7 +1304,9 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, ; print "\t}\n\n") end ; List.foreach (List.rev (!dfsBlocks), outputBlock) - ; print "EndDefineChunk\n\n" + ; print "} /* " + ; print (ChunkLabel.toString chunkLabel) + ; print " */\n\n" end fun outputChunks chunks = From 01a32c933c03633e64a0ab396a01486386d8084a Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 23 Jul 2019 15:32:11 -0400 Subject: [PATCH 063/102] Mark `doSwitchNextBlock` label as potentially unused --- mlton/codegen/c-codegen/c-codegen.fun | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index acd0d6d5c7..09ad60f8aa 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1287,11 +1287,11 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, ; print (Label.toString label) ; print ",\n")) ; print "\t};\n" - ; print "\tdoSwitchNextBlock:\n" + ; print "\tdoSwitchNextBlock: UNUSED;\n" ; print "\tgoto *nextLabels[nextBlock - " ; print (C.int (#2 (List.first entries))) ; print "];\n\n") - else (print "\tdoSwitchNextBlock:\n" + else (print "\tdoSwitchNextBlock: UNUSED;\n" ; print "\tswitch (nextBlock) {\n" ; List.foreach (entries, fn (label, index) => From 091df97eb533fb9b33a99cbed8a2601e61775588 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 23 Jul 2019 15:33:38 -0400 Subject: [PATCH 064/102] Tweak formatting of generated C code --- mlton/codegen/c-codegen/c-codegen.fun | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 09ad60f8aa..2a38688cd4 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1262,8 +1262,9 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, print) ; print " {\n\n" ; print "\tUNUSED ChunkFnPtr_t nextChunk;\n" - ; declareCReturns (); print "\n" - ; declareTemporaries (); print "\n" + ; declareCReturns () + ; declareTemporaries () + ; print "\n" ; let val entries = ref [] val () = From 7777736f500dfa2a029bb01f74a948cfbc62cc95 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 24 Jul 2019 09:34:27 -0400 Subject: [PATCH 065/102] The `{Load,Save}Array` macros are used as statements --- include/common-main.h | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/include/common-main.h b/include/common-main.h index 507949b09d..c211e2013b 100644 --- a/include/common-main.h +++ b/include/common-main.h @@ -26,8 +26,8 @@ #define VectorInitElem(es, gi, l, w) { es, gi, l, w }, #define EndVectorInits }; -#define LoadArray(a, f) if (fread (a, sizeof(*a), cardof(a), f) != cardof(a)) return -1; -#define SaveArray(a, f) if (fwrite(a, sizeof(*a), cardof(a), f) != cardof(a)) return -1; +#define LoadArray(a, f) do { if (fread (a, sizeof(*a), cardof(a), f) != cardof(a)) return -1; } while (0) +#define SaveArray(a, f) do { if (fwrite(a, sizeof(*a), cardof(a), f) != cardof(a)) return -1; } while (0) #define Initialize(s, al, mg, mfs, mmc, pk, ps) \ s->alignment = al; \ From 5280248c49c752e8764887f9ceb54cfdbf50eb20 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 24 Jul 2019 09:51:43 -0400 Subject: [PATCH 066/102] Assume C compiler supports `__attribute__((visibility("...")))` --- runtime/export.h | 6 ------ 1 file changed, 6 deletions(-) diff --git a/runtime/export.h b/runtime/export.h index 12616a1d09..aa575673d6 100644 --- a/runtime/export.h +++ b/runtime/export.h @@ -31,15 +31,9 @@ #define PUBLIC __declspec(dllexport) #define PRIVATE #else -#if __GNUC__ > 3 || (__GNUC__ == 3 && __GNUC_MINOR__ >= 4) #define EXTERNAL __attribute__((visibility("default"))) #define PUBLIC __attribute__((visibility("default"))) #define PRIVATE __attribute__((visibility("hidden"))) -#else -#define EXTERNAL -#define PUBLIC -#define PRIVATE -#endif #endif #endif /* _MLTON_EXPORT_H_ */ From 648fd9262fadcb2d5fc5fd34c9fd221b3a55b8d7 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 24 Jul 2019 10:08:45 -0400 Subject: [PATCH 067/102] Change `CCodegen.C.call{,NoSemi}` to return `string` --- mlton/codegen/c-codegen/c-codegen.fun | 82 +++++++++++++-------------- mlton/codegen/c-codegen/c-codegen.sig | 2 - 2 files changed, 39 insertions(+), 45 deletions(-) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 2a38688cd4..7dfaab7b53 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -33,11 +33,11 @@ structure C = fun args (ss: string list): string = concat ("(" :: List.separate (ss, ", ") @ [")"]) - fun callNoSemi (f: string, xs: string list, print: string -> unit): unit = - (print f; print " "; print (args xs)) + fun callNoSemi (f: string, xs: string list): string = + concat [f, " ", args xs] - fun call (f, xs, print) = - (callNoSemi (f, xs, print); print ";\n") + fun call (f, xs) = + concat [f, " ", args xs, ";\n"] fun int (i: int) = if i >= 0 @@ -215,7 +215,7 @@ fun outputIncludes (includes, print) = print ">\n")) fun declareProfileLabel (l, print) = - C.call ("DeclareProfileLabel", [ProfileLabel.toString l], print) + print (C.call ("DeclareProfileLabel", [ProfileLabel.toString l])) fun declareGlobals (prefix: string, print) = let @@ -273,14 +273,13 @@ fun outputDeclarations (print "BeginVectorInits\n" ; (List.foreach (vectors, fn (g, v) => - (C.callNoSemi ("VectorInitElem", - [C.int (Bytes.toInt - (WordSize.bytes - (WordXVector.elementSize v))), - C.int (Global.index g), - C.int (WordXVector.length v), - WordXVector.toC v], - print) + (print (C.callNoSemi ("VectorInitElem", + [C.int (Bytes.toInt + (WordSize.bytes + (WordXVector.elementSize v))), + C.int (Global.index g), + C.int (WordXVector.length v), + WordXVector.toC v])) ; print "\n"))) ; print "EndVectorInits\n") fun declareReals () = @@ -420,19 +419,18 @@ fun outputDeclarations | Control.ProfileTimeField => "PROFILE_TIME_FIELD" | Control.ProfileTimeLabel => "PROFILE_TIME_LABEL" in - C.callNoSemi (case !Control.format of - Control.Archive => "MLtonLibrary" - | Control.Executable => "MLtonMain" - | Control.LibArchive => "MLtonLibrary" - | Control.Library => "MLtonLibrary", - [C.int align, - C.word magic, - C.bytes maxFrameSize, - C.bool (!Control.markCards), - profile, - C.bool (!Control.profileStack)] - @ additionalMainArgs, - print) + print (C.callNoSemi (case !Control.format of + Control.Archive => "MLtonLibrary" + | Control.Executable => "MLtonMain" + | Control.LibArchive => "MLtonLibrary" + | Control.Library => "MLtonLibrary", + [C.int align, + C.word magic, + C.bytes maxFrameSize, + C.bool (!Control.markCards), + profile, + C.bool (!Control.profileStack)] + @ additionalMainArgs)) ; print "\n" end fun declareMain () = @@ -810,7 +808,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, end | ProfileLabel l => (print "\t" - ; C.call ("ProfileLabel", [ProfileLabel.toString l], print)) + ; print (C.call ("ProfileLabel", [ProfileLabel.toString l]))) end local fun mk (dst, src) () = @@ -907,10 +905,9 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, fun leaveChunk (nextChunk, nextBlock) = if !Control.chunkTailCall then (print "\treturn " - ; C.call (nextChunk, - List.map (chunkArgs, operandToString) - @ [nextBlock], - print)) + ; print (C.call (nextChunk, + List.map (chunkArgs, operandToString) + @ [nextBlock]))) else (flushFrontier () ; flushStackTop () ; print "\treturn " @@ -1067,7 +1064,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, datatype z = datatype CFunction.Target.t val _ = case target of - Direct name => C.call (name, args, print) + Direct name => print (C.call (name, args)) | Indirect => let val (fptr,args) = @@ -1079,7 +1076,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, CFunction.cPointerType func, " ", fptr, "))"] in - C.call (name, args, print) + print (C.call (name, args)) end val _ = afterCall () val _ = @@ -1139,7 +1136,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, ; gotoLabel (l, {tab = false}))) ; print "\tdefault: " ; (case default of - NONE => C.call ("Unreachable", [], print) + NONE => print (C.call ("Unreachable", [])) | SOME default => gotoLabel (default, {tab = false})) ; print "\t}\n") in @@ -1251,15 +1248,14 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, in declareProfileLabels () ; print "PRIVATE uintptr_t " - ; C.callNoSemi (ChunkLabel.toString chunkLabel, - List.map - (chunkArgs, fn oper => - concat ["UNUSED ", - CType.toString (Type.toCType (Operand.ty oper)), - " ", - operandToString oper]) - @ ["uintptr_t nextBlock"], - print) + ; print (C.callNoSemi (ChunkLabel.toString chunkLabel, + List.map + (chunkArgs, fn oper => + concat ["UNUSED ", + CType.toString (Type.toCType (Operand.ty oper)), + " ", + operandToString oper]) + @ ["uintptr_t nextBlock"])) ; print " {\n\n" ; print "\tUNUSED ChunkFnPtr_t nextChunk;\n" ; declareCReturns () diff --git a/mlton/codegen/c-codegen/c-codegen.sig b/mlton/codegen/c-codegen/c-codegen.sig index 1909e1d581..54ec74d502 100644 --- a/mlton/codegen/c-codegen/c-codegen.sig +++ b/mlton/codegen/c-codegen/c-codegen.sig @@ -18,8 +18,6 @@ signature C_CODEGEN = structure C: sig - val callNoSemi: string * string list * (string -> unit) -> unit - val call: string * string list * (string -> unit) -> unit val int: int -> string end From 01b3e489025f3578ce832a164f073e8a812634ca Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 24 Jul 2019 10:10:58 -0400 Subject: [PATCH 068/102] Fix `MLtonLibrary` macro in `c-main.h`; no longer called with a `mc` arg --- include/c-main.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/c-main.h b/include/c-main.h index e416353fca..230a340b99 100644 --- a/include/c-main.h +++ b/include/c-main.h @@ -75,7 +75,7 @@ PUBLIC int MLton_main (int argc, char* argv[]) { \ return 1; \ } -#define MLtonLibrary(al, mg, mfs, mmc, pk, ps, mc, ml) \ +#define MLtonLibrary(al, mg, mfs, mmc, pk, ps, ml) \ PUBLIC void LIB_OPEN(LIBNAME) (int argc, char* argv[]) { \ uintptr_t nextBlock; \ GC_state s = MLton_gcState(); \ From c0ccebb8f39a9a96f79e64383056e8a98bae339a Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 24 Jul 2019 13:39:04 -0400 Subject: [PATCH 069/102] Remove `#include ` from `c-chunk.h` --- include/c-chunk.h | 1 - 1 file changed, 1 deletion(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index 0f7dadec98..b51be8b0cf 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -10,7 +10,6 @@ #ifndef _C_CHUNK_H_ #define _C_CHUNK_H_ -#include /* `memcpy` is used by coercion `_castTo` functions (`basis/coerce.h`) * and by misaligned `_fetch`, `_store`, and `_move` functions * (`basis/Real/Real-ops.h` and `basis/Word/Word-ops.h`) From 006269b9c48cf940ce318d80f5a642006b70c446 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 25 Jul 2019 15:00:15 -0400 Subject: [PATCH 070/102] Eliminate unused `Machine.Operand.Contents` constructor --- include/c-chunk.h | 1 - mlton/backend/backend.fun | 1 - mlton/backend/machine.fun | 13 -------- mlton/backend/machine.sig | 2 -- .../codegen/amd64-codegen/amd64-translate.fun | 30 ------------------- mlton/codegen/c-codegen/c-codegen.fun | 6 ---- mlton/codegen/llvm-codegen/llvm-codegen.fun | 14 +-------- mlton/codegen/x86-codegen/x86-translate.fun | 30 ------------------- 8 files changed, 1 insertion(+), 96 deletions(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index b51be8b0cf..e1b605e81b 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -31,7 +31,6 @@ /* Operands */ /* ------------------------------------------------- */ -#define C(ty, x) (*(ty*)(x)) #define G(ty, i) (global##ty [i]) #define O(ty, b, o) (*(ty*)((b) + (o))) #define S(ty, i) (*(ty*)(StackTop + (i))) diff --git a/mlton/backend/backend.fun b/mlton/backend/backend.fun index f000228554..4db878ba84 100644 --- a/mlton/backend/backend.fun +++ b/mlton/backend/backend.fun @@ -1081,7 +1081,6 @@ fun toMachine (rssa: Rssa.Program.t) = SequenceOffset {base, index, ...} => doOperand (base, doOperand (index, max)) | Cast (z, _) => doOperand (z, max) - | Contents {oper, ...} => doOperand (oper, max) | Offset {base, ...} => doOperand (base, max) | StackOffset (StackOffset.T {offset, ty}) => Bytes.max (Bytes.+ (offset, Type.bytes ty), max) diff --git a/mlton/backend/machine.fun b/mlton/backend/machine.fun index c7844dd1de..e5edffcf7d 100644 --- a/mlton/backend/machine.fun +++ b/mlton/backend/machine.fun @@ -163,8 +163,6 @@ structure Operand = struct datatype t = Cast of t * Type.t - | Contents of {oper: t, - ty: Type.t} | Frontier | GCState | Global of Global.t @@ -186,7 +184,6 @@ structure Operand = val ty = fn Cast (_, ty) => ty - | Contents {ty, ...} => ty | Frontier => Type.cpointer () | GCState => Type.gcState () | Global g => Global.ty g @@ -211,9 +208,6 @@ structure Operand = case z of Cast (z, ty) => seq [str "Cast ", tuple [layout z, Type.layout ty]] - | Contents {oper, ty} => - seq [str (concat ["C", Type.name ty, " "]), - paren (layout oper)] | Frontier => str "" | GCState => str "" | Global g => Global.layout g @@ -240,8 +234,6 @@ structure Operand = val rec equals = fn (Cast (z, t), Cast (z', t')) => Type.equals (t, t') andalso equals (z, z') - | (Contents {oper = z, ...}, Contents {oper = z', ...}) => - equals (z, z') | (GCState, GCState) => true | (Global g, Global g') => Global.equals (g, g') | (Label l, Label l') => Label.equals (l, l') @@ -271,7 +263,6 @@ structure Operand = case (read, write) of (Cast (z, _), _) => interfere (write, z) | (_, Cast (z, _)) => interfere (z, read) - | (Contents {oper, ...}, _) => inter oper | (Global g, Global g') => Global.equals (g, g') | (Offset {base, ...}, _) => inter base | (SequenceOffset {base, index, ...}, _) => @@ -284,7 +275,6 @@ structure Operand = val rec isLocation = fn Cast (z, _) => isLocation z - | Contents _ => true | GCState => true | Global _ => true | Offset _ => true @@ -1060,9 +1050,6 @@ structure Program = {from = Operand.ty z, to = t, tyconTy = tyconTy})) - | Contents {oper, ...} => - (checkOperand (oper, alloc) - ; Type.isCPointer (Operand.ty oper)) | Frontier => true | GCState => true | Global _ => diff --git a/mlton/backend/machine.sig b/mlton/backend/machine.sig index cc59aa5a79..54373b75fc 100644 --- a/mlton/backend/machine.sig +++ b/mlton/backend/machine.sig @@ -60,8 +60,6 @@ signature MACHINE = sig datatype t = Cast of t * Type.t - | Contents of {oper: t, - ty: Type.t} | Frontier | GCState | Global of Global.t diff --git a/mlton/codegen/amd64-codegen/amd64-translate.fun b/mlton/codegen/amd64-codegen/amd64-translate.fun index d2ef9475ce..24973ac324 100644 --- a/mlton/codegen/amd64-codegen/amd64-translate.fun +++ b/mlton/codegen/amd64-codegen/amd64-translate.fun @@ -132,36 +132,6 @@ struct size = size}, size), offset + amd64.Size.toBytes size)) end | Cast (z, _) => toAMD64Operand z - | Contents {oper, ty} => - let - val ty = Type.toCType ty - val base = toAMD64Operand oper - val _ = Assert.assert("amd64Translate.Operand.toAMD64Operand: Contents/base", - fn () => Vector.length base = 1) - val base = getOp0 base - val origin = - case amd64.Operand.deMemloc base of - SOME base => - amd64.MemLoc.simple - {base = base, - index = amd64.Immediate.zero, - scale = amd64.Scale.One, - size = amd64.Size.BYTE, - class = amd64MLton.Classes.Heap} - | _ => Error.bug (concat - ["amd64Translate.Operand.toAMD64Operand: ", - "strange Contents: base: ", - amd64.Operand.toString base]) - val sizes = amd64.Size.fromCType ty - in - (#1 o Vector.mapAndFold) - (sizes, 0, fn (size,offset) => - (((amd64.Operand.memloc o amd64.MemLoc.shift) - {origin = origin, - disp = amd64.Immediate.int offset, - scale = amd64.Scale.One, - size = size}, size), offset + amd64.Size.toBytes size)) - end | Frontier => let val frontier = amd64MLton.gcState_frontierContentsOperand () diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 7dfaab7b53..09de00c8dd 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -131,7 +131,6 @@ structure Operand = fun isMem (z: t): bool = case z of Cast (z, _) => isMem z - | Contents _ => true | Offset _ => true | SequenceOffset _ => true | StackOffset _ => true @@ -703,9 +702,6 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, fun toString (z: Operand.t): string = case z of Cast (z, ty) => concat ["(", Type.toC ty, ")", toString z] - | Contents {oper, ty} => - concat ["C", C.args [Type.toC ty, - toString oper]] | Frontier => "Frontier" | GCState => "GCState" | Global g => @@ -852,8 +848,6 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, case z of Operand.Cast (z, _) => (usesStack z) - | Operand.Contents {oper, ...} => - (usesStack oper) | Operand.Offset {base, ...} => (usesStack base) | Operand.SequenceOffset {base, index, ...} => diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 6e1ac78486..7ac3892b51 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -413,18 +413,7 @@ fun getOperandAddr (cxt, operand) = val scope = mkOperScope operand in case operand of - Operand.Contents {oper, ty} => - let - val (operPre, operTy, operTemp) = getOperandAddr (cxt, oper) - val llvmTy = llty ty - val loaded = nextLLVMTemp () - val load = mkload (loaded, operTy ^ "*", operTemp, scope) - val temporary = nextLLVMTemp () - val cast = mkconv (temporary, "bitcast", operTy, loaded, llvmTy ^ "*") - in - (concat [operPre, load, cast], llvmTy, temporary) - end - | Operand.Frontier => ("", "%CPointer", "%frontier") + Operand.Frontier => ("", "%CPointer", "%frontier") | Operand.Global global => let val globalType = Global.ty global @@ -542,7 +531,6 @@ and getOperandValue (cxt, operand) = in (concat [operPre, inst], llvmTy, temp) end - | Operand.Contents _ => loadOperand () | Operand.Frontier => loadOperand () | Operand.GCState => ("", "%CPointer", "%gcState") | Operand.Global _ => loadOperand () diff --git a/mlton/codegen/x86-codegen/x86-translate.fun b/mlton/codegen/x86-codegen/x86-translate.fun index 1489d48acb..754ad8d268 100644 --- a/mlton/codegen/x86-codegen/x86-translate.fun +++ b/mlton/codegen/x86-codegen/x86-translate.fun @@ -132,36 +132,6 @@ struct size = size}, size), offset + x86.Size.toBytes size)) end | Cast (z, _) => toX86Operand z - | Contents {oper, ty} => - let - val ty = Type.toCType ty - val base = toX86Operand oper - val _ = Assert.assert("x86Translate.Operand.toX86Operand: Contents/base", - fn () => Vector.length base = 1) - val base = getOp0 base - val origin = - case x86.Operand.deMemloc base of - SOME base => - x86.MemLoc.simple - {base = base, - index = x86.Immediate.zero, - scale = x86.Scale.One, - size = x86.Size.BYTE, - class = x86MLton.Classes.Heap} - | _ => Error.bug (concat - ["x86Translate.Operand.toX86Operand: ", - "strange Contents: base: ", - x86.Operand.toString base]) - val sizes = x86.Size.fromCType ty - in - (#1 o Vector.mapAndFold) - (sizes, 0, fn (size,offset) => - (((x86.Operand.memloc o x86.MemLoc.shift) - {origin = origin, - disp = x86.Immediate.int offset, - scale = x86.Scale.One, - size = size}, size), offset + x86.Size.toBytes size)) - end | Frontier => let val frontier = x86MLton.gcState_frontierContentsOperand () From 01fe2401b38aabc6ccc8172b5f02503a9ac95007 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 26 Jul 2019 18:05:37 -0400 Subject: [PATCH 071/102] Add `Scale.toBytes` --- mlton/control/scale.sml | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/mlton/control/scale.sml b/mlton/control/scale.sml index 6335c41015..46eb86f1f9 100644 --- a/mlton/control/scale.sml +++ b/mlton/control/scale.sml @@ -12,6 +12,7 @@ signature SCALE = val fromBytes: Bytes.t -> t option val layout: t -> Layout.t + val toBytes: t -> Bytes.t val toString: t -> string end @@ -38,4 +39,10 @@ val fromInt: int -> t option = val fromBytes: Bytes.t -> t option = fromInt o Bytes.toInt +val toBytes: t -> Bytes.t = + fn One => Bytes.fromInt 1 + | Two => Bytes.fromInt 2 + | Four => Bytes.fromInt 4 + | Eight => Bytes.fromInt 8 + end From 079e7ff39816685c9d477d709517efa83e3726c8 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 26 Jul 2019 18:15:26 -0400 Subject: [PATCH 072/102] Lightly refactor CCodegen --- mlton/codegen/c-codegen/c-codegen.fun | 314 ++++++++++++-------------- 1 file changed, 150 insertions(+), 164 deletions(-) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 09de00c8dd..c340f3519a 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -218,6 +218,7 @@ fun declareProfileLabel (l, print) = fun declareGlobals (prefix: string, print) = let + fun prints ss = List.foreach (ss, print) val _ = List.foreach (CType.all, fn t => @@ -226,7 +227,7 @@ fun declareGlobals (prefix: string, print) = val n = Global.numberOfType t in if n > 0 - then print (concat [prefix, s, " global", s, " [", C.int n, "];\n"]) + then prints [prefix, s, " global", s, " [", C.int n, "];\n"] else () end) in @@ -243,6 +244,7 @@ fun outputDeclarations rest: unit -> unit }: unit = let + fun prints ss = List.foreach (ss, print) fun declareExports () = Ffi.declareExports {print = print} fun declareLoadSaveGlobals () = @@ -252,17 +254,17 @@ fun outputDeclarations ; (List.foreach (CType.all, fn t => if Global.numberOfType t > 0 - then print (concat ["\tSaveArray (global", - CType.toString t, ", f);\n"]) - else ())) + then prints ["\tSaveArray (global", + CType.toString t, ", f);\n"] + else ())) ; print "\treturn 0;\n}\n") val _ = (print "static int loadGlobals (FILE *f) {\n" ; (List.foreach (CType.all, fn t => if Global.numberOfType t > 0 - then print (concat ["\tLoadArray (global", - CType.toString t, ", f);\n"]) + then prints ["\tLoadArray (global", + CType.toString t, ", f);\n"] else ())) ; print "\treturn 0;\n}\n") in @@ -284,10 +286,10 @@ fun outputDeclarations fun declareReals () = (print "static void real_Init() {\n" ; List.foreach (reals, fn (g, r) => - print (concat ["\tglobalReal", - RealSize.toString (RealX.size r), - "[", C.int (Global.index g), "] = ", - RealX.toC r, ";\n"])) + prints ["\tglobalReal", + RealSize.toString (RealX.size r), + "[", C.int (Global.index g), "] = ", + RealX.toC r, ";\n"]) ; print "}\n") fun declareArray (ty: string, name: string, @@ -598,38 +600,24 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, end)) val nextChunks = Vector.keepAllMap (Vector.fromArray nextChunks, fn lo => lo) val labelChunk = #chunkLabel o labelInfo - val labelIndex = #index o labelInfo + val labelIndex = valOf o #index o labelInfo fun labelIndexAsString (l, {pretty}) = let - val s = C.int (valOf (labelIndex l)) + val s = C.int (labelIndex l) in if pretty then concat ["/* ", Label.toString l, " */ ", s] else s end + val amTimeProfiling = + !Control.profile = Control.ProfileTimeField + orelse !Control.profile = Control.ProfileTimeLabel + fun declareChunk (chunkLabel, print: string -> unit) = (print "PRIVATE extern ChunkFn_t " ; print (ChunkLabel.toString chunkLabel) ; print ";\n") - fun defineNextChunks print = - (List.foreach (chunks, fn Chunk.T {chunkLabel, ...} => - declareChunk (chunkLabel, print)) - ; print "PRIVATE ChunkFnPtr_t nextChunks[" - ; print (C.int (Vector.length nextChunks)) - ; print "] = {\n" - ; Vector.foreachi - (nextChunks, fn (i, label) => - (print "\t" - ; print "/* " - ; print (C.int i) - ; print ": */ " - ; print "/* " - ; print (Label.toString label) - ; print " */ &(" - ; print (ChunkLabel.toString (labelChunk label)) - ; print "),\n")) - ; print "};\n") fun declareNextChunks (chunks, print) = let val {destroy, get} = @@ -697,6 +685,10 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, | (true, false) => store ({dst = dst, src = src}, ty) | (true, true) => move' ({dst = dst, src = src}, ty)) else concat [dst, " = ", src, ";\n"] + + fun creturnName (ct: CType.t): string = concat ["CReturn", CType.name ct] + fun temporaryName (ct, i) = + concat ["T", C.args [CType.name ct, Int.toString i]] local datatype z = datatype Operand.t fun toString (z: Operand.t): string = @@ -723,8 +715,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, | StackOffset s => StackOffset.toString s | StackTop => "StackTop" | Temporary t => - concat ["T", C.args [Type.name (Temporary.ty t), - Int.toString (Temporary.index t)]] + temporaryName (Type.toCType (Temporary.ty t), Temporary.index t) | Word w => WordX.toC w in val operandToString = toString @@ -734,36 +725,23 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, if handleMisaligned (Operand.ty z) andalso Operand.isMem z then fetch (operandToString z, Operand.ty z) else operandToString z - fun creturn (t: Type.t): string = - concat ["CReturn", CType.name (Type.toCType t)] - - val amTimeProfiling = - !Control.profile = Control.ProfileTimeField - orelse !Control.profile = Control.ProfileTimeLabel fun outputChunkFn (Chunk.T {chunkLabel, blocks, tempsMax, ...}, print) = let val selfChunk = chunkLabel - fun declareCReturns () = - List.foreach - (CType.all, fn t => - let - val s = CType.toString t - in - print (concat ["\tUNUSED ", s, " CReturn", CType.name t, ";\n"]) - end) - fun declareTemporaries () = - List.foreach - (CType.all, fn t => - let - val pre = concat ["\t", CType.toString t, " "] - in - Int.for (0, 1 + tempsMax t, fn i => - (print pre - ; print (concat ["T", C.args [CType.name t, - Int.toString i]]) - ; print ";\n")) - end) + + fun prints ss = List.foreach (ss, print) + fun declareVar' (name, ty, unused, init) = + (print "\t" + ; if unused then print "UNUSED " else () + ; print ty + ; print " " + ; print name + ; case init of NONE => () | SOME v => (print " = "; print v) + ; print ";\n") + fun declareVar (name, ct, unused, init) = + declareVar' (name, CType.toString ct, unused, init) + fun outputStatement s = let datatype z = datatype Statement.t @@ -862,23 +840,17 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, val nextTmp = Counter.generator 0 val args = Vector.toListMap - (args, fn z => - if usesStack z + (args, fn arg => + if usesStack arg then let - val ty = Operand.ty z - val tmp = - concat ["tmp", - Int.toString (nextTmp ())] - val _ = - print - (concat - ["\t", Type.toC ty, " ", tmp, " = ", - fetchOperand z, ";\n"]) + val ty = Operand.ty arg + val tmp = concat ["tmp", Int.toString (nextTmp ())] + val _ = declareVar (tmp, Type.toCType ty, false, SOME (fetchOperand arg)) in tmp end - else fetchOperand z) + else fetchOperand arg) in (args, fn () => print "\t}\n") end @@ -886,7 +858,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, fn () => ()) end fun gotoLabel (l, {tab}) = - print (concat [if tab then "\tgoto " else "goto ", Label.toString l, ";\n"]) + prints [if tab then "\tgoto " else "goto ", Label.toString l, ";\n"] (* LeaveChunk(nextChunk, nextBlock) if (TailCall) { return nextChunk(gcState, stackTop, frontier, nextBlock); @@ -982,7 +954,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, let val c = labelChunk l in - if List.exists (cs, fn c' => ChunkLabel.equals (c, c')) + if List.contains (cs, c, ChunkLabel.equals) then cs else c::cs end) @@ -1006,7 +978,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, then mustRToOther else NONE) end - val () = + val _ = if !Control.codegenComments > 0 then (print "\t/* " ; print (Layout.toString (Transfer.layout t)) @@ -1025,8 +997,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, print "\treturn (uintptr_t)-1;\n") | CCall {args, func, return} => let - val CFunction.T {return = returnTy, - target, ...} = func + val CFunction.T {return = returnTy, target, ...} = func val (args, afterCall) = case return of NONE => @@ -1042,19 +1013,13 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, in res end - val _ = - if CFunction.modifiesFrontier func - then flushFrontier () - else () - val _ = - if CFunction.readsStackTop func - then flushStackTop () - else () + val _ = if CFunction.modifiesFrontier func then flushFrontier () else () + val _ = if CFunction.readsStackTop func then flushStackTop () else () val _ = print "\t" val _ = if Type.isUnit returnTy then () - else print (concat [creturn returnTy, " = "]) + else prints [creturnName (Type.toCType returnTy), " = "] datatype z = datatype CFunction.Target.t val _ = case target of @@ -1103,9 +1068,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, prim = Prim.cpointerAdd}) ; rtrans raisesTo) | Return {returnsTo} => rtrans returnsTo - | Switch switch => + | Switch (Switch.T {cases, default, expect, test, ...}) => let - val Switch.T {cases, default, expect, test, ...} = switch val test = operandToString test val test = case expect of @@ -1135,7 +1099,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, ; print "\t}\n") in case (Vector.length cases, default) of - (0, NONE) => Error.bug "CCodegen.outputTransfers: Switch" + (0, NONE) => Error.bug "CCodegen.outputTransfer: Switch" | (0, SOME ld) => gotoLabel (ld, {tab = true}) | (1, NONE) => gotoLabel (#2 (Vector.sub (cases, 0)), {tab = true}) | (1, SOME ld) => @@ -1162,7 +1126,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, end val outputStatement = fn s => let - val () = + val _ = if !Control.codegenComments > 1 then (print "\t/* " ; print (Layout.toString (Statement.layout s)) @@ -1173,7 +1137,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, end fun outputBlock (Block.T {kind, label, statements, transfer, ...}) = let - val _ = print (concat [Label.toString label, ":\n"]) + val _ = prints [Label.toString label, ":\n"] val _ = case kind of Kind.Cont {frameInfo, ...} => pop frameInfo @@ -1185,14 +1149,13 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, val x = Live.toOperand x val ty = Operand.ty x in - print - (concat - ["\t", - move {dst = operandToString x, - dstIsMem = Operand.isMem x, - src = creturn ty, - srcIsMem = false, - ty = ty}]) + print "\t" + ; (print o move) + {dst = operandToString x, + dstIsMem = Operand.isMem x, + src = creturnName (Type.toCType ty), + srcIsMem = false, + ty = ty} end))) | Kind.Func _ => () | Kind.Handler {frameInfo, ...} => pop frameInfo @@ -1225,7 +1188,21 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, (Vector.foreach (cases, visit o #2); Option.app (default, visit))) end - fun declareProfileLabels () = + val entries = + let + val entries = ref [] + val _ = + Vector.foreach + (blocks, fn Block.T {kind, label, ...} => + if Kind.isEntry kind + then (List.push (entries, (label, labelIndex label)) + ; visit label) + else ()) + in + List.insertionSort (!entries, fn ((_, i1), (_, i2)) => i1 <= i2) + end + + val _ = let val empty = ref true in @@ -1239,65 +1216,56 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, | _ => ())) ; if !empty then () else print "\n" end + val _ = print "PRIVATE uintptr_t " + val _ = print (C.callNoSemi (ChunkLabel.toString chunkLabel, + List.map + (chunkArgs, fn oper => + concat ["UNUSED ", + CType.toString (Type.toCType (Operand.ty oper)), + " ", + operandToString oper]) + @ ["uintptr_t nextBlock"])) + val _ = print " {\n\n" + + val _ = declareVar' ("nextChunk", "ChunkFnPtr_t", true, NONE) + val _ = List.foreach (CType.all, fn t => declareVar (creturnName t, t, true, NONE)) + val _ = List.foreach (CType.all, fn t => + Int.for (0, 1 + tempsMax t, fn i => + declareVar (temporaryName (t, i), t, false, NONE))) + val _ = print "\n" + val _ = print "doSwitchNextBlock: UNUSED;\n" + val _ = + if !Control.chunkJumpTable + then (print "\tstatic const void* nextLabels[" + ; print (C.int (List.length entries)) + ; print "] = {\n" + ; List.foreach + (entries, fn (label, index) => + (print "\t/* " + ; print (C.int index) + ; print " */ &&" + ; print (Label.toString label) + ; print ",\n")) + ; print "\t};\n" + ; print "\tgoto *nextLabels[nextBlock - " + ; print (C.int (#2 (List.first entries))) + ; print "];\n\n") + else (print "\tswitch (nextBlock) {\n" + ; List.foreach + (entries, fn (label, index) => + (print "\tcase " + ; print (C.int index) + ; print ": goto " + ; print (Label.toString label) + ; print ";\n")) + ; print "\tdefault: Unreachable();\n" + ; print "\t}\n\n") + val _ = List.foreach (List.rev (!dfsBlocks), outputBlock) + val _ = print "} /* " + val _ = print (ChunkLabel.toString chunkLabel) + val _ = print " */\n\n" in - declareProfileLabels () - ; print "PRIVATE uintptr_t " - ; print (C.callNoSemi (ChunkLabel.toString chunkLabel, - List.map - (chunkArgs, fn oper => - concat ["UNUSED ", - CType.toString (Type.toCType (Operand.ty oper)), - " ", - operandToString oper]) - @ ["uintptr_t nextBlock"])) - ; print " {\n\n" - ; print "\tUNUSED ChunkFnPtr_t nextChunk;\n" - ; declareCReturns () - ; declareTemporaries () - ; print "\n" - ; let - val entries = ref [] - val () = - Vector.foreach - (blocks, fn Block.T {kind, label, ...} => - if Kind.isEntry kind - then (List.push (entries, (label, valOf (labelIndex label))) - ; visit label) - else ()) - val entries = List.insertionSort (!entries, fn ((_, i1), (_, i2)) => i1 <= i2) - in - if !Control.chunkJumpTable - then (print "\tstatic const void* nextLabels[" - ; print (C.int (List.length entries)) - ; print "] = {\n" - ; List.foreach - (entries, fn (label, index) => - (print "\t/* " - ; print (C.int index) - ; print " */ &&" - ; print (Label.toString label) - ; print ",\n")) - ; print "\t};\n" - ; print "\tdoSwitchNextBlock: UNUSED;\n" - ; print "\tgoto *nextLabels[nextBlock - " - ; print (C.int (#2 (List.first entries))) - ; print "];\n\n") - else (print "\tdoSwitchNextBlock: UNUSED;\n" - ; print "\tswitch (nextBlock) {\n" - ; List.foreach - (entries, fn (label, index) => - (print "\tcase " - ; print (C.int index) - ; print ": goto " - ; print (Label.toString label) - ; print ";\n")) - ; print "\tdefault: Unreachable();\n" - ; print "\t}\n\n") - end - ; List.foreach (List.rev (!dfsBlocks), outputBlock) - ; print "} /* " - ; print (ChunkLabel.toString chunkLabel) - ; print " */\n\n" + () end fun outputChunks chunks = @@ -1311,35 +1279,53 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, ; List.foreach (chunks, fn chunk => outputChunkFn (chunk, print)) ; done () end - val chunks = + val chunksWithSizes = List.revMap (chunks, fn chunk as Chunk.T {blocks, ...} => (chunk, Vector.fold (blocks, 0, fn (Block.T {statements, ...}, n) => n + Vector.length statements + 1))) - fun batch (chunks, acc, n) = - case chunks of + fun batch (chunksWithSizes, acc, n) = + case chunksWithSizes of [] => outputChunks acc - | (chunk, s)::chunks' => + | (chunk, s)::chunksWithSizes' => let val m = n + s in if List.isEmpty acc orelse m <= !Control.chunkBatch - then batch (chunks', chunk::acc, m) + then batch (chunksWithSizes', chunk::acc, m) else (outputChunks acc; - batch (chunks, [], 0)) + batch (chunksWithSizes, [], 0)) end - val () = batch (chunks, [], 0) + val () = batch (chunksWithSizes, [], 0) val {print, done, ...} = outputC () + fun defineNextChunks () = + (List.foreach (chunks, fn Chunk.T {chunkLabel, ...} => + declareChunk (chunkLabel, print)) + ; print "PRIVATE ChunkFnPtr_t nextChunks[" + ; print (C.int (Vector.length nextChunks)) + ; print "] = {\n" + ; Vector.foreachi + (nextChunks, fn (i, label) => + (print "\t" + ; print "/* " + ; print (C.int i) + ; print ": */ " + ; print "/* " + ; print (Label.toString label) + ; print " */ &(" + ; print (ChunkLabel.toString (labelChunk label)) + ; print "),\n")) + ; print "};\n") val _ = outputDeclarations {additionalMainArgs = [labelIndexAsString (#label main, {pretty = true})], includes = ["c-main.h"], program = program, print = print, - rest = fn () => defineNextChunks print} + rest = defineNextChunks} val _ = done () in () From 9a4cadb8b773dde18021debd6dd988680d857cc0 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 26 Jul 2019 18:15:52 -0400 Subject: [PATCH 073/102] Remove support for `ProfileLabel` in C codegen The supporting C-side macro `ProfileLabel` was removed long ago. --- mlton/codegen/c-codegen/c-codegen.fun | 23 +++-------------------- 1 file changed, 3 insertions(+), 20 deletions(-) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index c340f3519a..3ce93dc9ff 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -213,9 +213,6 @@ fun outputIncludes (includes, print) = print i; print ">\n")) -fun declareProfileLabel (l, print) = - print (C.call ("DeclareProfileLabel", [ProfileLabel.toString l])) - fun declareGlobals (prefix: string, print) = let fun prints ss = List.foreach (ss, print) @@ -440,6 +437,8 @@ fun outputDeclarations else () fun declareSourceMaps () = let + fun declareProfileLabel (l, print) = + print (C.call ("DeclareProfileLabel", [ProfileLabel.toString l])) fun doit (SourceMaps.T {profileLabelInfos, sourceNames, sourceSeqs, sources}) = (Vector.foreach (profileLabelInfos, fn {profileLabel, ...} => declareProfileLabel (profileLabel, print)) @@ -780,9 +779,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, srcIsMem = false, ty = Operand.ty dst}) end - | ProfileLabel l => - (print "\t" - ; print (C.call ("ProfileLabel", [ProfileLabel.toString l]))) + | ProfileLabel _ => Error.bug "CCodegen.outputStatement: ProfileLabel" end local fun mk (dst, src) () = @@ -1202,20 +1199,6 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, List.insertionSort (!entries, fn ((_, i1), (_, i2)) => i1 <= i2) end - val _ = - let - val empty = ref true - in - Vector.foreach - (blocks, fn Block.T {statements, ...} => - Vector.foreach - (statements, fn s => - case s of - Statement.ProfileLabel l => (empty := false - ; declareProfileLabel (l, print)) - | _ => ())) - ; if !empty then () else print "\n" - end val _ = print "PRIVATE uintptr_t " val _ = print (C.callNoSemi (ChunkLabel.toString chunkLabel, List.map From a6a361717f70ee9f4958dac3ffc88f6396da7da6 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 26 Jul 2019 20:22:26 -0400 Subject: [PATCH 074/102] Add `RealSize.compare` --- mlton/atoms/real-size.fun | 9 ++++++++- mlton/atoms/real-size.sig | 4 +++- 2 files changed, 11 insertions(+), 2 deletions(-) diff --git a/mlton/atoms/real-size.fun b/mlton/atoms/real-size.fun index 1604a01fc9..fa7facc0ea 100644 --- a/mlton/atoms/real-size.fun +++ b/mlton/atoms/real-size.fun @@ -1,4 +1,5 @@ -(* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh +(* Copyright (C) 2019 Matthew Fluet. + * Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * * MLton is released under a HPND-style license. @@ -45,4 +46,10 @@ val bytes: t -> Bytes.t = val bits: t -> Bits.t = Bytes.toBits o bytes +val compare = + fn (R32, R32) => EQUAL + | (R32, R64) => LESS + | (R64, R32) => GREATER + | (R64, R64) => EQUAL + end diff --git a/mlton/atoms/real-size.sig b/mlton/atoms/real-size.sig index 3e1e7e3d98..bb5211c4b3 100644 --- a/mlton/atoms/real-size.sig +++ b/mlton/atoms/real-size.sig @@ -1,4 +1,5 @@ -(* Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh +(* Copyright (C) 2019 Matthew Fluet. + * Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * * MLton is released under a HPND-style license. @@ -18,6 +19,7 @@ signature REAL_SIZE = val all: t list val bits: t -> Bits.t val bytes: t -> Bytes.t + val compare: t * t -> Relation.t val equals: t * t -> bool val hash: t -> word val memoize: (t -> 'a) -> t -> 'a From 31d1f93ca3c814246aa93752ec8ce06db6086796 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 29 Jul 2019 16:24:59 -0400 Subject: [PATCH 075/102] Add `Bool.hash` --- lib/mlton/basic/bool.sig | 4 +++- lib/mlton/basic/bool.sml | 7 ++++++- 2 files changed, 9 insertions(+), 2 deletions(-) diff --git a/lib/mlton/basic/bool.sig b/lib/mlton/basic/bool.sig index 67a30d75e4..255b0756d2 100644 --- a/lib/mlton/basic/bool.sig +++ b/lib/mlton/basic/bool.sig @@ -1,4 +1,5 @@ -(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh +(* Copyright (C) 2019 Matthew Fluet. + * Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * * MLton is released under a HPND-style license. @@ -12,6 +13,7 @@ signature BOOL = val compare: t * t -> Relation.t val equals: t * t -> bool val fromString: string -> t option + val hash: t -> word val layout: t -> Layout.t val not: t -> t val toString: t -> string diff --git a/lib/mlton/basic/bool.sml b/lib/mlton/basic/bool.sml index e443347071..8f1520e58d 100644 --- a/lib/mlton/basic/bool.sml +++ b/lib/mlton/basic/bool.sml @@ -1,4 +1,5 @@ -(* Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh +(* Copyright (C) 2019 Matthew Fluet. + * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * * MLton is released under a HPND-style license. @@ -28,6 +29,10 @@ val equals = | (false, false) => true | _ => false +val hash = + fn true => 0wx1 + | false => 0wx0 + val layout = Layout.str o toString (*fun output(b, out) = Pervasive.IO.output(out, toString b)*) From cec30c52fb6e722ad38b4c5a9ec1933c2a8cc409 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Mon, 29 Jul 2019 16:36:34 -0400 Subject: [PATCH 076/102] Make a major refactoring of LLVM codegen Highlights: - Introduce a `structure LLVM` with sub-structures for `Type`, `Value`, `Instr`, `MetaData`, and `ModuleContext`. While much of the LLVM codegen still uses strings, the modules enforce a more correct usage. - Unify `implementsPrim` and `primApp`. - Eliminate a number of instances of code duplication in the translation of primitives. - Eliminate awkward `Context` type, which was a form of manual closure conversion. - Favor direct output and using `AppendList.t` over constructing large strings. - More closely match the C codegen. --- mlton/codegen/llvm-codegen/llvm-codegen.fun | 2986 +++++++++---------- 1 file changed, 1429 insertions(+), 1557 deletions(-) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 7ac3892b51..da49c88c13 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -8,14 +8,443 @@ functor LLVMCodegen(S: LLVM_CODEGEN_STRUCTS): LLVM_CODEGEN = struct +structure AList = AppendList + open S open Machine +structure LLVM = + struct + fun escape s = + let + fun needsEscape c = Char.isCntrl c orelse Char.equals (c, #"\\") orelse Char.equals (c, Char.dquote) + in + if String.exists (s, needsEscape) + then String.translate + (s, fn c => + if needsEscape c + then let + val hex = Int.format (Char.ord c, StringCvt.HEX) + in + if String.length hex < 2 + then "\\0" ^ hex + else "\\" ^ hex + end + else Char.toString c) + else s + end + structure Type = + struct + datatype t = + Array of int * t + | Function of t list * t + | Label + | Pointer of t + | Real of RealSize.t + | Struct of bool * t list + | Void + | Word of WordSize.t + + fun equals (ty1, ty2) = + case (ty1, ty2) of + (Array (n1, ty1), Array (n2, ty2)) => + Int.equals (n1, n2) andalso equals (ty1, ty2) + | (Function (atys1, rty1), Function (atys2, rty2)) => + equalss (atys1, atys2) andalso equals (rty1, rty2) + | (Label, Label) => true + | (Pointer ty1, Pointer ty2) => equals (ty1, ty2) + | (Real rs1, Real rs2) => RealSize.equals (rs1, rs2) + | (Struct (b1, tys1), Struct (b2, tys2)) => + Bool.equals (b1, b2) andalso equalss (tys1, tys2) + | (Void, Void) => true + | (Word ws1, Word ws2) => WordSize.equals (ws1, ws2) + | _ => false + and equalss (tys1, tys2) = List.equals (tys1, tys2, equals) + + local + val array = Random.word () + val function = Random.word () + val label = Random.word () + val pointer = Random.word () + val real = Random.word () + val str = Random.word () + val void = Random.word () + val word = Random.word () + in + fun hash ty = + case ty of + Array (n, ty) => Hash.combine3 (array, Word.fromInt n, hash ty) + | Function (atys, rty) => Hash.combine3 (function, Hash.listMap (atys, hash), hash rty) + | Label => label + | Pointer ty => Hash.combine (pointer, hash ty) + | Real rs => Hash.combine (real, RealSize.hash rs) + | Struct (b, tys) => Hash.combine3 (str, Bool.hash b, Hash.listMap (tys, hash)) + | Void => void + | Word ws => Hash.combine (word, WordSize.hash ws) + end + + val bool = Word (WordSize.fromBits Bits.one) + val word8 = Word WordSize.word8 + val word16 = Word WordSize.word16 + val word32 = Word WordSize.word32 + val word64 = Word WordSize.word64 + + fun toString ty = + case ty of + Array (n, ty) => + concat ["[", Int.toString n, " x ", toString ty, "]"] + | Function (args, res) => + concat [toString res, "(", + String.concatWith (List.map (args, toString), ","), + ")"] + | Label => "label" + | Pointer ty => concat [toString ty, "*"] + | Struct (packed, tys) => + let + val (l,r) = if packed then ("<{", "}>") else ("{","}") + in + concat [l, + String.concatWith (List.map (tys, toString), ","), + r] + end + | Real rs => (case rs of + RealSize.R32 => "float" + | RealSize.R64 => "double") + | Word ws => concat ["i", WordSize.toString ws] + | Void => "void" + + fun dePointer ty = + case ty of + Pointer ty => ty + | _ => Error.bug ("LLVMCodegen.LLVM.Type.dePointer: " ^ toString ty) + + fun fromCType ct = + case ct of + CType.CPointer => Pointer word8 + | CType.Int8 => word8 + | CType.Int16 => word16 + | CType.Int32 => word32 + | CType.Int64 => word64 + | CType.Objptr => Pointer (Word WordSize.word8) + | CType.Real32 => Real RealSize.R32 + | CType.Real64 => Real RealSize.R64 + | CType.Word8 => word8 + | CType.Word16 => word16 + | CType.Word32 => word32 + | CType.Word64 => word64 + + val cpointer = fromCType CType.CPointer + + val blockaddress = Pointer word8 + + val uintptr = Promise.lazy (Word o WordSize.cpointer) + end + structure Value = + struct + type t = string * Type.t + + fun equals ((s1, ty1), (s2, ty2)) = String.equals (s1, s2) andalso Type.equals (ty1, ty2) + fun hash (s, ty) = Hash.combine (String.hash s, Type.hash ty) + fun toString (s, ty) = concat [Type.toString ty, " ", s] + + fun fnptr (s, args, res) = (s, Type.Pointer (Type.Function (args, res))) + fun globptr (s, ty) = (s, Type.Pointer ty) + fun label' s = ("%" ^ s, Type.Label) + fun label l = label' (Label.toString l) + val null = ("null", Type.Pointer Type.word8) + fun real r = + (RealX.toString (r, {suffix = false}), + Type.Real (RealX.size r)) + (* fun undef ty = ("undef", ty) *) + fun word w = + (IntInf.toString (WordX.toIntInf w), + Type.Word (WordX.size w)) + fun zero ws = word (WordX.zero ws) + fun negOne ws = word (WordX.fromIntInf (~1, ws)) + fun negTwo ws = word (WordX.fromIntInf (~2, ws)) + end + structure Instr = + struct + type t = string AList.t + + (* terminator *) + fun br {test = (test, testTy), truee = (truee, trueeTy), falsee = (falsee, falseeTy)} = + AList.fromList ["br ", Type.toString testTy, " ", test, + ", ", Type.toString trueeTy, " ", truee, + ", ", Type.toString falseeTy, " ", falsee] + fun indirectbr {addr = (addr, addrTy), labels} = + AList.append + (AList.fromList ["indirectbr ", Type.toString addrTy, " ", addr, ", ["], + if List.length labels > 3 + then AList.append + ((AList.appends o List.mapi) + (labels, fn (i, (label, labelTy)) => + AList.fromList [if i > 0 then ",\n\t\t" else "\n\t\t", + Type.toString labelTy, " ", label]), + AList.single "\n\t]") + else AList.append + ((AList.appends o List.mapi) + (labels, fn (i, (label, labelTy)) => + AList.fromList [if i > 0 then ", " else "", + Type.toString labelTy, " ", label]), + AList.single "]")) + fun jmp (label, labelTy) = AList.fromList ["br ", Type.toString labelTy, " ", label] + fun ret (res, resTy) = AList.fromList ["ret ", Type.toString resTy, " ", res] + fun unreachable () = AList.single "unreachable" + fun switch {value = (value, valueTy), default = (default, defaultTy), table} = + AList.append + (AList.fromList ["switch ", + Type.toString valueTy, " ", value, ", ", + Type.toString defaultTy, " ", default, " ["], + if List.length table > 2 + then AList.appends + [AList.single "\n", + (AList.appends o List.map) + (table, fn ((index, indexTy), (label, labelTy)) => + AList.fromList ["\t\t", + Type.toString indexTy, " ", index, ", ", + Type.toString labelTy, " ", label, "\n"]), + AList.single "\t]"] + else AList.append + ((AList.appends o List.map) + (table, fn ((index, indexTy), (label, labelTy)) => + AList.fromList [" ", + Type.toString indexTy, " ", index, ", ", + Type.toString labelTy, " ", label, " "]), + AList.single "]")) + + (* nary *) + fun naryop {dst = (dst, _), oper = (oper, operTy), args} = + AList.append + (AList.fromList [dst, " = ", oper, " ", Type.toString operTy, " "], + (AList.appends o List.mapi) + (args, fn (i, (arg, _)) => + AList.fromList [if i > 0 then ", " else "", arg])) + + (* aggregate *) + fun xval {dst = (dst, _), src = (src, srcTy), args} = + AList.append + (AList.fromList [dst, " = extractvalue ", Type.toString srcTy, " ", src], + (AList.appends o List.map) + (args, fn arg => AList.fromList [", ", arg])) + + (* memory *) + fun alloca {dst = (dst, dstTy)} = + AList.fromList [dst, " = alloca ", Type.toString (Type.dePointer dstTy)] + fun gep {dst = (dst, _), src = (src, srcTy), args} = + AList.append + (AList.fromList [dst, " = getelementptr inbounds ", + Type.toString (Type.dePointer srcTy), + ", ", Type.toString srcTy, " ", src], + (AList.appends o List.map) + (args, fn (arg, argTy) => AList.fromList [", ", Type.toString argTy, " ", arg])) + fun load {dst = (dst, dstTy), src = (src, srcTy)} = + AList.fromList [dst, " = load ", Type.toString dstTy, ", ", Type.toString srcTy, " ", src] + fun store {dst = (dst, dstTy), src = (src, srcTy)} = + AList.fromList ["store ", Type.toString srcTy, " ", src, ", ", Type.toString dstTy, " ", dst] + + (* conversion *) + fun convop {dst = (dst, dstTy), oper, src = (src, srcTy)} = + AList.fromList [dst, " = ", oper, " ", Type.toString srcTy, " ", src, " to ", Type.toString dstTy] + local + fun mk oper {dst, src} = + convop {dst = dst, oper = oper, src = src} + in + val trunc = mk "trunc" + val zext = mk "zext" + val sext = mk "sext" + val fptrunc = mk "fptrunc" + val fpext = mk "fpext" + val fptoui = mk "fptoui" + val fptosi = mk "fptosi" + val uitofp = mk "uitofp" + val sitofp = mk "sitofp" + val ptrtoint = mk "ptrtoint" + val inttoptr = mk "inttoptr" + val bitcast = mk "bitcast" + end + fun resize {dst as (_, dstTy), src as (_, srcTy), signed} = + case (srcTy, dstTy) of + (Type.Word ws, Type.Word wd) => + (case WordSize.compare (ws, wd) of + LESS => if signed then sext else zext + | EQUAL => bitcast + | GREATER => trunc) {dst = dst, src = src} + | _ => Error.bug "LLVMCodegen.LLVM.Instr.resize" + fun fpresize {dst as (_, dstTy), src as (_, srcTy)} = + case (srcTy, dstTy) of + (Type.Real rs, Type.Real rd) => + (case RealSize.compare (rs, rd) of + LESS => fpext + | EQUAL => bitcast + | GREATER => fptrunc) {dst = dst, src = src} + | _ => Error.bug "LLVMCodegen.LLVM.Instr.fpresize" + fun cast (arg as {dst = (_, dstTy), src = (_, srcTy)}) = + (case (srcTy, dstTy) of + (Type.Pointer _, Type.Word _) => ptrtoint + | (Type.Word _, Type.Pointer _) => inttoptr + | _ => bitcast) arg + + (* other *) + fun call {dst = (dst, dstTy), tail, cconv, fnptr = (fnptr, _), args} = + AList.appends + [case dstTy of Type.Void => AList.empty | _ => AList.fromList [dst, " = "], + case tail of NONE => AList.empty | SOME tail => AList.fromList [tail, " "], + AList.single "call ", + case cconv of NONE => AList.empty | SOME cconv => AList.fromList [cconv, " "], + AList.fromList [Type.toString dstTy, " ", fnptr, "("], + (AList.appends o List.mapi) + (args, fn (i, (arg, argTy)) => + AList.fromList [if i > 0 then ", " else "", Type.toString argTy, " ", arg]), + AList.single ")"] + + fun addMetaData (i, md) = + case md of + NONE => i + | SOME md => AList.append (i, AList.fromList [", ", md]) + end + structure MetaData = + struct + structure Id = + struct + type t = string + val equals = String.equals + val hash = String.hash + fun toString id = id + end + structure Value = + struct + datatype t = Id of Id.t | Node of t list | String of String.t | Value of Value.t + fun equals (v1, v2) = + case (v1, v2) of + (Id i1, Id i2) => Id.equals (i1, i2) + | (Node vs1, Node vs2) => List.equals (vs1, vs2, equals) + | (String s1, String s2) => String.equals (s1, s2) + | (Value v1, Value v2) => Value.equals (v1, v2) + | _ => false + local + val id = Random.word () + val node = Random.word () + val string = Random.word () + val value = Random.word () + in + fun hash v = + case v of + Id i => Hash.combine (id, Id.hash i) + | Node vs => Hash.combine (node, Hash.listMap (vs, hash)) + | String s => Hash.combine (string, String.hash s) + | Value v => Hash.combine (value, Value.hash v) + end + fun toString v = + case v of + Id i => Id.toString i + | Node vs => concat ["!{", String.concatWith (List.map (vs, toString), ", "), "}"] + | String s => concat ["!\"", escape s, "\""] + | Value v => Value.toString v + end + val id = Value.Id + val string = Value.String + val value = Value.Value + datatype t = T of unit ref option * Value.t + fun node vs = T (NONE, Value.Node vs) + fun equals (T (xo1, v1), T (xo2, v2)) = + Option.equals (xo1, xo2, Ref.equals) andalso Value.equals (v1, v2) + local + val none = Random.word () + val some = Random.word () + in + fun hash (T (xo, v)) = + Hash.combine (case xo of NONE => none | SOME _ => some, Value.hash v) + end + fun toString (T (xo, v)) = + case xo of + NONE => Value.toString v + | SOME _ => concat ["distinct ", Value.toString v] + end + structure ModuleContext = + struct + datatype t = T of {fnDecls: (string, {argTys: Type.t list, + resTy: Type.t, + vis: string option}) HashTable.t, + fnDefns: (string, unit) HashTable.t, + globDecls: (string, {ty: Type.t, + vis: string option}) HashTable.t, + metaData: (MetaData.t, MetaData.Id.t) HashTable.t} + fun new () = T {fnDecls = HashTable.new {equals = String.equals, hash = String.hash}, + fnDefns = HashTable.new {equals = String.equals, hash = String.hash}, + globDecls = HashTable.new {equals = String.equals, hash = String.hash}, + metaData = HashTable.new {equals = MetaData.equals, hash = MetaData.hash}} + fun emit (T {fnDecls, fnDefns, globDecls, metaData}, print) = + let + val empty = ref true + val _ = + HashTable.foreachi + (globDecls, fn (name, {ty, vis}) => + (empty := false + ; print name + ; print " = external " + ; Option.app (vis, fn vis => (print vis; print " ")) + ; print "global " + ; print (Type.toString ty) + ; print "\n")) + val _ = if !empty then () else print "\n" + val empty = ref true + val _ = + HashTable.foreachi + (fnDecls, fn (name, {argTys, resTy, vis}) => + case HashTable.peek (fnDefns, name) of + NONE => + (empty := false + ; print "declare " + ; Option.app (vis, fn vis => (print vis; print " ")) + ; print (Type.toString resTy) + ; print " " + ; print name + ; print "(" + ; List.foreachi (argTys, fn (i, argTy) => + (if i > 0 then print ", " else () + ; print (Type.toString argTy))) + ; print ")\n") + | SOME _ => ()) + val _ = if !empty then () else print "\n" + val empty = ref true + val _ = + HashTable.foreachi + (metaData, fn (md, id) => + (empty := false + ; print (MetaData.Id.toString id) + ; print " = " + ; print (MetaData.toString md) + ; print "\n")) + val _ = if !empty then () else print "\n" + in + () + end + fun addFnDecl (T {fnDecls, ...}, name, argTys_resTy_vis as {argTys, resTy, ...}) = + ((ignore o HashTable.insertIfNew) + (fnDecls, name, fn () => argTys_resTy_vis, ignore) + ; Value.fnptr (name, argTys, resTy)) + fun addFnDefn (T {fnDefns, ...}, name) = + (ignore o HashTable.insertIfNew) + (fnDefns, name, fn () => (), ignore) + fun addGlobDecl (T {globDecls, ...}, name, ty_vis as {ty, ...}) = + ((ignore o HashTable.insertIfNew) + (globDecls, name, fn () => ty_vis, ignore) + ; Value.globptr (name, ty)) + fun addMetaData (T {metaData, ...}, md) = + HashTable.lookupOrInsert + (metaData, md, fn () => "!" ^ Int.toString (HashTable.size metaData)) + end + end + structure ChunkLabel = struct open ChunkLabel - fun toStringX cl = "X" ^ toString cl + val toStringForC = toString + fun toStringXForC cl = "X" ^ toStringForC cl + fun toString cl = "@" ^ toStringForC cl + fun toStringX cl = "@" ^ toStringXForC cl fun toString' cl = if !Control.llvmCC10 then toStringX cl @@ -23,1593 +452,1040 @@ structure ChunkLabel = end local - open Runtime + open Runtime in - structure GCField = GCField + structure GCField = GCField end -datatype z = datatype RealSize.t -datatype z = datatype WordSize.prim - -(* LLVM codegen context. Contains various values/functions that should - be shared amongst all codegen functions. *) -datatype Context = Context of { - amTimeProfiling: bool, - program: Program.t, - labelChunk: Label.t -> ChunkLabel.t, - labelIndex: Label.t -> int, - labelIndexAsString: Label.t -> string, - nextChunks: Label.t vector -} - -fun ctypes () = - concat ["%uintptr_t = type i", Bits.toString (Control.Target.Size.cpointer ()), "\n"] - -val mltypes = -"; ML types\n\ -\%Int8 = type i8\n\ -\%Int16 = type i16\n\ -\%Int32 = type i32\n\ -\%Int64 = type i64\n\ -\%Real32 = type float\n\ -\%Real64 = type double\n\ -\%Word8 = type i8\n\ -\%Word16 = type i16\n\ -\%Word32 = type i32\n\ -\%Word64 = type i64\n\ -\%CPointer = type i8*\n\ -\%Objptr = type i8*\n" - -val chunkfntypes = "\ -\%ChunkFn_t = type %uintptr_t(%CPointer,%CPointer,%CPointer,%uintptr_t)\n\ -\%ChunkFnPtr_t = type %ChunkFn_t*\n\ -\%ChunkFnPtrArr_t = type [0 x %ChunkFnPtr_t]\n" - -val llvmIntrinsics = -"declare float @llvm.sqrt.f32(float %Val)\n\ -\declare double @llvm.sqrt.f64(double %Val)\n\ -\declare float @llvm.sin.f32(float %Val)\n\ -\declare double @llvm.sin.f64(double %Val)\n\ -\declare float @llvm.cos.f32(float %Val)\n\ -\declare double @llvm.cos.f64(double %Val)\n\ -\declare float @llvm.exp.f32(float %Val)\n\ -\declare double @llvm.exp.f64(double %Val)\n\ -\declare float @llvm.log.f32(float %Val)\n\ -\declare double @llvm.log.f64(double %Val)\n\ -\declare float @llvm.log10.f32(float %Val)\n\ -\declare double @llvm.log10.f64(double %Val)\n\ -\declare float @llvm.fma.f32(float %a, float %b, float %c)\n\ -\declare double @llvm.fma.f64(double %a, double %b, double %c)\n\ -\declare float @llvm.fabs.f32(float %Val) ; requires LLVM 3.2\n\ -\declare double @llvm.fabs.f64(double %Val) ; requires LLVM 3.2\n\ -\declare float @llvm.rint.f32(float %Val) ; requires LLVM 3.3\n\ -\declare double @llvm.rint.f64(double %Val) ; requires LLVM 3.3\n\ -\declare {i8, i1} @llvm.sadd.with.overflow.i8(i8 %a, i8 %b)\n\ -\declare {i16, i1} @llvm.sadd.with.overflow.i16(i16 %a, i16 %b)\n\ -\declare {i32, i1} @llvm.sadd.with.overflow.i32(i32 %a, i32 %b)\n\ -\declare {i64, i1} @llvm.sadd.with.overflow.i64(i64 %a, i64 %b)\n\ -\declare {i8, i1} @llvm.uadd.with.overflow.i8(i8 %a, i8 %b)\n\ -\declare {i16, i1} @llvm.uadd.with.overflow.i16(i16 %a, i16 %b)\n\ -\declare {i32, i1} @llvm.uadd.with.overflow.i32(i32 %a, i32 %b)\n\ -\declare {i64, i1} @llvm.uadd.with.overflow.i64(i64 %a, i64 %b)\n\ -\declare {i8, i1} @llvm.ssub.with.overflow.i8(i8 %a, i8 %b)\n\ -\declare {i16, i1} @llvm.ssub.with.overflow.i16(i16 %a, i16 %b)\n\ -\declare {i32, i1} @llvm.ssub.with.overflow.i32(i32 %a, i32 %b)\n\ -\declare {i64, i1} @llvm.ssub.with.overflow.i64(i64 %a, i64 %b)\n\ -\declare {i8, i1} @llvm.usub.with.overflow.i8(i8 %a, i8 %b)\n\ -\declare {i16, i1} @llvm.usub.with.overflow.i16(i16 %a, i16 %b)\n\ -\declare {i32, i1} @llvm.usub.with.overflow.i32(i32 %a, i32 %b)\n\ -\declare {i64, i1} @llvm.usub.with.overflow.i64(i64 %a, i64 %b)\n\ -\declare {i8, i1} @llvm.smul.with.overflow.i8(i8 %a, i8 %b)\n\ -\declare {i16, i1} @llvm.smul.with.overflow.i16(i16 %a, i16 %b)\n\ -\declare {i32, i1} @llvm.smul.with.overflow.i32(i32 %a, i32 %b)\n\ -\declare {i64, i1} @llvm.smul.with.overflow.i64(i64 %a, i64 %b)\n\ -\declare {i8, i1} @llvm.umul.with.overflow.i8(i8 %a, i8 %b)\n\ -\declare {i16, i1} @llvm.umul.with.overflow.i16(i16 %a, i16 %b)\n\ -\declare {i32, i1} @llvm.umul.with.overflow.i32(i32 %a, i32 %b)\n\ -\declare {i64, i1} @llvm.umul.with.overflow.i64(i64 %a, i64 %b)\n" - -fun implementsPrim (p: 'a Prim.t): bool = - let - datatype z = datatype Prim.Name.t - in - case Prim.name p of - CPointer_add => true - | CPointer_diff => true - | CPointer_equal => true - | CPointer_fromWord => true - | CPointer_lt => true - | CPointer_sub => true - | CPointer_toWord => true - | FFI_Symbol _ => true - | Real_Math_acos _ => false - | Real_Math_asin _ => false - | Real_Math_atan _ => false - | Real_Math_atan2 _ => false - | Real_Math_cos _ => true - | Real_Math_exp _ => true - | Real_Math_ln _ => true - | Real_Math_log10 _ => true - | Real_Math_sin _ => true - | Real_Math_sqrt _ => true - | Real_Math_tan _ => false - | Real_abs _ => true (* Requires LLVM 3.2 to use "llvm.fabs" intrinsic *) - | Real_add _ => true - | Real_castToWord _ => true - | Real_div _ => true - | Real_equal _ => true - | Real_ldexp _ => false - | Real_le _ => true - | Real_lt _ => true - | Real_mul _ => true - | Real_muladd _ => true - | Real_mulsub _ => true - | Real_neg _ => true - | Real_qequal _ => true - | Real_rndToReal _ => true - | Real_rndToWord _ => true - | Real_round _ => true (* Requires LLVM 3.3 to use "llvm.rint" intrinsic *) - | Real_sub _ => true - | Thread_returnToC => false - | Word_add _ => true - | Word_addCheckP _ => true - | Word_andb _ => true - | Word_castToReal _ => true - | Word_equal _ => true - | Word_extdToWord _ => true - | Word_lshift _ => true - | Word_lt _ => true - | Word_mul _ => true - | Word_mulCheckP (ws, _) => - (case (!Control.Target.arch, ws) of - (Control.Target.X86, ws) => - (* @llvm.smul.with.overflow.i64 becomes a call to __mulodi4. - * @llvm.umul.with.overflow.i64 becomes a call to __udivdi3. - * These are provided by compiler-rt and not always by libgcc. - * In any case, do not depend on non-standard libraries. - *) - not (WordSize.equals (ws, WordSize.word64)) - | _ => true) - | Word_neg _ => true - | Word_negCheckP _ => true - | Word_notb _ => true - | Word_orb _ => true - | Word_quot _ => true - | Word_rem _ => true - | Word_rndToReal _ => true - | Word_rol _ => true - | Word_ror _ => true - | Word_rshift _ => true - | Word_sub _ => true - | Word_subCheckP _ => true - | Word_xorb _ => true - | _ => false +structure Type = + struct + open Type + val toLLVMType = LLVM.Type.fromCType o toCType end -(* WordX.toString converts to hexadecimal, this converts to base 10 *) -fun llwordx (w: WordX.t) = - IntInf.format (WordX.toIntInf w, StringCvt.DEC) - -fun llint (i: int) = - if i >= 0 - then Int.toString i - else "-" ^ Int.toString (~ i) - -fun llbytes b = llint (Bytes.toInt b) - -fun llws (ws: WordSize.t): string = - case WordSize.prim ws of - WordSize.W8 => "%Word8" - | WordSize.W16 => "%Word16" - | WordSize.W32 => "%Word32" - | WordSize.W64 => "%Word64" - -fun llwsInt (ws: WordSize.t): string = - case WordSize.prim ws of - WordSize.W8 => "i8" - | WordSize.W16 => "i16" - | WordSize.W32 => "i32" - | WordSize.W64 => "i64" - -fun llrs (rs: RealSize.t): string = - case rs of - RealSize.R32 => "%Real32" - | RealSize.R64 => "%Real64" - -(* Reuse CType for LLVM type *) -fun llty (ty: Type.t): string = "%" ^ CType.toString (Type.toCType ty) - -fun typeOfGlobal global = - let - val t = Type.toCType (Global.ty global) - val s = CType.toString t - val number = llint (Global.numberOfType t) - val array = concat ["[", number, " x %", s, "]"] - in - array - end - -fun getTypeFromPointer (typ: string):string = - case typ of - "%CPointer" => "i8" - | "%Objptr" => "i8" - | t => - let - val str_list = String.explode t - val len = List.length str_list - val last_char = List.nth (str_list, len - 1) - in - if Char.equals (last_char, #"*") - then String.implode (List.firstN (str_list, len - 1)) - else t - end - -(* Makes a two-operand instruction: - * = , -*) -fun mkinst (lhs, opr, ty, a0, a1) = - concat ["\t", lhs, " = ", opr, " ", ty, " ", a0, ", ", a1, "\n"] - -(* Makes a call to an LLVM math intrinsic function, given a RealSize as rs: - * = call type @llvm..fX(type ) -*) -fun mkmath (lhs, f, rs, a0) = - let - val ty = llrs rs - val fx = case rs of RealSize.R32 => "f32" | RealSize.R64 => "f64" - in - concat ["\t", lhs, " = call ", ty, " @llvm.", f, ".", fx, "(", ty, " ", a0, ")\n"] - end - -(* Makes a conversion instruction: - * = to -*) -fun mkconv (lhs, opr, fromty, arg, toty) = - concat ["\t", lhs, " = ", opr, " ", fromty, " ", arg, " to ", toty, "\n"] - -(* Makes a getelementptr instruction: - * = getelementptr inbounds , * , [i32 ]+ - * where is a list of integer offsets - * and ty must be a pointer type - *) -fun mkgep (lhs, ty, arg, idcs) = - let - val indices = String.concatWith (List.map (idcs, fn (ity, i) => ity ^ " " ^ i), ", ") - in - concat ["\t", lhs, " = getelementptr inbounds ", getTypeFromPointer ty, ", ", ty, " ", arg, ", ", indices, "\n"] - end - - - -structure Metadata = struct - datatype t = - Unnamed of int - fun str (Unnamed i) = "!" ^ (Int.toString i) - - val metaDataCounter = ref 0 - fun new () = - let - val i = !metaDataCounter - val () = Int.inc metaDataCounter - in - Unnamed i - end - fun reset () = - metaDataCounter := 0 - - fun defineNode (t, ts) = - concat - [str t, - " = !{", - String.concatWith (ts, ", "), - "}"] -end - -structure SimpleOper = struct - - datatype t = Stack of int - | Offset of int - | SequenceOffset - | Other - val equals : t * t -> bool = op = - val hash = - fn Stack i => Hash.combine (0w0, Word.fromInt i) - | Offset i => Hash.combine (0w1, Word.fromInt i) - | SequenceOffset => Hash.permute 0w2 - | Other => Hash.permute 0w3 - val fromOper = - fn Operand.StackOffset - (StackOffset.T {offset, ...}) => Stack (Bytes.toInt offset) - | Operand.Offset {offset, base, ...} => - if Type.isObjptr (Operand.ty base) - then Offset (Bytes.toInt offset) - else Other - | Operand.SequenceOffset {base, ...} => - if Type.isObjptr (Operand.ty base) - then SequenceOffset - else Other - | _ => Other - val toString = - fn Stack i => "Stack " ^ Int.toString i - | Offset i => "Offset " ^ Int.toString i - | SequenceOffset => "SequenceOffset" - | Other => "Other" -end - -val operScopes : (SimpleOper.t, Metadata.t) HashTable.t = - HashTable.new - {hash = SimpleOper.hash, - equals = SimpleOper.equals} - -fun scopeString scope = - concat [", !tbaa ", Metadata.str scope] -(* Generates the string for alias.scope and noalias metadata *) -fun getOperScopes t = - HashTable.lookupOrInsert - (operScopes, SimpleOper.fromOper t, - Metadata.new) - -fun mkOperScope oper = - case !Control.llvmAAMD of - Control.LLVMAliasAnalysisMetaData.None => "" - | Control.LLVMAliasAnalysisMetaData.TBAA => - scopeString (getOperScopes oper) - -(* Makes a load instruction: - * = load , * - * where ty must be a pointer type - *) -fun mkload (lhs, ty, arg, scope) = concat ["\t", lhs, " = load ", getTypeFromPointer ty, ", ", ty, " ", arg, scope, "\n"] - -(* Makes a store instruction: - * store , * - * where is the type of - *) -fun mkstore (ty, arg, loc, scope) = concat ["\tstore ", ty, " ", arg, ", ", ty, "* ", loc, scope, "\n"] - -val tempCounter = Counter.new 0 - -fun resetLLVMTemp () = Counter.reset (tempCounter, 0) -fun nextLLVMTemp () = concat ["%t", Int.toString (Counter.next tempCounter)] - -fun temporaryName (ty: CType.t, index: int): string = - concat ["%T", CType.name ty, "_", Int.toString index] - -val cFunctions : string list ref = ref [] - -fun addCFunction f = if not (List.contains (!cFunctions, f, String.equals)) - then cFunctions := List.cons (f, !cFunctions) - else () - -val ffiSymbols : {name: string, cty: CType.t option, symbolScope: CFunction.SymbolScope.t} list ref = ref [] - -fun addFfiSymbol s = if not (List.contains (!ffiSymbols, s, fn ({name=n1, ...}, {name=n2, ...}) => - String.equals (n1, n2))) - then ffiSymbols := List.cons (s, !ffiSymbols) - else () - -(* argv - vector of (pre, ty, addr) triples - i - index of argv - returns: (pre, type, temp) - *) -fun getArg (argv, i) = - if Vector.length argv > i - then Vector.sub (argv, i) - else ("", "", "") - -(* Converts an operand into its LLVM representation. Returns a triple - (pre, ty, temporary) where - - pre - A string containing preliminary statements that must be - executed before the temporary can be referenced - - ty - A string containing the LLVM representation of the temporary's - type when dereferenced (meaning temporary is really a pointer) - - temporary - The temporary containing a pointer to the value of the operand - *) -fun getOperandAddr (cxt, operand) = +fun primApp (prim: 'a Prim.t): ({args: LLVM.Value.t list, + mc: LLVM.ModuleContext.t, + newTemp: LLVM.Type.t -> LLVM.Value.t, + $ : LLVM.Instr.t -> unit} -> + LLVM.Value.t) option = let - val scope = mkOperScope operand + open LLVM.Instr + val nth = List.nth + fun intrinsic (name, argTys, resTy, mc) = + LLVM.ModuleContext.addFnDecl (mc, "@llvm." ^ name, {argTys = argTys, resTy = resTy, vis = NONE}) + fun compare oper {args, mc = _, newTemp, $} = + let + val tmp = newTemp LLVM.Type.bool + val res = newTemp (LLVM.Type.Word WordSize.bool) + val _ = $(naryop {dst = tmp, oper = oper, args = args}) + val _ = $(zext {dst = res, src = tmp}) + in + res + end + fun conv (instr, ty) {args, mc = _, newTemp, $} = + let + val res = newTemp ty + val _ = $(instr {dst = res, src = nth (args, 0)}) + in + res + end + fun cpointerAdd {args, mc = _, newTemp, $} = + let + val res = newTemp LLVM.Type.cpointer + val _ = $(gep {dst = res, src = nth (args, 0), + args = [nth (args, 1)]}) + in + res + end + fun cpointerCompare cond = + compare ("icmp " ^ cond, LLVM.Type.cpointer) + fun realCompare (cond, rs) = compare ("fcmp " ^ cond, LLVM.Type.Real rs) + fun realMath' (oper, rs, fargs) {args, mc, newTemp, $} = + let + val args = fargs args + val atys = List.map (args, #2) + val rty = LLVM.Type.Real rs + val name = concat [oper, ".f", RealSize.toString rs] + val fnptr = intrinsic (name, atys, rty, mc) + val res = newTemp rty + val _ = $(call {dst = res, tail = NONE, cconv = NONE, fnptr = fnptr, args = args}) + in + res + end + fun realMath (oper, rs) = realMath' (oper, rs, fn args => args) + fun realNary' (oper, rs, fargs) {args, mc = _, newTemp, $} = + let + val args = fargs args + val ty = LLVM.Type.Real rs + val res = newTemp ty + val _ = $(naryop {dst = res, oper = (oper, ty), args = args}) + in + res + end + fun realNary (oper, rs) = realNary' (oper, rs, fn args => args) + fun wordCompare (cond, ws) = compare ("icmp " ^ cond, LLVM.Type.Word ws) + fun wordCheckP' (oper, ws, fargs) {args, mc, newTemp, $} = + let + val args = fargs args + val atys = List.map (args, #2) + val wty = LLVM.Type.Word ws + val sty = LLVM.Type.Struct (false, [wty, LLVM.Type.bool]) + val name = concat [oper, ".with.overflow.i", WordSize.toString ws] + val fnptr = intrinsic (name, atys, sty, mc) + val tmps = newTemp sty + val tmpb = newTemp LLVM.Type.bool + val res = newTemp (LLVM.Type.Word WordSize.bool) + val _ = $(call {dst = tmps, tail = NONE, cconv = NONE, fnptr = fnptr, args = args}) + val _ = $(xval {dst = tmpb, src = tmps, args = ["1"]}) + val _ = $(zext {dst = res, src = tmpb}) + in + res + end + fun wordCheckP (oper, ws) = wordCheckP' (oper, ws, fn args => args) + fun wordNary' (oper, ws, fargs) {args, mc = _, newTemp, $} = + let + val args = fargs args + val ty = LLVM.Type.Word ws + val res = newTemp ty + val _ = $(naryop {dst = res, oper = (oper, ty), args = args}) + in + res + end + fun wordNary (oper, ws) = wordNary' (oper, ws, fn args => args) + fun wordRotate (oper, ws) {args, mc, newTemp, $} = + let + val wty = LLVM.Type.Word ws + val atys = [wty, wty, wty] + val rty = wty + val name = concat [oper, ".i", WordSize.toString ws] + val fnptr = intrinsic (name, atys, rty, mc) + val arg1 = newTemp wty + val res = newTemp wty + val _ = $(resize {dst = arg1, src = nth (args, 1), signed = false}) + val _ = $(call {dst = res, tail = NONE, cconv = NONE, fnptr = fnptr, args = [nth (args, 0), nth (args, 0), arg1]}) + in + res + end + fun wordShift (oper, ws) {args, mc = _, newTemp, $} = + let + val ty = LLVM.Type.Word ws + val arg1 = newTemp ty + val res = newTemp ty + val _ = $(resize {dst = arg1, src = nth (args, 1), signed = false}) + val _ = $(naryop {dst = res, oper = (oper, ty), args = [nth (args, 0), arg1]}) + in + res + end + datatype z = datatype Prim.Name.t in - case operand of - Operand.Frontier => ("", "%CPointer", "%frontier") - | Operand.Global global => - let - val globalType = Global.ty global - val globalIndex = Global.index global - val llvmTy = llty globalType - val ty = typeOfGlobal global - val globalID = "@global" ^ CType.toString (Type.toCType globalType) - val ptr = nextLLVMTemp () - val gep = mkgep (ptr, ty ^ "*", globalID, [("i32", "0"), ("i32", llint globalIndex)]) - in - (gep, llvmTy, ptr) - end - | Operand.Offset {base, offset, ty} => - let - val (basePre, baseTy, baseTemp) = getOperandValue (cxt, base) - val idx = llbytes offset - val llvmTy = llty ty - val ptr = nextLLVMTemp () - val gep = mkgep (ptr, baseTy, baseTemp, [("i32", idx)]) - val temporary = nextLLVMTemp () - val cast = mkconv (temporary, "bitcast", baseTy, ptr, llvmTy ^ "*") - in - (concat [basePre, gep, cast], llvmTy, temporary) - end - | Operand.SequenceOffset {base, index, offset, scale, ty} => - let - (* arrayoffset = base + (index * scale) + offset *) - val (basePre, baseTy, baseTemp) = getOperandValue (cxt, base) - val (indexPre, indexTy, indexTemp) = getOperandValue (cxt, index) - val scl = Scale.toString scale (* "1", "2", "4", or "8" *) - val scaledIndex = nextLLVMTemp () - val scaleIndex = mkinst (scaledIndex, "mul nsw", indexTy, indexTemp, scl) - val ofs = llbytes offset - val offsettedIndex = nextLLVMTemp () - val offsetIndex = mkinst (offsettedIndex, "add nsw", indexTy, scaledIndex, ofs) - val llvmTy = llty ty - val ptr = nextLLVMTemp () - val gep = mkgep (ptr, baseTy, baseTemp, [(indexTy, offsettedIndex)]) - val castedPtr = nextLLVMTemp () - val cast = mkconv (castedPtr, "bitcast", baseTy, ptr, llvmTy ^ "*") - in - (concat [basePre, indexPre, scaleIndex, offsetIndex, gep, cast], llvmTy, castedPtr) - end - | Operand.StackOffset stackOffset => - let - val StackOffset.T {offset, ty} = stackOffset - val idx = llbytes offset - val stackTop = nextLLVMTemp () - val load = mkload (stackTop, "%CPointer*", "%stackTop", scope) - val gepTemp = nextLLVMTemp () - val gep = mkgep (gepTemp, "%CPointer", stackTop, [("i32", idx)]) - val llvmTy = llty ty - val temp = nextLLVMTemp () - val cast = mkconv (temp, "bitcast", "%CPointer", gepTemp, llvmTy ^ "*") - in - (concat [load, gep, cast], llvmTy, temp) - end - | Operand.StackTop => ("", "%CPointer", "%stackTop") - | Operand.Temporary temporary => - let - val tempTy = Temporary.ty temporary - val temp = temporaryName (Type.toCType tempTy, Temporary.index temporary) - val ty = llty tempTy - in - ("", ty, temp) - end - | _ => Error.bug ("Cannot get address of " ^ Operand.toString operand) - end - -(* ty is the type of the value *) -and getOperandValue (cxt, operand) = - let - fun loadOperand () = - let - val (pre, ty, addr) = getOperandAddr (cxt, operand) - val scope = mkOperScope operand - val temp = nextLLVMTemp () - val load = mkload (temp, ty ^ "*", addr, scope) - in - (pre ^ load, ty, temp) - end - val Context { labelIndexAsString, ... } = cxt - in - case operand of - Operand.Cast (oper, ty) => - let - val (operPre, operTy, operTemp) = - getOperandValue (cxt, oper) - val llvmTy = llty ty - val temp = nextLLVMTemp () - fun isIntType cty = case cty of - CType.Int8 => true - | CType.Int16 => true - | CType.Int32 => true - | CType.Int64 => true - | CType.Word8 => true - | CType.Word16 => true - | CType.Word32 => true - | CType.Word64 => true - | _ => false - fun isPtrType cty = case cty of - CType.CPointer => true - | CType.Objptr => true - | _ => false - val operIsInt = (isIntType o Type.toCType o Operand.ty) oper - val operIsPtr = (isPtrType o Type.toCType o Operand.ty) oper - val tyIsInt = (isIntType o Type.toCType) ty - val tyIsPtr = (isPtrType o Type.toCType) ty - val operation = if operIsInt andalso tyIsPtr - then "inttoptr" - else if operIsPtr andalso tyIsInt - then "ptrtoint" - else "bitcast" - val inst = mkconv (temp, operation, operTy, operTemp, llvmTy) - in - (concat [operPre, inst], llvmTy, temp) - end - | Operand.Frontier => loadOperand () - | Operand.GCState => ("", "%CPointer", "%gcState") - | Operand.Global _ => loadOperand () - | Operand.Label label => ("", llws (WordSize.cpointer ()), labelIndexAsString label) - | Operand.Null => ("", "i8*", "null") - | Operand.Offset _ => loadOperand () - | Operand.Real real => ("", (llrs o RealX.size) real, RealX.toString (real, {suffix = false})) - | Operand.SequenceOffset _ => loadOperand () - | Operand.StackOffset _ => loadOperand () - | Operand.StackTop => loadOperand() - | Operand.Temporary _ => loadOperand () - | Operand.Word word => ("", (llws o WordX.size) word, llwordx word) - end - -(* Returns (instruction, ty) pair for the given prim operation *) -fun outputPrim (prim, res, argty, arg0, arg1, arg2) = - let - datatype z = datatype Prim.Name.t - - fun mkoverflowp (ws, intrinsic) = - let - val tmp1 = nextLLVMTemp () - val tmp2 = nextLLVMTemp () - val ty = llws ws - val oper = concat ["\t", tmp1, " = call {", ty, ", i1} @llvm.", - intrinsic, ".with.overflow.", llwsInt ws, - "(", ty, " ", arg0, ", ", ty, " ", arg1, ")\n"] - val extr = concat ["\t", tmp2, " = extractvalue {", ty, ", i1} ", tmp1, - ", 1\n"] - val ext = mkconv (res, "zext", "i1", tmp2, "%Word32") - in - (concat [oper, extr, ext], "%Word32") - end - in - case Prim.name prim of - CPointer_add => - let - val tmp1 = nextLLVMTemp () - val inst1 = mkconv (tmp1, "ptrtoint", "%CPointer", arg0, "%uintptr_t") - val tmp2 = nextLLVMTemp () - val inst2 = mkinst (tmp2, "add", "%uintptr_t", tmp1, arg1) - val inst3 = mkconv (res, "inttoptr", "%uintptr_t", tmp2, "%CPointer") - in - (concat [inst1, inst2, inst3], "%CPointer") - end - | CPointer_diff => - let - val tmp1 = nextLLVMTemp () - val inst1 = mkconv (tmp1, "ptrtoint", "%CPointer", arg0, "%uintptr_t") - val tmp2 = nextLLVMTemp () - val inst2 = mkconv (tmp2, "ptrtoint", "%CPointer", arg1, "%uintptr_t") - val inst3 = mkinst (res, "sub", "%uintptr_t", tmp1, tmp2) - in - (concat [inst1, inst2, inst3], "%uintptr_t") - end - | CPointer_equal => - let - val temp = nextLLVMTemp () - val cmp = mkinst (temp, "icmp eq", "%CPointer", arg0, arg1) - val ext = mkconv (res, "zext", "i1", temp, "%Word32") - in - (concat [cmp, ext], "%Word32") - end - | CPointer_fromWord => - (mkconv (res, "inttoptr", "%uintptr_t", arg0, "%CPointer"), "%CPointer") - | CPointer_lt => - let - val temp = nextLLVMTemp () - val cmp = mkinst (temp, "icmp ult", "%CPointer", arg0, arg1) - val ext = mkconv (res, "zext", "i1", temp, "%Word32") - in - (concat [cmp, ext], "%Word32") - end - | CPointer_sub => - let - val tmp1 = nextLLVMTemp () - val inst1 = mkconv (tmp1, "ptrtoint", "%CPointer", arg0, "%uintptr_t") - val tmp2 = nextLLVMTemp () - val inst2 = mkinst (tmp2, "sub", "%uintptr_t", tmp1, arg1) - val inst3 = mkconv (res, "inttoptr", "%uintptr_t", tmp2, "%CPointer") - in - (concat [inst1, inst2, inst3], "%CPointer") - end - | CPointer_toWord => - (mkconv (res, "ptrtoint", "%CPointer", arg0, "%uintptr_t"), "%CPointer") - | FFI_Symbol (s as {name, cty, ...}) => - let - val () = addFfiSymbol s - val ty = case cty of - SOME t => "%" ^ CType.toString t - | NONE => "i8" - val inst = mkconv (res, "bitcast", ty ^ "*", "@" ^ name, "%CPointer") - in - (inst, "%CPointer") - end - | Real_Math_cos rs => (mkmath (res, "cos", rs, arg0), llrs rs) - | Real_Math_exp rs => (mkmath (res, "exp", rs, arg0), llrs rs) - | Real_Math_ln rs => (mkmath (res, "log", rs, arg0), llrs rs) - | Real_Math_log10 rs => (mkmath (res, "log10", rs, arg0), llrs rs) - | Real_Math_sin rs => (mkmath (res, "sin", rs, arg0), llrs rs) - | Real_Math_sqrt rs => (mkmath (res, "sqrt", rs, arg0), llrs rs) - | Real_abs rs => (mkmath (res, "fabs", rs, arg0), llrs rs) - | Real_add rs => (mkinst (res, "fadd", llrs rs, arg0, arg1), llrs rs) - | Real_castToWord (rs, ws) => - (case rs of - R32 => if WordSize.equals (ws, WordSize.word32) - then (mkconv (res, "bitcast", "float", arg0, "i32"), "i32") - else Error.bug "LLVM codegen: Real_castToWord" - | R64 => if WordSize.equals (ws, WordSize.word64) - then (mkconv (res, "bitcast", "double", arg0, "i64"), "i64") - else Error.bug "LLVM codegen: Real_castToWord") - | Real_div rs => (mkinst (res, "fdiv", llrs rs, arg0, arg1), llrs rs) - | Real_equal rs => - let - val temp = nextLLVMTemp () - val cmp = mkinst (temp, "fcmp oeq", llrs rs, arg0, arg1) - val ext = mkconv (res, "zext", "i1", temp, "%Word32") - in - (concat [cmp, ext], "%Word32") - end - | Real_le rs => - let - val temp = nextLLVMTemp () - val cmp = mkinst (temp, "fcmp ole", llrs rs, arg0, arg1) - val ext = mkconv (res, "zext", "i1", temp, "%Word32") - in - (concat [cmp, ext], "%Word32") - end - | Real_lt rs => - let - val temp = nextLLVMTemp () - val cmp = mkinst (temp, "fcmp olt", llrs rs, arg0, arg1) - val ext = mkconv (res, "zext", "i1", temp, "%Word32") - in - (concat [cmp, ext], "%Word32") - end - | Real_mul rs => (mkinst (res, "fmul", llrs rs, arg0, arg1), llrs rs) - | Real_muladd rs => + case Prim.name prim of + CPointer_add => SOME cpointerAdd + | CPointer_diff => SOME (fn {args, mc = _, newTemp, $} => let - val size = case rs of - RealSize.R32 => "f32" - | RealSize.R64 => "f64" - val llsize = llrs rs - val inst = concat ["\t", res, " = call ", llsize, " @llvm.fma.", size, "(", - llsize, " ", arg0, ", ", llsize, " ", - arg1, ", ", llsize, " ", arg2, ")\n"] + val wptr = LLVM.Type.uintptr () + val arg0 = newTemp wptr + val arg1 = newTemp wptr + val res = newTemp wptr + val _ = $(ptrtoint {dst = arg0, src = nth (args, 0)}) + val _ = $(ptrtoint {dst = arg1, src = nth (args, 1)}) + val _ = $(naryop {dst = res, oper = ("sub", wptr), args = [arg0, arg1]}) in - (inst, llsize) - end - | Real_mulsub rs => - let - val size = case rs of - RealSize.R32 => "f32" - | RealSize.R64 => "f64" - val llsize = llrs rs - val tmp1 = nextLLVMTemp () - val inst1 = mkinst (tmp1, "fsub", llsize, "-0.0", arg2) - val inst2 = concat ["\t", res, " = call ", llsize, " @llvm.fma.", size, "(", - llsize, " ", arg0, ", ", llsize, " ", - arg1, ", ", llsize, " ", tmp1, ")\n"] - in - (concat [inst1, inst2], llsize) - end - | Real_neg rs => (mkinst (res, "fsub", llrs rs, "-0.0", arg0), llrs rs) - | Real_qequal rs => - let - val temp = nextLLVMTemp () - val cmp = mkinst (temp, "fcmp ueq", llrs rs, arg0, arg1) - val ext = mkconv (res, "zext", "i1", temp, "%Word32") - in - (concat [cmp, ext], "%Word32") - end - | Real_rndToReal rs => - (case rs of - (RealSize.R64, RealSize.R32) => - (mkconv (res, "fptrunc", "double", arg0, "float"), "float") - | (RealSize.R32, RealSize.R64) => - (mkconv (res, "fpext", "float", arg0, "double"), "double") - | (RealSize.R32, RealSize.R32) => (* this is a no-op *) - (mkconv (res, "bitcast", "float", arg0, "float"), "float") - | (RealSize.R64, RealSize.R64) => (* this is a no-op *) - (mkconv (res, "bitcast", "double", arg0, "double"), "double")) - | Real_rndToWord (rs, ws, {signed}) => - let - val opr = if signed then "fptosi" else "fptoui" - in - (mkconv (res, opr, llrs rs, arg0, llws ws), llws ws) - end - | Real_round rs => (mkmath (res, "rint", rs, arg0), llrs rs) - | Real_sub rs => (mkinst (res, "fsub", llrs rs, arg0, arg1), llrs rs) - | Word_add ws => (mkinst (res, "add", llws ws, arg0, arg1), llws ws) - | Word_addCheckP (ws, {signed}) => - mkoverflowp (ws, if signed then "sadd" else "uadd") - | Word_andb ws => (mkinst (res, "and", llws ws, arg0, arg1), llws ws) - | Word_castToReal (ws, rs) => - (case rs of - R32 => if WordSize.equals (ws, WordSize.word32) - then (mkconv (res, "bitcast", "i32", arg0, "float"), "float") - else Error.bug "LLVM codegen: Word_castToReal" - | R64 => if WordSize.equals (ws, WordSize.word64) - then (mkconv (res, "bitcast", "i64", arg0, "double"), "double") - else Error.bug "LLVM codegen: Word_castToReal") - | Word_equal _ => - let - val temp = nextLLVMTemp () - val cmp = mkinst (temp, "icmp eq", argty, arg0, arg1) - val ext = mkconv (res, "zext", "i1", temp, "%Word32") - in - (concat [cmp, ext], "%Word32") - end - | Word_extdToWord (ws1, ws2, {signed}) => - let - val opr = case WordSize.compare (ws1, ws2) of - LESS => if signed then "sext" else "zext" - | EQUAL => Error.bug "LLVM codegen: Word_extdToWord" - | GREATER => "trunc" - in - (mkconv (res, opr, llws ws1, arg0, llws ws2), llws ws2) - end - | Word_lshift ws => (mkinst (res, "shl", llws ws, arg0, arg1), llws ws) - | Word_lt (ws, {signed}) => - let - val temp = nextLLVMTemp () - val cmp = mkinst (temp, if signed then "icmp slt" else "icmp ult", - llws ws, arg0, arg1) - val ext = mkconv (res, "zext", "i1", temp, "%Word32") - in - (concat [cmp, ext], "%Word32") - end - | Word_mul (ws, _) => (mkinst (res, "mul", llws ws, arg0, arg1), llws ws) - | Word_mulCheckP (ws, {signed}) => - mkoverflowp (ws, if signed then "smul" else "umul") - | Word_neg ws => (mkinst (res, "sub", llws ws, "0", arg0), llws ws) - | Word_negCheckP (ws, {signed}) => + res + end) + | CPointer_equal => SOME (cpointerCompare "eq") + | CPointer_fromWord => SOME (conv (inttoptr, LLVM.Type.cpointer)) + | CPointer_lt => SOME (cpointerCompare "ult") + | CPointer_sub => SOME (fn {args, mc, newTemp, $} => let - val ty = llws ws - val tmp1 = nextLLVMTemp () - val tmp2 = nextLLVMTemp () - val intrinsic = if signed then "ssub" else "usub" - val oper = concat ["\t", tmp1, " = call {", ty, ", i1} @llvm.", - intrinsic, ".with.overflow.", llwsInt ws, - "(", ty, " 0, ", ty, " ", arg0, ")\n"] - val extr = concat ["\t", tmp2 , " = extractvalue {", ty, ", i1}", - tmp1, ", 1\n"] - val ext = mkconv (res, "zext", "i1", tmp2, "%Word32") + fun mk args = {args = args, mc = mc, newTemp = newTemp, $ = $} + val ws = WordSize.cpointer () + val tmp = wordNary ("sub", ws) (mk [LLVM.Value.zero ws, nth (args, 1)]) + val res = cpointerAdd (mk [nth (args, 0), tmp]) in - (concat [oper, extr, ext], "%Word32") - end - | Word_notb ws => (mkinst (res, "xor", llws ws, arg0, "-1"), llws ws) - | Word_orb ws => (mkinst (res, "or", llws ws, arg0, arg1), llws ws) - | Word_quot (ws, {signed}) => - (mkinst (res, if signed then "sdiv" else "udiv", llws ws, arg0, arg1), llws ws) - | Word_rem (ws, {signed}) => - (mkinst (res, if signed then "srem" else "urem", llws ws, arg0, arg1), llws ws) - | Word_rndToReal (ws, rs, {signed}) => - let - val opr = if signed then "sitofp" else "uitofp" - in - (mkconv (res, opr, llws ws, arg0, llrs rs), llrs rs) - end - | Word_rol ws => + res + end) + | CPointer_toWord => SOME (conv (ptrtoint, LLVM.Type.uintptr ())) + | FFI_Symbol {name, cty, symbolScope} => SOME (fn {args = _, mc, newTemp, $} => let - (* (arg0 >> (size - arg1)) | (arg0 << arg1) *) - val ty = llws ws - val tmp1 = nextLLVMTemp () - val inst1 = mkinst (tmp1, "sub", ty, WordSize.toString ws, arg1) - val tmp2 = nextLLVMTemp () - val inst2 = mkinst (tmp2, "lshr", ty, arg0, tmp1) - val tmp3 = nextLLVMTemp () - val inst3 = mkinst (tmp3, "shl", ty, arg0, arg1) - val inst4 = mkinst (res, "or", ty, tmp2, tmp3) + val name = "@" ^ name + val ty = + case cty of + NONE => LLVM.Type.Word WordSize.word8 + | SOME ty => LLVM.Type.fromCType ty + val vis = + case symbolScope of + CFunction.SymbolScope.External => "default" + | CFunction.SymbolScope.Private => "hidden" + | CFunction.SymbolScope.Public => "default" + val globptr = + LLVM.ModuleContext.addGlobDecl + (mc, name, {ty = ty, vis = SOME vis}) + val res = newTemp LLVM.Type.cpointer + val _ = $(bitcast {dst = res, src = globptr}) in - (concat [inst1, inst2, inst3, inst4], llws ws) - end - | Word_ror ws => - let - (* (arg0 >> arg1) | (arg0 << (size - arg1)) *) - val ty = llws ws - val tmp1 = nextLLVMTemp () - val inst1 = mkinst (tmp1, "lshr", ty, arg0, arg1) - val tmp2 = nextLLVMTemp () - val inst2 = mkinst (tmp2, "sub", ty, WordSize.toString ws, arg1) - val tmp3 = nextLLVMTemp () - val inst3 = mkinst (tmp3, "shl", ty, arg0, tmp2) - val inst4 = mkinst (res, "or", ty, tmp1, tmp3) - in - (concat [inst1, inst2, inst3, inst4], llws ws) - end - | Word_rshift (ws, {signed}) => + res + end) + | Real_Math_acos _ => NONE + | Real_Math_asin _ => NONE + | Real_Math_atan _ => NONE + | Real_Math_atan2 _ => NONE + | Real_Math_cos rs => SOME (realMath ("cos", rs)) + | Real_Math_exp rs => SOME (realMath ("exp", rs)) + | Real_Math_ln rs => SOME (realMath ("log", rs)) + | Real_Math_log10 rs => SOME (realMath ("log10", rs)) + | Real_Math_sin rs => SOME (realMath ("sin", rs)) + | Real_Math_sqrt rs => SOME (realMath ("sqrt", rs)) + | Real_Math_tan _ => NONE + | Real_abs rs => SOME (realMath ("fabs", rs)) + | Real_add rs => SOME (realNary ("fadd", rs)) + | Real_castToWord (_, ws) => SOME (conv (bitcast, LLVM.Type.Word ws)) + | Real_div rs => SOME (realNary ("fdiv", rs)) + | Real_equal rs => SOME (realCompare ("oeq", rs)) + | Real_ldexp _ => NONE + | Real_le rs => SOME (realCompare ("ole", rs)) + | Real_lt rs => SOME (realCompare ("olt", rs)) + | Real_mul rs => SOME (realNary ("fmul", rs)) + | Real_muladd rs => SOME (realMath ("fma", rs)) + | Real_mulsub rs => SOME (fn {args, mc, newTemp, $} => let - val opr = if signed then "ashr" else "lshr" + fun mk args = {args = args, mc = mc, newTemp = newTemp, $ = $} + val tmp = realNary ("fneg", rs) (mk [nth (args, 2)]) + val res = realMath ("fma", rs) (mk [nth (args, 0), nth (args, 1), tmp]) in - (mkinst (res, opr, llws ws, arg0, arg1), llws ws) - end - | Word_sub ws => (mkinst (res, "sub", llws ws, arg0, arg1), llws ws) - | Word_subCheckP (ws, {signed}) => - mkoverflowp (ws, if signed then "ssub" else "usub") - | Word_xorb ws => (mkinst (res, "xor", llws ws, arg0, arg1), llws ws) - | _ => Error.bug "LLVM Codegen: Unsupported operation in outputPrim" - end - -fun outputPrimApp (cxt, p) = - let - datatype z = datatype Prim.Name.t - val {args, dst, prim} = p - fun typeOfArg0 () = (WordSize.fromBits o Type.width o Operand.ty o Vector.sub) (args, 0) - val castArg1 = case Prim.name prim of - Word_rshift _ => SOME (typeOfArg0 ()) - | Word_lshift _ => SOME (typeOfArg0 ()) - | Word_rol _ => SOME (typeOfArg0 ()) - | Word_ror _ => SOME (typeOfArg0 ()) - | _ => NONE - val operands = Vector.map (args, fn opr => getOperandValue (cxt, opr)) - val (arg0pre, arg0ty, arg0temp) = getArg (operands, 0) - val (arg1pre, _, arg1) = getArg (operands, 1) - val (cast, arg1temp) = case castArg1 of - SOME ty => - let - val temp = nextLLVMTemp () - val opr = case WordSize.prim ty of - WordSize.W8 => "trunc" - | WordSize.W16 => "trunc" - | WordSize.W32 => "bitcast" - | WordSize.W64 => "zext" - val inst = mkconv (temp, opr, "%Word32", arg1, llws ty) - in - (inst, temp) - end - | NONE => ("", arg1) - val (arg2pre, _, arg2temp) = getArg (operands, 2) - val temp = nextLLVMTemp () - val (inst, _) = outputPrim (prim, temp, arg0ty, arg0temp, arg1temp, arg2temp) - val storeDest = - case dst of - NONE => "" - | SOME dest => - let - val (destPre, destTy, destTemp) = getOperandAddr (cxt, dest) - val scope = mkOperScope dest - val store = mkstore (destTy, temp, destTemp, scope) - in - concat [destPre, store] - end - in - concat [arg0pre, arg1pre, cast, arg2pre, inst, storeDest] - end + res + end) + | Real_neg rs => SOME (realNary ("fneg", rs)) + | Real_qequal rs => SOME (realCompare ("ueq", rs)) + | Real_rndToReal (_, rs) => SOME (conv (fpresize, LLVM.Type.Real rs)) + | Real_rndToWord (_, ws, {signed}) => SOME (conv (if signed then fptosi else fptoui, LLVM.Type.Word ws)) + | Real_round rs => SOME (realMath ("rint", rs)) + | Real_sub rs => SOME (realNary ("fsub", rs)) + | Thread_returnToC => NONE + | Word_add ws => SOME (wordNary ("add", ws)) + | Word_addCheckP (ws, {signed}) => SOME (wordCheckP (if signed then "sadd" else "uadd", ws)) + | Word_andb ws => SOME (wordNary ("and", ws)) + | Word_castToReal (_, rs) => SOME (conv (bitcast, LLVM.Type.Real rs)) + | Word_equal ws => SOME (wordCompare ("eq", ws)) + | Word_extdToWord (_, ws, {signed}) => SOME (conv (fn {dst, src} => resize {dst = dst, src = src, signed = signed}, LLVM.Type.Word ws)) + | Word_lshift ws => SOME (wordShift ("shl", ws)) + | Word_lt (ws, {signed}) => SOME (wordCompare (if signed then "slt" else "ult", ws)) + | Word_mul (ws, _) => SOME (wordNary ("mul", ws)) + | Word_mulCheckP (ws, {signed}) => SOME (wordCheckP (if signed then "smul" else "umul", ws)) + | Word_neg ws => SOME (wordNary' ("sub", ws, fn args => (LLVM.Value.zero ws)::args)) + | Word_negCheckP (ws, {signed}) => SOME (wordCheckP' (if signed then "ssub" else "usub", ws, fn args => (LLVM.Value.zero ws)::args)) + | Word_notb ws => SOME (wordNary' ("xor", ws, fn args =>(LLVM.Value.negOne ws)::args)) + | Word_orb ws => SOME (wordNary ("or", ws)) + | Word_quot (ws, {signed}) => SOME (wordNary (if signed then "sdiv" else "udiv", ws)) + | Word_rem (ws, {signed}) => SOME (wordNary (if signed then "srem" else "urem", ws)) + | Word_rndToReal (_, rs, {signed}) => SOME (conv (if signed then sitofp else uitofp, LLVM.Type.Real rs)) + | Word_rol ws => SOME (wordRotate ("fshl", ws)) + | Word_ror ws => SOME (wordRotate ("fshr", ws)) + | Word_rshift (ws, {signed}) => SOME (wordShift (if signed then "ashr" else "lshr", ws)) + | Word_sub ws => SOME (wordNary ("sub", ws)) + | Word_subCheckP (ws, {signed}) => SOME (wordCheckP (if signed then "ssub" else "usub", ws)) + | Word_xorb ws => SOME (wordNary ("xor", ws)) + | _ => NONE + end +fun implementsPrim (p: 'a Prim.t): bool = Option.isSome (primApp p) -fun outputStatement (cxt: Context, stmt: Statement.t): string = - let - val comment = concat ["\t; ", Layout.toString (Statement.layout stmt), "\n"] - val stmtcode = - case stmt of - Statement.Move {dst, src} => - let - val (srcpre, _, srctemp) = getOperandValue (cxt, src) - val (dstpre, dstty, dsttemp) = getOperandAddr (cxt, dst) - val scope = mkOperScope dst - val store = mkstore (dstty, srctemp, dsttemp, scope) +fun aamd (oper, mc) = + case !Control.llvmAAMD of + Control.LLVMAliasAnalysisMetaData.None => NONE + | Control.LLVMAliasAnalysisMetaData.TBAA => + let + fun tbaa s = + let + val root = + LLVM.ModuleContext.addMetaData + (mc, LLVM.MetaData.node [LLVM.MetaData.string "root"]) + val desc = + LLVM.ModuleContext.addMetaData + (mc, LLVM.MetaData.node [LLVM.MetaData.string s, + LLVM.MetaData.id root]) + val acc = + LLVM.ModuleContext.addMetaData + (mc, LLVM.MetaData.node [LLVM.MetaData.id desc, + LLVM.MetaData.id desc, + LLVM.MetaData.value (LLVM.Value.zero WordSize.word32)]) in - concat [srcpre, dstpre, store] - end - | Statement.Noop => "\t; Noop\n" - | Statement.PrimApp p => outputPrimApp (cxt, p) - | Statement.ProfileLabel _ => "\t; ProfileLabel\n" - in - concat [comment, stmtcode] - end - -local - fun mk (dst, src) cxt = - outputStatement (cxt, Statement.Move {dst = dst (), src = src ()}) - fun stackTop () = Operand.StackTop - fun gcStateStackTop () = Operand.gcField GCField.StackTop - fun frontier () = Operand.Frontier - fun gcStateFrontier () = Operand.gcField GCField.Frontier -in - val cacheStackTop = mk (stackTop, gcStateStackTop) - val flushStackTop = mk (gcStateStackTop, stackTop) - val cacheFrontier = mk (frontier, gcStateFrontier) - val flushFrontier = mk (gcStateFrontier, frontier) -end - -(* LeaveChunk(nextChunk, nextBlock) - - if (TailCall) { - return nextChunk(gcState, stackTop, frontier, nextBlock); - } else { - FlushFrontier(); - FlushStackTop(); - return nextBlock; - } -*) -fun leaveChunk (cxt, nextChunk, nextBlock) = - if !Control.chunkTailCall - then let - val stackTopArg = nextLLVMTemp () - val frontierArg = nextLLVMTemp () - val res = nextLLVMTemp () - in - concat - [mkload (stackTopArg, "%CPointer*", "%stackTop", ""), - mkload (frontierArg, "%CPointer*", "%frontier", ""), - "\t", res, " = musttail call ", - if !Control.llvmCC10 - then "cc10 " - else "", - "%uintptr_t ", - nextChunk, "(", - "%CPointer ", "%gcState", ", ", - "%CPointer ", stackTopArg, ", ", - "%CPointer ", frontierArg, ", ", - "%uintptr_t ", nextBlock, ")\n", - "\tret %uintptr_t ", res, "\n"] - end - else concat [flushFrontier cxt, - flushStackTop cxt, - "\tret %uintptr_t ", nextBlock, "\n"] - -(* IndJump(mustReturnToSelf, mayReturnToSelf, mustReturnToOther) + SOME (concat ["!tbaa ", LLVM.MetaData.Id.toString acc]) + end + fun other () = tbaa "other" + in + case oper of + Operand.Offset {base, offset, ...} => + if Type.isObjptr (Operand.ty base) + then tbaa ("Offset " ^ Bytes.toString offset) + else other () + | Operand.SequenceOffset {base, ...} => + if Type.isObjptr (Operand.ty base) + then tbaa "SequenceOffset" + else other () + | Operand.StackOffset (StackOffset.T {offset, ...}) => + tbaa ("StackOffset " ^ Bytes.toString offset) + | _ => tbaa "other" + end - nextBlock = *(uintptr_t* )(StackTop - sizeof(uintptr_t)); - ChunkFnPtr_t nextChunk = nextChunks[nextBlock]; - if (mustReturnToSelf || (mayReturnToSelf && (nextChunk == selfChunk))) { - goto doSwitchNextBlock; - } else if (mustReturnToOther != NULL) { - LeaveChunk( *mustReturnToOther, nextBlock); - } else { - LeaveChunk( *nextChunk, nextBlock); - } -*) -fun indJump (cxt, selfChunk, mustReturnToSelf, mayReturnToSelf, mustReturnToOther) = +fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, + outputC: unit -> {file: File.t, + print: string -> unit, + done: unit -> unit}, + outputLL: unit -> {file: File.t, + print: string -> unit, + done: unit -> unit}} = let - val stackTop = nextLLVMTemp () - val loadStackTop = mkload (stackTop, "%CPointer*", "%stackTop", "") - val nextBlock = nextLLVMTemp () - val loadNextBlockFromStackTop = + val {get = labelInfo: Label.t -> {block: Block.t, + chunkLabel: ChunkLabel.t, + index: int option}, + set = setLabelInfo, ...} = + Property.getSetOnce + (Label.plist, Property.initRaise ("LLVMCodeGen.labelInfo", Label.layout)) + val nextChunks = Array.new (Vector.length frameInfos, NONE) + val _ = + List.foreach + (chunks, fn Chunk.T {blocks, chunkLabel, ...} => + Vector.foreach + (blocks, fn block as Block.T {kind, label, ...} => + let + val index = + case Kind.frameInfoOpt kind of + NONE => NONE + | SOME fi => + let + val index = FrameInfo.index fi + in + if Kind.isEntry kind + then Array.update (nextChunks, index, SOME label) + else () + ; SOME index + end + in + setLabelInfo (label, {block = block, + chunkLabel = chunkLabel, + index = index}) + end)) + val nextChunks = Vector.keepAllMap (Vector.fromArray nextChunks, fn lo => lo) + val labelChunk = #chunkLabel o labelInfo + val labelIndex = valOf o #index o labelInfo + fun labelIndexValue l = + (LLVM.Value.word o WordX.fromIntInf) + (IntInf.fromInt (labelIndex l), WordSize.cpointer ()) + + val amTimeProfiling = + !Control.profile = Control.ProfileTimeField + orelse !Control.profile = Control.ProfileTimeLabel + + fun creturnName (ct: CType.t): string = + concat ["%CReturn", CType.name ct] + fun creturnVarC (ct: CType.t): LLVM.Value.t = + (creturnName ct, LLVM.Type.Pointer (LLVM.Type.fromCType ct)) + fun creturnVar t = creturnVarC (Type.toCType t) + fun globalName (ct: CType.t): string = + concat ["@global", CType.toString ct] + fun globalValC (ct: CType.t, mc): LLVM.Value.t = let - val tmp1 = nextLLVMTemp () - val tmp2 = nextLLVMTemp () + val name = globalName ct + val ty = LLVM.Type.Array (Global.numberOfType ct, LLVM.Type.fromCType ct) in - concat - [mkgep (tmp1, "%CPointer", stackTop, [("i32", "-" ^ (llbytes (Runtime.labelSize ())))]), - mkconv (tmp2, "bitcast", "%CPointer", tmp1, "%uintptr_t*"), - mkload (nextBlock, "%uintptr_t*", tmp2, "")] + LLVM.ModuleContext.addGlobDecl (mc, name, {ty = ty, vis = SOME "hidden"}) end - val storeNextBlock = mkstore ("%uintptr_t", nextBlock, "%nextBlock", "") - val nextChunk = nextLLVMTemp () - val loadNextChunk = + fun globalVal (c, mc) = globalValC (Type.toCType c, mc) + fun temporaryName (ct: CType.t, index: int): string = + concat ["%T", CType.name ct, "_", Int.toString index] + fun temporaryVarC (ct: CType.t, index: int): LLVM.Value.t = + (temporaryName (ct, index), LLVM.Type.Pointer (LLVM.Type.fromCType ct)) + fun temporaryVar (t, index) = temporaryVarC (Type.toCType t, index) + + val gcState = ("%gcState", LLVM.Type.cpointer) + local + fun mk (name, lty) = + ((name ^ "Arg", lty), + (name, LLVM.Type.Pointer lty)) + in + val (stackTopArg, stackTopVar) = mk ("%stackTop", LLVM.Type.cpointer) + val (frontierArg, frontierVar) = mk ("%frontier", LLVM.Type.cpointer) + val (nextBlockArg, nextBlockVar) = mk ("%nextBlock", LLVM.Type.uintptr ()) + end + val chunkFnArgs = [gcState, stackTopArg, frontierArg, nextBlockArg] + val chunkFnArgTys = List.map (chunkFnArgs, #2) + val chunkFnResTy = LLVM.Type.uintptr () + val chunkFnTy = LLVM.Type.Function (chunkFnArgTys, chunkFnResTy) + val chunkFnPtrTy = LLVM.Type.Pointer chunkFnTy + local + fun mk tos (cl: ChunkLabel.t, mc): LLVM.Value.t = + LLVM.ModuleContext.addFnDecl (mc, tos cl, {argTys = chunkFnArgTys, resTy = chunkFnResTy, vis = SOME "hidden"}) + in + val chunkFnValX = mk ChunkLabel.toStringX + val chunkFnVal' = mk ChunkLabel.toString' + end + fun nextChunksVar mc = let - val tmp = nextLLVMTemp () + val name = if !Control.llvmCC10 then "@nextXChunks" else "@nextChunks" + val ty = LLVM.Type.Array (Vector.length nextChunks, chunkFnPtrTy) in - concat - [mkgep (tmp, "%ChunkFnPtrArr_t*", - if !Control.llvmCC10 - then "@nextXChunks" - else "@nextChunks", - [("i32", "0"), ("%uintptr_t", nextBlock)]), - mkload (nextChunk, "%ChunkFnPtr_t*", tmp, "")] + LLVM.ModuleContext.addGlobDecl (mc, name, {ty = ty, vis = SOME "hidden"}) end - val returnToSelf = nextLLVMTemp () - val computeReturnToSelf = + + val doSwitchNextBlock = LLVM.Value.label' "doSwitchNextBlock" + + fun outputChunkFn (Chunk.T {chunkLabel, blocks, tempsMax, ...}, mc, print) = let - val tmp1 = nextLLVMTemp () - val tmp2 = nextLLVMTemp () - in - concat - [mkinst (tmp1, "icmp eq", "%ChunkFnPtr_t", nextChunk, concat ["@", ChunkLabel.toString' selfChunk]), - mkinst (tmp2, "and", "i1", if mayReturnToSelf then "1" else "0", tmp1), - mkinst (returnToSelf, "or", "i1", if mustReturnToSelf then "1" else "0", tmp2)] - end - val returnToSelfLabel = Label.toString (Label.newNoname ()) - val leaveChunkLabel = Label.toString (Label.newNoname ()) - in - concat - [loadStackTop, loadNextBlockFromStackTop, storeNextBlock, loadNextChunk, computeReturnToSelf, - "\tbr i1 ", returnToSelf, ", label %", returnToSelfLabel, ", label %", leaveChunkLabel, "\n", - returnToSelfLabel, ":\n", - "\tbr label %doSwitchNextBlock\n", - leaveChunkLabel, ":\n", - case mustReturnToOther of - NONE => leaveChunk (cxt, nextChunk, nextBlock) - | SOME dstChunk => leaveChunk (cxt, concat ["@", ChunkLabel.toString' dstChunk], nextBlock)] - end + val selfChunk = chunkLabel -fun adjStackTop (cxt, size: Bytes.t) = - concat - [outputStatement (cxt, - Statement.PrimApp - {args = Vector.new2 - (Operand.StackTop, - Operand.Word - (WordX.fromBytes - (size, - WordSize.cptrdiff ()))), - dst = SOME Operand.StackTop, - prim = Prim.cpointerAdd}), - let - val Context { amTimeProfiling, ... } = cxt - in - if amTimeProfiling - then flushStackTop cxt - else "" - end] -fun pop (cxt, fi: FrameInfo.t) = - adjStackTop (cxt, Bytes.~ (FrameInfo.size fi)) -fun push (cxt, return: Label.t, size: Bytes.t) = - concat - [outputStatement (cxt, - Statement.Move - {dst = Operand.stackOffset - {offset = Bytes.- (size, Runtime.labelSize ()), - ty = Type.label return}, - src = Operand.Label return}), - adjStackTop (cxt, size)] + local + fun tb () = print "\t" + fun ln () = print "\n" + in + fun prints ss = List.foreach (ss, print) + fun println s = (print s; ln ()) + fun printsln ss = (prints ss; ln ()) + fun tbprintsln ss = (tb (); prints ss; ln ()) + end -fun outputTransfer (cxt, chunkLabel, transfer) = - let - val comment = concat ["\t; ", Layout.toString (Transfer.layout transfer), "\n"] - val Context { labelChunk, labelIndexAsString, ... } = cxt - fun jump label = - let - val dstChunk = labelChunk label - in - if ChunkLabel.equals (chunkLabel, dstChunk) - then concat ["\tbr label %", Label.toString label, "\n"] - else leaveChunk (cxt, - concat ["@", ChunkLabel.toString' dstChunk], - labelIndexAsString label) - end - fun rtrans rsTo = - let - val mustRToOne = - case rsTo of - [] => NONE - | l::rsTo => - if List.forall (rsTo, fn l' => Label.equals (l, l')) - then SOME l - else NONE - fun isSelf c = ChunkLabel.equals (chunkLabel, c) - val rsTo = - List.fold - (rsTo, [], fn (l, cs) => - let - val c = labelChunk l - in - if List.exists (cs, fn c' => ChunkLabel.equals (c, c')) - then cs - else c::cs - end) - val mayRToSelf = List.exists (rsTo, isSelf) - val (mustRToSelf, mustRToOther) = - case List.revKeepAll (rsTo, not o isSelf) of - [] => (true, NONE) - | c::rsTo => - (false, - List.fold (rsTo, SOME c, fn (c', co) => - case co of - NONE => NONE - | SOME c => if ChunkLabel.equals (c, c') - then SOME c - else NONE)) - in - case (!Control.chunkMustRToSingOpt, mustRToOne) of - (true, SOME dst) => jump dst - | _ => - indJump (cxt, chunkLabel, - !Control.chunkMustRToSelfOpt andalso mustRToSelf, - !Control.chunkMayRToSelfOpt andalso mayRToSelf, - if (!Control.chunkMustRToOtherOpt andalso - (!Control.chunkMayRToSelfOpt orelse not mayRToSelf)) - then mustRToOther - else NONE) - end - in - case transfer of - Transfer.CCall {func = - CFunction.T - {target = CFunction.Target.Direct "Thread_returnToC", ...}, - return = SOME {return, size = SOME size}, ...} => - concat [comment, - push (cxt, return, size), - flushFrontier cxt, - flushStackTop cxt, - "\tret %uintptr_t -1\n"] - | Transfer.CCall {args, func, return} => - let - val CFunction.T {return = returnTy, target, ...} = func - val (argsPre, args) = - let - val args = Vector.toListMap (args, fn opr => getOperandValue (cxt, opr)) - in - (String.concat (List.map (args, #1)), - List.map (args, fn (_, ty, temp) => (ty, temp))) - end - val push = - case return of - NONE => "" - | SOME {size = NONE, ...} => "" - | SOME {return, size = SOME size} => push (cxt, return, size) - val flushFrontierCode = if CFunction.modifiesFrontier func then flushFrontier cxt else "" - val flushStackTopCode = if CFunction.readsStackTop func then flushStackTop cxt else "" - val (callLHS, callType, afterCall) = - if Type.isUnit returnTy - then ("\t", "void", "") - else let - val resTemp = nextLLVMTemp () - in - (concat ["\t", resTemp, " = "], - llty returnTy, - mkstore (llty returnTy, resTemp, - "%CReturn" ^ CType.name (Type.toCType returnTy), "")) - end - val (fnptrPre, fnptrVal, args) = - case target of - CFunction.Target.Direct name => + local + val next = Counter.generator 0 + in + fun newTemp ty = + (concat ["%t", Int.toString (next ())], ty) + end + + open LLVM.Instr + fun $ i = (print "\t"; AList.foreach (i, print); print "\n") + + fun operandToLValue oper = + let + val addr = + case oper of + Operand.Frontier => frontierVar + | Operand.Global g => + let + val ty = Global.ty g + val index = + LLVM.Value.word (WordX.fromIntInf + (IntInf.fromInt (Global.index g), + WordSize.word32)) + val res = newTemp (LLVM.Type.Pointer (Type.toLLVMType ty)) + val _ = $(gep {dst = res, src = globalVal (ty, mc), + args = [LLVM.Value.zero WordSize.word32, index]}) + in + res + end + | Operand.Offset {base, offset, ty} => + let + val base = operandToRValue base + val offset = LLVM.Value.word (WordX.fromBytes (offset, WordSize.word32)) + val tmp = newTemp LLVM.Type.cpointer + val res = newTemp (LLVM.Type.Pointer (Type.toLLVMType ty)) + val _ = $(gep {dst = tmp, src = base, args = [offset]}) + val _ = $(cast {dst = res, src = tmp}) + in + res + end + | Operand.SequenceOffset {base, index, offset, scale, ty} => + let + val base = operandToRValue base + val index as (_, indexTy) = operandToRValue index + val scale = LLVM.Value.word (WordX.fromBytes (Scale.toBytes scale, WordSize.cptrdiff ())) + val offset = LLVM.Value.word (WordX.fromBytes (offset, WordSize.word32)) + val tmp1 = newTemp indexTy + val tmp2 = newTemp LLVM.Type.cpointer + val tmp3 = newTemp LLVM.Type.cpointer + val res = newTemp (LLVM.Type.Pointer (Type.toLLVMType ty)) + val _ = $(naryop {dst = tmp1, oper = ("mul nsw", indexTy), + args = [index, scale]}) + val _ = $(gep {dst = tmp2, src = base, args = [tmp1]}) + val _ = $(gep {dst = tmp3, src = tmp2, args = [offset]}) + val _ = $(cast {dst = res, src = tmp3}) + in + res + end + | Operand.StackOffset (StackOffset.T {offset, ty}) => + let + val stackTop = newTemp LLVM.Type.cpointer + val addr = newTemp LLVM.Type.cpointer + val res = newTemp (LLVM.Type.Pointer (Type.toLLVMType ty)) + val _ = $(load {dst = stackTop, src = stackTopVar}) + val _ = $(gep {dst = addr, src = stackTop, + args = [LLVM.Value.word + (WordX.fromBytes + (offset, WordSize.word32))]}) + val _ = $(cast {dst = res, src = addr}) + in + res + end + | Operand.StackTop => stackTopVar + | Operand.Temporary t => temporaryVar (Temporary.ty t, Temporary.index t) + | _ => Error.bug ("LLVMCodegen.operandToLValue: " ^ Operand.toString oper) + val aamd = aamd (oper, mc) + in + (fn {dst} => addMetaData (load {dst = dst, src = addr}, aamd), + fn {src} => addMetaData (store {dst = addr, src = src}, aamd)) + end + and operandToRValue oper = + let + val load = fn () => + let + val (loadOper, _) = operandToLValue oper + val res = newTemp (Type.toLLVMType (Operand.ty oper)) + val _ = $(loadOper {dst = res}) + in + res + end + in + case oper of + Operand.Cast (oper, ty) => let - val name = "@" ^ name - val () = - addCFunction - (concat [callType, " ", - name, " (", - String.concatWith - (List.map (args, #1), - ", "), ")"]) + val oper = operandToRValue oper + val res = newTemp (Type.toLLVMType ty) + val _ = $(cast {dst = res, src = oper}) in - ("", name, args) + res end - | CFunction.Target.Indirect => + | Operand.Frontier => load () + | Operand.GCState => gcState + | Operand.Global _ => load () + | Operand.Label label => labelIndexValue label + | Operand.Null => LLVM.Value.null + | Operand.Offset _ => load () + | Operand.Real r => LLVM.Value.real r + | Operand.SequenceOffset _ => load () + | Operand.StackOffset _ => load () + | Operand.StackTop => load () + | Operand.Temporary _ => load () + | Operand.Word w => LLVM.Value.word w + end + fun operandsToRValues opers = + (List.rev o Vector.fold) + (opers, [], fn (oper, opers) => (operandToRValue oper)::opers) + + fun outputStatement (s: Statement.t): unit = + let in + case s of + Statement.Move {dst, src} => let - val (fnptrArgTy, fnptrArgTemp, args) = - case args of - (fnptrTy, fnptrTemp)::args => (fnptrTy, fnptrTemp, args) - | _ => Error.bug "LLVMCodegen.outputTransfer: CCall,Indirect" - val fnptrTy = - concat [callType, " (", - String.concatWith - (List.map (args, #1), - ", "), ") *"] - val fnptrTemp = nextLLVMTemp () - val cast = mkconv (fnptrTemp, "bitcast", - fnptrArgTy, fnptrArgTemp, - fnptrTy) + val (_, storeDst) = operandToLValue dst + val src = operandToRValue src + val _ = $(storeDst {src = src}) in - (cast, - fnptrTemp, - args) + () end - val call = - concat [callLHS, - "call ", - callType, " ", - fnptrVal, "(", - String.concatWith - (List.map - (args, fn (ty, temp) => ty ^ " " ^ temp), - ", "), ")"] - val epilogue = - case return of - NONE => "\tret %uintptr_t -2\n" - | SOME {return, ...} => + | Statement.Noop => () + | Statement.PrimApp {args, dst, prim} => let - val cacheFrontierCode = - if CFunction.modifiesFrontier func then cacheFrontier cxt else "" - val cacheStackTopCode = - if CFunction.writesStackTop func then cacheStackTop cxt else "" - val br = if CFunction.maySwitchThreadsFrom func - then indJump (cxt, chunkLabel, false, true, NONE) - else concat ["\tbr label %", Label.toString return, "\n"] + val args = operandsToRValues args + val res = + (valOf (primApp prim)) + {args = args, mc = mc, newTemp = newTemp, $ = $} + val _ = + case dst of + NONE => () + | SOME dst => + let + val (_, storeDst) = operandToLValue dst + val _ = $(storeDst {src = res}) + in + () + end in - concat [cacheFrontierCode, cacheStackTopCode, br] + () end + | Statement.ProfileLabel _ => Error.bug "LLVMCodegen.outputStatement: ProfileLabel" + end + local + fun mk (dst, src) () = + outputStatement (Statement.Move {dst = dst, src = src}) + val stackTop = Operand.StackTop + val gcStateStackTop = Operand.gcField GCField.StackTop + val frontier = Operand.Frontier + val gcStateFrontier = Operand.gcField GCField.Frontier in - concat [comment, - "\t; GetOperands\n", - argsPre, - push, - flushFrontierCode, - flushStackTopCode, - "\t; Call\n", - fnptrPre, - call, - afterCall, - epilogue] - end - | Transfer.Call {label, return, ...} => - let - val push = case return of - NONE => "" - | SOME {return, size, ...} => push (cxt, return, size) - in - concat [comment, push, jump label] - end - | Transfer.Goto label => - let - val goto = concat ["\tbr label %", Label.toString label, "\n"] - in - concat [comment, goto] + val cacheStackTop = mk (stackTop, gcStateStackTop) + val flushStackTop = mk (gcStateStackTop, stackTop) + val cacheFrontier = mk (frontier, gcStateFrontier) + val flushFrontier = mk (gcStateFrontier, frontier) end - | Transfer.Raise {raisesTo} => - let - (* StackTop = StackBottom + ExnStack *) - val cutStack = - outputStatement (cxt, - Statement.PrimApp - {args = Vector.new2 - (Operand.gcField GCField.StackBottom, - Operand.gcField GCField.ExnStack), - dst = SOME Operand.StackTop, - prim = Prim.cpointerAdd}) - in - concat [comment, cutStack, rtrans raisesTo] - end - | Transfer.Return {returnsTo} => - concat [comment, rtrans returnsTo] - | Transfer.Switch switch => - let - val Switch.T {cases, default, test, ...} = switch - val (testpre, testty, testtemp) = getOperandValue (cxt, test) - val (default, extra) = - case default of - SOME d => (d, "") - | NONE => let - val d = Label.newNoname () - in - (d, - concat [Label.toString d, ":\n", - "\tunreachable\n"]) - end - in - concat [comment, testpre, - "\tswitch ", testty, " ", testtemp, - ", label %", Label.toString default, " [\n", - String.concatV - (Vector.map - (cases, fn (w, l) => - concat ["\t\t", llws (WordX.size w), " ", llwordx w, - ", label %", Label.toString l, "\n"])), - "\t]\n", extra] - end - end - -fun outputBlock (cxt, chunkLabel, block) = - let - val Block.T {kind, label, statements, transfer, ...} = block - val labelstr = Label.toString label - val blockLabel = labelstr ^ ":\n" - val dopop = case kind of - Kind.Cont {frameInfo, ...} => pop (cxt, frameInfo) - | Kind.CReturn {dst, frameInfo, ...} => + (* StackTop += size *) + fun adjStackTop (size: Bytes.t) = + (outputStatement (Statement.PrimApp + {args = Vector.new2 + (Operand.StackTop, + Operand.Word + (WordX.fromBytes + (size, + WordSize.cptrdiff ()))), + dst = SOME Operand.StackTop, + prim = Prim.cpointerAdd}) + ; if amTimeProfiling + then flushStackTop () + else ()) + fun pop (fi: FrameInfo.t) = + adjStackTop (Bytes.~ (FrameInfo.size fi)) + fun push (return: Label.t, size: Bytes.t) = + (outputStatement (Statement.Move + {dst = Operand.stackOffset + {offset = Bytes.- (size, Runtime.labelSize ()), + ty = Type.label return}, + src = Operand.Label return}) + ; adjStackTop size) + (* LeaveChunk(nextChunk, nextBlock) + if (TailCall) { + return nextChunk(gcState, stackTop, frontier, nextBlock); + } else { + flushFrontier(); + flushStackTop(); + return nextBlock; + } + *) + fun leaveChunk (nextChunk, nextBlock) = + if !Control.chunkTailCall + then let + val stackTop = newTemp LLVM.Type.cpointer + val frontier = newTemp LLVM.Type.cpointer + val res = newTemp chunkFnResTy + in + $(load {dst = stackTop, src = stackTopVar}) + ; $(load {dst = frontier, src = frontierVar}) + ; $(call {dst = res, + tail = SOME "musttail", + cconv = if !Control.llvmCC10 + then SOME "cc10" + else NONE, + fnptr = nextChunk, + args = [gcState, stackTop, frontier, nextBlock]}) + ; $(ret res) + end + else (flushFrontier () + ; flushStackTop () + ; $(ret nextBlock)) + (* IndJump(mustReturnToSelf, mayReturnToSelf, mustReturnToOther) + nextBlock = *(uintptr_t* )(StackTop - sizeof(uintptr_t)); + if (mustReturnToSelf) { + goto doSwitchNextBlock; + } else { + ChunkFnPtr_t nextChunk = nextChunks[nextBlock]; + if (mayReturnToSelf && (nextChunk == selfChunk)) { + goto doSwitchNextBlock; + } + if (mustReturnToOther != NULL) { + LeaveChunk( *mustReturnToOther, nextBlock); + } else { + LeaveChunk( *nextChunk, nextBlock); + } + } + *) + fun indJump (mustReturnToSelf, mayReturnToSelf, mustReturnToOther) = + let + val nextBlock = + operandToRValue + (Operand.stackOffset + {offset = Bytes.~ (Runtime.labelSize ()), + ty = Type.label (Label.newNoname ())}) + val _ = $(store {dst = nextBlockVar, src = nextBlock}) + in + if mustReturnToSelf + then $(jmp doSwitchNextBlock) + else let + val nextChunkAddr = newTemp (LLVM.Type.Pointer chunkFnPtrTy) + val nextChunk = newTemp chunkFnPtrTy + val doNextChunk = + Promise.delay + (fn () => + ($(gep {dst = nextChunkAddr, src = nextChunksVar mc, + args = [LLVM.Value.zero WordSize.word32, nextBlock]}) + ; $(load {dst = nextChunk, src = nextChunkAddr}))) + val _ = + if mayReturnToSelf + then let + val _ = Promise.force doNextChunk + val rToSelf = Label.newNoname () + val rToOther = Label.newNoname () + val test = newTemp LLVM.Type.bool + val _ = $(naryop {dst = test, + oper = ("icmp eq", chunkFnPtrTy), + args = [nextChunk, chunkFnVal' (selfChunk, mc)]}) + val _ = $(br {test = test, + truee = LLVM.Value.label rToSelf, + falsee = LLVM.Value.label rToOther}) + val _ = printsln [Label.toString rToSelf, ":"] + val _ = $(jmp doSwitchNextBlock) + val _ = printsln [Label.toString rToOther, ":"] + in + () + end + else () + val _ = + case mustReturnToOther of + NONE => (Promise.force doNextChunk; leaveChunk (nextChunk, nextBlock)) + | SOME dstChunk => leaveChunk (chunkFnVal' (dstChunk, mc), nextBlock) + in + () + end + end + fun outputTransfer (t: Transfer.t): unit = + let + fun jump label = + let + val dstChunk = labelChunk label + in + if ChunkLabel.equals (dstChunk, selfChunk) + then $(jmp (LLVM.Value.label label)) + else leaveChunk (chunkFnVal' (dstChunk, mc), + labelIndexValue label) + end + fun rtrans rsTo = + let + val mustRToOne = + case rsTo of + [] => NONE + | l::rsTo => + if List.forall (rsTo, fn l' => Label.equals (l, l')) + then SOME l + else NONE + fun isSelf c = ChunkLabel.equals (selfChunk, c) + val rsTo = + List.fold + (rsTo, [], fn (l, cs) => + let + val c = labelChunk l + in + if List.contains (cs, c, ChunkLabel.equals) + then cs + else c::cs + end) + val mayRToSelf = List.exists (rsTo, isSelf) + val (mustRToSelf, mustRToOther) = + case List.revKeepAll (rsTo, not o isSelf) of + [] => (true, NONE) + | c::rsTo => + (false, + if List.forall (rsTo, fn c' => ChunkLabel.equals (c, c')) + then SOME c + else NONE) + in + case (!Control.chunkMustRToSingOpt, mustRToOne) of + (true, SOME dst) => jump dst + | _ => + indJump (!Control.chunkMustRToSelfOpt andalso mustRToSelf, + !Control.chunkMayRToSelfOpt andalso mayRToSelf, + if (!Control.chunkMustRToOtherOpt andalso + (!Control.chunkMayRToSelfOpt orelse not mayRToSelf)) + then mustRToOther + else NONE) + end + val _ = + if !Control.codegenComments > 0 + then tbprintsln ["; ", Layout.toString (Transfer.layout t)] + else () + in + case t of + Transfer.CCall {func = + CFunction.T + {target = + CFunction.Target.Direct "Thread_returnToC", ...}, + return = SOME {return, size = SOME size}, ...} => + (push (return, size); + flushFrontier (); + flushStackTop (); + $(ret (LLVM.Value.negOne (WordSize.cpointer ())))) + | Transfer.CCall {args, func, return} => let - val popfi = case frameInfo of - NONE => "" - | SOME fi => pop (cxt, fi) - val move = case dst of - NONE => "" - | SOME x => - let - val xop = Live.toOperand x - val ty = Operand.ty xop - val llvmTy = llty ty - val temp = nextLLVMTemp () - val scope = mkOperScope xop - val load = mkload (temp, llvmTy ^ "*", - "%CReturn" ^ - CType.name (Type.toCType ty), - scope) - val (dstpre, dstty, dsttemp) = - getOperandAddr (cxt, xop) - val store = mkstore (dstty, temp, dsttemp, scope) - in - concat [dstpre, load, store] - end + val CFunction.T {return = returnTy, target, symbolScope, ...} = func + val args = operandsToRValues args + val _ = Option.app (return, fn {return, size} => + Option.app (size, fn size => + push (return, size))) + val _ = if CFunction.modifiesFrontier func then flushFrontier () else () + val _ = if CFunction.readsStackTop func then flushStackTop () else () + val resTy = if Type.isUnit returnTy + then LLVM.Type.Void + else Type.toLLVMType returnTy + val res = newTemp resTy + val (fnptr, args) = + case target of + CFunction.Target.Direct name => + let + val name = "@" ^ name + val argTys = List.map (args, #2) + val vis = + case symbolScope of + CFunction.SymbolScope.External => "default" + | CFunction.SymbolScope.Private => "hidden" + | CFunction.SymbolScope.Public => "default" + val _ = + LLVM.ModuleContext.addFnDecl + (mc, name, {argTys = argTys, resTy = resTy, vis = SOME vis}) + in + (LLVM.Value.fnptr (name, argTys, resTy), args) + end + | CFunction.Target.Indirect => + let + val (cptr, args) = + case args of + cptr::args => (cptr, args) + | _ => Error.bug "LLVMCodegen.outputTransfer: CCall,Indirect" + val argTys = List.map (args, #2) + val fnty = LLVM.Type.Function (argTys, resTy) + val fnptr = newTemp (LLVM.Type.Pointer fnty) + val _ = $(cast {dst = fnptr, src = cptr}) + in + (fnptr, args) + end + val _ = $(call {dst = res, + tail = NONE, cconv = NONE, + fnptr = fnptr, args = args}) + val _ = + case return of + NONE => $(ret (LLVM.Value.negTwo (WordSize.cpointer ()))) + | SOME {return, ...} => + let + val _ = if CFunction.modifiesFrontier func then cacheFrontier () else () + val _ = if CFunction.writesStackTop func then cacheStackTop () else () + val _ = if Type.isUnit returnTy + then () + else $(store {dst = creturnVar returnTy, src = res}) + val _ = + if CFunction.maySwitchThreadsFrom func + then indJump (false, true, NONE) + else $(jmp (LLVM.Value.label return)) + in + () + end in - concat [popfi, move] + () end - | Kind.Handler {frameInfo, ...} => pop (cxt, frameInfo) - | _ => "" - val outputStatementWithCxt = fn s => outputStatement (cxt, s) - val blockBody = String.concatV (Vector.map (statements, outputStatementWithCxt)) - val blockTransfer = outputTransfer (cxt, chunkLabel, transfer) - in - concat [blockLabel, dopop, blockBody, blockTransfer, "\n"] - end - -fun outputLLVMDeclarations print = - let - val globals = concat (List.map (CType.all, fn t => - let - val s = CType.toString t - val n = Global.numberOfType t - in - if n > 0 - then concat ["@global", s, " = external hidden global [", - llint n, " x %", s, "]\n"] - else "" - end)) - in - print (concat [llvmIntrinsics, "\n", mltypes, "\n", ctypes (), - "\n", chunkfntypes, - "\n", globals, "\n"]) - end - -fun outputChunkFn (cxt, chunk, print) = - let - val () = resetLLVMTemp () - val Context { labelIndex, ... } = cxt - val Chunk.T {blocks, chunkLabel, tempsMax} = chunk - val entries = - let - val entries = ref [] - val () = - Vector.foreach - (blocks, fn Block.T {kind, label, ...} => - if Kind.isEntry kind - then List.push (entries, (label, labelIndex label)) - else ()) - in - List.insertionSort (!entries, fn ((_, i1), (_, i2)) => i1 <= i2) - end - val numEntries = List.length entries - val () = if !Control.chunkJumpTable - then let - val () = print (concat ["@", ChunkLabel.toString' chunkLabel, ".nextLabels ", - "= internal constant ", - "[", llint numEntries, " x i8*] ", - "[\n"]) - val () = List.foreachi (entries, fn (i, (label, _)) => - print (concat ["\t\ti8* blockaddress(", - "@", - ChunkLabel.toString' chunkLabel, - ", ", - "%", Label.toString label, ")", - if i < numEntries - 1 - then ",\n" - else " ]\n"])) - in - () - end - else () - val () = print (concat ["define hidden %uintptr_t @", - ChunkLabel.toString chunkLabel, - "(%CPointer %gcState, %CPointer %stackTopArg, %CPointer %frontierArg, %uintptr_t %nextBlockArg) {\nentry:\n"]) - val () = - if !Control.llvmCC10 - then (print (concat ["\t%res = call cc10 %uintptr_t @", - ChunkLabel.toStringX chunkLabel, - "(%CPointer %gcState, %CPointer %stackTopArg, %CPointer %frontierArg, %uintptr_t %nextBlockArg)\n", - "\tret %uintptr_t %res\n}\n"]) - ; print (concat ["define hidden cc10 %uintptr_t @", - ChunkLabel.toStringX chunkLabel, - "(%CPointer %gcState, %CPointer %stackTopArg, %CPointer %frontierArg, %uintptr_t %nextBlockArg) {\nentry:\n"])) - else () - val () = print "\t%stackTop = alloca %CPointer\n" - val () = print "\t%frontier = alloca %CPointer\n" - val () = print "\t%nextBlock = alloca %uintptr_t\n" - val () = List.foreach (CType.all, - fn t => - print (concat ["\t%CReturn", CType.name t, - " = alloca %", CType.toString t, "\n"])) - val () = List.foreach (CType.all, fn t => - Int.for (0, 1 + tempsMax t, fn i => - (print "\t" - ; print (temporaryName (t, i)) - ; print " = alloca %" - ; print (CType.toString t) - ; print "\n"))) - val () = print (mkstore ("%CPointer", "%stackTopArg", "%stackTop", "")) - val () = print (mkstore ("%CPointer", "%frontierArg", "%frontier", "")) - val () = print (mkstore ("%uintptr_t", "%nextBlockArg", "%nextBlock", "")) - val () = print "\tbr label %doSwitchNextBlock\n\n" - val () = print "doSwitchNextBlock:\n" - val () = - if !Control.chunkJumpTable - then let - val tmp1 = nextLLVMTemp () - val tmp2 = nextLLVMTemp () - val tmp3 = nextLLVMTemp () - val tmp4 = nextLLVMTemp () - val () = print (mkload (tmp1, "%uintptr_t*", "%nextBlock", "")) - val () = print (mkinst (tmp2, "sub", "i64", tmp1, llint (#2 (List.first entries)))) - val () = print (mkgep (tmp3, - concat ["[", llint numEntries, " x i8*]*"], - concat ["@", ChunkLabel.toString' chunkLabel, ".nextLabels"], - [("i64", "0"), ("%uintptr_t", tmp2)])) - val () = print (mkload (tmp4, "i8**", tmp3, "")) - val () = print (concat ["\tindirectbr i8* ", tmp4, - ", [\n"]) - val () = List.foreachi (entries, fn (i, (label, _)) => - print (concat ["\t\t label %", - Label.toString label, - if i < numEntries - 1 - then ",\n" - else " ]\n"])) - in - () - end - else let - val tmp = nextLLVMTemp () - val () = print (mkload (tmp, "%uintptr_t*", "%nextBlock", "")) - val () = print (concat ["\tswitch %uintptr_t ", tmp, - ", label %switchNextBlockDefault [\n"]) - val () = List.foreach (entries, fn (label, index) => - print (concat ["\t\t%uintptr_t ", - llint index, - ", label %", - Label.toString label, - "\n"])) - val () = print "\t]\n\n" - val () = print "switchNextBlockDefault:\n" - val () = print "\tunreachable\n" - in - () - end - val () = print "\n" - val () = print (String.concatV (Vector.map (blocks, fn b => outputBlock (cxt, chunkLabel, b)))) - val () = print "}\n\n" - in - () - end - -fun outputChunks (cxt, chunks, - outputLL: unit -> {file: File.t, - print: string -> unit, - done: unit -> unit}) = - let - val Context { program, ... } = cxt - val () = cFunctions := [] - val () = ffiSymbols := [] - val () = HashTable.removeAll (operScopes, fn _ => true) - val () = Metadata.reset () - val { done, print, file=_ } = outputLL () - val () = outputLLVMDeclarations print - val () = print "\n" - val () = let - fun declareChunk (Chunk.T {chunkLabel, ...}) = - if List.exists (chunks, fn chunk => - ChunkLabel.equals (chunkLabel, Chunk.chunkLabel chunk)) - then () - else print (concat ["declare hidden %uintptr_t @", - ChunkLabel.toString' chunkLabel, - "(%CPointer,%CPointer,%CPointer,%uintptr_t)\n"]) - val Program.T {chunks, ...} = program - in - List.foreach (chunks, declareChunk) - ; print (if !Control.llvmCC10 then "@nextXChunks" else "@nextChunks") - ; print " = external hidden global %ChunkFnPtrArr_t\n" - ; print "\n\n" - end - val () = List.foreach (chunks, fn chunk => outputChunkFn (cxt, chunk, print)) - val () = - case !Control.llvmAAMD of - Control.LLVMAliasAnalysisMetaData.None => () - | Control.LLVMAliasAnalysisMetaData.TBAA => - let - val operDomain = Metadata.new () - val () = print (concat - [Metadata.defineNode (operDomain, ["!\"operRoot\""]), - "\t; ", "Operator domain", "\n"]) - val () = - List.foreach - (HashTable.toList operScopes, fn (oper, m) => + | Transfer.Call {label, return, ...} => + (Option.app (return, fn {return, size, ...} => push (return, size)) + ; jump label) + | Transfer.Goto dst => $(jmp (LLVM.Value.label dst)) + | Transfer.Raise {raisesTo} => + (outputStatement (Statement.PrimApp + {args = Vector.new2 + (Operand.gcField GCField.StackBottom, + Operand.gcField GCField.ExnStack), + dst = SOME Operand.StackTop, + prim = Prim.cpointerAdd}) + ; rtrans raisesTo) + | Transfer.Return {returnsTo} => rtrans returnsTo + | Transfer.Switch (Switch.T {cases, default, test, ...}) => let - val () = print (Metadata.defineNode - (m, - ["!\"" ^ SimpleOper.toString oper ^ "\"", - Metadata.str operDomain, - "i64 0"])) - val () = print "\n" + val test = operandToRValue test + val (default, extra) = + case default of + SOME d => (d, fn () => ()) + | NONE => let + val d = Label.newNoname () + in + (d, fn () => + (printsln [Label.toString d, ":"] + ; $(unreachable ()))) + end + val _ = $(switch {value = test, default = LLVM.Value.label default, + table = Vector.toListMap (cases, fn (w, l) => + (LLVM.Value.word w, + LLVM.Value.label l))}) + val _ = extra () in () - end) - val () = print "\n" - in - () - end - val () = List.foreach (!cFunctions, fn f => - print (concat ["declare ", f, "\n"])) - val () = List.foreach (!ffiSymbols, fn {name, cty, symbolScope} => - let - val ty = case cty of - SOME t => "%" ^ CType.toString t - | NONE => "i8" - val visibility = case symbolScope of - CFunction.SymbolScope.External => "default" - | CFunction.SymbolScope.Private => "hidden" - | CFunction.SymbolScope.Public => "default" - in - print (concat ["@", name, " = external ", visibility, " global ", ty, - "\n"]) - end) - - in - done () - end + end -fun makeContext program = - let - val Program.T { chunks, frameInfos, ...} = program - val {get = labelInfo: Label.t -> {chunkLabel: ChunkLabel.t, - index: int option}, - set = setLabelInfo, ...} = - Property.getSetOnce - (Label.plist, Property.initRaise ("LLVMCodeGen.labelInfo", Label.layout)) - val nextChunks = Array.new (Vector.length frameInfos, NONE) - val _ = - List.foreach - (chunks, fn Chunk.T {blocks, chunkLabel, ...} => - Vector.foreach - (blocks, fn Block.T {kind, label, ...} => - let - val index = - case Kind.frameInfoOpt kind of - NONE => NONE - | SOME fi => - let - val index = FrameInfo.index fi + end + val outputStatement = fn s => + let + val _ = + if !Control.codegenComments > 1 + then tbprintsln ["; ", Layout.toString (Statement.layout s)] + else () + in + outputStatement s + end + + fun outputBlock (Block.T {kind, label, statements, transfer, ...}) = + let + val _ = printsln [Label.toString label, ":"] + val _ = + case kind of + Kind.Cont {frameInfo, ...} => pop frameInfo + | Kind.CReturn {dst, frameInfo, ...} => + (Option.app (frameInfo, pop) + ; (Option.app + (dst, fn dst => + let + val dst = Live.toOperand dst + val ty = Operand.ty dst + val creturn = newTemp (Type.toLLVMType ty) + val _ = $(load {dst = creturn, src = creturnVar ty}) + val (_, storeDst) = operandToLValue dst + val _ = $(storeDst {src = creturn}) + in + () + end)) + ; ()) + | Kind.Func _ => () + | Kind.Handler {frameInfo, ...} => pop frameInfo + | Kind.Jump => () + val _ = Vector.foreach (statements, outputStatement) + val _ = outputTransfer transfer + val _ = print "\n" + in + () + end + + val entries = + let + val entries = ref [] + val _ = + Vector.foreach + (blocks, fn Block.T {kind, label, ...} => + if Kind.isEntry kind + then List.push (entries, (label, labelIndex label)) + else ()) + in + List.insertionSort (!entries, fn ((_, i1), (_, i2)) => i1 <= i2) + end + val numEntries = List.length entries + val nextLabels = (concat [ChunkLabel.toString' chunkLabel, ".nextLabels"], + LLVM.Type.Pointer (LLVM.Type.Array (numEntries, LLVM.Type.blockaddress))) + val _ = if !Control.chunkJumpTable + then let + val _ = + prints [#1 nextLabels, + " = internal constant ", + LLVM.Type.toString (LLVM.Type.dePointer (#2 nextLabels)), + " ["] + val _ = + List.foreachi (entries, fn (i, (label, _)) => + (if i > 0 then print "," else () + ; prints ["\n\ti8* blockaddress(", + ChunkLabel.toString' chunkLabel, + ", ", "%", Label.toString label, ")"])) + val _ = print " ]\n" in - if Kind.isEntry kind - then Array.update (nextChunks, index, SOME label) - else () - ; SOME index + () end - in - setLabelInfo (label, {chunkLabel = chunkLabel, - index = index}) - end)) - val nextChunks = Vector.keepAllMap (Vector.fromArray nextChunks, fn lo => lo) - val labelChunk = #chunkLabel o labelInfo - val labelIndex = valOf o #index o labelInfo - fun labelIndexAsString (l: Label.t): string = llint (labelIndex l) - val amTimeProfiling = - !Control.profile = Control.ProfileTimeField - orelse !Control.profile = Control.ProfileTimeLabel - in - Context { amTimeProfiling = amTimeProfiling, - program = program, - labelIndex = labelIndex, - labelIndexAsString = labelIndexAsString, - labelChunk = labelChunk, - nextChunks = nextChunks - } - end - -fun transLLVM (cxt, outputLL) = - let - val Context { program, ... } = cxt - val Program.T { chunks, ...} = program - val chunks = - List.revMap - (chunks, fn chunk as Chunk.T {blocks, ...} => - (chunk, - Vector.fold - (blocks, 0, fn (Block.T {statements, ...}, n) => - n + Vector.length statements + 1))) - fun batch (chunks, acc, n) = - case chunks of - [] => outputChunks (cxt, acc, outputLL) - | (chunk, s)::chunks' => - let - val m = n + s - in - if List.isEmpty acc orelse m <= !Control.chunkBatch - then batch (chunks', chunk::acc, m) - else (outputChunks (cxt, acc, outputLL); - batch (chunks, [], 0)) - end - in - batch (chunks, [], 0) - end - -structure C = CCodegen.C + else () -fun transC (cxt, outputC) = - let - val Context { program, ... } = cxt - val Program.T {main = main, chunks = chunks, ... } = program - val Context { labelChunk, labelIndexAsString, nextChunks, ... } = cxt + val chunkArgs = + concat ["(", + String.concatWith + (List.map + (chunkFnArgs, fn (arg, argTy) => + concat [LLVM.Type.toString argTy, " ", arg]), + ", "), + ")"] + val _ = LLVM.ModuleContext.addFnDefn (mc, ChunkLabel.toString chunkLabel) + val _ = printsln ["define hidden ", + LLVM.Type.toString chunkFnResTy, " ", ChunkLabel.toString chunkLabel, + chunkArgs, " {"] + val _ = + if !Control.llvmCC10 + then let + val res = ("%res", chunkFnResTy) + val _ = $(call {dst = res, tail = NONE, cconv = SOME "cc10", + fnptr = chunkFnValX (chunkLabel, mc), + args = chunkFnArgs}) + val _ = $(ret res) + val _ = println "}" + val _ = LLVM.ModuleContext.addFnDefn (mc, ChunkLabel.toStringX chunkLabel) + val _ = printsln ["define hidden cc10 ", + LLVM.Type.toString chunkFnResTy, " ", ChunkLabel.toStringX chunkLabel, + chunkArgs, " {"] + in + () + end + else () + + val _ = print "start:\n" + val _ = List.foreach (CType.all, fn ct => + $(alloca {dst = creturnVarC ct})) + val _ = List.foreach (CType.all, fn ct => + Int.for (0, 1 + tempsMax ct, fn i => + $(alloca {dst = temporaryVarC (ct, i)}))) + val _ = $(alloca {dst = stackTopVar}) + val _ = $(store {dst = stackTopVar, src = stackTopArg}) + val _ = $(alloca {dst = frontierVar}) + val _ = $(store {dst = frontierVar, src = frontierArg}) + val _ = $(alloca {dst = nextBlockVar}) + val _ = $(store {dst = nextBlockVar, src = nextBlockArg}) + val _ = $(jmp doSwitchNextBlock) + val _ = print "\n" + + val _ = print "doSwitchNextBlock:\n" + val nextBlock = newTemp (LLVM.Type.uintptr ()) + val _ = $(load {dst = nextBlock, src = nextBlockVar}) + val _ = + if !Control.chunkJumpTable + then let + val index = newTemp (LLVM.Type.uintptr ()) + val nextLabelAddr = newTemp (LLVM.Type.Pointer LLVM.Type.blockaddress) + val nextLabel = newTemp LLVM.Type.blockaddress + val bias = LLVM.Value.word (WordX.fromIntInf (Int.toIntInf (#2 (List.first entries)), + WordSize.cpointer ())) + + val _ = $(naryop {dst = index, oper = ("sub nuw nsw", LLVM.Type.uintptr ()), + args = [nextBlock, bias]}) + val _ = $(gep {dst = nextLabelAddr, src = nextLabels, + args = [LLVM.Value.zero WordSize.word32, index]}) + val _ = $(load {dst = nextLabel, src = nextLabelAddr}) + val _ = $(indirectbr {addr = nextLabel, labels = List.map (entries, LLVM.Value.label o #1)}) + in + () + end + else let + val _ = $(switch {value = nextBlock, + default = LLVM.Value.label' "switchNextBlockDefault", + table = List.map (entries, fn (label, index) => + (LLVM.Value.word + (WordX.fromIntInf + (IntInf.fromInt index, + WordSize.cpointer ())), + LLVM.Value.label label))}) + val _ = print "switchNextBlockDefault:\n" + val _ = $(unreachable ()) + in + () + end + val _ = print "\n" + + val _ = Vector.foreach (blocks, outputBlock) + + val _ = print "}\n\n" + in + () + end - fun defineNextChunks (print, nextChunksName, chunkName) = + fun outputChunks chunks = + let + val {done, print, ...} = outputLL () + val mc = LLVM.ModuleContext.new () + in + print "\n" + ; List.foreach (chunks, fn chunk => outputChunkFn (chunk, mc, print)) + ; LLVM.ModuleContext.emit (mc, print) + ; done () + end + val chunksWithSizes = + List.revMap + (chunks, fn chunk as Chunk.T {blocks, ...} => + (chunk, + Vector.fold + (blocks, 0, fn (Block.T {statements, ...}, n) => + n + Vector.length statements + 1))) + fun batch (chunksWithSizes, acc, n) = + case chunksWithSizes of + [] => outputChunks acc + | (chunk, s)::chunksWithSizes' => + let + val m = n + s + in + if List.isEmpty acc orelse m <= !Control.chunkBatch + then batch (chunksWithSizes', chunk::acc, m) + else (outputChunks acc; + batch (chunksWithSizes, [], 0)) + end + val _ = batch (chunksWithSizes, [], 0) + + val {print, done, ...} = outputC () + fun defineNextChunks (nextChunksName, chunkName) = (List.foreach (chunks, fn Chunk.T {chunkLabel, ...} => (print "PRIVATE extern ChunkFn_t " @@ -1618,13 +1494,13 @@ fun transC (cxt, outputC) = ; print "PRIVATE ChunkFnPtr_t " ; print nextChunksName ; print "[" - ; print (C.int (Vector.length nextChunks)) + ; print (Int.toString (Vector.length nextChunks)) ; print "] = {\n" ; Vector.foreachi (nextChunks, fn (i, label) => (print "\t" ; print "/* " - ; print (C.int i) + ; print (Int.toString i) ; print ": */ " ; print "/* " ; print (Label.toString label) @@ -1632,32 +1508,28 @@ fun transC (cxt, outputC) = ; print (chunkName (labelChunk label)) ; print "),\n")) ; print "};\n") - val defineNextChunks = fn print => - (defineNextChunks (print, "nextChunks", ChunkLabel.toString) + val defineNextChunks = fn () => + (defineNextChunks ("nextChunks", ChunkLabel.toStringForC) ; if !Control.llvmCC10 - then defineNextChunks (print, "nextXChunks", ChunkLabel.toStringX) + then defineNextChunks ("nextXChunks", ChunkLabel.toStringXForC) else ()) - - val {print, done, file = _} = outputC () + val additionalMainArgs = + let + val mainLabel = #label main + in + [concat [Int.toString (labelIndex mainLabel), + " /* ", Label.toString mainLabel, " */"]] + end val _ = CCodegen.outputDeclarations - {additionalMainArgs = [labelIndexAsString (#label main)], + {additionalMainArgs = additionalMainArgs, includes = ["c-main.h"], - print = print, program = program, - rest = fn () => defineNextChunks print} + print = print, + rest = defineNextChunks} val _ = done () in () end -fun output {program, outputC, outputLL} = - let - val context = makeContext program - val () = transLLVM (context, outputLL) - val () = transC (context, outputC) - in - () - end - end From e34905fadde7da6e1c90543a841de554eed79843 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 30 Jul 2019 10:06:08 -0400 Subject: [PATCH 077/102] Declare/Define `nextChunks` as `ChunkFnPtr_t const` --- include/c-main.h | 2 +- mlton/codegen/c-codegen/c-codegen.fun | 4 ++-- mlton/codegen/llvm-codegen/llvm-codegen.fun | 19 ++++++++++--------- 3 files changed, 13 insertions(+), 12 deletions(-) diff --git a/include/c-main.h b/include/c-main.h index 230a340b99..97c80abd1d 100644 --- a/include/c-main.h +++ b/include/c-main.h @@ -26,7 +26,7 @@ static inline uintptr_t getNextBlockFromStackTop (GC_state s) { return *(uintptr_t*)(s->stackTop - GC_RETURNADDRESS_SIZE); } -PRIVATE extern ChunkFnPtr_t nextChunks[]; +PRIVATE extern ChunkFnPtr_t const nextChunks[]; static inline void MLton_trampoline (GC_state s, uintptr_t nextBlock, bool mayReturnToC) { do { diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 3ce93dc9ff..e7538feec1 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -646,7 +646,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, List.foreach (returnsTo, declareChunk o labelChunk) | _ => ()))) ; destroy () - ; print "PRIVATE extern ChunkFnPtr_t nextChunks[];\n" + ; print "PRIVATE extern ChunkFnPtr_t const nextChunks[];\n" end val handleMisaligned = @@ -1287,7 +1287,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, fun defineNextChunks () = (List.foreach (chunks, fn Chunk.T {chunkLabel, ...} => declareChunk (chunkLabel, print)) - ; print "PRIVATE ChunkFnPtr_t nextChunks[" + ; print "PRIVATE ChunkFnPtr_t const nextChunks[" ; print (C.int (Vector.length nextChunks)) ; print "] = {\n" ; Vector.foreachi diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index da49c88c13..6025dcb9c9 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -368,7 +368,8 @@ structure LLVM = resTy: Type.t, vis: string option}) HashTable.t, fnDefns: (string, unit) HashTable.t, - globDecls: (string, {ty: Type.t, + globDecls: (string, {const: bool, + ty: Type.t, vis: string option}) HashTable.t, metaData: (MetaData.t, MetaData.Id.t) HashTable.t} fun new () = T {fnDecls = HashTable.new {equals = String.equals, hash = String.hash}, @@ -380,12 +381,12 @@ structure LLVM = val empty = ref true val _ = HashTable.foreachi - (globDecls, fn (name, {ty, vis}) => + (globDecls, fn (name, {const, ty, vis}) => (empty := false ; print name ; print " = external " ; Option.app (vis, fn vis => (print vis; print " ")) - ; print "global " + ; print (if const then "constant " else "global ") ; print (Type.toString ty) ; print "\n")) val _ = if !empty then () else print "\n" @@ -428,9 +429,9 @@ structure LLVM = fun addFnDefn (T {fnDefns, ...}, name) = (ignore o HashTable.insertIfNew) (fnDefns, name, fn () => (), ignore) - fun addGlobDecl (T {globDecls, ...}, name, ty_vis as {ty, ...}) = + fun addGlobDecl (T {globDecls, ...}, name, const_ty_vis as {ty, ...}) = ((ignore o HashTable.insertIfNew) - (globDecls, name, fn () => ty_vis, ignore) + (globDecls, name, fn () => const_ty_vis, ignore) ; Value.globptr (name, ty)) fun addMetaData (T {metaData, ...}, md) = HashTable.lookupOrInsert @@ -619,7 +620,7 @@ fun primApp (prim: 'a Prim.t): ({args: LLVM.Value.t list, | CFunction.SymbolScope.Public => "default" val globptr = LLVM.ModuleContext.addGlobDecl - (mc, name, {ty = ty, vis = SOME vis}) + (mc, name, {const = false, ty = ty, vis = SOME vis}) val res = newTemp LLVM.Type.cpointer val _ = $(bitcast {dst = res, src = globptr}) in @@ -787,7 +788,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, val name = globalName ct val ty = LLVM.Type.Array (Global.numberOfType ct, LLVM.Type.fromCType ct) in - LLVM.ModuleContext.addGlobDecl (mc, name, {ty = ty, vis = SOME "hidden"}) + LLVM.ModuleContext.addGlobDecl (mc, name, {const = false, ty = ty, vis = SOME "hidden"}) end fun globalVal (c, mc) = globalValC (Type.toCType c, mc) fun temporaryName (ct: CType.t, index: int): string = @@ -823,7 +824,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, val name = if !Control.llvmCC10 then "@nextXChunks" else "@nextChunks" val ty = LLVM.Type.Array (Vector.length nextChunks, chunkFnPtrTy) in - LLVM.ModuleContext.addGlobDecl (mc, name, {ty = ty, vis = SOME "hidden"}) + LLVM.ModuleContext.addGlobDecl (mc, name, {const = true, ty = ty, vis = SOME "hidden"}) end val doSwitchNextBlock = LLVM.Value.label' "doSwitchNextBlock" @@ -1491,7 +1492,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, (print "PRIVATE extern ChunkFn_t " ; print (chunkName chunkLabel) ; print ";\n")) - ; print "PRIVATE ChunkFnPtr_t " + ; print "PRIVATE ChunkFnPtr_t const " ; print nextChunksName ; print "[" ; print (Int.toString (Vector.length nextChunks)) From 04af37ae12f8b9ed9052b74abddf018815bc4579 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 30 Jul 2019 11:33:20 -0400 Subject: [PATCH 078/102] Declare/Define more static arrays as `const` --- mlton/codegen/c-codegen/c-codegen.fun | 22 +++++++++++----------- runtime/gc/call-stack.c | 4 ++-- runtime/gc/call-stack.h | 5 +++-- runtime/gc/frame.h | 12 ++++++------ runtime/gc/init.c | 2 +- runtime/gc/object.c | 4 ++-- runtime/gc/object.h | 14 +++++++------- runtime/gc/profiling.c | 10 +++++----- runtime/gc/profiling.h | 4 ++-- runtime/gc/sources.c | 6 +++--- runtime/gc/sources.h | 18 +++++++++--------- 11 files changed, 51 insertions(+), 50 deletions(-) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index e7538feec1..c934963733 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -314,11 +314,11 @@ fun outputDeclarations fun declareFrameInfos () = (Vector.foreachi (frameOffsets, fn (i, fo) => - declareArray ("uint16_t", concat ["frameOffsets", C.int i], + declareArray ("const uint16_t", concat ["frameOffsets", C.int i], {firstElemLen = true, oneline = true}, FrameOffsets.offsets fo, fn (_, offset) => C.bytes offset)) - ; declareArray ("struct GC_frameInfo", "frameInfos", + ; declareArray ("const struct GC_frameInfo", "frameInfos", {firstElemLen = false, oneline = false}, frameInfos, fn (_, fi) => concat ["{", @@ -330,12 +330,12 @@ fun outputDeclarations | SOME ssi => C.int ssi), "}"])) fun declareAtMLtons () = - declareArray ("char*", "atMLtons", + declareArray ("char *", "atMLtons", {firstElemLen = false, oneline = true}, !Control.atMLtons, fn (_, s) => C.string s) fun declareObjectTypes () = declareArray - ("struct GC_objectType", "objectTypes", + ("const struct GC_objectType", "objectTypes", {firstElemLen = false, oneline = false}, objectTypes, fn (_, ty) => let @@ -447,17 +447,17 @@ fun outputDeclarations profileLabelInfos, fn (_, {profileLabel, sourceSeqIndex}) => concat ["{(pointer)&", ProfileLabel.toString profileLabel, ", ", C.int sourceSeqIndex, "}"]) - ; declareArray ("char*", "sourceNames", + ; declareArray ("const char * const", "sourceNames", {firstElemLen = false, oneline = false}, sourceNames, fn (_, s) => C.string s) ; Vector.foreachi (sourceSeqs, fn (i, ss) => - declareArray ("GC_sourceIndex", concat ["sourceSeq", C.int i], + declareArray ("const GC_sourceIndex", concat ["sourceSeq", C.int i], {firstElemLen = true, oneline = true}, ss, fn (_, {sourceIndex}) => C.int sourceIndex)) - ; declareArray ("uint32_t*", "sourceSeqs", + ; declareArray ("const uint32_t * const", "sourceSeqs", {firstElemLen = false, oneline = false}, sourceSeqs, fn (i, _) => concat ["sourceSeq", Int.toString i]) - ; declareArray ("struct GC_source", "sources", + ; declareArray ("const struct GC_source", "sources", {firstElemLen = false, oneline = false}, sources, fn (_, {sourceNameIndex, successorSourceSeqIndex}) => concat ["{ ", Int.toString sourceNameIndex, ", ", @@ -646,7 +646,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, List.foreach (returnsTo, declareChunk o labelChunk) | _ => ()))) ; destroy () - ; print "PRIVATE extern ChunkFnPtr_t const nextChunks[];\n" + ; print "PRIVATE extern const ChunkFnPtr_t nextChunks[];\n" end val handleMisaligned = @@ -1219,7 +1219,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, val _ = print "doSwitchNextBlock: UNUSED;\n" val _ = if !Control.chunkJumpTable - then (print "\tstatic const void* nextLabels[" + then (print "\tstatic void* const nextLabels[" ; print (C.int (List.length entries)) ; print "] = {\n" ; List.foreach @@ -1287,7 +1287,7 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, fun defineNextChunks () = (List.foreach (chunks, fn Chunk.T {chunkLabel, ...} => declareChunk (chunkLabel, print)) - ; print "PRIVATE ChunkFnPtr_t const nextChunks[" + ; print "PRIVATE const ChunkFnPtr_t nextChunks[" ; print (C.int (Vector.length nextChunks)) ; print "] = {\n" ; Vector.foreachi diff --git a/runtime/gc/call-stack.c b/runtime/gc/call-stack.c index 1ff708cc4a..a5a4a75675 100644 --- a/runtime/gc/call-stack.c +++ b/runtime/gc/call-stack.c @@ -36,8 +36,8 @@ void GC_callStack (GC_state s, pointer p) { foreachStackFrame (s, callStackAux); } -uint32_t* GC_frameIndexSourceSeq (GC_state s, GC_frameIndex frameIndex) { - uint32_t *res; +const uint32_t * GC_frameIndexSourceSeq (GC_state s, GC_frameIndex frameIndex) { + const uint32_t *res; res = s->sourceMaps.sourceSeqs[s->frameInfos[frameIndex].sourceSeqIndex]; if (DEBUG_CALL_STACK) diff --git a/runtime/gc/call-stack.h b/runtime/gc/call-stack.h index 8d894c712b..d5ecf48bfe 100644 --- a/runtime/gc/call-stack.h +++ b/runtime/gc/call-stack.h @@ -1,4 +1,5 @@ -/* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh +/* Copyright (C) 2019 Matthew Fluet. + * Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. * @@ -27,6 +28,6 @@ static inline void callStackAux (GC_state s, GC_frameIndex i); PRIVATE uint32_t GC_numStackFrames (GC_state s); PRIVATE void GC_callStack (GC_state s, pointer p); -PRIVATE uint32_t* GC_frameIndexSourceSeq (GC_state s, GC_frameIndex frameIndex); +PRIVATE const uint32_t * GC_frameIndexSourceSeq (GC_state s, GC_frameIndex frameIndex); #endif /* (defined (MLTON_GC_INTERNAL_BASIS)) */ diff --git a/runtime/gc/frame.h b/runtime/gc/frame.h index 97de857549..582459c55c 100644 --- a/runtime/gc/frame.h +++ b/runtime/gc/frame.h @@ -31,18 +31,18 @@ * the sequence of source names corresponding to the frame as an index * into sourceSeqs; see sources.h. */ -typedef uint16_t *GC_frameOffsets; +typedef const uint16_t *GC_frameOffsets; typedef enum { C_FRAME, ML_FRAME } GC_frameKind; -typedef struct GC_frameInfo { - GC_frameKind kind; - GC_frameOffsets offsets; - uint16_t size; - GC_sourceSeqIndex sourceSeqIndex; +typedef const struct GC_frameInfo { + const GC_frameKind kind; + const GC_frameOffsets offsets; + const uint16_t size; + const GC_sourceSeqIndex sourceSeqIndex; } *GC_frameInfo; typedef uint32_t GC_frameIndex; #define PRIFI PRIu32 diff --git a/runtime/gc/init.c b/runtime/gc/init.c index 1649ddae4c..8cf0c0dca4 100644 --- a/runtime/gc/init.c +++ b/runtime/gc/init.c @@ -376,7 +376,7 @@ int GC_init (GC_state s, int argc, char **argv) { uint32_t i; for (i = 0; i < s->frameInfosLength; i++) { uint32_t j; - uint32_t *sourceSeq; + const uint32_t *sourceSeq; fprintf (stderr, "%"PRIu32"\n", i); sourceSeq = s->sourceMaps.sourceSeqs[s->frameInfos[i].sourceSeqIndex]; for (j = 1; j <= sourceSeq[0]; j++) diff --git a/runtime/gc/object.c b/runtime/gc/object.c index f312f271ed..8fdcad3ca1 100644 --- a/runtime/gc/object.c +++ b/runtime/gc/object.c @@ -1,4 +1,4 @@ -/* Copyright (C) 2012,2016 Matthew Fluet. +/* Copyright (C) 2012,2016,2019 Matthew Fluet. * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. @@ -7,7 +7,7 @@ * See the file MLton-LICENSE for details. */ -const char* objectTypeTagToString (GC_objectTypeTag tag) { +const char * objectTypeTagToString (GC_objectTypeTag tag) { switch (tag) { case SEQUENCE_TAG: return "SEQUENCE"; diff --git a/runtime/gc/object.h b/runtime/gc/object.h index ff144c0532..198dd127c0 100644 --- a/runtime/gc/object.h +++ b/runtime/gc/object.h @@ -1,4 +1,4 @@ -/* Copyright (C) 2016 Matthew Fluet. +/* Copyright (C) 2016,2019 Matthew Fluet. * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. @@ -26,7 +26,7 @@ typedef enum { #if (defined (MLTON_GC_INTERNAL_FUNCS)) -static const char* objectTypeTagToString (GC_objectTypeTag tag); +static const char * objectTypeTagToString (GC_objectTypeTag tag); #endif /* (defined (MLTON_GC_INTERNAL_FUNCS)) */ @@ -130,12 +130,12 @@ static inline GC_header buildHeaderFromTypeIndex (uint32_t t); * In a weak object, the bytesNonObjptrs and numObjptrs fields are * interpreted as in a normal object. */ -typedef struct GC_objectType { +typedef const struct GC_objectType { /* Keep tag first, at zero offset, since it is referenced most often. */ - GC_objectTypeTag tag; - bool hasIdentity; - uint16_t bytesNonObjptrs; - uint16_t numObjptrs; + const GC_objectTypeTag tag; + const bool hasIdentity; + const uint16_t bytesNonObjptrs; + const uint16_t numObjptrs; } *GC_objectType; enum { /* The type indices here must agree with those in backend/rep-type.fun. */ diff --git a/runtime/gc/profiling.c b/runtime/gc/profiling.c index c97301b429..e84557e8f5 100644 --- a/runtime/gc/profiling.c +++ b/runtime/gc/profiling.c @@ -23,8 +23,8 @@ GC_sourceNameIndex profileMasterIndexToSourceNameIndex (GC_state s, return i - s->sourceMaps.sourcesLength; } -char* profileIndexSourceName (GC_state s, GC_sourceIndex i) { - char* res; +const char * profileIndexSourceName (GC_state s, GC_sourceIndex i) { + const char *res; if (i < s->sourceMaps.sourcesLength) res = getSourceName (s, i); @@ -76,7 +76,7 @@ void enterSourceForProfiling (GC_state s, GC_profileMasterIndex i) { void enterForProfiling (GC_state s, GC_sourceSeqIndex sourceSeqIndex) { uint32_t i; GC_sourceIndex sourceIndex; - uint32_t *sourceSeq; + const uint32_t *sourceSeq; if (DEBUG_PROFILE) fprintf (stderr, "enterForProfiling ("FMTSSI")\n", sourceSeqIndex); @@ -132,7 +132,7 @@ void leaveSourceForProfiling (GC_state s, GC_profileMasterIndex i) { void leaveForProfiling (GC_state s, GC_sourceSeqIndex sourceSeqIndex) { uint32_t i; GC_sourceIndex sourceIndex; - uint32_t *sourceSeq; + const uint32_t *sourceSeq; if (DEBUG_PROFILE) fprintf (stderr, "leaveForProfiling ("FMTSSI")\n", sourceSeqIndex); @@ -158,7 +158,7 @@ void GC_profileLeave (GC_state s) { void incForProfiling (GC_state s, size_t amount, GC_sourceSeqIndex sourceSeqIndex) { - uint32_t *sourceSeq; + const uint32_t *sourceSeq; GC_sourceIndex topSourceIndex; if (DEBUG_PROFILE) diff --git a/runtime/gc/profiling.h b/runtime/gc/profiling.h index 00b1ae486c..a9eb85db85 100644 --- a/runtime/gc/profiling.h +++ b/runtime/gc/profiling.h @@ -1,4 +1,4 @@ -/* Copyright (C) 2012 Matthew Fluet. +/* Copyright (C) 2012,2019 Matthew Fluet. * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. @@ -96,7 +96,7 @@ static inline void leaveForProfiling (GC_state s, GC_sourceSeqIndex sourceSeqInd static inline void incForProfiling (GC_state s, size_t amount, GC_sourceSeqIndex sourceSeqIndex); -static inline char* profileIndexSourceName (GC_state s, GC_sourceIndex i); +static inline const char * profileIndexSourceName (GC_state s, GC_sourceIndex i); static void writeProfileCount (GC_state s, FILE *f, GC_profileData p, GC_profileMasterIndex i); diff --git a/runtime/gc/sources.c b/runtime/gc/sources.c index 84cc887391..4a0775606f 100644 --- a/runtime/gc/sources.c +++ b/runtime/gc/sources.c @@ -15,12 +15,12 @@ GC_sourceSeqIndex getCachedStackTopFrameSourceSeqIndex (GC_state s) { return s->frameInfos[i].sourceSeqIndex; } -char* getSourceName (GC_state s, GC_sourceIndex i) { +const char * getSourceName (GC_state s, GC_sourceIndex i) { assert (i < s->sourceMaps.sourcesLength); return s->sourceMaps.sourceNames[s->sourceMaps.sources[i].sourceNameIndex]; } -char* GC_sourceName (GC_state s, GC_sourceIndex i) { +const char * GC_sourceName (GC_state s, GC_sourceIndex i) { return getSourceName (s, i); } @@ -101,7 +101,7 @@ void showSources (GC_state s) { s->sourceMaps.sources[i].successorSourceSeqIndex); fprintf (stdout, "%"PRIu32"\n", s->sourceMaps.sourceSeqsLength); for (i = 0; i < s->sourceMaps.sourceSeqsLength; i++) { - uint32_t *sourceSeq; + const uint32_t *sourceSeq; sourceSeq = s->sourceMaps.sourceSeqs[i]; for (j = 1; j <= sourceSeq[0]; j++) diff --git a/runtime/gc/sources.h b/runtime/gc/sources.h index 4e49bbee49..87b197be34 100644 --- a/runtime/gc/sources.h +++ b/runtime/gc/sources.h @@ -27,9 +27,9 @@ typedef uint32_t GC_sourceIndex; #define UNKNOWN_SOURCE_INDEX 0 #define GC_SOURCE_INDEX 1 -typedef struct GC_source { - GC_sourceNameIndex sourceNameIndex; - GC_sourceSeqIndex successorSourceSeqIndex; +typedef const struct GC_source { + const GC_sourceNameIndex sourceNameIndex; + const GC_sourceSeqIndex successorSourceSeqIndex; } *GC_source; typedef struct GC_profileLabelInfo { @@ -49,25 +49,25 @@ struct GC_sourceMaps { * names corresponding to the code pointer; only used with * ProfileTimeLabel. */ - struct GC_profileLabelInfo *profileLabelInfos; + GC_profileLabelInfo profileLabelInfos; uint32_t profileLabelInfosLength; /* sourceNames is an array of cardinality sourceNamesLength; * the collection of source names from the program. */ - char **sourceNames; + const char * const *sourceNames; uint32_t sourceNamesLength; /* sourceSeqs is an array of cardinality sourceSeqsLength; * each entry describes a sequence of source names as a length * followed by the sequence of indices into sources. */ - uint32_t **sourceSeqs; + const uint32_t * const *sourceSeqs; uint32_t sourceSeqsLength; /* sources is an array of cardinality sourcesLength; * each entry describes a source name and successor sources as * the pair of an index into sourceNames and an index into * sourceSeqs. */ - struct GC_source *sources; + GC_source sources; uint32_t sourcesLength; }; @@ -77,7 +77,7 @@ struct GC_sourceMaps { static inline GC_sourceSeqIndex getCachedStackTopFrameSourceSeqIndex (GC_state s); -static inline char* getSourceName (GC_state s, GC_sourceIndex i); +static inline const char * getSourceName (GC_state s, GC_sourceIndex i); #if HAS_TIME_PROFILING static inline int compareProfileLabelInfos (const void *v1, const void *v2); @@ -92,6 +92,6 @@ static void showSources (GC_state s); #if (defined (MLTON_GC_INTERNAL_BASIS)) -PRIVATE char* GC_sourceName (GC_state s, GC_sourceIndex i); +PRIVATE const char * GC_sourceName (GC_state s, GC_sourceIndex i); #endif /* (defined (MLTON_GC_INTERNAL_BASIS)) */ From 0a649f266f2400d858c4730b275e68ea5b39bff1 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 30 Jul 2019 13:25:21 -0400 Subject: [PATCH 079/102] Include all codegen prims in `CCodegen.implementsPrim` --- mlton/codegen/c-codegen/c-codegen.fun | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index c934963733..a06a35b800 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -178,6 +178,7 @@ fun implementsPrim (p: 'a Prim.t): bool = | Real_rndToWord _ => true | Real_round _ => true | Real_sub _ => true + | Thread_returnToC => false | Word_add _ => true | Word_addCheckP _ => true | Word_andb _ => true @@ -205,7 +206,7 @@ fun implementsPrim (p: 'a Prim.t): bool = | Word_sub _ => true | Word_subCheckP _ => true | Word_xorb _ => true - | _ => false + | _ => Error.bug ("CCodegen.implementsPrim: " ^ Prim.toString p) end fun outputIncludes (includes, print) = From 9b7b2bdc246e71b944b37a19a2f64a868259e92e Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 30 Jul 2019 14:34:38 -0400 Subject: [PATCH 080/102] Implement `Real_qequal` for C codegen --- basis-library/real/real.sml | 13 ++----------- mlton/codegen/c-codegen/c-codegen.fun | 2 +- runtime/basis/Real/Real-ops.h | 8 ++++++++ 3 files changed, 11 insertions(+), 12 deletions(-) diff --git a/basis-library/real/real.sml b/basis-library/real/real.sml index bb3ba4f304..75786ad092 100644 --- a/basis-library/real/real.sml +++ b/basis-library/real/real.sml @@ -1,4 +1,4 @@ -(* Copyright (C) 2011-2014,2017 Matthew Fluet. +(* Copyright (C) 2011-2014,2017,2019 Matthew Fluet. * Copyright (C) 2003-2007 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * @@ -179,16 +179,7 @@ functor Real (structure W: WORD_EXTRA fun isNormal r = class r = NORMAL - val op ?= = - if MLton.Codegen.isAMD64 orelse MLton.Codegen.isLLVM orelse MLton.Codegen.isX86 - then R.?= - else - fn (x, y) => - case (class x, class y) of - (NAN, _) => true - | (_, NAN) => true - | (ZERO, ZERO) => true - | _ => R.== (x, y) + val op ?= = R.?= fun min (x, y) = if x <= y then x diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index a06a35b800..9f3f5ebdc9 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -173,7 +173,7 @@ fun implementsPrim (p: 'a Prim.t): bool = | Real_muladd _ => true | Real_mulsub _ => true | Real_neg _ => true - | Real_qequal _ => false + | Real_qequal _ => true | Real_rndToReal _ => true | Real_rndToWord _ => true | Real_round _ => true diff --git a/runtime/basis/Real/Real-ops.h b/runtime/basis/Real/Real-ops.h index c93f1491da..7181632552 100644 --- a/runtime/basis/Real/Real-ops.h +++ b/runtime/basis/Real/Real-ops.h @@ -35,6 +35,12 @@ binaryNameFn(size, Math_##f, f) #define fmaNameOp(size, name, op) \ naryNameFnResArgsCall(size, name, fma, Real##size##_t, (Real##size##_t r1, Real##size##_t r2, Real##size##_t r3), (r1, r2, op r3)) +#define qequal(size) \ + MLTON_CODEGEN_STATIC_INLINE \ + Bool Real##size##_qequal (Real##size##_t r1, Real##size##_t r2) { \ + return isunordered (r1, r2) || r1 == r2; \ + } + #define unaryOp(size, name, op) \ MLTON_CODEGEN_STATIC_INLINE \ Real##size##_t Real##size##_##name (Real##size##_t r) { \ @@ -82,6 +88,7 @@ binaryOp(size, mul, *) \ fmaNameOp(size, muladd, ) \ fmaNameOp(size, mulsub, -) \ unaryOp(size, neg, -) \ +qequal(size) \ unaryNameFn(size, realCeil, ceil) \ unaryNameFn(size, realFloor, floor) \ unaryNameFn(size, realTrunc, trunc) \ @@ -113,6 +120,7 @@ all(64) #undef unaryFn #undef unaryNameFn #undef unaryOp +#undef qequal #undef fmaNameOp #undef compareOp #undef binaryMathFn From 7b558195760eead6cdd00c14b847d62b94ceeef7 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 30 Jul 2019 14:35:08 -0400 Subject: [PATCH 081/102] Use `is{less,lessequal}` for `Real_l{t,e}` in C codegen --- runtime/basis/Real/Real-ops.h | 19 +++++++++++++------ 1 file changed, 13 insertions(+), 6 deletions(-) diff --git a/runtime/basis/Real/Real-ops.h b/runtime/basis/Real/Real-ops.h index 7181632552..b6f78df7cb 100644 --- a/runtime/basis/Real/Real-ops.h +++ b/runtime/basis/Real/Real-ops.h @@ -26,10 +26,16 @@ binaryNameFn(size, f, f) #define binaryMathFn(size, f) \ binaryNameFn(size, Math_##f, f) -#define compareOp(size, name, op) \ +#define compareNameFn(size, name, f) \ MLTON_CODEGEN_STATIC_INLINE \ Bool Real##size##_##name (Real##size##_t r1, Real##size##_t r2) { \ - return r1 op r2; \ + return f (r1, r2); \ + } + +#define equal(size) \ + MLTON_CODEGEN_STATIC_INLINE \ + Bool Real##size##_equal (Real##size##_t r1, Real##size##_t r2) { \ + return r1 == r2; \ } #define fmaNameOp(size, name, op) \ @@ -78,11 +84,11 @@ unaryNameFn(size, Math_##f, f) unaryNameFn(size, abs, fabs) \ binaryOp(size, add, +) \ binaryOp(size, div, /) \ -compareOp(size, equal, ==) \ +equal(size) \ naryNameFnResArgsCall(size, frexp, frexp, Real##size##_t, (Real##size##_t r, Ref(C_Int_t) ip), (r, (int*)ip)) \ naryNameFnResArgsCall(size, ldexp, ldexp, Real##size##_t, (Real##size##_t r, C_Int_t i), (r, i)) \ -compareOp(size, le, <=) \ -compareOp(size, lt, <) \ +compareNameFn(size, le, islessequal) \ +compareNameFn(size, lt, isless) \ naryNameFnResArgsCall(size, modf, modf, Real##size##_t, (Real##size##_t x, Ref(Real##size##_t) yp), (x, (Real##size##_t*)yp)) \ binaryOp(size, mul, *) \ fmaNameOp(size, muladd, ) \ @@ -122,7 +128,8 @@ all(64) #undef unaryOp #undef qequal #undef fmaNameOp -#undef compareOp +#undef equal +#undef compareNameFn #undef binaryMathFn #undef binaryFn #undef binaryNameFn From 32606ccb5df578236c339243eb1f09864e1bfc0a Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 30 Jul 2019 15:33:31 -0400 Subject: [PATCH 082/102] Eliminate `Machine.Statement.Noop` --- mlton/backend/backend.fun | 41 +++++++++---------- mlton/backend/machine.fun | 14 ++----- mlton/backend/machine.sig | 6 +-- mlton/backend/parallel-move.fun | 17 +++++--- mlton/backend/parallel-move.sig | 5 ++- .../codegen/amd64-codegen/amd64-translate.fun | 4 +- mlton/codegen/c-codegen/c-codegen.fun | 1 - mlton/codegen/llvm-codegen/llvm-codegen.fun | 1 - mlton/codegen/x86-codegen/x86-translate.fun | 4 +- 9 files changed, 41 insertions(+), 52 deletions(-) diff --git a/mlton/backend/backend.fun b/mlton/backend/backend.fun index 4db878ba84..551f7c3635 100644 --- a/mlton/backend/backend.fun +++ b/mlton/backend/backend.fun @@ -457,16 +457,18 @@ fun toMachine (rssa: Rssa.Program.t) = fun handlerOffset () = #handlerOffset (valOf handlersInfo) fun linkOffset () = #linkOffset (valOf handlersInfo) datatype z = datatype R.Statement.t + fun move arg = + case M.Statement.move arg of + NONE => Vector.new0 () + | SOME move => Vector.new1 move in case s of Bind {dst = (var, _), src, ...} => - Vector.new1 - (M.Statement.move {dst = varOperand var, - src = translateOperand src}) + move {dst = varOperand var, + src = translateOperand src} | Move {dst, src} => - Vector.new1 - (M.Statement.move {dst = translateOperand dst, - src = translateOperand src}) + move {dst = translateOperand dst, + src = translateOperand src} | Object {dst, header, size} => M.Statement.object {dst = varOperand (#1 dst), header = header, @@ -511,25 +513,22 @@ fun toMachine (rssa: Rssa.Program.t) = end | SetExnStackSlot => (* ExnStack = *(ptrdiff_t* )(stackTop + linkOffset); *) - Vector.new1 - (M.Statement.move - {dst = exnStackOp, - src = M.Operand.stackOffset {offset = linkOffset (), - ty = Type.exnStack ()}}) + move + {dst = exnStackOp, + src = M.Operand.stackOffset {offset = linkOffset (), + ty = Type.exnStack ()}} | SetHandler h => (* *(uintptr_t)(stackTop + handlerOffset) = h; *) - Vector.new1 - (M.Statement.move - {dst = M.Operand.stackOffset {offset = handlerOffset (), - ty = Type.label h}, - src = M.Operand.Label h}) + move + {dst = M.Operand.stackOffset {offset = handlerOffset (), + ty = Type.label h}, + src = M.Operand.Label h} | SetSlotExnStack => (* *(ptrdiff_t* )(stackTop + linkOffset) = ExnStack; *) - Vector.new1 - (M.Statement.move - {dst = M.Operand.stackOffset {offset = linkOffset (), - ty = Type.exnStack ()}, - src = exnStackOp}) + move + {dst = M.Operand.stackOffset {offset = linkOffset (), + ty = Type.exnStack ()}, + src = exnStackOp} | _ => Error.bug (concat ["Backend.genStatement: strange statement: ", R.Statement.toString s]) diff --git a/mlton/backend/machine.fun b/mlton/backend/machine.fun index e5edffcf7d..a29edf8835 100644 --- a/mlton/backend/machine.fun +++ b/mlton/backend/machine.fun @@ -293,7 +293,6 @@ structure Statement = datatype t = Move of {dst: Operand.t, src: Operand.t} - | Noop | PrimApp of {args: Operand.t vector, dst: Operand.t option, prim: Type.t Prim.t} @@ -307,7 +306,6 @@ structure Statement = mayAlign [seq [Operand.layout dst, str " ="], indent (Operand.layout src, 2)] - | Noop => str "Noop" | PrimApp {args, dst, prim, ...} => let val rest = @@ -327,22 +325,17 @@ structure Statement = fun move (arg as {dst, src}) = if Operand.equals (dst, src) - then Noop - else Move arg + then NONE + else SOME (Move arg) val move = Trace.trace ("Machine.Statement.move", fn {dst, src} => Layout.record [("dst", Operand.layout dst), ("src", Operand.layout src)], - layout) + Option.layout layout) move - fun moves {srcs, dsts} = - Vector.fromListRev - (Vector.fold2 (srcs, dsts, [], fn (src, dst, ac) => - move {src = src, dst = dst} :: ac)) - fun object {dst, header, size} = let datatype z = datatype Operand.t @@ -1234,7 +1227,6 @@ structure Program = then SOME alloc else NONE end - | Noop => SOME alloc | PrimApp {args, dst, prim, ...} => let val _ = checkOperands (args, alloc) diff --git a/mlton/backend/machine.sig b/mlton/backend/machine.sig index 54373b75fc..54b98dfe0d 100644 --- a/mlton/backend/machine.sig +++ b/mlton/backend/machine.sig @@ -113,7 +113,6 @@ signature MACHINE = *) Move of {dst: Operand.t, src: Operand.t} - | Noop | PrimApp of {args: Operand.t vector, dst: Operand.t option, prim: Type.t Prim.t} @@ -121,10 +120,7 @@ signature MACHINE = val foldOperands: t * 'a * (Operand.t * 'a -> 'a) -> 'a val layout: t -> Layout.t - val move: {dst: Operand.t, src: Operand.t} -> t - (* Error if dsts and srcs aren't of same length. *) - val moves: {dsts: Operand.t vector, - srcs: Operand.t vector} -> t vector + val move: {dst: Operand.t, src: Operand.t} -> t option val object: {dst: Operand.t, header: word, size: Bytes.t} -> t vector end diff --git a/mlton/backend/parallel-move.fun b/mlton/backend/parallel-move.fun index 199d1cf5d3..c4561e207a 100644 --- a/mlton/backend/parallel-move.fun +++ b/mlton/backend/parallel-move.fun @@ -1,4 +1,5 @@ -(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh +(* Copyright (C) 2019 Matthew Fluet + * Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. * @@ -37,11 +38,15 @@ fun ('temporary, 'statement) move {moves, equals, move, interfere, temp} if interfere (dst, s) then let val temp = temp s in ({src = temp, dst = d} :: hard, - move {dst = temp, src = s} - :: moves) + case move {dst = temp, src = s} of + NONE => moves + | SOME move => move :: moves) end else (mv :: hard, moves)) - val moves = move {src = src, dst = dst} :: moves + val moves = + case move {src = src, dst = dst} of + NONE => moves + | SOME move => move :: moves in loopTop (hard, moves) end) | (mv as {src, dst}) :: mvs => @@ -52,7 +57,9 @@ fun ('temporary, 'statement) move {moves, equals, move, interfere, temp} in if isHard mvs orelse isHard hard then loop (mvs, mv :: hard, moves, changed) else loop (mvs, hard, - move {src = src, dst = dst} :: moves, + case move {src = src, dst = dst} of + NONE => moves + | SOME move => move :: moves, true) end in loopTop (mvs, []) diff --git a/mlton/backend/parallel-move.sig b/mlton/backend/parallel-move.sig index 30d8ed8999..9c4e707d5e 100644 --- a/mlton/backend/parallel-move.sig +++ b/mlton/backend/parallel-move.sig @@ -1,4 +1,5 @@ -(* Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh +(* Copyright (C) 2019 Matthew Fluet + * Copyright (C) 1999-2005 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. * @@ -23,7 +24,7 @@ signature PARALLEL_MOVE = (* Are two temporaries the same. *) equals: 'temporary * 'temporary -> bool, (* How to create a move statement. *) - move: {src: 'temporary, dst: 'temporary} -> 'statement, + move: {src: 'temporary, dst: 'temporary} -> 'statement option, (* The moves to occur. *) moves: {src: 'temporary, dst: 'temporary} list, (* Would writing the write invalidate the read? *) diff --git a/mlton/codegen/amd64-codegen/amd64-translate.fun b/mlton/codegen/amd64-codegen/amd64-translate.fun index 24973ac324..2733222daa 100644 --- a/mlton/codegen/amd64-codegen/amd64-translate.fun +++ b/mlton/codegen/amd64-codegen/amd64-translate.fun @@ -380,9 +380,7 @@ struct fun toAMD64Blocks {statement, transInfo as {...} : transInfo} = (case statement - of Noop - => AppendList.empty - | Move {src, dst} + of Move {src, dst} => let val (comment_begin, comment_end) = comments statement diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 9f3f5ebdc9..48f6543bff 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -754,7 +754,6 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, src = operandToString src, srcIsMem = Operand.isMem src, ty = Operand.ty dst})) - | Noop => () | PrimApp {args, dst, prim} => let fun call (): string = diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 6025dcb9c9..eb5bf80c32 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -970,7 +970,6 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, in () end - | Statement.Noop => () | Statement.PrimApp {args, dst, prim} => let val args = operandsToRValues args diff --git a/mlton/codegen/x86-codegen/x86-translate.fun b/mlton/codegen/x86-codegen/x86-translate.fun index 754ad8d268..85efc5ee88 100644 --- a/mlton/codegen/x86-codegen/x86-translate.fun +++ b/mlton/codegen/x86-codegen/x86-translate.fun @@ -391,9 +391,7 @@ struct fun toX86Blocks {statement, transInfo as {...} : transInfo} = (case statement - of Noop - => AppendList.empty - | Move {src, dst} + of Move {src, dst} => let val (comment_begin, comment_end) = comments statement From 27709ef748f49be9ee37ce3f6aec5bbbce5849d7 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 31 Jul 2019 13:45:07 -0400 Subject: [PATCH 083/102] Generalize LLVM type-based alias-analysis Include `Global` and `GCState` domains, distinct from `Heap`, `Stack`, and `Other`. For each domain, include optional extra information for further distinctions: * `GCState`: offset * `Global`: cty, index * `Heap`: kind, tycon, cty, offset * `Stack`: offset Not all options lead to sound alias analysis; limitations are noted in comments. --- mlton/codegen/llvm-codegen/llvm-codegen.fun | 164 +++++++++++++++++--- mlton/control/control-flags.sig | 6 +- mlton/control/control-flags.sml | 84 +++++++++- 3 files changed, 228 insertions(+), 26 deletions(-) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index eb5bf80c32..0bb3867e21 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -692,17 +692,27 @@ fun implementsPrim (p: 'a Prim.t): bool = Option.isSome (primApp p) fun aamd (oper, mc) = case !Control.llvmAAMD of Control.LLVMAliasAnalysisMetaData.None => NONE - | Control.LLVMAliasAnalysisMetaData.TBAA => + | Control.LLVMAliasAnalysisMetaData.TBAA {gcstate, global, heap, other, stack} => let - fun tbaa s = + fun tbaa path = let val root = LLVM.ModuleContext.addMetaData - (mc, LLVM.MetaData.node [LLVM.MetaData.string "root"]) - val desc = - LLVM.ModuleContext.addMetaData - (mc, LLVM.MetaData.node [LLVM.MetaData.string s, - LLVM.MetaData.id root]) + (mc, LLVM.MetaData.node [LLVM.MetaData.string "MLton TBAA Root"]) + val (desc, _) = + List.foldr + (path, (root, ""), fn (node,(desc,name)) => + let + val name = + if String.isEmpty name + then node + else concat [name, " ", node] + in + (LLVM.ModuleContext.addMetaData + (mc, LLVM.MetaData.node [LLVM.MetaData.string name, + LLVM.MetaData.id desc]), + name) + end) val acc = LLVM.ModuleContext.addMetaData (mc, LLVM.MetaData.node [LLVM.MetaData.id desc, @@ -711,20 +721,138 @@ fun aamd (oper, mc) = in SOME (concat ["!tbaa ", LLVM.MetaData.Id.toString acc]) end - fun other () = tbaa "other" + val other = fn () => + if other then tbaa ["Other"] else NONE in case oper of - Operand.Offset {base, offset, ...} => - if Type.isObjptr (Operand.ty base) - then tbaa ("Offset " ^ Bytes.toString offset) - else other () - | Operand.SequenceOffset {base, ...} => - if Type.isObjptr (Operand.ty base) - then tbaa "SequenceOffset" - else other () + Operand.Frontier => NONE (* alloca *) + | Operand.Global g => + (case global of + NONE => NONE + | SOME {cty = doCTy, index = doIndex} => + let + val path = ["Global"] + val path = + if doCTy + then (CType.name (Type.toCType (Global.ty g)))::path + else path + val path = + if doIndex + then (Int.toString (Global.index g))::path + else path + in + tbaa path + end) + | Operand.Offset {base = Operand.GCState, offset, ...} => + (case gcstate of + NONE => NONE + | SOME {offset = doOffset} => + let + val path = ["GCState"] + val path = + if doOffset + then (Bytes.toString offset)::path + else path + in + tbaa path + end) + | Operand.Offset {base, offset, ty, ...} => + (if Type.isObjptr (Operand.ty base) + then (case heap of + NONE => NONE + | SOME {cty = doCTy, kind = doKind, offset = doOffset, tycon = doTycon} => + let + val path = ["Heap"] + val path = + if doKind + then "Normal"::path + else path + val path = + if doTycon + then (case Type.deObjptr (Operand.ty base) of + NONE => path + | SOME tyc => (ObjptrTycon.toString tyc)::path) + else path + val path = + if doCTy + then (CType.name (Type.toCType ty))::path + else path + val path = + if doOffset + then (Bytes.toString offset)::path + else path + in + tbaa path + end) + else other ()) + | Operand.SequenceOffset {base, offset, ty, ...} => + (if Type.isObjptr (Operand.ty base) + then (case heap of + NONE => NONE + | SOME {cty = doCTy, kind = doKind, offset = doOffset, tycon = doTycon} => + let + val path = ["Heap"] + val path = + if doKind + then "Sequence"::path + else path + (* Unsound: Around a `Array_toVector` primitive, a sequence may + * be written to at one `ObjptrTycon.t` (corresponding to an + * `array`) and then read from at a distinct `ObjptrTycon.t` + * (corresponding to a `vector`). + *) + val path = + if doTycon + then (case Type.deObjptr (Operand.ty base) of + NONE => path + | SOME tyc => (ObjptrTycon.toString tyc)::path) + else path + (* Unsound: `WordArray_{sub,update}Word {seqSize, elemSize}` + * and `WordVector_subWord {seqSize, elemSize}` primitives (for + * `signature PACK_WORD`) are translated to `SequenceOffset` + * with `base` corresponding to a sequence of `seqSize`, + * `offset = Bytes.zero`, `scale` corresponding to `elemSize`, + * and `ty` corresponding to the `elemSize`; thus, the same + * address can be accessed for `Word8` and `Word64` elements. + *) + val path = + if doCTy + then (CType.name (Type.toCType ty))::path + else path + val path = + if doOffset + then (Bytes.toString offset)::path + else path + in + tbaa path + end) + else other ()) | Operand.StackOffset (StackOffset.T {offset, ...}) => - tbaa ("StackOffset " ^ Bytes.toString offset) - | _ => tbaa "other" + (case stack of + NONE => NONE + | SOME {offset = doOffset} => + let + (* Unsound: At raise, exception results are written to the stack via an + * `Offset` with `base` corresponding to `StackBottom + exnStack` and + * then read from the stack via a `StackOffset` by the handler. + *) + val path = ["StackOffset"] + (* Unsound: At non-tail call/return, arguments/results are written to + * the stack relative to the callee/caller stack frame and then read + * from the stack relative to the caller/callee stack frame. In + * general, around a stack push/pop, distinct offsets correspond to the + * same location. + *) + val path = + if doOffset + then (Bytes.toString offset)::path + else path + in + tbaa path + end) + | Operand.StackTop => NONE (* alloca *) + | Operand.Temporary _ => NONE (* alloca *) + | _ => NONE (* not lvalue *) end fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, diff --git a/mlton/control/control-flags.sig b/mlton/control/control-flags.sig index 965e6937f3..ca474c3877 100644 --- a/mlton/control/control-flags.sig +++ b/mlton/control/control-flags.sig @@ -282,7 +282,11 @@ signature CONTROL_FLAGS = structure LLVMAliasAnalysisMetaData: sig - datatype t = None | TBAA + datatype t = None | TBAA of {gcstate: {offset: bool} option, + global: {cty: bool, index: bool} option, + heap: {cty: bool, kind: bool, offset: bool, tycon: bool} option, + other: bool, + stack: {offset: bool} option} val toString: t -> string val fromString: string -> t option end diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index f5587049c1..9c2292f20c 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -1026,20 +1026,90 @@ val libname = ref "" structure LLVMAliasAnalysisMetaData = struct - datatype t = None | TBAA + datatype t = None | TBAA of {gcstate: {offset: bool} option, + global: {cty: bool, index: bool} option, + heap: {cty: bool, kind: bool, offset: bool, tycon: bool} option, + other: bool, + stack: {offset: bool} option} + val tbaaDefault = + TBAA {gcstate = SOME {offset = false}, + global = SOME {cty = false, index = false}, + heap = SOME {cty = false, kind = false, offset = false, tycon = false}, + other = true, + stack = SOME {offset = false}} + fun toString aamd = case aamd of None => "none" - | TBAA => "tbaa" + | TBAA {gcstate, global, heap, other, stack} => + let + open Layout + in + toString + (namedRecord + ("tbaa", + [("gcstate", + Option.layout (fn {offset} => + record [("offset", Bool.layout offset)]) + gcstate), + ("global", + Option.layout (fn {cty, index} => + record [("cty", Bool.layout cty), + ("index", Bool.layout index)]) + global), + ("heap", + Option.layout (fn {cty, kind, offset, tycon} => + record [("cty", Bool.layout cty), + ("kind", Bool.layout kind), + ("offset", Bool.layout offset), + ("tycon", Bool.layout tycon)]) + heap), + ("other", Bool.layout other), + ("stack", + Option.layout (fn {offset} => + record [("offset", Bool.layout offset)]) + stack)])) + end fun fromString s = - case s of - "none" => SOME None - | "tbaa" => SOME TBAA - | _ => NONE + let + open Parse + infix 1 <|> >>= + infix 3 <*> <* *> + infixr 4 <$> <$$> <$$$> <$$$$> <$ <$?> + val p = + any + [kw "none" *> pure None, + kw "tbaa" *> + (cbrack (ffield ("gcstate", option (cbrack (ffield ("offset", bool) >>= (fn offset => + pure {offset = offset})))) >>= (fn gcstate => + nfield ("global", option (cbrack (ffield ("cty", bool) >>= (fn cty => + nfield ("index", bool) >>= (fn index => + pure {cty = cty, + index = index}))))) >>= (fn global => + nfield ("heap", option (cbrack (ffield ("cty", bool) >>= (fn cty => + nfield ("kind", bool) >>= (fn kind => + nfield ("offset", bool) >>= (fn offset => + nfield ("tycon", bool) >>= (fn tycon => + pure {cty = cty, + kind = kind, + offset = offset, + tycon = tycon}))))))) >>= (fn heap => + nfield ("other", bool) >>= (fn other => + nfield ("stack", option (cbrack (ffield ("offset", bool) >>= (fn offset => + pure {offset = offset})))) >>= (fn stack => + pure (TBAA {gcstate = gcstate, global = global, heap = heap, other = other, stack = stack}))))))) + <|> + pure tbaaDefault)] + <* failing next + in + case parseString (p, s) of + No _ => NONE + | Yes c => SOME c + end end val llvmAAMD = - control {name = "llvmTBAA", + control {name = "llvmAAMD", default = LLVMAliasAnalysisMetaData.None, toString = LLVMAliasAnalysisMetaData.toString} From b825f5633d72f590342a046cc2158495add4b7b7 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 31 Jul 2019 14:14:45 -0400 Subject: [PATCH 084/102] Add `-llvm-aamd scope` for simple `noalias`/`alias.scope` alias-analysis metadata --- mlton/codegen/llvm-codegen/llvm-codegen.fun | 44 +++++++++++++++++++++ mlton/control/control-flags.sig | 13 +++--- mlton/control/control-flags.sml | 16 +++++--- 3 files changed, 63 insertions(+), 10 deletions(-) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 0bb3867e21..57c5cf5ba2 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -692,6 +692,50 @@ fun implementsPrim (p: 'a Prim.t): bool = Option.isSome (primApp p) fun aamd (oper, mc) = case !Control.llvmAAMD of Control.LLVMAliasAnalysisMetaData.None => NONE + | Control.LLVMAliasAnalysisMetaData.Scope => + let + val domain = + LLVM.ModuleContext.addMetaData + (mc, LLVM.MetaData.node [LLVM.MetaData.string "MLton Scope Domain"]) + fun scope s = + LLVM.ModuleContext.addMetaData + (mc, LLVM.MetaData.node [LLVM.MetaData.string s, + LLVM.MetaData.id domain]) + val (global,gcstate,heap,other,stack) = + (scope "Global", scope "GCState", scope "Heap", scope "Other", scope "Stack") + val scopes = [global,gcstate,heap,other,stack] + fun scope s = + let + fun scopeSet ss = + LLVM.ModuleContext.addMetaData + (mc, LLVM.MetaData.node (List.map (ss, LLVM.MetaData.id))) + val noalias = scopeSet (List.remove (scopes, fn s' => LLVM.MetaData.Id.equals (s, s'))) + val alias = scopeSet [s] + in + SOME (concat ["!noalias ", LLVM.MetaData.Id.toString noalias, + ", !alias.scope ", LLVM.MetaData.Id.toString alias]) + end + in + case oper of + Operand.Frontier => NONE (* alloca *) + | Operand.Global _ => scope global + | Operand.Offset {base = Operand.GCState, ...} => scope gcstate + | Operand.Offset {base, ...} => if Type.isObjptr (Operand.ty base) + then scope heap + else scope other + | Operand.SequenceOffset {base, ...} => if Type.isObjptr (Operand.ty base) + then scope heap + else scope other + | Operand.StackOffset _ => + (* Unsound: At raise, exception results are written to the stack via an + * `Offset` with `base` corresponding to `StackBottom + exnStack` and + * then read from the stack via a `StackOffset` by the handler. + *) + scope stack + | Operand.StackTop => NONE (* alloca *) + | Operand.Temporary _ => NONE (* alloca *) + | _ => NONE (* not lvalue *) + end | Control.LLVMAliasAnalysisMetaData.TBAA {gcstate, global, heap, other, stack} => let fun tbaa path = diff --git a/mlton/control/control-flags.sig b/mlton/control/control-flags.sig index ca474c3877..45ad6b429d 100644 --- a/mlton/control/control-flags.sig +++ b/mlton/control/control-flags.sig @@ -282,11 +282,14 @@ signature CONTROL_FLAGS = structure LLVMAliasAnalysisMetaData: sig - datatype t = None | TBAA of {gcstate: {offset: bool} option, - global: {cty: bool, index: bool} option, - heap: {cty: bool, kind: bool, offset: bool, tycon: bool} option, - other: bool, - stack: {offset: bool} option} + datatype t = + None + | Scope + | TBAA of {gcstate: {offset: bool} option, + global: {cty: bool, index: bool} option, + heap: {cty: bool, kind: bool, offset: bool, tycon: bool} option, + other: bool, + stack: {offset: bool} option} val toString: t -> string val fromString: string -> t option end diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index 9c2292f20c..721fc72063 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -1026,11 +1026,15 @@ val libname = ref "" structure LLVMAliasAnalysisMetaData = struct - datatype t = None | TBAA of {gcstate: {offset: bool} option, - global: {cty: bool, index: bool} option, - heap: {cty: bool, kind: bool, offset: bool, tycon: bool} option, - other: bool, - stack: {offset: bool} option} + datatype t = + None + | Scope + | TBAA of {gcstate: {offset: bool} option, + global: {cty: bool, index: bool} option, + heap: {cty: bool, kind: bool, offset: bool, tycon: bool} option, + other: bool, + stack: {offset: bool} option} + val tbaaDefault = TBAA {gcstate = SOME {offset = false}, global = SOME {cty = false, index = false}, @@ -1041,6 +1045,7 @@ structure LLVMAliasAnalysisMetaData = fun toString aamd = case aamd of None => "none" + | Scope => "scope" | TBAA {gcstate, global, heap, other, stack} => let open Layout @@ -1079,6 +1084,7 @@ structure LLVMAliasAnalysisMetaData = val p = any [kw "none" *> pure None, + kw "scope" *> pure Scope, kw "tbaa" *> (cbrack (ffield ("gcstate", option (cbrack (ffield ("offset", bool) >>= (fn offset => pure {offset = offset})))) >>= (fn gcstate => From 311331c100387aaea35d6debf3e36c1d17c389b0 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 31 Jul 2019 16:28:42 -0400 Subject: [PATCH 085/102] Add `inline` attribute for `_import` This allows marking an `_import`ed C function to have its prototype emitted with the `inline` keyword. This will be used to properly mark Basis Library functions (as opposed to primitives) that are provided as `inline` to be properly annotated as such in the emitted C declarations. --- mlton/ast/ast-core.fun | 5 +++-- mlton/ast/ast-core.sig | 4 ++-- mlton/atoms/c-function.fun | 19 ++++++++++------- mlton/atoms/c-function.sig | 1 + mlton/backend/implement-profiling.fun | 1 + mlton/backend/limit-check.fun | 1 + mlton/backend/rep-type.fun | 28 ++++++++++++------------- mlton/backend/ssa2-to-rssa.fun | 18 ++++++++++++++++ mlton/elaborate/elaborate-core.fun | 30 ++++++++++++++++++++++++++- mlton/front-end/ml.grm | 3 ++- mlton/ssa/split-types.fun | 4 ++-- 11 files changed, 85 insertions(+), 29 deletions(-) diff --git a/mlton/ast/ast-core.fun b/mlton/ast/ast-core.fun index 06ac65cc7f..c59ee0c912 100644 --- a/mlton/ast/ast-core.fun +++ b/mlton/ast/ast-core.fun @@ -1,4 +1,4 @@ -(* Copyright (C) 2009,2012,2015,2017 Matthew Fluet. +(* Copyright (C) 2009,2012,2015,2017,2019 Matthew Fluet. * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. @@ -236,12 +236,13 @@ structure PrimKind = struct structure ImportExportAttribute = struct - datatype t = Cdecl | External | Impure | Private | Public | Pure | Reentrant | Runtime | Stdcall + datatype t = Cdecl | External | Impure | Inline | Private | Public | Pure | Reentrant | Runtime | Stdcall val toString: t -> string = fn Cdecl => "cdecl" | External => "external" | Impure => "impure" + | Inline => "inline" | Private => "private" | Public => "public" | Pure => "pure" diff --git a/mlton/ast/ast-core.sig b/mlton/ast/ast-core.sig index 1f1fb95b51..7bf65a6370 100644 --- a/mlton/ast/ast-core.sig +++ b/mlton/ast/ast-core.sig @@ -1,4 +1,4 @@ -(* Copyright (C) 2009,2012,2015,2017 Matthew Fluet. +(* Copyright (C) 2009,2012,2015,2017,2019 Matthew Fluet. * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. @@ -84,7 +84,7 @@ signature AST_CORE = sig structure ImportExportAttribute: sig - datatype t = Cdecl | External | Impure | Private | Public | Pure | Reentrant | Runtime | Stdcall + datatype t = Cdecl | External | Impure | Inline | Private | Public | Pure | Reentrant | Runtime | Stdcall val layout: t -> Layout.t end diff --git a/mlton/atoms/c-function.fun b/mlton/atoms/c-function.fun index 88c6947862..420ab36281 100644 --- a/mlton/atoms/c-function.fun +++ b/mlton/atoms/c-function.fun @@ -189,16 +189,18 @@ datatype z = datatype Target.t datatype 'a t = T of {args: 'a vector, convention: Convention.t, kind: Kind.t, + inline: bool, prototype: CType.t vector * CType.t option, return: 'a, symbolScope: SymbolScope.t, target: Target.t} -fun layout (T {args, convention, kind, prototype, return, symbolScope, target, ...}, +fun layout (T {args, convention, inline, kind, prototype, return, symbolScope, target, ...}, layoutType) = Layout.record [("args", Vector.layout layoutType args), ("convention", Convention.layout convention), + ("inline", Bool.layout inline), ("kind", Kind.layout kind), ("prototype", (fn (args,ret) => Layout.record @@ -215,6 +217,7 @@ fun parse parseType = T <$> cbrack (ffield ("args", vector parseType) >>= (fn args => nfield ("convention", Convention.parse) >>= (fn convention => + nfield ("inline", bool) >>= (fn inline => nfield ("kind", Kind.parse) >>= (fn kind => nfield ("prototype", cbrack (ffield ("args", vector CType.parse) >>= (fn args => nfield ("res", option CType.parse) >>= (fn res => @@ -222,9 +225,9 @@ fun parse parseType = nfield ("return", parseType) >>= (fn return => nfield ("symbolScope", SymbolScope.parse) >>= (fn symbolScope => nfield ("target", Target.parse) >>= (fn target => - pure {args = args, convention = convention, + pure {args = args, convention = convention, inline = inline, kind = kind, prototype = prototype, return = return, - symbolScope = symbolScope, target = target})))))))) + symbolScope = symbolScope, target = target}))))))))) end local @@ -251,10 +254,11 @@ val _ = (modifiesFrontier, readsStackTop, writesStackTop) fun equals (f, f') = Target.equals (target f, target f') -fun map (T {args, convention, kind, prototype, return, symbolScope, target}, +fun map (T {args, convention, inline, kind, prototype, return, symbolScope, target}, f) = T {args = Vector.map (args, f), convention = convention, + inline = inline, kind = kind, prototype = prototype, return = f return, @@ -285,14 +289,14 @@ fun isOk (T {kind, return, ...}, fun vanilla {args, name, prototype, return} = T {args = args, convention = Convention.Cdecl, + inline = false, kind = Kind.Impure, prototype = prototype, return = return, symbolScope = SymbolScope.Private, target = Direct name} -fun cPrototype (T {convention, prototype = (args, return), symbolScope, target, - ...}) = +fun cPrototype (T {convention, inline, prototype = (args, return), symbolScope, target, ...}) = let val convention = if convention <> Convention.Cdecl @@ -305,6 +309,7 @@ fun cPrototype (T {convention, prototype = (args, return), symbolScope, target, SymbolScope.External => "EXTERNAL " | SymbolScope.Private => "PRIVATE " | SymbolScope.Public => "PUBLIC " + val inline = if inline then "inline " else "" val name = case target of Direct name => name @@ -317,7 +322,7 @@ fun cPrototype (T {convention, prototype = (args, return), symbolScope, target, NONE => "void" | SOME t => CType.toString t in - concat [symbolScope, return, convention, name, + concat [symbolScope, inline, return, convention, name, " (", concat (List.separate (Vector.toListMap (args, arg), ", ")), ")"] diff --git a/mlton/atoms/c-function.sig b/mlton/atoms/c-function.sig index c1321775e7..ef94ae9a93 100644 --- a/mlton/atoms/c-function.sig +++ b/mlton/atoms/c-function.sig @@ -91,6 +91,7 @@ signature C_FUNCTION = datatype 'a t = T of {args: 'a vector, convention: Convention.t, + inline: bool, kind: Kind.t, prototype: CType.t vector * CType.t option, return: 'a, diff --git a/mlton/backend/implement-profiling.fun b/mlton/backend/implement-profiling.fun index c4a40c4161..e5413e8515 100644 --- a/mlton/backend/implement-profiling.fun +++ b/mlton/backend/implement-profiling.fun @@ -25,6 +25,7 @@ structure CFunction = fun make {args, name, prototype} = T {args = args, convention = Convention.Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = false, diff --git a/mlton/backend/limit-check.fun b/mlton/backend/limit-check.fun index 25e4a4a623..ea366b516a 100644 --- a/mlton/backend/limit-check.fun +++ b/mlton/backend/limit-check.fun @@ -175,6 +175,7 @@ fun insertFunction (f: Function.t, val cfunc = CFunction.T {args = Vector.new0 (), convention = CFunction.Convention.Cdecl, + inline = false, kind = CFunction.Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = false, diff --git a/mlton/backend/rep-type.fun b/mlton/backend/rep-type.fun index a0962dbaec..7df0cf3323 100644 --- a/mlton/backend/rep-type.fun +++ b/mlton/backend/rep-type.fun @@ -872,20 +872,20 @@ structure BuiltInCFunction = local fun make b = fn () => T {args = Vector.new3 (Type.gcState (), Type.csize (), Type.bool), - convention = Cdecl, - kind = Kind.Runtime {bytesNeeded = NONE, - ensuresBytesFree = SOME 1, - mayGC = true, - maySwitchThreadsFrom = b, - maySwitchThreadsTo = b, - modifiesFrontier = true, - readsStackTop = true, - writesStackTop = true}, - prototype = (Vector.new3 (CType.cpointer, CType.csize (), CType.bool), - NONE), - return = Type.unit, - symbolScope = SymbolScope.Private, - target = Direct "GC_collect"} + convention = Cdecl, + inline = false, + kind = Kind.Runtime {bytesNeeded = NONE, + ensuresBytesFree = SOME 1, + mayGC = true, + maySwitchThreadsFrom = b, + maySwitchThreadsTo = b, + modifiesFrontier = true, + readsStackTop = true, + writesStackTop = true}, + prototype = (Vector.new3 (CType.cpointer, CType.csize (), CType.bool), NONE), + return = Type.unit, + symbolScope = SymbolScope.Private, + target = Direct "GC_collect"} val t = make true val f = make false in diff --git a/mlton/backend/ssa2-to-rssa.fun b/mlton/backend/ssa2-to-rssa.fun index d708acc03f..616d8debec 100644 --- a/mlton/backend/ssa2-to-rssa.fun +++ b/mlton/backend/ssa2-to-rssa.fun @@ -59,6 +59,7 @@ structure CFunction = val copyCurrentThread = fn () => T {args = Vector.new1 (Type.gcState ()), convention = Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = true, @@ -76,6 +77,7 @@ structure CFunction = val copyThread = fn () => T {args = Vector.new2 (Type.gcState (), Type.thread ()), convention = Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = true, @@ -96,6 +98,7 @@ structure CFunction = val halt = fn () => T {args = Vector.new2 (Type.gcState (), Type.cint ()), convention = Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = true, @@ -115,6 +118,7 @@ structure CFunction = Type.seqIndex (), Type.objptrHeader ()), convention = Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = SOME 1, mayGC = true, @@ -140,6 +144,7 @@ structure CFunction = Type.seqIndex (), Type.seqIndex ()), convention = Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = false, @@ -162,6 +167,7 @@ structure CFunction = val returnToC = fn () => T {args = Vector.new0 (), convention = Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = true, @@ -179,6 +185,7 @@ structure CFunction = val threadSwitchTo = fn () => T {args = Vector.new3 (Type.gcState (), Type.thread (), Type.csize ()), convention = Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = SOME 2, mayGC = true, @@ -199,6 +206,7 @@ structure CFunction = fun weakCanGet {arg} = T {args = Vector.new2 (Type.gcState (), arg), convention = Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = false, @@ -217,6 +225,7 @@ structure CFunction = fun weakGet {arg, return} = T {args = Vector.new2 (Type.gcState (), arg), convention = Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = false, @@ -235,6 +244,7 @@ structure CFunction = fun weakNew {arg, return} = T {args = Vector.new3 (Type.gcState (), Type.objptrHeader (), arg), convention = Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = true, @@ -254,6 +264,7 @@ structure CFunction = val worldSave = fn () => T {args = Vector.new2 (Type.gcState (), Type.string ()), convention = Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = true, @@ -271,6 +282,7 @@ structure CFunction = fun share t = T {args = Vector.new2 (Type.gcState (), t), convention = Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = true, (* MLton.share works by tracing an object. @@ -292,6 +304,7 @@ structure CFunction = fun size t = T {args = Vector.new2 (Type.gcState (), t), convention = Cdecl, + inline = false, kind = Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = true, (* MLton.size works by tracing an object. @@ -318,6 +331,7 @@ structure CFunction = Type.intInf (), Type.csize ()), convention = Cdecl, + inline = false, kind = CFunction.Kind.Runtime {bytesNeeded = SOME 3, ensuresBytesFree = NONE, mayGC = false, @@ -340,6 +354,7 @@ structure CFunction = Type.intInf (), Type.intInf ()), convention = Cdecl, + inline = false, kind = CFunction.Kind.Runtime {bytesNeeded = NONE, ensuresBytesFree = NONE, mayGC = false, @@ -361,6 +376,7 @@ structure CFunction = Type.shiftArg, Type.csize ()), convention = Cdecl, + inline = false, kind = CFunction.Kind.Runtime {bytesNeeded = SOME 3, ensuresBytesFree = NONE, mayGC = false, @@ -384,6 +400,7 @@ structure CFunction = Type.word WordSize.word32, Type.csize ()), convention = Cdecl, + inline = false, kind = CFunction.Kind.Runtime {bytesNeeded = SOME 3, ensuresBytesFree = NONE, mayGC = false, @@ -405,6 +422,7 @@ structure CFunction = Type.intInf (), Type.csize ()), convention = Cdecl, + inline = false, kind = CFunction.Kind.Runtime {bytesNeeded = SOME 2, ensuresBytesFree = NONE, mayGC = false, diff --git a/mlton/elaborate/elaborate-core.fun b/mlton/elaborate/elaborate-core.fun index d6cf46cc83..a82816b791 100644 --- a/mlton/elaborate/elaborate-core.fun +++ b/mlton/elaborate/elaborate-core.fun @@ -1,4 +1,4 @@ -(* Copyright (C) 2009-2012,2015,2017 Matthew Fluet. +(* Copyright (C) 2009-2012,2015,2017,2019 Matthew Fluet. * Copyright (C) 1999-2008 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. @@ -1137,6 +1137,19 @@ fun parseIEAttributesConvention (attributes: ImportExportAttribute.t list) | _ => NONE) | _ => NONE +val isIEAttributeInline = + fn ImportExportAttribute.Inline => true + | _ => false + +fun parseIEAttributesInline (attributes: ImportExportAttribute.t list) + : bool option = + case attributes of + [] => SOME false + | [a] => (case a of + ImportExportAttribute.Inline => SOME true + | _ => NONE) + | _ => NONE + val isIEAttributeKind = fn ImportExportAttribute.Impure => true | ImportExportAttribute.Pure => true @@ -1224,6 +1237,20 @@ fun import {attributes: ImportExportAttribute.t list, NONE => (invalidAttributes () ; Convention.Cdecl) | SOME c => c + val inline = + List.keepAll (attributes, isIEAttributeInline) + val inline = + case name of + NONE => + (if List.isEmpty inline + then () + else invalidAttributes () + ; false) + | SOME _ => + (case parseIEAttributesInline inline of + NONE => (invalidAttributes () + ; false) + | SOME i => i) val kind = List.keepAll (attributes, isIEAttributeKind) val kind = @@ -1265,6 +1292,7 @@ fun import {attributes: ImportExportAttribute.t list, [Vector.new1 addrTy, args] end, convention = convention, + inline = inline, kind = kind, prototype = (Vector.map (args, #ctype), Option.map (result, #ctype)), diff --git a/mlton/front-end/ml.grm b/mlton/front-end/ml.grm index a8d64d9fe1..ae08d0be50 100644 --- a/mlton/front-end/ml.grm +++ b/mlton/front-end/ml.grm @@ -8,7 +8,7 @@ * See the file NJ-LICENSE for details. *) -(* Copyright (C) 2008,2009,2014-2017 Matthew Fluet. +(* Copyright (C) 2008,2009,2014-2017,2019 Matthew Fluet. * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. @@ -1085,6 +1085,7 @@ ieattributes "cdecl" => PrimKind.ImportExportAttribute.Cdecl :: ieattributes | "external" => PrimKind.ImportExportAttribute.External :: ieattributes | "impure" => PrimKind.ImportExportAttribute.Impure :: ieattributes + | "inline" => PrimKind.ImportExportAttribute.Inline :: ieattributes | "private" => PrimKind.ImportExportAttribute.Private :: ieattributes | "public" => PrimKind.ImportExportAttribute.Public :: ieattributes | "pure" => PrimKind.ImportExportAttribute.Pure :: ieattributes diff --git a/mlton/ssa/split-types.fun b/mlton/ssa/split-types.fun index 6b97a266e0..264888f65b 100644 --- a/mlton/ssa/split-types.fun +++ b/mlton/ssa/split-types.fun @@ -285,7 +285,7 @@ fun transform (program as Program.T {datatypes, globals, functions, main}) = val newPrim = case Prim.name prim of Prim.Name.FFI (cfunc as CFunction.T {args=_, return=_, - convention, kind, prototype, symbolScope, target}) => + convention, inline, kind, prototype, symbolScope, target}) => let val newArgs = argTys val newReturn = newTy @@ -293,7 +293,7 @@ fun transform (program as Program.T {datatypes, globals, functions, main}) = case kind of CFunction.Kind.Runtime _ => CFunction.T {args=newArgs, return=newReturn, - convention=convention, kind=kind, prototype=prototype, + convention=convention, inline=inline, kind=kind, prototype=prototype, symbolScope=symbolScope, target=target} | _ => cfunc in From c86449276e3862e68708562031cb55f8d9e5e3b5 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Wed, 31 Jul 2019 22:22:03 -0400 Subject: [PATCH 086/102] Use C99/C11 `inline` for primitive and Basis Library functions Previously, functions meant to be inlined because they correspond to primitives or Basis Library functions (e.g., `Real` and `Real.Math`) were marked `static inline` when included via `c-chunk.h`. If a C compiler chooses not to inline a function (such as clang at -O1), then each .o file included its own copy of the function (and the copy of the function provided by `libmlton.a` was not linked into the final executable). Now, functions are marked `inline` when included via `c-chunk.h` (and the corresponding `_import` is given the `inline` attribute). The C99/C11 semantics of `inline` requires the C compiler to *not* include a copy of the function in the .o file (if it chooses not to inline the function) and treat the function as an external reference. The copy of the function provided by `libmlton.a` is used to satisfy the external reference when linking. --- basis-library/primitive/basis-ffi.sml | 546 +++++------ basis-library/primitive/prim-real.sml | 36 +- basis-library/primitive/primitive.mlb | 9 +- include/c-chunk.h | 4 +- runtime/basis-ffi.h | 542 +++++------ runtime/basis/Real/Real-ops.h | 18 +- runtime/basis/Word/Word-ops.h | 26 +- runtime/basis/coerce.h | 5 +- runtime/basis/cpointer.h | 29 +- runtime/gen/basis-ffi.def | 1198 ++++++++++++------------- runtime/gen/basis-ffi.h | 542 +++++------ runtime/gen/basis-ffi.sml | 546 +++++------ runtime/gen/gen-basis-ffi.sml | 11 +- runtime/platform.h | 4 +- 14 files changed, 1751 insertions(+), 1765 deletions(-) diff --git a/basis-library/primitive/basis-ffi.sml b/basis-library/primitive/basis-ffi.sml index ada190a03c..1997ca7146 100644 --- a/basis-library/primitive/basis-ffi.sml +++ b/basis-library/primitive/basis-ffi.sml @@ -909,118 +909,118 @@ end structure Real32 = struct type t = Real32.t -val abs = _import "Real32_abs" private : Real32.t -> Real32.t; -val add = _import "Real32_add" private : Real32.t * Real32.t -> Real32.t; -val castToWord32 = _import "Real32_castToWord32" private : Real32.t -> Word32.t; -val div = _import "Real32_div" private : Real32.t * Real32.t -> Real32.t; -val equal = _import "Real32_equal" private : Real32.t * Real32.t -> Bool.t; -val fetch = _import "Real32_fetch" private : (Real32.t) ref -> Real32.t; -val frexp = _import "Real32_frexp" private : Real32.t * (C_Int.t) ref -> Real32.t; +val abs = _import "Real32_abs" private inline : Real32.t -> Real32.t; +val add = _import "Real32_add" private inline : Real32.t * Real32.t -> Real32.t; +val castToWord32 = _import "Real32_castToWord32" private inline : Real32.t -> Word32.t; +val div = _import "Real32_div" private inline : Real32.t * Real32.t -> Real32.t; +val equal = _import "Real32_equal" private inline : Real32.t * Real32.t -> Bool.t; +val fetch = _import "Real32_fetch" private inline : (Real32.t) ref -> Real32.t; +val frexp = _import "Real32_frexp" private inline : Real32.t * (C_Int.t) ref -> Real32.t; val gdtoa = _import "Real32_gdtoa" private : Real32.t * C_Int.t * C_Int.t * C_Int.t * (C_Int.t) ref -> C_String.t; -val ldexp = _import "Real32_ldexp" private : Real32.t * C_Int.t -> Real32.t; -val le = _import "Real32_le" private : Real32.t * Real32.t -> Bool.t; -val lt = _import "Real32_lt" private : Real32.t * Real32.t -> Bool.t; +val ldexp = _import "Real32_ldexp" private inline : Real32.t * C_Int.t -> Real32.t; +val le = _import "Real32_le" private inline : Real32.t * Real32.t -> Bool.t; +val lt = _import "Real32_lt" private inline : Real32.t * Real32.t -> Bool.t; structure Math = struct -val acos = _import "Real32_Math_acos" private : Real32.t -> Real32.t; -val asin = _import "Real32_Math_asin" private : Real32.t -> Real32.t; -val atan = _import "Real32_Math_atan" private : Real32.t -> Real32.t; -val atan2 = _import "Real32_Math_atan2" private : Real32.t * Real32.t -> Real32.t; -val cos = _import "Real32_Math_cos" private : Real32.t -> Real32.t; -val cosh = _import "Real32_Math_cosh" private : Real32.t -> Real32.t; +val acos = _import "Real32_Math_acos" private inline : Real32.t -> Real32.t; +val asin = _import "Real32_Math_asin" private inline : Real32.t -> Real32.t; +val atan = _import "Real32_Math_atan" private inline : Real32.t -> Real32.t; +val atan2 = _import "Real32_Math_atan2" private inline : Real32.t * Real32.t -> Real32.t; +val cos = _import "Real32_Math_cos" private inline : Real32.t -> Real32.t; +val cosh = _import "Real32_Math_cosh" private inline : Real32.t -> Real32.t; val (eGet, eSet) = _symbol "Real32_Math_e" private : (unit -> (Real32.t)) * ((Real32.t) -> unit); -val exp = _import "Real32_Math_exp" private : Real32.t -> Real32.t; -val ln = _import "Real32_Math_ln" private : Real32.t -> Real32.t; -val log10 = _import "Real32_Math_log10" private : Real32.t -> Real32.t; +val exp = _import "Real32_Math_exp" private inline : Real32.t -> Real32.t; +val ln = _import "Real32_Math_ln" private inline : Real32.t -> Real32.t; +val log10 = _import "Real32_Math_log10" private inline : Real32.t -> Real32.t; val (piGet, piSet) = _symbol "Real32_Math_pi" private : (unit -> (Real32.t)) * ((Real32.t) -> unit); -val pow = _import "Real32_Math_pow" private : Real32.t * Real32.t -> Real32.t; -val sin = _import "Real32_Math_sin" private : Real32.t -> Real32.t; -val sinh = _import "Real32_Math_sinh" private : Real32.t -> Real32.t; -val sqrt = _import "Real32_Math_sqrt" private : Real32.t -> Real32.t; -val tan = _import "Real32_Math_tan" private : Real32.t -> Real32.t; -val tanh = _import "Real32_Math_tanh" private : Real32.t -> Real32.t; -end -val modf = _import "Real32_modf" private : Real32.t * (Real32.t) ref -> Real32.t; -val move = _import "Real32_move" private : (Real32.t) ref * (Real32.t) ref -> unit; -val mul = _import "Real32_mul" private : Real32.t * Real32.t -> Real32.t; -val muladd = _import "Real32_muladd" private : Real32.t * Real32.t * Real32.t -> Real32.t; -val mulsub = _import "Real32_mulsub" private : Real32.t * Real32.t * Real32.t -> Real32.t; -val neg = _import "Real32_neg" private : Real32.t -> Real32.t; -val realCeil = _import "Real32_realCeil" private : Real32.t -> Real32.t; -val realFloor = _import "Real32_realFloor" private : Real32.t -> Real32.t; -val realTrunc = _import "Real32_realTrunc" private : Real32.t -> Real32.t; -val rndToReal32 = _import "Real32_rndToReal32" private : Real32.t -> Real32.t; -val rndToReal64 = _import "Real32_rndToReal64" private : Real32.t -> Real64.t; -val rndToWordS16 = _import "Real32_rndToWordS16" private : Real32.t -> Int16.t; -val rndToWordS32 = _import "Real32_rndToWordS32" private : Real32.t -> Int32.t; -val rndToWordS64 = _import "Real32_rndToWordS64" private : Real32.t -> Int64.t; -val rndToWordS8 = _import "Real32_rndToWordS8" private : Real32.t -> Int8.t; -val rndToWordU16 = _import "Real32_rndToWordU16" private : Real32.t -> Word16.t; -val rndToWordU32 = _import "Real32_rndToWordU32" private : Real32.t -> Word32.t; -val rndToWordU64 = _import "Real32_rndToWordU64" private : Real32.t -> Word64.t; -val rndToWordU8 = _import "Real32_rndToWordU8" private : Real32.t -> Word8.t; -val round = _import "Real32_round" private : Real32.t -> Real32.t; -val store = _import "Real32_store" private : (Real32.t) ref * Real32.t -> unit; +val pow = _import "Real32_Math_pow" private inline : Real32.t * Real32.t -> Real32.t; +val sin = _import "Real32_Math_sin" private inline : Real32.t -> Real32.t; +val sinh = _import "Real32_Math_sinh" private inline : Real32.t -> Real32.t; +val sqrt = _import "Real32_Math_sqrt" private inline : Real32.t -> Real32.t; +val tan = _import "Real32_Math_tan" private inline : Real32.t -> Real32.t; +val tanh = _import "Real32_Math_tanh" private inline : Real32.t -> Real32.t; +end +val modf = _import "Real32_modf" private inline : Real32.t * (Real32.t) ref -> Real32.t; +val move = _import "Real32_move" private inline : (Real32.t) ref * (Real32.t) ref -> unit; +val mul = _import "Real32_mul" private inline : Real32.t * Real32.t -> Real32.t; +val muladd = _import "Real32_muladd" private inline : Real32.t * Real32.t * Real32.t -> Real32.t; +val mulsub = _import "Real32_mulsub" private inline : Real32.t * Real32.t * Real32.t -> Real32.t; +val neg = _import "Real32_neg" private inline : Real32.t -> Real32.t; +val realCeil = _import "Real32_realCeil" private inline : Real32.t -> Real32.t; +val realFloor = _import "Real32_realFloor" private inline : Real32.t -> Real32.t; +val realTrunc = _import "Real32_realTrunc" private inline : Real32.t -> Real32.t; +val rndToReal32 = _import "Real32_rndToReal32" private inline : Real32.t -> Real32.t; +val rndToReal64 = _import "Real32_rndToReal64" private inline : Real32.t -> Real64.t; +val rndToWordS16 = _import "Real32_rndToWordS16" private inline : Real32.t -> Int16.t; +val rndToWordS32 = _import "Real32_rndToWordS32" private inline : Real32.t -> Int32.t; +val rndToWordS64 = _import "Real32_rndToWordS64" private inline : Real32.t -> Int64.t; +val rndToWordS8 = _import "Real32_rndToWordS8" private inline : Real32.t -> Int8.t; +val rndToWordU16 = _import "Real32_rndToWordU16" private inline : Real32.t -> Word16.t; +val rndToWordU32 = _import "Real32_rndToWordU32" private inline : Real32.t -> Word32.t; +val rndToWordU64 = _import "Real32_rndToWordU64" private inline : Real32.t -> Word64.t; +val rndToWordU8 = _import "Real32_rndToWordU8" private inline : Real32.t -> Word8.t; +val round = _import "Real32_round" private inline : Real32.t -> Real32.t; +val store = _import "Real32_store" private inline : (Real32.t) ref * Real32.t -> unit; val strtor = _import "Real32_strtor" private : NullString8.t * C_Int.t -> Real32.t; -val sub = _import "Real32_sub" private : Real32.t * Real32.t -> Real32.t; +val sub = _import "Real32_sub" private inline : Real32.t * Real32.t -> Real32.t; end structure Real64 = struct type t = Real64.t -val abs = _import "Real64_abs" private : Real64.t -> Real64.t; -val add = _import "Real64_add" private : Real64.t * Real64.t -> Real64.t; -val castToWord64 = _import "Real64_castToWord64" private : Real64.t -> Word64.t; -val div = _import "Real64_div" private : Real64.t * Real64.t -> Real64.t; -val equal = _import "Real64_equal" private : Real64.t * Real64.t -> Bool.t; -val fetch = _import "Real64_fetch" private : (Real64.t) ref -> Real64.t; -val frexp = _import "Real64_frexp" private : Real64.t * (C_Int.t) ref -> Real64.t; +val abs = _import "Real64_abs" private inline : Real64.t -> Real64.t; +val add = _import "Real64_add" private inline : Real64.t * Real64.t -> Real64.t; +val castToWord64 = _import "Real64_castToWord64" private inline : Real64.t -> Word64.t; +val div = _import "Real64_div" private inline : Real64.t * Real64.t -> Real64.t; +val equal = _import "Real64_equal" private inline : Real64.t * Real64.t -> Bool.t; +val fetch = _import "Real64_fetch" private inline : (Real64.t) ref -> Real64.t; +val frexp = _import "Real64_frexp" private inline : Real64.t * (C_Int.t) ref -> Real64.t; val gdtoa = _import "Real64_gdtoa" private : Real64.t * C_Int.t * C_Int.t * C_Int.t * (C_Int.t) ref -> C_String.t; -val ldexp = _import "Real64_ldexp" private : Real64.t * C_Int.t -> Real64.t; -val le = _import "Real64_le" private : Real64.t * Real64.t -> Bool.t; -val lt = _import "Real64_lt" private : Real64.t * Real64.t -> Bool.t; +val ldexp = _import "Real64_ldexp" private inline : Real64.t * C_Int.t -> Real64.t; +val le = _import "Real64_le" private inline : Real64.t * Real64.t -> Bool.t; +val lt = _import "Real64_lt" private inline : Real64.t * Real64.t -> Bool.t; structure Math = struct -val acos = _import "Real64_Math_acos" private : Real64.t -> Real64.t; -val asin = _import "Real64_Math_asin" private : Real64.t -> Real64.t; -val atan = _import "Real64_Math_atan" private : Real64.t -> Real64.t; -val atan2 = _import "Real64_Math_atan2" private : Real64.t * Real64.t -> Real64.t; -val cos = _import "Real64_Math_cos" private : Real64.t -> Real64.t; -val cosh = _import "Real64_Math_cosh" private : Real64.t -> Real64.t; +val acos = _import "Real64_Math_acos" private inline : Real64.t -> Real64.t; +val asin = _import "Real64_Math_asin" private inline : Real64.t -> Real64.t; +val atan = _import "Real64_Math_atan" private inline : Real64.t -> Real64.t; +val atan2 = _import "Real64_Math_atan2" private inline : Real64.t * Real64.t -> Real64.t; +val cos = _import "Real64_Math_cos" private inline : Real64.t -> Real64.t; +val cosh = _import "Real64_Math_cosh" private inline : Real64.t -> Real64.t; val (eGet, eSet) = _symbol "Real64_Math_e" private : (unit -> (Real64.t)) * ((Real64.t) -> unit); -val exp = _import "Real64_Math_exp" private : Real64.t -> Real64.t; -val ln = _import "Real64_Math_ln" private : Real64.t -> Real64.t; -val log10 = _import "Real64_Math_log10" private : Real64.t -> Real64.t; +val exp = _import "Real64_Math_exp" private inline : Real64.t -> Real64.t; +val ln = _import "Real64_Math_ln" private inline : Real64.t -> Real64.t; +val log10 = _import "Real64_Math_log10" private inline : Real64.t -> Real64.t; val (piGet, piSet) = _symbol "Real64_Math_pi" private : (unit -> (Real64.t)) * ((Real64.t) -> unit); -val pow = _import "Real64_Math_pow" private : Real64.t * Real64.t -> Real64.t; -val sin = _import "Real64_Math_sin" private : Real64.t -> Real64.t; -val sinh = _import "Real64_Math_sinh" private : Real64.t -> Real64.t; -val sqrt = _import "Real64_Math_sqrt" private : Real64.t -> Real64.t; -val tan = _import "Real64_Math_tan" private : Real64.t -> Real64.t; -val tanh = _import "Real64_Math_tanh" private : Real64.t -> Real64.t; -end -val modf = _import "Real64_modf" private : Real64.t * (Real64.t) ref -> Real64.t; -val move = _import "Real64_move" private : (Real64.t) ref * (Real64.t) ref -> unit; -val mul = _import "Real64_mul" private : Real64.t * Real64.t -> Real64.t; -val muladd = _import "Real64_muladd" private : Real64.t * Real64.t * Real64.t -> Real64.t; -val mulsub = _import "Real64_mulsub" private : Real64.t * Real64.t * Real64.t -> Real64.t; -val neg = _import "Real64_neg" private : Real64.t -> Real64.t; -val realCeil = _import "Real64_realCeil" private : Real64.t -> Real64.t; -val realFloor = _import "Real64_realFloor" private : Real64.t -> Real64.t; -val realTrunc = _import "Real64_realTrunc" private : Real64.t -> Real64.t; -val rndToReal32 = _import "Real64_rndToReal32" private : Real64.t -> Real32.t; -val rndToReal64 = _import "Real64_rndToReal64" private : Real64.t -> Real64.t; -val rndToWordS16 = _import "Real64_rndToWordS16" private : Real64.t -> Int16.t; -val rndToWordS32 = _import "Real64_rndToWordS32" private : Real64.t -> Int32.t; -val rndToWordS64 = _import "Real64_rndToWordS64" private : Real64.t -> Int64.t; -val rndToWordS8 = _import "Real64_rndToWordS8" private : Real64.t -> Int8.t; -val rndToWordU16 = _import "Real64_rndToWordU16" private : Real64.t -> Word16.t; -val rndToWordU32 = _import "Real64_rndToWordU32" private : Real64.t -> Word32.t; -val rndToWordU64 = _import "Real64_rndToWordU64" private : Real64.t -> Word64.t; -val rndToWordU8 = _import "Real64_rndToWordU8" private : Real64.t -> Word8.t; -val round = _import "Real64_round" private : Real64.t -> Real64.t; -val store = _import "Real64_store" private : (Real64.t) ref * Real64.t -> unit; +val pow = _import "Real64_Math_pow" private inline : Real64.t * Real64.t -> Real64.t; +val sin = _import "Real64_Math_sin" private inline : Real64.t -> Real64.t; +val sinh = _import "Real64_Math_sinh" private inline : Real64.t -> Real64.t; +val sqrt = _import "Real64_Math_sqrt" private inline : Real64.t -> Real64.t; +val tan = _import "Real64_Math_tan" private inline : Real64.t -> Real64.t; +val tanh = _import "Real64_Math_tanh" private inline : Real64.t -> Real64.t; +end +val modf = _import "Real64_modf" private inline : Real64.t * (Real64.t) ref -> Real64.t; +val move = _import "Real64_move" private inline : (Real64.t) ref * (Real64.t) ref -> unit; +val mul = _import "Real64_mul" private inline : Real64.t * Real64.t -> Real64.t; +val muladd = _import "Real64_muladd" private inline : Real64.t * Real64.t * Real64.t -> Real64.t; +val mulsub = _import "Real64_mulsub" private inline : Real64.t * Real64.t * Real64.t -> Real64.t; +val neg = _import "Real64_neg" private inline : Real64.t -> Real64.t; +val realCeil = _import "Real64_realCeil" private inline : Real64.t -> Real64.t; +val realFloor = _import "Real64_realFloor" private inline : Real64.t -> Real64.t; +val realTrunc = _import "Real64_realTrunc" private inline : Real64.t -> Real64.t; +val rndToReal32 = _import "Real64_rndToReal32" private inline : Real64.t -> Real32.t; +val rndToReal64 = _import "Real64_rndToReal64" private inline : Real64.t -> Real64.t; +val rndToWordS16 = _import "Real64_rndToWordS16" private inline : Real64.t -> Int16.t; +val rndToWordS32 = _import "Real64_rndToWordS32" private inline : Real64.t -> Int32.t; +val rndToWordS64 = _import "Real64_rndToWordS64" private inline : Real64.t -> Int64.t; +val rndToWordS8 = _import "Real64_rndToWordS8" private inline : Real64.t -> Int8.t; +val rndToWordU16 = _import "Real64_rndToWordU16" private inline : Real64.t -> Word16.t; +val rndToWordU32 = _import "Real64_rndToWordU32" private inline : Real64.t -> Word32.t; +val rndToWordU64 = _import "Real64_rndToWordU64" private inline : Real64.t -> Word64.t; +val rndToWordU8 = _import "Real64_rndToWordU8" private inline : Real64.t -> Word8.t; +val round = _import "Real64_round" private inline : Real64.t -> Real64.t; +val store = _import "Real64_store" private inline : (Real64.t) ref * Real64.t -> unit; val strtor = _import "Real64_strtor" private : NullString8.t * C_Int.t -> Real64.t; -val sub = _import "Real64_sub" private : Real64.t * Real64.t -> Real64.t; +val sub = _import "Real64_sub" private inline : Real64.t * Real64.t -> Real64.t; end structure Socket = struct @@ -1143,235 +1143,235 @@ end structure Word16 = struct type t = Word16.t -val add = _import "Word16_add" private : Word16.t * Word16.t -> Word16.t; -val andb = _import "Word16_andb" private : Word16.t * Word16.t -> Word16.t; -val equal = _import "Word16_equal" private : Word16.t * Word16.t -> Bool.t; -val lshift = _import "Word16_lshift" private : Word16.t * Word32.t -> Word16.t; -val neg = _import "Word16_neg" private : Word16.t -> Word16.t; -val notb = _import "Word16_notb" private : Word16.t -> Word16.t; -val orb = _import "Word16_orb" private : Word16.t * Word16.t -> Word16.t; -val rol = _import "Word16_rol" private : Word16.t * Word32.t -> Word16.t; -val ror = _import "Word16_ror" private : Word16.t * Word32.t -> Word16.t; -val sub = _import "Word16_sub" private : Word16.t * Word16.t -> Word16.t; -val xorb = _import "Word16_xorb" private : Word16.t * Word16.t -> Word16.t; +val add = _import "Word16_add" private inline : Word16.t * Word16.t -> Word16.t; +val andb = _import "Word16_andb" private inline : Word16.t * Word16.t -> Word16.t; +val equal = _import "Word16_equal" private inline : Word16.t * Word16.t -> Bool.t; +val lshift = _import "Word16_lshift" private inline : Word16.t * Word32.t -> Word16.t; +val neg = _import "Word16_neg" private inline : Word16.t -> Word16.t; +val notb = _import "Word16_notb" private inline : Word16.t -> Word16.t; +val orb = _import "Word16_orb" private inline : Word16.t * Word16.t -> Word16.t; +val rol = _import "Word16_rol" private inline : Word16.t * Word32.t -> Word16.t; +val ror = _import "Word16_ror" private inline : Word16.t * Word32.t -> Word16.t; +val sub = _import "Word16_sub" private inline : Word16.t * Word16.t -> Word16.t; +val xorb = _import "Word16_xorb" private inline : Word16.t * Word16.t -> Word16.t; end structure Word32 = struct type t = Word32.t -val add = _import "Word32_add" private : Word32.t * Word32.t -> Word32.t; -val andb = _import "Word32_andb" private : Word32.t * Word32.t -> Word32.t; -val castToReal32 = _import "Word32_castToReal32" private : Word32.t -> Real32.t; -val equal = _import "Word32_equal" private : Word32.t * Word32.t -> Bool.t; -val lshift = _import "Word32_lshift" private : Word32.t * Word32.t -> Word32.t; -val neg = _import "Word32_neg" private : Word32.t -> Word32.t; -val notb = _import "Word32_notb" private : Word32.t -> Word32.t; -val orb = _import "Word32_orb" private : Word32.t * Word32.t -> Word32.t; -val rol = _import "Word32_rol" private : Word32.t * Word32.t -> Word32.t; -val ror = _import "Word32_ror" private : Word32.t * Word32.t -> Word32.t; -val sub = _import "Word32_sub" private : Word32.t * Word32.t -> Word32.t; -val xorb = _import "Word32_xorb" private : Word32.t * Word32.t -> Word32.t; +val add = _import "Word32_add" private inline : Word32.t * Word32.t -> Word32.t; +val andb = _import "Word32_andb" private inline : Word32.t * Word32.t -> Word32.t; +val castToReal32 = _import "Word32_castToReal32" private inline : Word32.t -> Real32.t; +val equal = _import "Word32_equal" private inline : Word32.t * Word32.t -> Bool.t; +val lshift = _import "Word32_lshift" private inline : Word32.t * Word32.t -> Word32.t; +val neg = _import "Word32_neg" private inline : Word32.t -> Word32.t; +val notb = _import "Word32_notb" private inline : Word32.t -> Word32.t; +val orb = _import "Word32_orb" private inline : Word32.t * Word32.t -> Word32.t; +val rol = _import "Word32_rol" private inline : Word32.t * Word32.t -> Word32.t; +val ror = _import "Word32_ror" private inline : Word32.t * Word32.t -> Word32.t; +val sub = _import "Word32_sub" private inline : Word32.t * Word32.t -> Word32.t; +val xorb = _import "Word32_xorb" private inline : Word32.t * Word32.t -> Word32.t; end structure Word64 = struct type t = Word64.t -val add = _import "Word64_add" private : Word64.t * Word64.t -> Word64.t; -val andb = _import "Word64_andb" private : Word64.t * Word64.t -> Word64.t; -val castToReal64 = _import "Word64_castToReal64" private : Word64.t -> Real64.t; -val equal = _import "Word64_equal" private : Word64.t * Word64.t -> Bool.t; -val fetch = _import "Word64_fetch" private : (Word64.t) ref -> Word64.t; -val lshift = _import "Word64_lshift" private : Word64.t * Word32.t -> Word64.t; -val move = _import "Word64_move" private : (Word64.t) ref * (Word64.t) ref -> unit; -val neg = _import "Word64_neg" private : Word64.t -> Word64.t; -val notb = _import "Word64_notb" private : Word64.t -> Word64.t; -val orb = _import "Word64_orb" private : Word64.t * Word64.t -> Word64.t; -val rol = _import "Word64_rol" private : Word64.t * Word32.t -> Word64.t; -val ror = _import "Word64_ror" private : Word64.t * Word32.t -> Word64.t; -val store = _import "Word64_store" private : (Word64.t) ref * Word64.t -> unit; -val sub = _import "Word64_sub" private : Word64.t * Word64.t -> Word64.t; -val xorb = _import "Word64_xorb" private : Word64.t * Word64.t -> Word64.t; +val add = _import "Word64_add" private inline : Word64.t * Word64.t -> Word64.t; +val andb = _import "Word64_andb" private inline : Word64.t * Word64.t -> Word64.t; +val castToReal64 = _import "Word64_castToReal64" private inline : Word64.t -> Real64.t; +val equal = _import "Word64_equal" private inline : Word64.t * Word64.t -> Bool.t; +val fetch = _import "Word64_fetch" private inline : (Word64.t) ref -> Word64.t; +val lshift = _import "Word64_lshift" private inline : Word64.t * Word32.t -> Word64.t; +val move = _import "Word64_move" private inline : (Word64.t) ref * (Word64.t) ref -> unit; +val neg = _import "Word64_neg" private inline : Word64.t -> Word64.t; +val notb = _import "Word64_notb" private inline : Word64.t -> Word64.t; +val orb = _import "Word64_orb" private inline : Word64.t * Word64.t -> Word64.t; +val rol = _import "Word64_rol" private inline : Word64.t * Word32.t -> Word64.t; +val ror = _import "Word64_ror" private inline : Word64.t * Word32.t -> Word64.t; +val store = _import "Word64_store" private inline : (Word64.t) ref * Word64.t -> unit; +val sub = _import "Word64_sub" private inline : Word64.t * Word64.t -> Word64.t; +val xorb = _import "Word64_xorb" private inline : Word64.t * Word64.t -> Word64.t; end structure Word8 = struct type t = Word8.t -val add = _import "Word8_add" private : Word8.t * Word8.t -> Word8.t; -val andb = _import "Word8_andb" private : Word8.t * Word8.t -> Word8.t; -val equal = _import "Word8_equal" private : Word8.t * Word8.t -> Bool.t; -val lshift = _import "Word8_lshift" private : Word8.t * Word32.t -> Word8.t; -val neg = _import "Word8_neg" private : Word8.t -> Word8.t; -val notb = _import "Word8_notb" private : Word8.t -> Word8.t; -val orb = _import "Word8_orb" private : Word8.t * Word8.t -> Word8.t; -val rol = _import "Word8_rol" private : Word8.t * Word32.t -> Word8.t; -val ror = _import "Word8_ror" private : Word8.t * Word32.t -> Word8.t; -val sub = _import "Word8_sub" private : Word8.t * Word8.t -> Word8.t; -val xorb = _import "Word8_xorb" private : Word8.t * Word8.t -> Word8.t; +val add = _import "Word8_add" private inline : Word8.t * Word8.t -> Word8.t; +val andb = _import "Word8_andb" private inline : Word8.t * Word8.t -> Word8.t; +val equal = _import "Word8_equal" private inline : Word8.t * Word8.t -> Bool.t; +val lshift = _import "Word8_lshift" private inline : Word8.t * Word32.t -> Word8.t; +val neg = _import "Word8_neg" private inline : Word8.t -> Word8.t; +val notb = _import "Word8_notb" private inline : Word8.t -> Word8.t; +val orb = _import "Word8_orb" private inline : Word8.t * Word8.t -> Word8.t; +val rol = _import "Word8_rol" private inline : Word8.t * Word32.t -> Word8.t; +val ror = _import "Word8_ror" private inline : Word8.t * Word32.t -> Word8.t; +val sub = _import "Word8_sub" private inline : Word8.t * Word8.t -> Word8.t; +val xorb = _import "Word8_xorb" private inline : Word8.t * Word8.t -> Word8.t; end structure WordS16 = struct -val addCheckP = _import "WordS16_addCheckP" private : Int16.t * Int16.t -> Bool.t; -val extdToWord16 = _import "WordS16_extdToWord16" private : Int16.t -> Word16.t; -val extdToWord32 = _import "WordS16_extdToWord32" private : Int16.t -> Word32.t; -val extdToWord64 = _import "WordS16_extdToWord64" private : Int16.t -> Word64.t; -val extdToWord8 = _import "WordS16_extdToWord8" private : Int16.t -> Word8.t; -val ge = _import "WordS16_ge" private : Int16.t * Int16.t -> Bool.t; -val gt = _import "WordS16_gt" private : Int16.t * Int16.t -> Bool.t; -val le = _import "WordS16_le" private : Int16.t * Int16.t -> Bool.t; -val lt = _import "WordS16_lt" private : Int16.t * Int16.t -> Bool.t; -val mul = _import "WordS16_mul" private : Int16.t * Int16.t -> Int16.t; -val mulCheckP = _import "WordS16_mulCheckP" private : Int16.t * Int16.t -> Bool.t; -val negCheckP = _import "WordS16_negCheckP" private : Int16.t -> Bool.t; -val quot = _import "WordS16_quot" private : Int16.t * Int16.t -> Int16.t; -val rem = _import "WordS16_rem" private : Int16.t * Int16.t -> Int16.t; +val addCheckP = _import "WordS16_addCheckP" private inline : Int16.t * Int16.t -> Bool.t; +val extdToWord16 = _import "WordS16_extdToWord16" private inline : Int16.t -> Word16.t; +val extdToWord32 = _import "WordS16_extdToWord32" private inline : Int16.t -> Word32.t; +val extdToWord64 = _import "WordS16_extdToWord64" private inline : Int16.t -> Word64.t; +val extdToWord8 = _import "WordS16_extdToWord8" private inline : Int16.t -> Word8.t; +val ge = _import "WordS16_ge" private inline : Int16.t * Int16.t -> Bool.t; +val gt = _import "WordS16_gt" private inline : Int16.t * Int16.t -> Bool.t; +val le = _import "WordS16_le" private inline : Int16.t * Int16.t -> Bool.t; +val lt = _import "WordS16_lt" private inline : Int16.t * Int16.t -> Bool.t; +val mul = _import "WordS16_mul" private inline : Int16.t * Int16.t -> Int16.t; +val mulCheckP = _import "WordS16_mulCheckP" private inline : Int16.t * Int16.t -> Bool.t; +val negCheckP = _import "WordS16_negCheckP" private inline : Int16.t -> Bool.t; +val quot = _import "WordS16_quot" private inline : Int16.t * Int16.t -> Int16.t; +val rem = _import "WordS16_rem" private inline : Int16.t * Int16.t -> Int16.t; val rndToReal32 = _import "WordS16_rndToReal32" private : Int16.t -> Real32.t; val rndToReal64 = _import "WordS16_rndToReal64" private : Int16.t -> Real64.t; -val rshift = _import "WordS16_rshift" private : Int16.t * Word32.t -> Int16.t; -val subCheckP = _import "WordS16_subCheckP" private : Int16.t * Int16.t -> Bool.t; +val rshift = _import "WordS16_rshift" private inline : Int16.t * Word32.t -> Int16.t; +val subCheckP = _import "WordS16_subCheckP" private inline : Int16.t * Int16.t -> Bool.t; end structure WordS32 = struct -val addCheckP = _import "WordS32_addCheckP" private : Int32.t * Int32.t -> Bool.t; -val extdToWord16 = _import "WordS32_extdToWord16" private : Int32.t -> Word16.t; -val extdToWord32 = _import "WordS32_extdToWord32" private : Int32.t -> Word32.t; -val extdToWord64 = _import "WordS32_extdToWord64" private : Int32.t -> Word64.t; -val extdToWord8 = _import "WordS32_extdToWord8" private : Int32.t -> Word8.t; -val ge = _import "WordS32_ge" private : Int32.t * Int32.t -> Bool.t; -val gt = _import "WordS32_gt" private : Int32.t * Int32.t -> Bool.t; -val le = _import "WordS32_le" private : Int32.t * Int32.t -> Bool.t; -val lt = _import "WordS32_lt" private : Int32.t * Int32.t -> Bool.t; -val mul = _import "WordS32_mul" private : Int32.t * Int32.t -> Int32.t; -val mulCheckP = _import "WordS32_mulCheckP" private : Int32.t * Int32.t -> Bool.t; -val negCheckP = _import "WordS32_negCheckP" private : Int32.t -> Bool.t; -val quot = _import "WordS32_quot" private : Int32.t * Int32.t -> Int32.t; -val rem = _import "WordS32_rem" private : Int32.t * Int32.t -> Int32.t; +val addCheckP = _import "WordS32_addCheckP" private inline : Int32.t * Int32.t -> Bool.t; +val extdToWord16 = _import "WordS32_extdToWord16" private inline : Int32.t -> Word16.t; +val extdToWord32 = _import "WordS32_extdToWord32" private inline : Int32.t -> Word32.t; +val extdToWord64 = _import "WordS32_extdToWord64" private inline : Int32.t -> Word64.t; +val extdToWord8 = _import "WordS32_extdToWord8" private inline : Int32.t -> Word8.t; +val ge = _import "WordS32_ge" private inline : Int32.t * Int32.t -> Bool.t; +val gt = _import "WordS32_gt" private inline : Int32.t * Int32.t -> Bool.t; +val le = _import "WordS32_le" private inline : Int32.t * Int32.t -> Bool.t; +val lt = _import "WordS32_lt" private inline : Int32.t * Int32.t -> Bool.t; +val mul = _import "WordS32_mul" private inline : Int32.t * Int32.t -> Int32.t; +val mulCheckP = _import "WordS32_mulCheckP" private inline : Int32.t * Int32.t -> Bool.t; +val negCheckP = _import "WordS32_negCheckP" private inline : Int32.t -> Bool.t; +val quot = _import "WordS32_quot" private inline : Int32.t * Int32.t -> Int32.t; +val rem = _import "WordS32_rem" private inline : Int32.t * Int32.t -> Int32.t; val rndToReal32 = _import "WordS32_rndToReal32" private : Int32.t -> Real32.t; val rndToReal64 = _import "WordS32_rndToReal64" private : Int32.t -> Real64.t; -val rshift = _import "WordS32_rshift" private : Int32.t * Word32.t -> Int32.t; -val subCheckP = _import "WordS32_subCheckP" private : Int32.t * Int32.t -> Bool.t; +val rshift = _import "WordS32_rshift" private inline : Int32.t * Word32.t -> Int32.t; +val subCheckP = _import "WordS32_subCheckP" private inline : Int32.t * Int32.t -> Bool.t; end structure WordS64 = struct -val addCheckP = _import "WordS64_addCheckP" private : Int64.t * Int64.t -> Bool.t; -val extdToWord16 = _import "WordS64_extdToWord16" private : Int64.t -> Word16.t; -val extdToWord32 = _import "WordS64_extdToWord32" private : Int64.t -> Word32.t; -val extdToWord64 = _import "WordS64_extdToWord64" private : Int64.t -> Word64.t; -val extdToWord8 = _import "WordS64_extdToWord8" private : Int64.t -> Word8.t; -val ge = _import "WordS64_ge" private : Int64.t * Int64.t -> Bool.t; -val gt = _import "WordS64_gt" private : Int64.t * Int64.t -> Bool.t; -val le = _import "WordS64_le" private : Int64.t * Int64.t -> Bool.t; -val lt = _import "WordS64_lt" private : Int64.t * Int64.t -> Bool.t; -val mul = _import "WordS64_mul" private : Int64.t * Int64.t -> Int64.t; -val mulCheckP = _import "WordS64_mulCheckP" private : Int64.t * Int64.t -> Bool.t; -val negCheckP = _import "WordS64_negCheckP" private : Int64.t -> Bool.t; -val quot = _import "WordS64_quot" private : Int64.t * Int64.t -> Int64.t; -val rem = _import "WordS64_rem" private : Int64.t * Int64.t -> Int64.t; +val addCheckP = _import "WordS64_addCheckP" private inline : Int64.t * Int64.t -> Bool.t; +val extdToWord16 = _import "WordS64_extdToWord16" private inline : Int64.t -> Word16.t; +val extdToWord32 = _import "WordS64_extdToWord32" private inline : Int64.t -> Word32.t; +val extdToWord64 = _import "WordS64_extdToWord64" private inline : Int64.t -> Word64.t; +val extdToWord8 = _import "WordS64_extdToWord8" private inline : Int64.t -> Word8.t; +val ge = _import "WordS64_ge" private inline : Int64.t * Int64.t -> Bool.t; +val gt = _import "WordS64_gt" private inline : Int64.t * Int64.t -> Bool.t; +val le = _import "WordS64_le" private inline : Int64.t * Int64.t -> Bool.t; +val lt = _import "WordS64_lt" private inline : Int64.t * Int64.t -> Bool.t; +val mul = _import "WordS64_mul" private inline : Int64.t * Int64.t -> Int64.t; +val mulCheckP = _import "WordS64_mulCheckP" private inline : Int64.t * Int64.t -> Bool.t; +val negCheckP = _import "WordS64_negCheckP" private inline : Int64.t -> Bool.t; +val quot = _import "WordS64_quot" private inline : Int64.t * Int64.t -> Int64.t; +val rem = _import "WordS64_rem" private inline : Int64.t * Int64.t -> Int64.t; val rndToReal32 = _import "WordS64_rndToReal32" private : Int64.t -> Real32.t; val rndToReal64 = _import "WordS64_rndToReal64" private : Int64.t -> Real64.t; -val rshift = _import "WordS64_rshift" private : Int64.t * Word32.t -> Int64.t; -val subCheckP = _import "WordS64_subCheckP" private : Int64.t * Int64.t -> Bool.t; +val rshift = _import "WordS64_rshift" private inline : Int64.t * Word32.t -> Int64.t; +val subCheckP = _import "WordS64_subCheckP" private inline : Int64.t * Int64.t -> Bool.t; end structure WordS8 = struct -val addCheckP = _import "WordS8_addCheckP" private : Int8.t * Int8.t -> Bool.t; -val extdToWord16 = _import "WordS8_extdToWord16" private : Int8.t -> Word16.t; -val extdToWord32 = _import "WordS8_extdToWord32" private : Int8.t -> Word32.t; -val extdToWord64 = _import "WordS8_extdToWord64" private : Int8.t -> Word64.t; -val extdToWord8 = _import "WordS8_extdToWord8" private : Int8.t -> Word8.t; -val ge = _import "WordS8_ge" private : Int8.t * Int8.t -> Bool.t; -val gt = _import "WordS8_gt" private : Int8.t * Int8.t -> Bool.t; -val le = _import "WordS8_le" private : Int8.t * Int8.t -> Bool.t; -val lt = _import "WordS8_lt" private : Int8.t * Int8.t -> Bool.t; -val mul = _import "WordS8_mul" private : Int8.t * Int8.t -> Int8.t; -val mulCheckP = _import "WordS8_mulCheckP" private : Int8.t * Int8.t -> Bool.t; -val negCheckP = _import "WordS8_negCheckP" private : Int8.t -> Bool.t; -val quot = _import "WordS8_quot" private : Int8.t * Int8.t -> Int8.t; -val rem = _import "WordS8_rem" private : Int8.t * Int8.t -> Int8.t; +val addCheckP = _import "WordS8_addCheckP" private inline : Int8.t * Int8.t -> Bool.t; +val extdToWord16 = _import "WordS8_extdToWord16" private inline : Int8.t -> Word16.t; +val extdToWord32 = _import "WordS8_extdToWord32" private inline : Int8.t -> Word32.t; +val extdToWord64 = _import "WordS8_extdToWord64" private inline : Int8.t -> Word64.t; +val extdToWord8 = _import "WordS8_extdToWord8" private inline : Int8.t -> Word8.t; +val ge = _import "WordS8_ge" private inline : Int8.t * Int8.t -> Bool.t; +val gt = _import "WordS8_gt" private inline : Int8.t * Int8.t -> Bool.t; +val le = _import "WordS8_le" private inline : Int8.t * Int8.t -> Bool.t; +val lt = _import "WordS8_lt" private inline : Int8.t * Int8.t -> Bool.t; +val mul = _import "WordS8_mul" private inline : Int8.t * Int8.t -> Int8.t; +val mulCheckP = _import "WordS8_mulCheckP" private inline : Int8.t * Int8.t -> Bool.t; +val negCheckP = _import "WordS8_negCheckP" private inline : Int8.t -> Bool.t; +val quot = _import "WordS8_quot" private inline : Int8.t * Int8.t -> Int8.t; +val rem = _import "WordS8_rem" private inline : Int8.t * Int8.t -> Int8.t; val rndToReal32 = _import "WordS8_rndToReal32" private : Int8.t -> Real32.t; val rndToReal64 = _import "WordS8_rndToReal64" private : Int8.t -> Real64.t; -val rshift = _import "WordS8_rshift" private : Int8.t * Word32.t -> Int8.t; -val subCheckP = _import "WordS8_subCheckP" private : Int8.t * Int8.t -> Bool.t; +val rshift = _import "WordS8_rshift" private inline : Int8.t * Word32.t -> Int8.t; +val subCheckP = _import "WordS8_subCheckP" private inline : Int8.t * Int8.t -> Bool.t; end structure WordU16 = struct -val addCheckP = _import "WordU16_addCheckP" private : Word16.t * Word16.t -> Bool.t; -val extdToWord16 = _import "WordU16_extdToWord16" private : Word16.t -> Word16.t; -val extdToWord32 = _import "WordU16_extdToWord32" private : Word16.t -> Word32.t; -val extdToWord64 = _import "WordU16_extdToWord64" private : Word16.t -> Word64.t; -val extdToWord8 = _import "WordU16_extdToWord8" private : Word16.t -> Word8.t; -val ge = _import "WordU16_ge" private : Word16.t * Word16.t -> Bool.t; -val gt = _import "WordU16_gt" private : Word16.t * Word16.t -> Bool.t; -val le = _import "WordU16_le" private : Word16.t * Word16.t -> Bool.t; -val lt = _import "WordU16_lt" private : Word16.t * Word16.t -> Bool.t; -val mul = _import "WordU16_mul" private : Word16.t * Word16.t -> Word16.t; -val mulCheckP = _import "WordU16_mulCheckP" private : Word16.t * Word16.t -> Bool.t; -val negCheckP = _import "WordU16_negCheckP" private : Word16.t -> Bool.t; -val quot = _import "WordU16_quot" private : Word16.t * Word16.t -> Word16.t; -val rem = _import "WordU16_rem" private : Word16.t * Word16.t -> Word16.t; +val addCheckP = _import "WordU16_addCheckP" private inline : Word16.t * Word16.t -> Bool.t; +val extdToWord16 = _import "WordU16_extdToWord16" private inline : Word16.t -> Word16.t; +val extdToWord32 = _import "WordU16_extdToWord32" private inline : Word16.t -> Word32.t; +val extdToWord64 = _import "WordU16_extdToWord64" private inline : Word16.t -> Word64.t; +val extdToWord8 = _import "WordU16_extdToWord8" private inline : Word16.t -> Word8.t; +val ge = _import "WordU16_ge" private inline : Word16.t * Word16.t -> Bool.t; +val gt = _import "WordU16_gt" private inline : Word16.t * Word16.t -> Bool.t; +val le = _import "WordU16_le" private inline : Word16.t * Word16.t -> Bool.t; +val lt = _import "WordU16_lt" private inline : Word16.t * Word16.t -> Bool.t; +val mul = _import "WordU16_mul" private inline : Word16.t * Word16.t -> Word16.t; +val mulCheckP = _import "WordU16_mulCheckP" private inline : Word16.t * Word16.t -> Bool.t; +val negCheckP = _import "WordU16_negCheckP" private inline : Word16.t -> Bool.t; +val quot = _import "WordU16_quot" private inline : Word16.t * Word16.t -> Word16.t; +val rem = _import "WordU16_rem" private inline : Word16.t * Word16.t -> Word16.t; val rndToReal32 = _import "WordU16_rndToReal32" private : Word16.t -> Real32.t; val rndToReal64 = _import "WordU16_rndToReal64" private : Word16.t -> Real64.t; -val rshift = _import "WordU16_rshift" private : Word16.t * Word32.t -> Word16.t; -val subCheckP = _import "WordU16_subCheckP" private : Word16.t * Word16.t -> Bool.t; +val rshift = _import "WordU16_rshift" private inline : Word16.t * Word32.t -> Word16.t; +val subCheckP = _import "WordU16_subCheckP" private inline : Word16.t * Word16.t -> Bool.t; end structure WordU32 = struct -val addCheckP = _import "WordU32_addCheckP" private : Word32.t * Word32.t -> Bool.t; -val extdToWord16 = _import "WordU32_extdToWord16" private : Word32.t -> Word16.t; -val extdToWord32 = _import "WordU32_extdToWord32" private : Word32.t -> Word32.t; -val extdToWord64 = _import "WordU32_extdToWord64" private : Word32.t -> Word64.t; -val extdToWord8 = _import "WordU32_extdToWord8" private : Word32.t -> Word8.t; -val ge = _import "WordU32_ge" private : Word32.t * Word32.t -> Bool.t; -val gt = _import "WordU32_gt" private : Word32.t * Word32.t -> Bool.t; -val le = _import "WordU32_le" private : Word32.t * Word32.t -> Bool.t; -val lt = _import "WordU32_lt" private : Word32.t * Word32.t -> Bool.t; -val mul = _import "WordU32_mul" private : Word32.t * Word32.t -> Word32.t; -val mulCheckP = _import "WordU32_mulCheckP" private : Word32.t * Word32.t -> Bool.t; -val negCheckP = _import "WordU32_negCheckP" private : Word32.t -> Bool.t; -val quot = _import "WordU32_quot" private : Word32.t * Word32.t -> Word32.t; -val rem = _import "WordU32_rem" private : Word32.t * Word32.t -> Word32.t; +val addCheckP = _import "WordU32_addCheckP" private inline : Word32.t * Word32.t -> Bool.t; +val extdToWord16 = _import "WordU32_extdToWord16" private inline : Word32.t -> Word16.t; +val extdToWord32 = _import "WordU32_extdToWord32" private inline : Word32.t -> Word32.t; +val extdToWord64 = _import "WordU32_extdToWord64" private inline : Word32.t -> Word64.t; +val extdToWord8 = _import "WordU32_extdToWord8" private inline : Word32.t -> Word8.t; +val ge = _import "WordU32_ge" private inline : Word32.t * Word32.t -> Bool.t; +val gt = _import "WordU32_gt" private inline : Word32.t * Word32.t -> Bool.t; +val le = _import "WordU32_le" private inline : Word32.t * Word32.t -> Bool.t; +val lt = _import "WordU32_lt" private inline : Word32.t * Word32.t -> Bool.t; +val mul = _import "WordU32_mul" private inline : Word32.t * Word32.t -> Word32.t; +val mulCheckP = _import "WordU32_mulCheckP" private inline : Word32.t * Word32.t -> Bool.t; +val negCheckP = _import "WordU32_negCheckP" private inline : Word32.t -> Bool.t; +val quot = _import "WordU32_quot" private inline : Word32.t * Word32.t -> Word32.t; +val rem = _import "WordU32_rem" private inline : Word32.t * Word32.t -> Word32.t; val rndToReal32 = _import "WordU32_rndToReal32" private : Word32.t -> Real32.t; val rndToReal64 = _import "WordU32_rndToReal64" private : Word32.t -> Real64.t; -val rshift = _import "WordU32_rshift" private : Word32.t * Word32.t -> Word32.t; -val subCheckP = _import "WordU32_subCheckP" private : Word32.t * Word32.t -> Bool.t; +val rshift = _import "WordU32_rshift" private inline : Word32.t * Word32.t -> Word32.t; +val subCheckP = _import "WordU32_subCheckP" private inline : Word32.t * Word32.t -> Bool.t; end structure WordU64 = struct -val addCheckP = _import "WordU64_addCheckP" private : Word64.t * Word64.t -> Bool.t; -val extdToWord16 = _import "WordU64_extdToWord16" private : Word64.t -> Word16.t; -val extdToWord32 = _import "WordU64_extdToWord32" private : Word64.t -> Word32.t; -val extdToWord64 = _import "WordU64_extdToWord64" private : Word64.t -> Word64.t; -val extdToWord8 = _import "WordU64_extdToWord8" private : Word64.t -> Word8.t; -val ge = _import "WordU64_ge" private : Word64.t * Word64.t -> Bool.t; -val gt = _import "WordU64_gt" private : Word64.t * Word64.t -> Bool.t; -val le = _import "WordU64_le" private : Word64.t * Word64.t -> Bool.t; -val lt = _import "WordU64_lt" private : Word64.t * Word64.t -> Bool.t; -val mul = _import "WordU64_mul" private : Word64.t * Word64.t -> Word64.t; -val mulCheckP = _import "WordU64_mulCheckP" private : Word64.t * Word64.t -> Bool.t; -val negCheckP = _import "WordU64_negCheckP" private : Word64.t -> Bool.t; -val quot = _import "WordU64_quot" private : Word64.t * Word64.t -> Word64.t; -val rem = _import "WordU64_rem" private : Word64.t * Word64.t -> Word64.t; +val addCheckP = _import "WordU64_addCheckP" private inline : Word64.t * Word64.t -> Bool.t; +val extdToWord16 = _import "WordU64_extdToWord16" private inline : Word64.t -> Word16.t; +val extdToWord32 = _import "WordU64_extdToWord32" private inline : Word64.t -> Word32.t; +val extdToWord64 = _import "WordU64_extdToWord64" private inline : Word64.t -> Word64.t; +val extdToWord8 = _import "WordU64_extdToWord8" private inline : Word64.t -> Word8.t; +val ge = _import "WordU64_ge" private inline : Word64.t * Word64.t -> Bool.t; +val gt = _import "WordU64_gt" private inline : Word64.t * Word64.t -> Bool.t; +val le = _import "WordU64_le" private inline : Word64.t * Word64.t -> Bool.t; +val lt = _import "WordU64_lt" private inline : Word64.t * Word64.t -> Bool.t; +val mul = _import "WordU64_mul" private inline : Word64.t * Word64.t -> Word64.t; +val mulCheckP = _import "WordU64_mulCheckP" private inline : Word64.t * Word64.t -> Bool.t; +val negCheckP = _import "WordU64_negCheckP" private inline : Word64.t -> Bool.t; +val quot = _import "WordU64_quot" private inline : Word64.t * Word64.t -> Word64.t; +val rem = _import "WordU64_rem" private inline : Word64.t * Word64.t -> Word64.t; val rndToReal32 = _import "WordU64_rndToReal32" private : Word64.t -> Real32.t; val rndToReal64 = _import "WordU64_rndToReal64" private : Word64.t -> Real64.t; -val rshift = _import "WordU64_rshift" private : Word64.t * Word32.t -> Word64.t; -val subCheckP = _import "WordU64_subCheckP" private : Word64.t * Word64.t -> Bool.t; +val rshift = _import "WordU64_rshift" private inline : Word64.t * Word32.t -> Word64.t; +val subCheckP = _import "WordU64_subCheckP" private inline : Word64.t * Word64.t -> Bool.t; end structure WordU8 = struct -val addCheckP = _import "WordU8_addCheckP" private : Word8.t * Word8.t -> Bool.t; -val extdToWord16 = _import "WordU8_extdToWord16" private : Word8.t -> Word16.t; -val extdToWord32 = _import "WordU8_extdToWord32" private : Word8.t -> Word32.t; -val extdToWord64 = _import "WordU8_extdToWord64" private : Word8.t -> Word64.t; -val extdToWord8 = _import "WordU8_extdToWord8" private : Word8.t -> Word8.t; -val ge = _import "WordU8_ge" private : Word8.t * Word8.t -> Bool.t; -val gt = _import "WordU8_gt" private : Word8.t * Word8.t -> Bool.t; -val le = _import "WordU8_le" private : Word8.t * Word8.t -> Bool.t; -val lt = _import "WordU8_lt" private : Word8.t * Word8.t -> Bool.t; -val mul = _import "WordU8_mul" private : Word8.t * Word8.t -> Word8.t; -val mulCheckP = _import "WordU8_mulCheckP" private : Word8.t * Word8.t -> Bool.t; -val negCheckP = _import "WordU8_negCheckP" private : Word8.t -> Bool.t; -val quot = _import "WordU8_quot" private : Word8.t * Word8.t -> Word8.t; -val rem = _import "WordU8_rem" private : Word8.t * Word8.t -> Word8.t; +val addCheckP = _import "WordU8_addCheckP" private inline : Word8.t * Word8.t -> Bool.t; +val extdToWord16 = _import "WordU8_extdToWord16" private inline : Word8.t -> Word16.t; +val extdToWord32 = _import "WordU8_extdToWord32" private inline : Word8.t -> Word32.t; +val extdToWord64 = _import "WordU8_extdToWord64" private inline : Word8.t -> Word64.t; +val extdToWord8 = _import "WordU8_extdToWord8" private inline : Word8.t -> Word8.t; +val ge = _import "WordU8_ge" private inline : Word8.t * Word8.t -> Bool.t; +val gt = _import "WordU8_gt" private inline : Word8.t * Word8.t -> Bool.t; +val le = _import "WordU8_le" private inline : Word8.t * Word8.t -> Bool.t; +val lt = _import "WordU8_lt" private inline : Word8.t * Word8.t -> Bool.t; +val mul = _import "WordU8_mul" private inline : Word8.t * Word8.t -> Word8.t; +val mulCheckP = _import "WordU8_mulCheckP" private inline : Word8.t * Word8.t -> Bool.t; +val negCheckP = _import "WordU8_negCheckP" private inline : Word8.t -> Bool.t; +val quot = _import "WordU8_quot" private inline : Word8.t * Word8.t -> Word8.t; +val rem = _import "WordU8_rem" private inline : Word8.t * Word8.t -> Word8.t; val rndToReal32 = _import "WordU8_rndToReal32" private : Word8.t -> Real32.t; val rndToReal64 = _import "WordU8_rndToReal64" private : Word8.t -> Real64.t; -val rshift = _import "WordU8_rshift" private : Word8.t * Word32.t -> Word8.t; -val subCheckP = _import "WordU8_subCheckP" private : Word8.t * Word8.t -> Bool.t; +val rshift = _import "WordU8_rshift" private inline : Word8.t * Word32.t -> Word8.t; +val subCheckP = _import "WordU8_subCheckP" private inline : Word8.t * Word8.t -> Bool.t; end end end diff --git a/basis-library/primitive/prim-real.sml b/basis-library/primitive/prim-real.sml index 4e19b1b421..79f57330b4 100644 --- a/basis-library/primitive/prim-real.sml +++ b/basis-library/primitive/prim-real.sml @@ -1,4 +1,4 @@ -(* Copyright (C) 2012,2013 Matthew Fluet. +(* Copyright (C) 2012,2013,2019 Matthew Fluet. * Copyright (C) 1999-2007 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * Copyright (C) 1997-2000 NEC Research Institute. @@ -103,6 +103,7 @@ open Primitive structure Real32 : PRIM_REAL = struct + open PrimitiveFFI.Real32 open Real32 val realSize : Int32.int = 32 @@ -113,24 +114,21 @@ structure Real32 : PRIM_REAL = structure Math = struct type real = real + open Math val acos = _prim "Real32_Math_acos": real -> real; val asin = _prim "Real32_Math_asin": real -> real; val atan = _prim "Real32_Math_atan": real -> real; val atan2 = _prim "Real32_Math_atan2": real * real -> real; val cos = _prim "Real32_Math_cos": real -> real; - val cosh = _import "Real32_Math_cosh" private: real -> real; - val e = #1 _symbol "Real32_Math_e" private: real GetSet.t; () + val e = eGet () val exp = _prim "Real32_Math_exp": real -> real; val ln = _prim "Real32_Math_ln": real -> real; val log10 = _prim "Real32_Math_log10": real -> real; - val pi = #1 _symbol "Real32_Math_pi" private: real GetSet.t; () - val pow = _import "Real32_Math_pow" private: real * real -> real; + val pi = piGet () val sin = _prim "Real32_Math_sin": real -> real; - val sinh = _import "Real32_Math_sinh" private: real -> real; val sqrt = _prim "Real32_Math_sqrt": real -> real; val tan = _prim "Real32_Math_tan": real -> real; - val tanh = _import "Real32_Math_tanh" private: real -> real; end val * = _prim "Real32_mul": real * real -> real; @@ -145,15 +143,8 @@ structure Real32 : PRIM_REAL = val == = _prim "Real32_equal": real * real -> bool; val ?= = _prim "Real32_qequal": real * real -> bool; val abs = _prim "Real32_abs": real -> real; - val frexp = _import "Real32_frexp" private: real * C_Int.t ref -> real; - val gdtoa = _import "Real32_gdtoa" private: real * C_Int.t * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t; val ldexp = _prim "Real32_ldexp": real * C_Int.t -> real; - val modf = _import "Real32_modf" private: real * real ref -> real; val round = _prim "Real32_round": real -> real; - val realCeil = _import "Real32_realCeil" private: real -> real; - val realFloor = _import "Real32_realFloor" private: real -> real; - val realTrunc = _import "Real32_realTrunc" private: real -> real; - val strtor = _import "Real32_strtor" private: NullString8.t * C_Int.t -> real; val fromInt8Unsafe = _prim "WordS8_rndToReal32": Int8.int -> real; val fromInt16Unsafe = _prim "WordS16_rndToReal32": Int16.int -> real; @@ -193,6 +184,7 @@ structure Real32 = structure Real64 : PRIM_REAL = struct + open PrimitiveFFI.Real64 open Real64 val realSize : Int32.int = 64 @@ -203,24 +195,21 @@ structure Real64 : PRIM_REAL = structure Math = struct type real = real + open Math val acos = _prim "Real64_Math_acos": real -> real; val asin = _prim "Real64_Math_asin": real -> real; val atan = _prim "Real64_Math_atan": real -> real; val atan2 = _prim "Real64_Math_atan2": real * real -> real; val cos = _prim "Real64_Math_cos": real -> real; - val cosh = _import "Real64_Math_cosh" private: real -> real; - val e = #1 _symbol "Real64_Math_e" private: real GetSet.t; () + val e = eGet () val exp = _prim "Real64_Math_exp": real -> real; val ln = _prim "Real64_Math_ln": real -> real; val log10 = _prim "Real64_Math_log10": real -> real; - val pi = #1 _symbol "Real64_Math_pi" private: real GetSet.t; () - val pow = _import "Real64_Math_pow" private: real * real -> real; + val pi = piGet () val sin = _prim "Real64_Math_sin": real -> real; - val sinh = _import "Real64_Math_sinh" private: real -> real; val sqrt = _prim "Real64_Math_sqrt": real -> real; val tan = _prim "Real64_Math_tan": real -> real; - val tanh = _import "Real64_Math_tanh" private: real -> real; end val * = _prim "Real64_mul": real * real -> real; @@ -235,15 +224,8 @@ structure Real64 : PRIM_REAL = val == = _prim "Real64_equal": real * real -> bool; val ?= = _prim "Real64_qequal": real * real -> bool; val abs = _prim "Real64_abs": real -> real; - val frexp = _import "Real64_frexp" private: real * C_Int.t ref -> real; - val gdtoa = _import "Real64_gdtoa" private: real * C_Int.t * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t; val ldexp = _prim "Real64_ldexp": real * C_Int.t -> real; - val modf = _import "Real64_modf" private: real * real ref -> real; val round = _prim "Real64_round": real -> real; - val realCeil = _import "Real64_realCeil" private: real -> real; - val realFloor = _import "Real64_realFloor" private: real -> real; - val realTrunc = _import "Real64_realTrunc" private: real -> real; - val strtor = _import "Real64_strtor" private: NullString8.t * C_Int.t -> real; val fromInt8Unsafe = _prim "WordS8_rndToReal64": Int8.int -> real; val fromInt16Unsafe = _prim "WordS16_rndToReal64": Int16.int -> real; diff --git a/basis-library/primitive/primitive.mlb b/basis-library/primitive/primitive.mlb index 28eb226cac..7d041f1eff 100644 --- a/basis-library/primitive/primitive.mlb +++ b/basis-library/primitive/primitive.mlb @@ -1,4 +1,4 @@ -(* Copyright (C) 2016-2017 Matthew Fluet. +(* Copyright (C) 2016-2017,2019 Matthew Fluet. * Copyright (C) 2004-2007 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * @@ -59,6 +59,10 @@ in prim-seq.sml prim-nullstring.sml + prim-mlton.sml + + basis-ffi.sml + prim-int-inf.sml prim-char.sml @@ -69,9 +73,6 @@ in prim-pack-word.sml prim-pack-real.sml - prim-mlton.sml - - basis-ffi.sml prim2.sml (* Check compatibility between primitives and runtime functions. *) diff --git a/include/c-chunk.h b/include/c-chunk.h index e1b605e81b..fb3d75e790 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -41,8 +41,8 @@ /* Primitives */ /* ------------------------------------------------- */ -#ifndef MLTON_CODEGEN_STATIC_INLINE -#define MLTON_CODEGEN_STATIC_INLINE static inline +#ifndef INLINE +#define INLINE inline #endif #include "basis/coerce.h" #include "basis/cpointer.h" diff --git a/runtime/basis-ffi.h b/runtime/basis-ffi.h index 9fdeb6bd9f..ac83e54492 100644 --- a/runtime/basis-ffi.h +++ b/runtime/basis-ffi.h @@ -749,108 +749,108 @@ PRIVATE extern const C_Int_t Posix_TTY_V_VSTART; PRIVATE extern const C_Int_t Posix_TTY_V_VSTOP; PRIVATE extern const C_Int_t Posix_TTY_V_VSUSP; PRIVATE extern const C_Int_t Posix_TTY_V_VTIME; -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_abs(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_add(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Real32_castToWord32(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_div(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Real32_equal(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_fetch(Ref(Real32_t)); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_frexp(Real32_t,Ref(C_Int_t)); +PRIVATE INLINE Real32_t Real32_abs(Real32_t); +PRIVATE INLINE Real32_t Real32_add(Real32_t,Real32_t); +PRIVATE INLINE Word32_t Real32_castToWord32(Real32_t); +PRIVATE INLINE Real32_t Real32_div(Real32_t,Real32_t); +PRIVATE INLINE Bool_t Real32_equal(Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_fetch(Ref(Real32_t)); +PRIVATE INLINE Real32_t Real32_frexp(Real32_t,Ref(C_Int_t)); PRIVATE C_String_t Real32_gdtoa(Real32_t,C_Int_t,C_Int_t,C_Int_t,Ref(C_Int_t)); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_ldexp(Real32_t,C_Int_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Real32_le(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Real32_lt(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_acos(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_asin(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_atan(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_atan2(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_cos(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_cosh(Real32_t); +PRIVATE INLINE Real32_t Real32_ldexp(Real32_t,C_Int_t); +PRIVATE INLINE Bool_t Real32_le(Real32_t,Real32_t); +PRIVATE INLINE Bool_t Real32_lt(Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_Math_acos(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_asin(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_atan(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_atan2(Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_Math_cos(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_cosh(Real32_t); PRIVATE extern Real32_t Real32_Math_e; -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_exp(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_ln(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_log10(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_exp(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_ln(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_log10(Real32_t); PRIVATE extern Real32_t Real32_Math_pi; -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_pow(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_sin(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_sinh(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_sqrt(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_tan(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_tanh(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_modf(Real32_t,Ref(Real32_t)); -MLTON_CODEGEN_STATIC_INLINE void Real32_move(Ref(Real32_t),Ref(Real32_t)); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_mul(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_muladd(Real32_t,Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_mulsub(Real32_t,Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_neg(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_realCeil(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_realFloor(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_realTrunc(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_rndToReal32(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real32_rndToReal64(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Int16_t Real32_rndToWordS16(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Int32_t Real32_rndToWordS32(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Int64_t Real32_rndToWordS64(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Int8_t Real32_rndToWordS8(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Real32_rndToWordU16(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Real32_rndToWordU32(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Real32_rndToWordU64(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Real32_rndToWordU8(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_round(Real32_t); -MLTON_CODEGEN_STATIC_INLINE void Real32_store(Ref(Real32_t),Real32_t); +PRIVATE INLINE Real32_t Real32_Math_pow(Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_Math_sin(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_sinh(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_sqrt(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_tan(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_tanh(Real32_t); +PRIVATE INLINE Real32_t Real32_modf(Real32_t,Ref(Real32_t)); +PRIVATE INLINE void Real32_move(Ref(Real32_t),Ref(Real32_t)); +PRIVATE INLINE Real32_t Real32_mul(Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_muladd(Real32_t,Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_mulsub(Real32_t,Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_neg(Real32_t); +PRIVATE INLINE Real32_t Real32_realCeil(Real32_t); +PRIVATE INLINE Real32_t Real32_realFloor(Real32_t); +PRIVATE INLINE Real32_t Real32_realTrunc(Real32_t); +PRIVATE INLINE Real32_t Real32_rndToReal32(Real32_t); +PRIVATE INLINE Real64_t Real32_rndToReal64(Real32_t); +PRIVATE INLINE Int16_t Real32_rndToWordS16(Real32_t); +PRIVATE INLINE Int32_t Real32_rndToWordS32(Real32_t); +PRIVATE INLINE Int64_t Real32_rndToWordS64(Real32_t); +PRIVATE INLINE Int8_t Real32_rndToWordS8(Real32_t); +PRIVATE INLINE Word16_t Real32_rndToWordU16(Real32_t); +PRIVATE INLINE Word32_t Real32_rndToWordU32(Real32_t); +PRIVATE INLINE Word64_t Real32_rndToWordU64(Real32_t); +PRIVATE INLINE Word8_t Real32_rndToWordU8(Real32_t); +PRIVATE INLINE Real32_t Real32_round(Real32_t); +PRIVATE INLINE void Real32_store(Ref(Real32_t),Real32_t); PRIVATE Real32_t Real32_strtor(NullString8_t,C_Int_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_sub(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_abs(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_add(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Real64_castToWord64(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_div(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Real64_equal(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_fetch(Ref(Real64_t)); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_frexp(Real64_t,Ref(C_Int_t)); +PRIVATE INLINE Real32_t Real32_sub(Real32_t,Real32_t); +PRIVATE INLINE Real64_t Real64_abs(Real64_t); +PRIVATE INLINE Real64_t Real64_add(Real64_t,Real64_t); +PRIVATE INLINE Word64_t Real64_castToWord64(Real64_t); +PRIVATE INLINE Real64_t Real64_div(Real64_t,Real64_t); +PRIVATE INLINE Bool_t Real64_equal(Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_fetch(Ref(Real64_t)); +PRIVATE INLINE Real64_t Real64_frexp(Real64_t,Ref(C_Int_t)); PRIVATE C_String_t Real64_gdtoa(Real64_t,C_Int_t,C_Int_t,C_Int_t,Ref(C_Int_t)); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_ldexp(Real64_t,C_Int_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Real64_le(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Real64_lt(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_acos(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_asin(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_atan(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_atan2(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_cos(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_cosh(Real64_t); +PRIVATE INLINE Real64_t Real64_ldexp(Real64_t,C_Int_t); +PRIVATE INLINE Bool_t Real64_le(Real64_t,Real64_t); +PRIVATE INLINE Bool_t Real64_lt(Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_Math_acos(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_asin(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_atan(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_atan2(Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_Math_cos(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_cosh(Real64_t); PRIVATE extern Real64_t Real64_Math_e; -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_exp(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_ln(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_log10(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_exp(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_ln(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_log10(Real64_t); PRIVATE extern Real64_t Real64_Math_pi; -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_pow(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_sin(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_sinh(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_sqrt(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_tan(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_tanh(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_modf(Real64_t,Ref(Real64_t)); -MLTON_CODEGEN_STATIC_INLINE void Real64_move(Ref(Real64_t),Ref(Real64_t)); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_mul(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_muladd(Real64_t,Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_mulsub(Real64_t,Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_neg(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_realCeil(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_realFloor(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_realTrunc(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real64_rndToReal32(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_rndToReal64(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Int16_t Real64_rndToWordS16(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Int32_t Real64_rndToWordS32(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Int64_t Real64_rndToWordS64(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Int8_t Real64_rndToWordS8(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Real64_rndToWordU16(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Real64_rndToWordU32(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Real64_rndToWordU64(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Real64_rndToWordU8(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_round(Real64_t); -MLTON_CODEGEN_STATIC_INLINE void Real64_store(Ref(Real64_t),Real64_t); +PRIVATE INLINE Real64_t Real64_Math_pow(Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_Math_sin(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_sinh(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_sqrt(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_tan(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_tanh(Real64_t); +PRIVATE INLINE Real64_t Real64_modf(Real64_t,Ref(Real64_t)); +PRIVATE INLINE void Real64_move(Ref(Real64_t),Ref(Real64_t)); +PRIVATE INLINE Real64_t Real64_mul(Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_muladd(Real64_t,Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_mulsub(Real64_t,Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_neg(Real64_t); +PRIVATE INLINE Real64_t Real64_realCeil(Real64_t); +PRIVATE INLINE Real64_t Real64_realFloor(Real64_t); +PRIVATE INLINE Real64_t Real64_realTrunc(Real64_t); +PRIVATE INLINE Real32_t Real64_rndToReal32(Real64_t); +PRIVATE INLINE Real64_t Real64_rndToReal64(Real64_t); +PRIVATE INLINE Int16_t Real64_rndToWordS16(Real64_t); +PRIVATE INLINE Int32_t Real64_rndToWordS32(Real64_t); +PRIVATE INLINE Int64_t Real64_rndToWordS64(Real64_t); +PRIVATE INLINE Int8_t Real64_rndToWordS8(Real64_t); +PRIVATE INLINE Word16_t Real64_rndToWordU16(Real64_t); +PRIVATE INLINE Word32_t Real64_rndToWordU32(Real64_t); +PRIVATE INLINE Word64_t Real64_rndToWordU64(Real64_t); +PRIVATE INLINE Word8_t Real64_rndToWordU8(Real64_t); +PRIVATE INLINE Real64_t Real64_round(Real64_t); +PRIVATE INLINE void Real64_store(Ref(Real64_t),Real64_t); PRIVATE Real64_t Real64_strtor(NullString8_t,C_Int_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_sub(Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_sub(Real64_t,Real64_t); PRIVATE C_Errno_t(C_Int_t) Socket_accept(C_Sock_t,Array(Word8_t),Ref(C_Socklen_t)); PRIVATE extern const C_Int_t Socket_AF_INET; PRIVATE extern const C_Int_t Socket_AF_INET6; @@ -933,197 +933,197 @@ PRIVATE C_Errno_t(C_PId_t) Windows_Process_create(NullString8_t,NullString8_t,Nu PRIVATE C_Errno_t(C_PId_t) Windows_Process_createNull(NullString8_t,NullString8_t,C_Fd_t,C_Fd_t,C_Fd_t); PRIVATE C_Errno_t(C_Int_t) Windows_Process_getexitcode(C_PId_t,Ref(C_Status_t)); PRIVATE C_Errno_t(C_Int_t) Windows_Process_terminate(C_PId_t,C_Signal_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_add(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_andb(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Word16_equal(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_lshift(Word16_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_neg(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_notb(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_orb(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_rol(Word16_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_ror(Word16_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_sub(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_xorb(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_add(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_andb(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Word32_castToReal32(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Word32_equal(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_lshift(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_neg(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_notb(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_orb(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_rol(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_ror(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_sub(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_xorb(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_add(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_andb(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Word64_castToReal64(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Word64_equal(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_fetch(Ref(Word64_t)); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_lshift(Word64_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE void Word64_move(Ref(Word64_t),Ref(Word64_t)); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_neg(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_notb(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_orb(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_rol(Word64_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_ror(Word64_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE void Word64_store(Ref(Word64_t),Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_sub(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_xorb(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_add(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_andb(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Word8_equal(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_lshift(Word8_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_neg(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_notb(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_orb(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_rol(Word8_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_ror(Word8_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_sub(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_xorb(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_addCheckP(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordS16_extdToWord16(Int16_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordS16_extdToWord32(Int16_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordS16_extdToWord64(Int16_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordS16_extdToWord8(Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_ge(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_gt(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_le(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_lt(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Int16_t WordS16_mul(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_mulCheckP(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_negCheckP(Int16_t); -MLTON_CODEGEN_STATIC_INLINE Int16_t WordS16_quot(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Int16_t WordS16_rem(Int16_t,Int16_t); +PRIVATE INLINE Word16_t Word16_add(Word16_t,Word16_t); +PRIVATE INLINE Word16_t Word16_andb(Word16_t,Word16_t); +PRIVATE INLINE Bool_t Word16_equal(Word16_t,Word16_t); +PRIVATE INLINE Word16_t Word16_lshift(Word16_t,Word32_t); +PRIVATE INLINE Word16_t Word16_neg(Word16_t); +PRIVATE INLINE Word16_t Word16_notb(Word16_t); +PRIVATE INLINE Word16_t Word16_orb(Word16_t,Word16_t); +PRIVATE INLINE Word16_t Word16_rol(Word16_t,Word32_t); +PRIVATE INLINE Word16_t Word16_ror(Word16_t,Word32_t); +PRIVATE INLINE Word16_t Word16_sub(Word16_t,Word16_t); +PRIVATE INLINE Word16_t Word16_xorb(Word16_t,Word16_t); +PRIVATE INLINE Word32_t Word32_add(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_andb(Word32_t,Word32_t); +PRIVATE INLINE Real32_t Word32_castToReal32(Word32_t); +PRIVATE INLINE Bool_t Word32_equal(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_lshift(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_neg(Word32_t); +PRIVATE INLINE Word32_t Word32_notb(Word32_t); +PRIVATE INLINE Word32_t Word32_orb(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_rol(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_ror(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_sub(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_xorb(Word32_t,Word32_t); +PRIVATE INLINE Word64_t Word64_add(Word64_t,Word64_t); +PRIVATE INLINE Word64_t Word64_andb(Word64_t,Word64_t); +PRIVATE INLINE Real64_t Word64_castToReal64(Word64_t); +PRIVATE INLINE Bool_t Word64_equal(Word64_t,Word64_t); +PRIVATE INLINE Word64_t Word64_fetch(Ref(Word64_t)); +PRIVATE INLINE Word64_t Word64_lshift(Word64_t,Word32_t); +PRIVATE INLINE void Word64_move(Ref(Word64_t),Ref(Word64_t)); +PRIVATE INLINE Word64_t Word64_neg(Word64_t); +PRIVATE INLINE Word64_t Word64_notb(Word64_t); +PRIVATE INLINE Word64_t Word64_orb(Word64_t,Word64_t); +PRIVATE INLINE Word64_t Word64_rol(Word64_t,Word32_t); +PRIVATE INLINE Word64_t Word64_ror(Word64_t,Word32_t); +PRIVATE INLINE void Word64_store(Ref(Word64_t),Word64_t); +PRIVATE INLINE Word64_t Word64_sub(Word64_t,Word64_t); +PRIVATE INLINE Word64_t Word64_xorb(Word64_t,Word64_t); +PRIVATE INLINE Word8_t Word8_add(Word8_t,Word8_t); +PRIVATE INLINE Word8_t Word8_andb(Word8_t,Word8_t); +PRIVATE INLINE Bool_t Word8_equal(Word8_t,Word8_t); +PRIVATE INLINE Word8_t Word8_lshift(Word8_t,Word32_t); +PRIVATE INLINE Word8_t Word8_neg(Word8_t); +PRIVATE INLINE Word8_t Word8_notb(Word8_t); +PRIVATE INLINE Word8_t Word8_orb(Word8_t,Word8_t); +PRIVATE INLINE Word8_t Word8_rol(Word8_t,Word32_t); +PRIVATE INLINE Word8_t Word8_ror(Word8_t,Word32_t); +PRIVATE INLINE Word8_t Word8_sub(Word8_t,Word8_t); +PRIVATE INLINE Word8_t Word8_xorb(Word8_t,Word8_t); +PRIVATE INLINE Bool_t WordS16_addCheckP(Int16_t,Int16_t); +PRIVATE INLINE Word16_t WordS16_extdToWord16(Int16_t); +PRIVATE INLINE Word32_t WordS16_extdToWord32(Int16_t); +PRIVATE INLINE Word64_t WordS16_extdToWord64(Int16_t); +PRIVATE INLINE Word8_t WordS16_extdToWord8(Int16_t); +PRIVATE INLINE Bool_t WordS16_ge(Int16_t,Int16_t); +PRIVATE INLINE Bool_t WordS16_gt(Int16_t,Int16_t); +PRIVATE INLINE Bool_t WordS16_le(Int16_t,Int16_t); +PRIVATE INLINE Bool_t WordS16_lt(Int16_t,Int16_t); +PRIVATE INLINE Int16_t WordS16_mul(Int16_t,Int16_t); +PRIVATE INLINE Bool_t WordS16_mulCheckP(Int16_t,Int16_t); +PRIVATE INLINE Bool_t WordS16_negCheckP(Int16_t); +PRIVATE INLINE Int16_t WordS16_quot(Int16_t,Int16_t); +PRIVATE INLINE Int16_t WordS16_rem(Int16_t,Int16_t); PRIVATE Real32_t WordS16_rndToReal32(Int16_t); PRIVATE Real64_t WordS16_rndToReal64(Int16_t); -MLTON_CODEGEN_STATIC_INLINE Int16_t WordS16_rshift(Int16_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_subCheckP(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_addCheckP(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordS32_extdToWord16(Int32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordS32_extdToWord32(Int32_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordS32_extdToWord64(Int32_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordS32_extdToWord8(Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_ge(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_gt(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_le(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_lt(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Int32_t WordS32_mul(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_mulCheckP(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_negCheckP(Int32_t); -MLTON_CODEGEN_STATIC_INLINE Int32_t WordS32_quot(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Int32_t WordS32_rem(Int32_t,Int32_t); +PRIVATE INLINE Int16_t WordS16_rshift(Int16_t,Word32_t); +PRIVATE INLINE Bool_t WordS16_subCheckP(Int16_t,Int16_t); +PRIVATE INLINE Bool_t WordS32_addCheckP(Int32_t,Int32_t); +PRIVATE INLINE Word16_t WordS32_extdToWord16(Int32_t); +PRIVATE INLINE Word32_t WordS32_extdToWord32(Int32_t); +PRIVATE INLINE Word64_t WordS32_extdToWord64(Int32_t); +PRIVATE INLINE Word8_t WordS32_extdToWord8(Int32_t); +PRIVATE INLINE Bool_t WordS32_ge(Int32_t,Int32_t); +PRIVATE INLINE Bool_t WordS32_gt(Int32_t,Int32_t); +PRIVATE INLINE Bool_t WordS32_le(Int32_t,Int32_t); +PRIVATE INLINE Bool_t WordS32_lt(Int32_t,Int32_t); +PRIVATE INLINE Int32_t WordS32_mul(Int32_t,Int32_t); +PRIVATE INLINE Bool_t WordS32_mulCheckP(Int32_t,Int32_t); +PRIVATE INLINE Bool_t WordS32_negCheckP(Int32_t); +PRIVATE INLINE Int32_t WordS32_quot(Int32_t,Int32_t); +PRIVATE INLINE Int32_t WordS32_rem(Int32_t,Int32_t); PRIVATE Real32_t WordS32_rndToReal32(Int32_t); PRIVATE Real64_t WordS32_rndToReal64(Int32_t); -MLTON_CODEGEN_STATIC_INLINE Int32_t WordS32_rshift(Int32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_subCheckP(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_addCheckP(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordS64_extdToWord16(Int64_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordS64_extdToWord32(Int64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordS64_extdToWord64(Int64_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordS64_extdToWord8(Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_ge(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_gt(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_le(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_lt(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Int64_t WordS64_mul(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_mulCheckP(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_negCheckP(Int64_t); -MLTON_CODEGEN_STATIC_INLINE Int64_t WordS64_quot(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Int64_t WordS64_rem(Int64_t,Int64_t); +PRIVATE INLINE Int32_t WordS32_rshift(Int32_t,Word32_t); +PRIVATE INLINE Bool_t WordS32_subCheckP(Int32_t,Int32_t); +PRIVATE INLINE Bool_t WordS64_addCheckP(Int64_t,Int64_t); +PRIVATE INLINE Word16_t WordS64_extdToWord16(Int64_t); +PRIVATE INLINE Word32_t WordS64_extdToWord32(Int64_t); +PRIVATE INLINE Word64_t WordS64_extdToWord64(Int64_t); +PRIVATE INLINE Word8_t WordS64_extdToWord8(Int64_t); +PRIVATE INLINE Bool_t WordS64_ge(Int64_t,Int64_t); +PRIVATE INLINE Bool_t WordS64_gt(Int64_t,Int64_t); +PRIVATE INLINE Bool_t WordS64_le(Int64_t,Int64_t); +PRIVATE INLINE Bool_t WordS64_lt(Int64_t,Int64_t); +PRIVATE INLINE Int64_t WordS64_mul(Int64_t,Int64_t); +PRIVATE INLINE Bool_t WordS64_mulCheckP(Int64_t,Int64_t); +PRIVATE INLINE Bool_t WordS64_negCheckP(Int64_t); +PRIVATE INLINE Int64_t WordS64_quot(Int64_t,Int64_t); +PRIVATE INLINE Int64_t WordS64_rem(Int64_t,Int64_t); PRIVATE Real32_t WordS64_rndToReal32(Int64_t); PRIVATE Real64_t WordS64_rndToReal64(Int64_t); -MLTON_CODEGEN_STATIC_INLINE Int64_t WordS64_rshift(Int64_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_subCheckP(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_addCheckP(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordS8_extdToWord16(Int8_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordS8_extdToWord32(Int8_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordS8_extdToWord64(Int8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordS8_extdToWord8(Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_ge(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_gt(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_le(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_lt(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Int8_t WordS8_mul(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_mulCheckP(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_negCheckP(Int8_t); -MLTON_CODEGEN_STATIC_INLINE Int8_t WordS8_quot(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Int8_t WordS8_rem(Int8_t,Int8_t); +PRIVATE INLINE Int64_t WordS64_rshift(Int64_t,Word32_t); +PRIVATE INLINE Bool_t WordS64_subCheckP(Int64_t,Int64_t); +PRIVATE INLINE Bool_t WordS8_addCheckP(Int8_t,Int8_t); +PRIVATE INLINE Word16_t WordS8_extdToWord16(Int8_t); +PRIVATE INLINE Word32_t WordS8_extdToWord32(Int8_t); +PRIVATE INLINE Word64_t WordS8_extdToWord64(Int8_t); +PRIVATE INLINE Word8_t WordS8_extdToWord8(Int8_t); +PRIVATE INLINE Bool_t WordS8_ge(Int8_t,Int8_t); +PRIVATE INLINE Bool_t WordS8_gt(Int8_t,Int8_t); +PRIVATE INLINE Bool_t WordS8_le(Int8_t,Int8_t); +PRIVATE INLINE Bool_t WordS8_lt(Int8_t,Int8_t); +PRIVATE INLINE Int8_t WordS8_mul(Int8_t,Int8_t); +PRIVATE INLINE Bool_t WordS8_mulCheckP(Int8_t,Int8_t); +PRIVATE INLINE Bool_t WordS8_negCheckP(Int8_t); +PRIVATE INLINE Int8_t WordS8_quot(Int8_t,Int8_t); +PRIVATE INLINE Int8_t WordS8_rem(Int8_t,Int8_t); PRIVATE Real32_t WordS8_rndToReal32(Int8_t); PRIVATE Real64_t WordS8_rndToReal64(Int8_t); -MLTON_CODEGEN_STATIC_INLINE Int8_t WordS8_rshift(Int8_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_subCheckP(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_addCheckP(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU16_extdToWord16(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU16_extdToWord32(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU16_extdToWord64(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU16_extdToWord8(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_ge(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_gt(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_le(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_lt(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU16_mul(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_mulCheckP(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_negCheckP(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU16_quot(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU16_rem(Word16_t,Word16_t); +PRIVATE INLINE Int8_t WordS8_rshift(Int8_t,Word32_t); +PRIVATE INLINE Bool_t WordS8_subCheckP(Int8_t,Int8_t); +PRIVATE INLINE Bool_t WordU16_addCheckP(Word16_t,Word16_t); +PRIVATE INLINE Word16_t WordU16_extdToWord16(Word16_t); +PRIVATE INLINE Word32_t WordU16_extdToWord32(Word16_t); +PRIVATE INLINE Word64_t WordU16_extdToWord64(Word16_t); +PRIVATE INLINE Word8_t WordU16_extdToWord8(Word16_t); +PRIVATE INLINE Bool_t WordU16_ge(Word16_t,Word16_t); +PRIVATE INLINE Bool_t WordU16_gt(Word16_t,Word16_t); +PRIVATE INLINE Bool_t WordU16_le(Word16_t,Word16_t); +PRIVATE INLINE Bool_t WordU16_lt(Word16_t,Word16_t); +PRIVATE INLINE Word16_t WordU16_mul(Word16_t,Word16_t); +PRIVATE INLINE Bool_t WordU16_mulCheckP(Word16_t,Word16_t); +PRIVATE INLINE Bool_t WordU16_negCheckP(Word16_t); +PRIVATE INLINE Word16_t WordU16_quot(Word16_t,Word16_t); +PRIVATE INLINE Word16_t WordU16_rem(Word16_t,Word16_t); PRIVATE Real32_t WordU16_rndToReal32(Word16_t); PRIVATE Real64_t WordU16_rndToReal64(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU16_rshift(Word16_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_subCheckP(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_addCheckP(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU32_extdToWord16(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU32_extdToWord32(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU32_extdToWord64(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU32_extdToWord8(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_ge(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_gt(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_le(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_lt(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU32_mul(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_mulCheckP(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_negCheckP(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU32_quot(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU32_rem(Word32_t,Word32_t); +PRIVATE INLINE Word16_t WordU16_rshift(Word16_t,Word32_t); +PRIVATE INLINE Bool_t WordU16_subCheckP(Word16_t,Word16_t); +PRIVATE INLINE Bool_t WordU32_addCheckP(Word32_t,Word32_t); +PRIVATE INLINE Word16_t WordU32_extdToWord16(Word32_t); +PRIVATE INLINE Word32_t WordU32_extdToWord32(Word32_t); +PRIVATE INLINE Word64_t WordU32_extdToWord64(Word32_t); +PRIVATE INLINE Word8_t WordU32_extdToWord8(Word32_t); +PRIVATE INLINE Bool_t WordU32_ge(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU32_gt(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU32_le(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU32_lt(Word32_t,Word32_t); +PRIVATE INLINE Word32_t WordU32_mul(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU32_mulCheckP(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU32_negCheckP(Word32_t); +PRIVATE INLINE Word32_t WordU32_quot(Word32_t,Word32_t); +PRIVATE INLINE Word32_t WordU32_rem(Word32_t,Word32_t); PRIVATE Real32_t WordU32_rndToReal32(Word32_t); PRIVATE Real64_t WordU32_rndToReal64(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU32_rshift(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_subCheckP(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_addCheckP(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU64_extdToWord16(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU64_extdToWord32(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU64_extdToWord64(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU64_extdToWord8(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_ge(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_gt(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_le(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_lt(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU64_mul(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_mulCheckP(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_negCheckP(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU64_quot(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU64_rem(Word64_t,Word64_t); +PRIVATE INLINE Word32_t WordU32_rshift(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU32_subCheckP(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU64_addCheckP(Word64_t,Word64_t); +PRIVATE INLINE Word16_t WordU64_extdToWord16(Word64_t); +PRIVATE INLINE Word32_t WordU64_extdToWord32(Word64_t); +PRIVATE INLINE Word64_t WordU64_extdToWord64(Word64_t); +PRIVATE INLINE Word8_t WordU64_extdToWord8(Word64_t); +PRIVATE INLINE Bool_t WordU64_ge(Word64_t,Word64_t); +PRIVATE INLINE Bool_t WordU64_gt(Word64_t,Word64_t); +PRIVATE INLINE Bool_t WordU64_le(Word64_t,Word64_t); +PRIVATE INLINE Bool_t WordU64_lt(Word64_t,Word64_t); +PRIVATE INLINE Word64_t WordU64_mul(Word64_t,Word64_t); +PRIVATE INLINE Bool_t WordU64_mulCheckP(Word64_t,Word64_t); +PRIVATE INLINE Bool_t WordU64_negCheckP(Word64_t); +PRIVATE INLINE Word64_t WordU64_quot(Word64_t,Word64_t); +PRIVATE INLINE Word64_t WordU64_rem(Word64_t,Word64_t); PRIVATE Real32_t WordU64_rndToReal32(Word64_t); PRIVATE Real64_t WordU64_rndToReal64(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU64_rshift(Word64_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_subCheckP(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_addCheckP(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU8_extdToWord16(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU8_extdToWord32(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU8_extdToWord64(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU8_extdToWord8(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_ge(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_gt(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_le(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_lt(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU8_mul(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_mulCheckP(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_negCheckP(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU8_quot(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU8_rem(Word8_t,Word8_t); +PRIVATE INLINE Word64_t WordU64_rshift(Word64_t,Word32_t); +PRIVATE INLINE Bool_t WordU64_subCheckP(Word64_t,Word64_t); +PRIVATE INLINE Bool_t WordU8_addCheckP(Word8_t,Word8_t); +PRIVATE INLINE Word16_t WordU8_extdToWord16(Word8_t); +PRIVATE INLINE Word32_t WordU8_extdToWord32(Word8_t); +PRIVATE INLINE Word64_t WordU8_extdToWord64(Word8_t); +PRIVATE INLINE Word8_t WordU8_extdToWord8(Word8_t); +PRIVATE INLINE Bool_t WordU8_ge(Word8_t,Word8_t); +PRIVATE INLINE Bool_t WordU8_gt(Word8_t,Word8_t); +PRIVATE INLINE Bool_t WordU8_le(Word8_t,Word8_t); +PRIVATE INLINE Bool_t WordU8_lt(Word8_t,Word8_t); +PRIVATE INLINE Word8_t WordU8_mul(Word8_t,Word8_t); +PRIVATE INLINE Bool_t WordU8_mulCheckP(Word8_t,Word8_t); +PRIVATE INLINE Bool_t WordU8_negCheckP(Word8_t); +PRIVATE INLINE Word8_t WordU8_quot(Word8_t,Word8_t); +PRIVATE INLINE Word8_t WordU8_rem(Word8_t,Word8_t); PRIVATE Real32_t WordU8_rndToReal32(Word8_t); PRIVATE Real64_t WordU8_rndToReal64(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU8_rshift(Word8_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_subCheckP(Word8_t,Word8_t); +PRIVATE INLINE Word8_t WordU8_rshift(Word8_t,Word32_t); +PRIVATE INLINE Bool_t WordU8_subCheckP(Word8_t,Word8_t); #endif /* _MLTON_BASIS_FFI_H_ */ diff --git a/runtime/basis/Real/Real-ops.h b/runtime/basis/Real/Real-ops.h index b6f78df7cb..867b6bc53b 100644 --- a/runtime/basis/Real/Real-ops.h +++ b/runtime/basis/Real/Real-ops.h @@ -2,7 +2,7 @@ #define FNSUF64 #define naryNameFnSufResArgsCall_(size, name, f, suf, rty, args, call) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ rty Real##size##_##name args { \ return f##suf call; \ } @@ -12,7 +12,7 @@ naryNameFnSufResArgsCall_(size, name, f, suf, rty, args, call) naryNameFnSufResArgsCall(size, name, f, FNSUF##size, rty, args, call) #define binaryOp(size, name, op) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Real##size##_t Real##size##_##name (Real##size##_t r1, Real##size##_t r2) { \ return r1 op r2; \ } @@ -27,13 +27,13 @@ binaryNameFn(size, f, f) binaryNameFn(size, Math_##f, f) #define compareNameFn(size, name, f) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Bool Real##size##_##name (Real##size##_t r1, Real##size##_t r2) { \ return f (r1, r2); \ } #define equal(size) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Bool Real##size##_equal (Real##size##_t r1, Real##size##_t r2) { \ return r1 == r2; \ } @@ -42,13 +42,13 @@ binaryNameFn(size, Math_##f, f) naryNameFnResArgsCall(size, name, fma, Real##size##_t, (Real##size##_t r1, Real##size##_t r2, Real##size##_t r3), (r1, r2, op r3)) #define qequal(size) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Bool Real##size##_qequal (Real##size##_t r1, Real##size##_t r2) { \ return isunordered (r1, r2) || r1 == r2; \ } #define unaryOp(size, name, op) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Real##size##_t Real##size##_##name (Real##size##_t r) { \ return op r; \ } @@ -63,18 +63,18 @@ unaryNameFn(size, f, f) unaryNameFn(size, Math_##f, f) #define misaligned(size) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Real##size##_t Real##size##_fetch (Ref(Real##size##_t) rp) { \ Real##size##_t r; \ memcpy(&r, rp, sizeof(Real##size##_t)); \ return r; \ } \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ void Real##size##_store (Ref(Real##size##_t) rp, Real##size##_t r) { \ memcpy(rp, &r, sizeof(Real##size##_t)); \ return; \ } \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ void Real##size##_move (Ref(Real##size##_t) dst, Ref(Real##size##_t) src) { \ memcpy(dst, src, sizeof(Real##size##_t)); \ return; \ diff --git a/runtime/basis/Word/Word-ops.h b/runtime/basis/Word/Word-ops.h index 1c73ead286..ee43ba4d56 100644 --- a/runtime/basis/Word/Word-ops.h +++ b/runtime/basis/Word/Word-ops.h @@ -1,5 +1,5 @@ #define binary(kind, name, op) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Word##kind Word##kind##_##name (Word##kind w1, Word##kind w2) { \ return w1 op w2; \ } @@ -13,7 +13,7 @@ binary (U##size, name, op) * and to encourage fusing with matching `Word_CheckP`. */ #define binaryOvflOp(kind, name) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Word##kind Word##kind##_##name (Word##kind w1, Word##kind w2) { \ Word##kind res; \ __builtin_##name##_overflow(w1, w2, &res); \ @@ -25,7 +25,7 @@ binaryOvflOp (S##size, name) \ binaryOvflOp (U##size, name) #define binaryOvflChk(kind, name) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Bool Word##kind##_##name##CheckP (Word##kind w1, Word##kind w2) { \ Word##kind res; \ return __builtin_##name##_overflow(w1, w2, &res); \ @@ -36,7 +36,7 @@ binaryOvflChk (S##size, name) \ binaryOvflChk (U##size, name) #define compare(kind, name, op) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Bool Word##kind##_##name (Word##kind w1, Word##kind w2) { \ return w1 op w2; \ } @@ -46,7 +46,7 @@ compare (S##size, name, op) \ compare (U##size, name, op) #define negOvflOp(kind) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Word##kind Word##kind##_neg (Word##kind w) { \ Word##kind res; \ __builtin_sub_overflow(0, w, &res); \ @@ -54,49 +54,49 @@ compare (U##size, name, op) } #define negOvflChk(kind) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Bool Word##kind##_negCheckP (Word##kind w) { \ Word##kind res; \ return __builtin_sub_overflow(0, w, &res); \ } #define rol(size) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Word##size Word##size##_rol (Word##size w1, Word32 w2) { \ return (Word##size)(w1 >> (size - w2)) | (Word##size)(w1 << w2); \ } #define ror(size) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Word##size Word##size##_ror (Word##size w1, Word32 w2) { \ return (Word##size)(w1 >> w2) | (Word##size)(w1 << (size - w2)); \ } \ #define shift(kind, name, op) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Word##kind Word##kind##_##name (Word##kind w1, Word32 w2) { \ return (Word##kind)(w1 op w2); \ } #define unary(kind, name, op) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Word##kind Word##kind##_##name (Word##kind w) { \ return (Word##kind)(op w); \ } #define misaligned(size) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ Word##size##_t Word##size##_fetch (Ref(Word##size##_t) wp) { \ Word##size##_t w; \ memcpy(&w, wp, sizeof(Word##size##_t)); \ return w; \ } \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ void Word##size##_store (Ref(Word##size##_t) wp, Word##size##_t w) { \ memcpy(wp, &w, sizeof(Word##size##_t)); \ return; \ } \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ void Word##size##_move (Ref(Word##size##_t) dst, Ref(Word##size##_t) src) { \ memcpy(dst, src, sizeof(Word##size##_t)); \ return; \ diff --git a/runtime/basis/coerce.h b/runtime/basis/coerce.h index 590da71ebb..1fdf53acf9 100644 --- a/runtime/basis/coerce.h +++ b/runtime/basis/coerce.h @@ -1,6 +1,5 @@ - #define coerce(n, f, t) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ t f##_##n##To##t (f x) { \ return (t)x; \ } @@ -36,7 +35,7 @@ coerce(rnd, Real64, Real64) #undef coerce #define cast(f, t) \ - MLTON_CODEGEN_STATIC_INLINE \ + PRIVATE INLINE \ t f##_castTo##t (f x) { \ t y; \ memcpy(&y, &x, sizeof(t)); \ diff --git a/runtime/basis/cpointer.h b/runtime/basis/cpointer.h index 23030ab7dc..d4577cccd1 100644 --- a/runtime/basis/cpointer.h +++ b/runtime/basis/cpointer.h @@ -1,44 +1,43 @@ - -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE Pointer CPointer_add (Pointer p, C_Size_t s); -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE C_Size_t CPointer_diff (Pointer p1, Pointer p2); -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE Bool CPointer_equal (Pointer p1, Pointer p2); -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE Pointer CPointer_fromWord (C_Pointer_t x); -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE Bool CPointer_lt (Pointer p1, Pointer p2); -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE Pointer CPointer_sub (Pointer p, C_Size_t s); -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE C_Pointer_t CPointer_toWord (Pointer p); -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE Pointer CPointer_add (Pointer p, C_Size_t s) { return (p + s); } -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE C_Size_t CPointer_diff (Pointer p1, Pointer p2) { return (size_t)(p1 - p2); } -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE Bool CPointer_equal (Pointer p1, Pointer p2) { return (p1 == p2); } -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE Pointer CPointer_fromWord (C_Pointer_t x) { return (Pointer)x; } -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE Bool CPointer_lt (Pointer p1, Pointer p2) { return (p1 < p2); } -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE Pointer CPointer_sub (Pointer p, C_Size_t s) { return (p - s); } -MLTON_CODEGEN_STATIC_INLINE +PRIVATE INLINE C_Pointer_t CPointer_toWord (Pointer p) { return (C_Pointer_t)p; } diff --git a/runtime/gen/basis-ffi.def b/runtime/gen/basis-ffi.def index 8cc646bf99..d709e15e14 100644 --- a/runtime/gen/basis-ffi.def +++ b/runtime/gen/basis-ffi.def @@ -1,44 +1,44 @@ CommandLine.argc = _symbol : C_Int.t CommandLine.argv = _symbol : C_StringArray.t CommandLine.commandName = _symbol : C_String.t -Cygwin.toFullWindowsPath = _import PRIVATE : NullString8.t -> C_String.t -Date.Tm.getHour = _import PRIVATE : unit -> C_Int.t -Date.Tm.getIsDst = _import PRIVATE : unit -> C_Int.t -Date.Tm.getMDay = _import PRIVATE : unit -> C_Int.t -Date.Tm.getMin = _import PRIVATE : unit -> C_Int.t -Date.Tm.getMon = _import PRIVATE : unit -> C_Int.t -Date.Tm.getSec = _import PRIVATE : unit -> C_Int.t -Date.Tm.getWDay = _import PRIVATE : unit -> C_Int.t -Date.Tm.getYDay = _import PRIVATE : unit -> C_Int.t -Date.Tm.getYear = _import PRIVATE : unit -> C_Int.t -Date.Tm.setHour = _import PRIVATE : C_Int.t -> unit -Date.Tm.setIsDst = _import PRIVATE : C_Int.t -> unit -Date.Tm.setMDay = _import PRIVATE : C_Int.t -> unit -Date.Tm.setMin = _import PRIVATE : C_Int.t -> unit -Date.Tm.setMon = _import PRIVATE : C_Int.t -> unit -Date.Tm.setSec = _import PRIVATE : C_Int.t -> unit -Date.Tm.setWDay = _import PRIVATE : C_Int.t -> unit -Date.Tm.setYDay = _import PRIVATE : C_Int.t -> unit -Date.Tm.setYear = _import PRIVATE : C_Int.t -> unit -Date.gmTime = _import PRIVATE : C_Time.t ref -> C_Int.t C_Errno.t -Date.localOffset = _import PRIVATE : unit -> C_Double.t -Date.localTime = _import PRIVATE : C_Time.t ref -> C_Int.t C_Errno.t -Date.mkTime = _import PRIVATE : unit -> C_Time.t C_Errno.t -Date.strfTime = _import PRIVATE : Char8.t array * C_Size.t * NullString8.t -> C_Size.t +Cygwin.toFullWindowsPath = _import : NullString8.t -> C_String.t +Date.Tm.getHour = _import : unit -> C_Int.t +Date.Tm.getIsDst = _import : unit -> C_Int.t +Date.Tm.getMDay = _import : unit -> C_Int.t +Date.Tm.getMin = _import : unit -> C_Int.t +Date.Tm.getMon = _import : unit -> C_Int.t +Date.Tm.getSec = _import : unit -> C_Int.t +Date.Tm.getWDay = _import : unit -> C_Int.t +Date.Tm.getYDay = _import : unit -> C_Int.t +Date.Tm.getYear = _import : unit -> C_Int.t +Date.Tm.setHour = _import : C_Int.t -> unit +Date.Tm.setIsDst = _import : C_Int.t -> unit +Date.Tm.setMDay = _import : C_Int.t -> unit +Date.Tm.setMin = _import : C_Int.t -> unit +Date.Tm.setMon = _import : C_Int.t -> unit +Date.Tm.setSec = _import : C_Int.t -> unit +Date.Tm.setWDay = _import : C_Int.t -> unit +Date.Tm.setYDay = _import : C_Int.t -> unit +Date.Tm.setYear = _import : C_Int.t -> unit +Date.gmTime = _import : C_Time.t ref -> C_Int.t C_Errno.t +Date.localOffset = _import : unit -> C_Double.t +Date.localTime = _import : C_Time.t ref -> C_Int.t C_Errno.t +Date.mkTime = _import : unit -> C_Time.t C_Errno.t +Date.strfTime = _import : Char8.t array * C_Size.t * NullString8.t -> C_Size.t IEEEReal.RoundingMode.FE_DOWNWARD = _const : C_Int.t IEEEReal.RoundingMode.FE_NOSUPPORT = _const : C_Int.t IEEEReal.RoundingMode.FE_TONEAREST = _const : C_Int.t IEEEReal.RoundingMode.FE_TOWARDZERO = _const : C_Int.t IEEEReal.RoundingMode.FE_UPWARD = _const : C_Int.t -IEEEReal.getRoundingMode = _import PRIVATE : unit -> C_Int.t -IEEEReal.setRoundingMode = _import PRIVATE : C_Int.t -> C_Int.t -MLton.bug = _import PRIVATE __attribute__((noreturn)) : String8.t -> unit +IEEEReal.getRoundingMode = _import : unit -> C_Int.t +IEEEReal.setRoundingMode = _import : C_Int.t -> C_Int.t +MLton.bug = _import __attribute__((noreturn)) : String8.t -> unit MLton.Itimer.PROF = _const : C_Int.t MLton.Itimer.REAL = _const : C_Int.t MLton.Itimer.VIRTUAL = _const : C_Int.t -MLton.Itimer.set = _import PRIVATE : C_Int.t * C_Time.t * C_SUSeconds.t * C_Time.t * C_SUSeconds.t -> C_Int.t C_Errno.t -MLton.Process.spawne = _import PRIVATE : NullString8.t * NullString8.t array * NullString8.t array -> C_PId.t C_Errno.t -MLton.Process.spawnp = _import PRIVATE : NullString8.t * NullString8.t array -> C_PId.t C_Errno.t +MLton.Itimer.set = _import : C_Int.t * C_Time.t * C_SUSeconds.t * C_Time.t * C_SUSeconds.t -> C_Int.t C_Errno.t +MLton.Process.spawne = _import : NullString8.t * NullString8.t array * NullString8.t array -> C_PId.t C_Errno.t +MLton.Process.spawnp = _import : NullString8.t * NullString8.t array -> C_PId.t C_Errno.t MLton.Rlimit.AS = _const : C_Int.t MLton.Rlimit.CORE = _const : C_Int.t MLton.Rlimit.CPU = _const : C_Int.t @@ -50,23 +50,23 @@ MLton.Rlimit.NOFILE = _const : C_Int.t MLton.Rlimit.NPROC = _const : C_Int.t MLton.Rlimit.RSS = _const : C_Int.t MLton.Rlimit.STACK = _const : C_Int.t -MLton.Rlimit.get = _import PRIVATE : C_Int.t -> C_Int.t C_Errno.t -MLton.Rlimit.getHard = _import PRIVATE : unit -> C_RLim.t -MLton.Rlimit.getSoft = _import PRIVATE : unit -> C_RLim.t -MLton.Rlimit.set = _import PRIVATE : C_Int.t * C_RLim.t * C_RLim.t -> C_Int.t C_Errno.t -MLton.Rusage.children_stime_sec = _import PRIVATE : unit -> C_Time.t -MLton.Rusage.children_stime_usec = _import PRIVATE : unit -> C_SUSeconds.t -MLton.Rusage.children_utime_sec = _import PRIVATE : unit -> C_Time.t -MLton.Rusage.children_utime_usec = _import PRIVATE : unit -> C_SUSeconds.t -MLton.Rusage.gc_stime_sec = _import PRIVATE : unit -> C_Time.t -MLton.Rusage.gc_stime_usec = _import PRIVATE : unit -> C_SUSeconds.t -MLton.Rusage.gc_utime_sec = _import PRIVATE : unit -> C_Time.t -MLton.Rusage.gc_utime_usec = _import PRIVATE : unit -> C_SUSeconds.t -MLton.Rusage.getrusage = _import PRIVATE : GCState.t -> unit -MLton.Rusage.self_stime_sec = _import PRIVATE : unit -> C_Time.t -MLton.Rusage.self_stime_usec = _import PRIVATE : unit -> C_SUSeconds.t -MLton.Rusage.self_utime_sec = _import PRIVATE : unit -> C_Time.t -MLton.Rusage.self_utime_usec = _import PRIVATE : unit -> C_SUSeconds.t +MLton.Rlimit.get = _import : C_Int.t -> C_Int.t C_Errno.t +MLton.Rlimit.getHard = _import : unit -> C_RLim.t +MLton.Rlimit.getSoft = _import : unit -> C_RLim.t +MLton.Rlimit.set = _import : C_Int.t * C_RLim.t * C_RLim.t -> C_Int.t C_Errno.t +MLton.Rusage.children_stime_sec = _import : unit -> C_Time.t +MLton.Rusage.children_stime_usec = _import : unit -> C_SUSeconds.t +MLton.Rusage.children_utime_sec = _import : unit -> C_Time.t +MLton.Rusage.children_utime_usec = _import : unit -> C_SUSeconds.t +MLton.Rusage.gc_stime_sec = _import : unit -> C_Time.t +MLton.Rusage.gc_stime_usec = _import : unit -> C_SUSeconds.t +MLton.Rusage.gc_utime_sec = _import : unit -> C_Time.t +MLton.Rusage.gc_utime_usec = _import : unit -> C_SUSeconds.t +MLton.Rusage.getrusage = _import : GCState.t -> unit +MLton.Rusage.self_stime_sec = _import : unit -> C_Time.t +MLton.Rusage.self_stime_usec = _import : unit -> C_SUSeconds.t +MLton.Rusage.self_utime_sec = _import : unit -> C_Time.t +MLton.Rusage.self_utime_usec = _import : unit -> C_SUSeconds.t MLton.Syslog.Facility.LOG_AUTH = _const : C_Int.t MLton.Syslog.Facility.LOG_CRON = _const : C_Int.t MLton.Syslog.Facility.LOG_DAEMON = _const : C_Int.t @@ -99,47 +99,47 @@ MLton.Syslog.Severity.LOG_ERR = _const : C_Int.t MLton.Syslog.Severity.LOG_INFO = _const : C_Int.t MLton.Syslog.Severity.LOG_NOTICE = _const : C_Int.t MLton.Syslog.Severity.LOG_WARNING = _const : C_Int.t -MLton.Syslog.closelog = _import PRIVATE : unit -> unit -MLton.Syslog.openlog = _import PRIVATE : NullString8.t * C_Int.t * C_Int.t -> unit -MLton.Syslog.syslog = _import PRIVATE : C_Int.t * NullString8.t -> unit -MinGW.getTempPath = _import PRIVATE : C_Size.t * Char8.t array -> C_Size.t -MinGW.setNonBlock = _import PRIVATE : C_Fd.t -> unit -MinGW.clearNonBlock = _import PRIVATE : C_Fd.t -> unit -Net.htonl = _import PRIVATE : Word32.t -> Word32.t -Net.htons = _import PRIVATE : Word16.t -> Word16.t -Net.ntohl = _import PRIVATE : Word32.t -> Word32.t -Net.ntohs = _import PRIVATE : Word16.t -> Word16.t +MLton.Syslog.closelog = _import : unit -> unit +MLton.Syslog.openlog = _import : NullString8.t * C_Int.t * C_Int.t -> unit +MLton.Syslog.syslog = _import : C_Int.t * NullString8.t -> unit +MinGW.getTempPath = _import : C_Size.t * Char8.t array -> C_Size.t +MinGW.setNonBlock = _import : C_Fd.t -> unit +MinGW.clearNonBlock = _import : C_Fd.t -> unit +Net.htonl = _import : Word32.t -> Word32.t +Net.htons = _import : Word16.t -> Word16.t +Net.ntohl = _import : Word32.t -> Word32.t +Net.ntohs = _import : Word16.t -> Word16.t NetHostDB.INADDR_ANY = _const : C_Int.t -NetHostDB.getByAddress = _import PRIVATE : Word8.t vector * C_Socklen.t -> C_Int.t -NetHostDB.getByName = _import PRIVATE : NullString8.t -> C_Int.t -NetHostDB.getEntryAddrType = _import PRIVATE : unit -> C_Int.t -NetHostDB.getEntryAddrsN = _import PRIVATE : C_Int.t * Word8.t array -> unit -NetHostDB.getEntryAddrsNum = _import PRIVATE : unit -> C_Int.t -NetHostDB.getEntryAliasesN = _import PRIVATE : C_Int.t -> C_String.t -NetHostDB.getEntryAliasesNum = _import PRIVATE : unit -> C_Int.t -NetHostDB.getEntryLength = _import PRIVATE : unit -> C_Int.t -NetHostDB.getEntryName = _import PRIVATE : unit -> C_String.t -NetHostDB.getHostName = _import PRIVATE : Char8.t array * C_Size.t -> C_Int.t C_Errno.t +NetHostDB.getByAddress = _import : Word8.t vector * C_Socklen.t -> C_Int.t +NetHostDB.getByName = _import : NullString8.t -> C_Int.t +NetHostDB.getEntryAddrType = _import : unit -> C_Int.t +NetHostDB.getEntryAddrsN = _import : C_Int.t * Word8.t array -> unit +NetHostDB.getEntryAddrsNum = _import : unit -> C_Int.t +NetHostDB.getEntryAliasesN = _import : C_Int.t -> C_String.t +NetHostDB.getEntryAliasesNum = _import : unit -> C_Int.t +NetHostDB.getEntryLength = _import : unit -> C_Int.t +NetHostDB.getEntryName = _import : unit -> C_String.t +NetHostDB.getHostName = _import : Char8.t array * C_Size.t -> C_Int.t C_Errno.t NetHostDB.inAddrSize = _const : C_Size.t -NetProtDB.getByName = _import PRIVATE : NullString8.t -> C_Int.t -NetProtDB.getByNumber = _import PRIVATE : C_Int.t -> C_Int.t -NetProtDB.getEntryAliasesN = _import PRIVATE : C_Int.t -> C_String.t -NetProtDB.getEntryAliasesNum = _import PRIVATE : unit -> C_Int.t -NetProtDB.getEntryName = _import PRIVATE : unit -> C_String.t -NetProtDB.getEntryProto = _import PRIVATE : unit -> C_Int.t -NetServDB.getByName = _import PRIVATE : NullString8.t * NullString8.t -> C_Int.t -NetServDB.getByNameNull = _import PRIVATE : NullString8.t -> C_Int.t -NetServDB.getByPort = _import PRIVATE : C_Int.t * NullString8.t -> C_Int.t -NetServDB.getByPortNull = _import PRIVATE : C_Int.t -> C_Int.t -NetServDB.getEntryAliasesN = _import PRIVATE : C_Int.t -> C_String.t -NetServDB.getEntryAliasesNum = _import PRIVATE : unit -> C_Int.t -NetServDB.getEntryName = _import PRIVATE : unit -> C_String.t -NetServDB.getEntryPort = _import PRIVATE : unit -> C_Int.t -NetServDB.getEntryProto = _import PRIVATE : unit -> C_String.t +NetProtDB.getByName = _import : NullString8.t -> C_Int.t +NetProtDB.getByNumber = _import : C_Int.t -> C_Int.t +NetProtDB.getEntryAliasesN = _import : C_Int.t -> C_String.t +NetProtDB.getEntryAliasesNum = _import : unit -> C_Int.t +NetProtDB.getEntryName = _import : unit -> C_String.t +NetProtDB.getEntryProto = _import : unit -> C_Int.t +NetServDB.getByName = _import : NullString8.t * NullString8.t -> C_Int.t +NetServDB.getByNameNull = _import : NullString8.t -> C_Int.t +NetServDB.getByPort = _import : C_Int.t * NullString8.t -> C_Int.t +NetServDB.getByPortNull = _import : C_Int.t -> C_Int.t +NetServDB.getEntryAliasesN = _import : C_Int.t -> C_String.t +NetServDB.getEntryAliasesNum = _import : unit -> C_Int.t +NetServDB.getEntryName = _import : unit -> C_String.t +NetServDB.getEntryPort = _import : unit -> C_Int.t +NetServDB.getEntryProto = _import : unit -> C_String.t OS.IO.POLLIN = _const : C_Short.t OS.IO.POLLOUT = _const : C_Short.t OS.IO.POLLPRI = _const : C_Short.t -OS.IO.poll = _import PRIVATE : C_Fd.t vector * C_Short.t vector * C_NFds.t * C_Int.t * C_Short.t array -> C_Int.t C_Errno.t +OS.IO.poll = _import : C_Fd.t vector * C_Short.t vector * C_NFds.t * C_Int.t * C_Short.t array -> C_Int.t C_Errno.t Posix.Error.E2BIG = _const : C_Int.t Posix.Error.EACCES = _const : C_Int.t Posix.Error.EADDRINUSE = _const : C_Int.t @@ -219,17 +219,17 @@ Posix.Error.ETIMEDOUT = _const : C_Int.t Posix.Error.ETXTBSY = _const : C_Int.t Posix.Error.EWOULDBLOCK = _const : C_Int.t Posix.Error.EXDEV = _const : C_Int.t -Posix.Error.clearErrno = _import PRIVATE : unit -> unit -Posix.Error.getErrno = _import PRIVATE : unit -> C_Int.t -Posix.Error.strError = _import PRIVATE : C_Int.t -> C_String.t +Posix.Error.clearErrno = _import : unit -> unit +Posix.Error.getErrno = _import : unit -> C_Int.t +Posix.Error.strError = _import : C_Int.t -> C_String.t Posix.FileSys.A.F_OK = _const : C_Int.t Posix.FileSys.A.R_OK = _const : C_Int.t Posix.FileSys.A.W_OK = _const : C_Int.t Posix.FileSys.A.X_OK = _const : C_Int.t -Posix.FileSys.Dirstream.closeDir = _import PRIVATE : C_DirP.t -> C_Int.t C_Errno.t -Posix.FileSys.Dirstream.openDir = _import PRIVATE : NullString8.t -> C_DirP.t C_Errno.t -Posix.FileSys.Dirstream.readDir = _import PRIVATE : C_DirP.t -> C_String.t C_Errno.t -Posix.FileSys.Dirstream.rewindDir = _import PRIVATE : C_DirP.t -> unit +Posix.FileSys.Dirstream.closeDir = _import : C_DirP.t -> C_Int.t C_Errno.t +Posix.FileSys.Dirstream.openDir = _import : NullString8.t -> C_DirP.t C_Errno.t +Posix.FileSys.Dirstream.readDir = _import : C_DirP.t -> C_String.t C_Errno.t +Posix.FileSys.Dirstream.rewindDir = _import : C_DirP.t -> unit Posix.FileSys.O.APPEND = _const : C_Int.t Posix.FileSys.O.BINARY = _const : C_Int.t Posix.FileSys.O.CREAT = _const : C_Int.t @@ -287,55 +287,55 @@ Posix.FileSys.S.IWUSR = _const : C_Mode.t Posix.FileSys.S.IXGRP = _const : C_Mode.t Posix.FileSys.S.IXOTH = _const : C_Mode.t Posix.FileSys.S.IXUSR = _const : C_Mode.t -Posix.FileSys.ST.isBlk = _import PRIVATE : C_Mode.t -> C_Int.t -Posix.FileSys.ST.isChr = _import PRIVATE : C_Mode.t -> C_Int.t -Posix.FileSys.ST.isDir = _import PRIVATE : C_Mode.t -> C_Int.t -Posix.FileSys.ST.isFIFO = _import PRIVATE : C_Mode.t -> C_Int.t -Posix.FileSys.ST.isLink = _import PRIVATE : C_Mode.t -> C_Int.t -Posix.FileSys.ST.isReg = _import PRIVATE : C_Mode.t -> C_Int.t -Posix.FileSys.ST.isSock = _import PRIVATE : C_Mode.t -> C_Int.t -Posix.FileSys.Stat.fstat = _import PRIVATE : C_Fd.t -> C_Int.t C_Errno.t -Posix.FileSys.Stat.getATime = _import PRIVATE : unit -> C_Time.t -# Posix.FileSys.Stat.getBlkCnt = _import PRIVATE : unit -> C_BlkCnt.t -# Posix.FileSys.Stat.getBlkSize = _import PRIVATE : unit -> C_BlkSize.t -Posix.FileSys.Stat.getCTime = _import PRIVATE : unit -> C_Time.t -Posix.FileSys.Stat.getDev = _import PRIVATE : unit -> C_Dev.t -Posix.FileSys.Stat.getGId = _import PRIVATE : unit -> C_GId.t -Posix.FileSys.Stat.getINo = _import PRIVATE : unit -> C_INo.t -Posix.FileSys.Stat.getMTime = _import PRIVATE : unit -> C_Time.t -Posix.FileSys.Stat.getMode = _import PRIVATE : unit -> C_Mode.t -Posix.FileSys.Stat.getNLink = _import PRIVATE : unit -> C_NLink.t -Posix.FileSys.Stat.getRDev = _import PRIVATE : unit -> C_Dev.t -Posix.FileSys.Stat.getSize = _import PRIVATE : unit -> C_Off.t -Posix.FileSys.Stat.getUId = _import PRIVATE : unit -> C_UId.t -Posix.FileSys.Stat.lstat = _import PRIVATE : NullString8.t -> C_Int.t C_Errno.t -Posix.FileSys.Stat.stat = _import PRIVATE : NullString8.t -> C_Int.t C_Errno.t -Posix.FileSys.Utimbuf.setAcTime = _import PRIVATE : C_Time.t -> unit -Posix.FileSys.Utimbuf.setModTime = _import PRIVATE : C_Time.t -> unit -Posix.FileSys.Utimbuf.utime = _import PRIVATE : NullString8.t -> C_Int.t C_Errno.t -Posix.FileSys.access = _import PRIVATE : NullString8.t * C_Int.t -> C_Int.t C_Errno.t -Posix.FileSys.chdir = _import PRIVATE : NullString8.t -> C_Int.t C_Errno.t -Posix.FileSys.chmod = _import PRIVATE : NullString8.t * C_Mode.t -> C_Int.t C_Errno.t -Posix.FileSys.chown = _import PRIVATE : NullString8.t * C_UId.t * C_GId.t -> C_Int.t C_Errno.t -Posix.FileSys.fchdir = _import PRIVATE : C_Fd.t -> C_Int.t C_Errno.t -Posix.FileSys.fchmod = _import PRIVATE : C_Fd.t * C_Mode.t -> C_Int.t C_Errno.t -Posix.FileSys.fchown = _import PRIVATE : C_Fd.t * C_UId.t * C_GId.t -> C_Int.t C_Errno.t -Posix.FileSys.fpathconf = _import PRIVATE : C_Fd.t * C_Int.t -> C_Long.t C_Errno.t -Posix.FileSys.ftruncate = _import PRIVATE : C_Fd.t * C_Off.t -> C_Int.t C_Errno.t -Posix.FileSys.getcwd = _import PRIVATE : Char8.t array * C_Size.t -> C_String.t C_Errno.t -Posix.FileSys.link = _import PRIVATE : NullString8.t * NullString8.t -> C_Int.t C_Errno.t -Posix.FileSys.mkdir = _import PRIVATE : NullString8.t * C_Mode.t -> C_Int.t C_Errno.t -Posix.FileSys.mkfifo = _import PRIVATE : NullString8.t * C_Mode.t -> C_Int.t C_Errno.t -Posix.FileSys.open2 = _import PRIVATE : NullString8.t * C_Int.t -> C_Fd.t C_Errno.t -Posix.FileSys.open3 = _import PRIVATE : NullString8.t * C_Int.t * C_Mode.t -> C_Fd.t C_Errno.t -Posix.FileSys.pathconf = _import PRIVATE : NullString8.t * C_Int.t -> C_Long.t C_Errno.t -Posix.FileSys.readlink = _import PRIVATE : NullString8.t * Char8.t array * C_Size.t -> C_SSize.t C_Errno.t -Posix.FileSys.rename = _import PRIVATE : NullString8.t * NullString8.t -> C_Int.t C_Errno.t -Posix.FileSys.rmdir = _import PRIVATE : NullString8.t -> C_Int.t C_Errno.t -Posix.FileSys.symlink = _import PRIVATE : NullString8.t * NullString8.t -> C_Int.t C_Errno.t -Posix.FileSys.truncate = _import PRIVATE : NullString8.t * C_Off.t -> C_Int.t C_Errno.t -Posix.FileSys.umask = _import PRIVATE : C_Mode.t -> C_Mode.t -Posix.FileSys.unlink = _import PRIVATE : NullString8.t -> C_Int.t C_Errno.t +Posix.FileSys.ST.isBlk = _import : C_Mode.t -> C_Int.t +Posix.FileSys.ST.isChr = _import : C_Mode.t -> C_Int.t +Posix.FileSys.ST.isDir = _import : C_Mode.t -> C_Int.t +Posix.FileSys.ST.isFIFO = _import : C_Mode.t -> C_Int.t +Posix.FileSys.ST.isLink = _import : C_Mode.t -> C_Int.t +Posix.FileSys.ST.isReg = _import : C_Mode.t -> C_Int.t +Posix.FileSys.ST.isSock = _import : C_Mode.t -> C_Int.t +Posix.FileSys.Stat.fstat = _import : C_Fd.t -> C_Int.t C_Errno.t +Posix.FileSys.Stat.getATime = _import : unit -> C_Time.t +# Posix.FileSys.Stat.getBlkCnt = _import : unit -> C_BlkCnt.t +# Posix.FileSys.Stat.getBlkSize = _import : unit -> C_BlkSize.t +Posix.FileSys.Stat.getCTime = _import : unit -> C_Time.t +Posix.FileSys.Stat.getDev = _import : unit -> C_Dev.t +Posix.FileSys.Stat.getGId = _import : unit -> C_GId.t +Posix.FileSys.Stat.getINo = _import : unit -> C_INo.t +Posix.FileSys.Stat.getMTime = _import : unit -> C_Time.t +Posix.FileSys.Stat.getMode = _import : unit -> C_Mode.t +Posix.FileSys.Stat.getNLink = _import : unit -> C_NLink.t +Posix.FileSys.Stat.getRDev = _import : unit -> C_Dev.t +Posix.FileSys.Stat.getSize = _import : unit -> C_Off.t +Posix.FileSys.Stat.getUId = _import : unit -> C_UId.t +Posix.FileSys.Stat.lstat = _import : NullString8.t -> C_Int.t C_Errno.t +Posix.FileSys.Stat.stat = _import : NullString8.t -> C_Int.t C_Errno.t +Posix.FileSys.Utimbuf.setAcTime = _import : C_Time.t -> unit +Posix.FileSys.Utimbuf.setModTime = _import : C_Time.t -> unit +Posix.FileSys.Utimbuf.utime = _import : NullString8.t -> C_Int.t C_Errno.t +Posix.FileSys.access = _import : NullString8.t * C_Int.t -> C_Int.t C_Errno.t +Posix.FileSys.chdir = _import : NullString8.t -> C_Int.t C_Errno.t +Posix.FileSys.chmod = _import : NullString8.t * C_Mode.t -> C_Int.t C_Errno.t +Posix.FileSys.chown = _import : NullString8.t * C_UId.t * C_GId.t -> C_Int.t C_Errno.t +Posix.FileSys.fchdir = _import : C_Fd.t -> C_Int.t C_Errno.t +Posix.FileSys.fchmod = _import : C_Fd.t * C_Mode.t -> C_Int.t C_Errno.t +Posix.FileSys.fchown = _import : C_Fd.t * C_UId.t * C_GId.t -> C_Int.t C_Errno.t +Posix.FileSys.fpathconf = _import : C_Fd.t * C_Int.t -> C_Long.t C_Errno.t +Posix.FileSys.ftruncate = _import : C_Fd.t * C_Off.t -> C_Int.t C_Errno.t +Posix.FileSys.getcwd = _import : Char8.t array * C_Size.t -> C_String.t C_Errno.t +Posix.FileSys.link = _import : NullString8.t * NullString8.t -> C_Int.t C_Errno.t +Posix.FileSys.mkdir = _import : NullString8.t * C_Mode.t -> C_Int.t C_Errno.t +Posix.FileSys.mkfifo = _import : NullString8.t * C_Mode.t -> C_Int.t C_Errno.t +Posix.FileSys.open2 = _import : NullString8.t * C_Int.t -> C_Fd.t C_Errno.t +Posix.FileSys.open3 = _import : NullString8.t * C_Int.t * C_Mode.t -> C_Fd.t C_Errno.t +Posix.FileSys.pathconf = _import : NullString8.t * C_Int.t -> C_Long.t C_Errno.t +Posix.FileSys.readlink = _import : NullString8.t * Char8.t array * C_Size.t -> C_SSize.t C_Errno.t +Posix.FileSys.rename = _import : NullString8.t * NullString8.t -> C_Int.t C_Errno.t +Posix.FileSys.rmdir = _import : NullString8.t -> C_Int.t C_Errno.t +Posix.FileSys.symlink = _import : NullString8.t * NullString8.t -> C_Int.t C_Errno.t +Posix.FileSys.truncate = _import : NullString8.t * C_Off.t -> C_Int.t C_Errno.t +Posix.FileSys.umask = _import : C_Mode.t -> C_Mode.t +Posix.FileSys.unlink = _import : NullString8.t -> C_Int.t C_Errno.t Posix.IO.FD.CLOEXEC = _const : C_Int.t Posix.IO.FLock.F_GETLK = _const : C_Int.t Posix.IO.FLock.F_RDLCK = _const : C_Short.t @@ -346,17 +346,17 @@ Posix.IO.FLock.F_WRLCK = _const : C_Short.t Posix.IO.FLock.SEEK_CUR = _const : C_Short.t Posix.IO.FLock.SEEK_END= _const : C_Short.t Posix.IO.FLock.SEEK_SET = _const : C_Short.t -Posix.IO.FLock.fcntl = _import PRIVATE : C_Fd.t * C_Int.t -> C_Int.t C_Errno.t -Posix.IO.FLock.getLen = _import PRIVATE : unit -> C_Off.t -Posix.IO.FLock.getPId = _import PRIVATE : unit -> C_PId.t -Posix.IO.FLock.getStart = _import PRIVATE : unit -> C_Off.t -Posix.IO.FLock.getType = _import PRIVATE : unit -> C_Short.t -Posix.IO.FLock.getWhence = _import PRIVATE : unit -> C_Short.t -Posix.IO.FLock.setLen = _import PRIVATE : C_Off.t -> unit -Posix.IO.FLock.setPId = _import PRIVATE : C_PId.t -> unit -Posix.IO.FLock.setStart = _import PRIVATE : C_Off.t -> unit -Posix.IO.FLock.setType = _import PRIVATE : C_Short.t -> unit -Posix.IO.FLock.setWhence = _import PRIVATE : C_Short.t -> unit +Posix.IO.FLock.fcntl = _import : C_Fd.t * C_Int.t -> C_Int.t C_Errno.t +Posix.IO.FLock.getLen = _import : unit -> C_Off.t +Posix.IO.FLock.getPId = _import : unit -> C_PId.t +Posix.IO.FLock.getStart = _import : unit -> C_Off.t +Posix.IO.FLock.getType = _import : unit -> C_Short.t +Posix.IO.FLock.getWhence = _import : unit -> C_Short.t +Posix.IO.FLock.setLen = _import : C_Off.t -> unit +Posix.IO.FLock.setPId = _import : C_PId.t -> unit +Posix.IO.FLock.setStart = _import : C_Off.t -> unit +Posix.IO.FLock.setType = _import : C_Short.t -> unit +Posix.IO.FLock.setWhence = _import : C_Short.t -> unit Posix.IO.F_DUPFD = _const : C_Int.t Posix.IO.F_GETFD = _const : C_Int.t Posix.IO.F_GETFL = _const : C_Int.t @@ -368,22 +368,22 @@ Posix.IO.O_ACCMODE = _const : C_Int.t Posix.IO.SEEK_CUR = _const : C_Int.t Posix.IO.SEEK_END= _const : C_Int.t Posix.IO.SEEK_SET = _const : C_Int.t -Posix.IO.close = _import PRIVATE : C_Fd.t -> C_Int.t C_Errno.t -Posix.IO.dup = _import PRIVATE : C_Fd.t -> C_Fd.t C_Errno.t -Posix.IO.dup2 = _import PRIVATE : C_Fd.t * C_Fd.t -> C_Fd.t C_Errno.t -Posix.IO.fcntl2 = _import PRIVATE : C_Fd.t * C_Int.t -> C_Int.t C_Errno.t -Posix.IO.fcntl3 = _import PRIVATE : C_Fd.t * C_Int.t * C_Int.t -> C_Int.t C_Errno.t -Posix.IO.fsync = _import PRIVATE : C_Fd.t -> C_Int.t C_Errno.t -Posix.IO.lseek = _import PRIVATE : C_Fd.t * C_Off.t * C_Int.t -> C_Off.t C_Errno.t -Posix.IO.pipe = _import PRIVATE : C_Fd.t array -> C_Int.t C_Errno.t -Posix.IO.readChar8 = _import PRIVATE : C_Fd.t * Char8.t array * C_Int.t * C_Size.t -> C_SSize.t C_Errno.t -Posix.IO.readWord8 = _import PRIVATE : C_Fd.t * Word8.t array * C_Int.t * C_Size.t -> C_SSize.t C_Errno.t -Posix.IO.setbin = _import PRIVATE : C_Fd.t -> unit -Posix.IO.settext = _import PRIVATE : C_Fd.t -> unit -Posix.IO.writeChar8Arr = _import PRIVATE : C_Fd.t * Char8.t array * C_Int.t * C_Size.t -> C_SSize.t C_Errno.t -Posix.IO.writeChar8Vec = _import PRIVATE : C_Fd.t * Char8.t vector * C_Int.t * C_Size.t -> C_SSize.t C_Errno.t -Posix.IO.writeWord8Arr = _import PRIVATE : C_Fd.t * Word8.t array * C_Int.t * C_Size.t -> C_SSize.t C_Errno.t -Posix.IO.writeWord8Vec = _import PRIVATE : C_Fd.t * Word8.t vector * C_Int.t * C_Size.t -> C_SSize.t C_Errno.t +Posix.IO.close = _import : C_Fd.t -> C_Int.t C_Errno.t +Posix.IO.dup = _import : C_Fd.t -> C_Fd.t C_Errno.t +Posix.IO.dup2 = _import : C_Fd.t * C_Fd.t -> C_Fd.t C_Errno.t +Posix.IO.fcntl2 = _import : C_Fd.t * C_Int.t -> C_Int.t C_Errno.t +Posix.IO.fcntl3 = _import : C_Fd.t * C_Int.t * C_Int.t -> C_Int.t C_Errno.t +Posix.IO.fsync = _import : C_Fd.t -> C_Int.t C_Errno.t +Posix.IO.lseek = _import : C_Fd.t * C_Off.t * C_Int.t -> C_Off.t C_Errno.t +Posix.IO.pipe = _import : C_Fd.t array -> C_Int.t C_Errno.t +Posix.IO.readChar8 = _import : C_Fd.t * Char8.t array * C_Int.t * C_Size.t -> C_SSize.t C_Errno.t +Posix.IO.readWord8 = _import : C_Fd.t * Word8.t array * C_Int.t * C_Size.t -> C_SSize.t C_Errno.t +Posix.IO.setbin = _import : C_Fd.t -> unit +Posix.IO.settext = _import : C_Fd.t -> unit +Posix.IO.writeChar8Arr = _import : C_Fd.t * Char8.t array * C_Int.t * C_Size.t -> C_SSize.t C_Errno.t +Posix.IO.writeChar8Vec = _import : C_Fd.t * Char8.t vector * C_Int.t * C_Size.t -> C_SSize.t C_Errno.t +Posix.IO.writeWord8Arr = _import : C_Fd.t * Word8.t array * C_Int.t * C_Size.t -> C_SSize.t C_Errno.t +Posix.IO.writeWord8Vec = _import : C_Fd.t * Word8.t vector * C_Int.t * C_Size.t -> C_SSize.t C_Errno.t Posix.ProcEnv.SC_2_CHAR_TERM = _const : C_Int.t Posix.ProcEnv.SC_2_C_BIND = _const : C_Int.t Posix.ProcEnv.SC_2_C_DEV = _const : C_Int.t @@ -511,59 +511,59 @@ Posix.ProcEnv.SC_XOPEN_SHM = _const : C_Int.t Posix.ProcEnv.SC_XOPEN_STREAMS = _const : C_Int.t Posix.ProcEnv.SC_XOPEN_UNIX = _const : C_Int.t Posix.ProcEnv.SC_XOPEN_VERSION = _const : C_Int.t -Posix.ProcEnv.Times.getCSTime = _import PRIVATE : unit -> C_Clock.t -Posix.ProcEnv.Times.getCUTime = _import PRIVATE : unit -> C_Clock.t -Posix.ProcEnv.Times.getSTime = _import PRIVATE : unit -> C_Clock.t -Posix.ProcEnv.Times.getUTime = _import PRIVATE : unit -> C_Clock.t -Posix.ProcEnv.Uname.getMachine = _import PRIVATE : unit -> C_String.t -Posix.ProcEnv.Uname.getNodeName = _import PRIVATE : unit -> C_String.t -Posix.ProcEnv.Uname.getRelease = _import PRIVATE : unit -> C_String.t -Posix.ProcEnv.Uname.getSysName = _import PRIVATE : unit -> C_String.t -Posix.ProcEnv.Uname.getVersion = _import PRIVATE : unit -> C_String.t -Posix.ProcEnv.ctermid = _import PRIVATE : unit -> C_String.t +Posix.ProcEnv.Times.getCSTime = _import : unit -> C_Clock.t +Posix.ProcEnv.Times.getCUTime = _import : unit -> C_Clock.t +Posix.ProcEnv.Times.getSTime = _import : unit -> C_Clock.t +Posix.ProcEnv.Times.getUTime = _import : unit -> C_Clock.t +Posix.ProcEnv.Uname.getMachine = _import : unit -> C_String.t +Posix.ProcEnv.Uname.getNodeName = _import : unit -> C_String.t +Posix.ProcEnv.Uname.getRelease = _import : unit -> C_String.t +Posix.ProcEnv.Uname.getSysName = _import : unit -> C_String.t +Posix.ProcEnv.Uname.getVersion = _import : unit -> C_String.t +Posix.ProcEnv.ctermid = _import : unit -> C_String.t Posix.ProcEnv.environ = _symbol : C_StringArray.t -Posix.ProcEnv.getegid = _import PRIVATE : unit -> C_GId.t -Posix.ProcEnv.getenv = _import PRIVATE : NullString8.t -> C_String.t -Posix.ProcEnv.geteuid = _import PRIVATE : unit -> C_UId.t -Posix.ProcEnv.getgid = _import PRIVATE : unit -> C_GId.t -Posix.ProcEnv.getgroups = _import PRIVATE : C_Int.t * C_GId.t array -> C_Int.t C_Errno.t -Posix.ProcEnv.getgroupsN = _import PRIVATE : unit -> C_Int.t -Posix.ProcEnv.getlogin = _import PRIVATE : unit -> C_String.t C_Errno.t -Posix.ProcEnv.getpgrp = _import PRIVATE : unit -> C_PId.t -Posix.ProcEnv.getpid = _import PRIVATE : unit -> C_PId.t -Posix.ProcEnv.getppid = _import PRIVATE : unit -> C_PId.t -Posix.ProcEnv.getuid = _import PRIVATE : unit -> C_UId.t -Posix.ProcEnv.isatty = _import PRIVATE : C_Fd.t -> C_Int.t -Posix.ProcEnv.setenv = _import PRIVATE : NullString8.t * NullString8.t -> C_Int.t C_Errno.t -Posix.ProcEnv.setgid = _import PRIVATE : C_GId.t -> C_Int.t C_Errno.t -Posix.ProcEnv.setgroups = _import PRIVATE : C_Int.t * C_GId.t vector -> C_Int.t C_Errno.t -Posix.ProcEnv.setpgid = _import PRIVATE : C_PId.t * C_PId.t -> C_Int.t C_Errno.t -Posix.ProcEnv.setsid = _import PRIVATE : unit -> C_PId.t C_Errno.t -Posix.ProcEnv.setuid = _import PRIVATE : C_UId.t -> C_Int.t C_Errno.t -Posix.ProcEnv.sysconf = _import PRIVATE : C_Int.t -> C_Long.t C_Errno.t -Posix.ProcEnv.times = _import PRIVATE : unit -> C_Clock.t C_Errno.t -Posix.ProcEnv.ttyname = _import PRIVATE : C_Fd.t -> C_String.t C_Errno.t -Posix.ProcEnv.uname = _import PRIVATE : unit -> C_Int.t C_Errno.t +Posix.ProcEnv.getegid = _import : unit -> C_GId.t +Posix.ProcEnv.getenv = _import : NullString8.t -> C_String.t +Posix.ProcEnv.geteuid = _import : unit -> C_UId.t +Posix.ProcEnv.getgid = _import : unit -> C_GId.t +Posix.ProcEnv.getgroups = _import : C_Int.t * C_GId.t array -> C_Int.t C_Errno.t +Posix.ProcEnv.getgroupsN = _import : unit -> C_Int.t +Posix.ProcEnv.getlogin = _import : unit -> C_String.t C_Errno.t +Posix.ProcEnv.getpgrp = _import : unit -> C_PId.t +Posix.ProcEnv.getpid = _import : unit -> C_PId.t +Posix.ProcEnv.getppid = _import : unit -> C_PId.t +Posix.ProcEnv.getuid = _import : unit -> C_UId.t +Posix.ProcEnv.isatty = _import : C_Fd.t -> C_Int.t +Posix.ProcEnv.setenv = _import : NullString8.t * NullString8.t -> C_Int.t C_Errno.t +Posix.ProcEnv.setgid = _import : C_GId.t -> C_Int.t C_Errno.t +Posix.ProcEnv.setgroups = _import : C_Int.t * C_GId.t vector -> C_Int.t C_Errno.t +Posix.ProcEnv.setpgid = _import : C_PId.t * C_PId.t -> C_Int.t C_Errno.t +Posix.ProcEnv.setsid = _import : unit -> C_PId.t C_Errno.t +Posix.ProcEnv.setuid = _import : C_UId.t -> C_Int.t C_Errno.t +Posix.ProcEnv.sysconf = _import : C_Int.t -> C_Long.t C_Errno.t +Posix.ProcEnv.times = _import : unit -> C_Clock.t C_Errno.t +Posix.ProcEnv.ttyname = _import : C_Fd.t -> C_String.t C_Errno.t +Posix.ProcEnv.uname = _import : unit -> C_Int.t C_Errno.t # Posix.Process.W.CONTINUED = _const : C_Int.t Posix.Process.W.NOHANG = _const : C_Int.t Posix.Process.W.UNTRACED = _const : C_Int.t -Posix.Process.alarm = _import PRIVATE : C_UInt.t -> C_UInt.t -Posix.Process.exece = _import PRIVATE : NullString8.t * NullString8.t array * NullString8.t array -> C_Int.t C_Errno.t -Posix.Process.execp = _import PRIVATE : NullString8.t * NullString8.t array -> C_Int.t C_Errno.t -Posix.Process.exit = _import PRIVATE __attribute__((noreturn)) : C_Status.t -> unit -Posix.Process.exitStatus = _import PRIVATE : C_Status.t -> C_Int.t -Posix.Process.fork = _import PRIVATE : unit -> C_PId.t C_Errno.t -Posix.Process.ifExited = _import PRIVATE : C_Status.t -> C_Int.t -Posix.Process.ifSignaled = _import PRIVATE : C_Status.t -> C_Int.t -Posix.Process.ifStopped = _import PRIVATE : C_Status.t -> C_Int.t -Posix.Process.kill = _import PRIVATE : C_PId.t * C_Signal.t -> C_Int.t C_Errno.t -Posix.Process.nanosleep = _import PRIVATE : C_Time.t ref * C_Long.t ref -> C_Int.t C_Errno.t -Posix.Process.pause = _import PRIVATE : unit -> C_Int.t C_Errno.t -Posix.Process.sleep = _import PRIVATE : C_UInt.t -> C_UInt.t -Posix.Process.stopSig = _import PRIVATE : C_Status.t -> C_Signal.t -Posix.Process.system = _import PRIVATE : NullString8.t -> C_Status.t C_Errno.t -Posix.Process.termSig = _import PRIVATE : C_Status.t -> C_Signal.t -Posix.Process.waitpid = _import PRIVATE : C_PId.t * C_Status.t ref * C_Int.t -> C_PId.t C_Errno.t +Posix.Process.alarm = _import : C_UInt.t -> C_UInt.t +Posix.Process.exece = _import : NullString8.t * NullString8.t array * NullString8.t array -> C_Int.t C_Errno.t +Posix.Process.execp = _import : NullString8.t * NullString8.t array -> C_Int.t C_Errno.t +Posix.Process.exit = _import __attribute__((noreturn)) : C_Status.t -> unit +Posix.Process.exitStatus = _import : C_Status.t -> C_Int.t +Posix.Process.fork = _import : unit -> C_PId.t C_Errno.t +Posix.Process.ifExited = _import : C_Status.t -> C_Int.t +Posix.Process.ifSignaled = _import : C_Status.t -> C_Int.t +Posix.Process.ifStopped = _import : C_Status.t -> C_Int.t +Posix.Process.kill = _import : C_PId.t * C_Signal.t -> C_Int.t C_Errno.t +Posix.Process.nanosleep = _import : C_Time.t ref * C_Long.t ref -> C_Int.t C_Errno.t +Posix.Process.pause = _import : unit -> C_Int.t C_Errno.t +Posix.Process.sleep = _import : C_UInt.t -> C_UInt.t +Posix.Process.stopSig = _import : C_Status.t -> C_Signal.t +Posix.Process.system = _import : NullString8.t -> C_Status.t C_Errno.t +Posix.Process.termSig = _import : C_Status.t -> C_Signal.t +Posix.Process.waitpid = _import : C_PId.t * C_Status.t ref * C_Int.t -> C_PId.t C_Errno.t Posix.Signal.sigSetLen = _const : C_Size.t Posix.Signal.NSIG = _const : C_Int.t Posix.Signal.SIGABRT = _const : C_Signal.t @@ -597,34 +597,34 @@ Posix.Signal.SIGXFSZ = _const : C_Signal.t Posix.Signal.SIG_BLOCK = _const : C_Int.t Posix.Signal.SIG_SETMASK = _const : C_Int.t Posix.Signal.SIG_UNBLOCK = _const : C_Int.t -Posix.Signal.default = _import PRIVATE : GCState.t * C_Signal.t -> C_Int.t C_Errno.t -Posix.Signal.handleGC = _import PRIVATE : GCState.t -> unit -Posix.Signal.handlee = _import PRIVATE : GCState.t * C_Signal.t -> C_Int.t C_Errno.t -Posix.Signal.ignore = _import PRIVATE : GCState.t * C_Signal.t -> C_Int.t C_Errno.t -Posix.Signal.isDefault = _import PRIVATE : C_Signal.t * C_Int.t ref -> C_Int.t C_Errno.t -Posix.Signal.isIgnore = _import PRIVATE : C_Signal.t * C_Int.t ref -> C_Int.t C_Errno.t -Posix.Signal.isPending = _import PRIVATE : GCState.t * C_Signal.t -> C_Int.t -Posix.Signal.isPendingGC = _import PRIVATE : GCState.t -> C_Int.t -Posix.Signal.resetPending = _import PRIVATE : GCState.t -> unit -Posix.Signal.sigaddset = _import PRIVATE : Word8.t array * C_Signal.t -> C_Int.t C_Errno.t -Posix.Signal.sigdelset = _import PRIVATE : Word8.t array * C_Signal.t -> C_Int.t C_Errno.t -Posix.Signal.sigemptyset = _import PRIVATE : Word8.t array -> C_Int.t C_Errno.t -Posix.Signal.sigfillset = _import PRIVATE : Word8.t array -> C_Int.t C_Errno.t -Posix.Signal.sigismember = _import PRIVATE : Word8.t vector * C_Signal.t -> C_Int.t C_Errno.t -Posix.Signal.sigprocmask = _import PRIVATE : C_Int.t * Word8.t vector * Word8.t array -> C_Int.t C_Errno.t -Posix.Signal.sigsuspend = _import PRIVATE : Word8.t vector -> unit -Posix.SysDB.Group.getGId = _import PRIVATE : unit -> C_GId.t -Posix.SysDB.Group.getMem = _import PRIVATE : unit -> C_StringArray.t -Posix.SysDB.Group.getName = _import PRIVATE : unit -> C_String.t -Posix.SysDB.Passwd.getDir = _import PRIVATE : unit -> C_String.t -Posix.SysDB.Passwd.getGId = _import PRIVATE : unit -> C_GId.t -Posix.SysDB.Passwd.getName = _import PRIVATE : unit -> C_String.t -Posix.SysDB.Passwd.getShell = _import PRIVATE : unit -> C_String.t -Posix.SysDB.Passwd.getUId = _import PRIVATE : unit -> C_UId.t -Posix.SysDB.getgrgid = _import PRIVATE : C_GId.t -> C_Int.t C_Errno.t -Posix.SysDB.getgrnam = _import PRIVATE : NullString8.t -> C_Int.t C_Errno.t -Posix.SysDB.getpwnam = _import PRIVATE : NullString8.t -> C_Int.t C_Errno.t -Posix.SysDB.getpwuid = _import PRIVATE : C_GId.t -> C_Int.t C_Errno.t +Posix.Signal.default = _import : GCState.t * C_Signal.t -> C_Int.t C_Errno.t +Posix.Signal.handleGC = _import : GCState.t -> unit +Posix.Signal.handlee = _import : GCState.t * C_Signal.t -> C_Int.t C_Errno.t +Posix.Signal.ignore = _import : GCState.t * C_Signal.t -> C_Int.t C_Errno.t +Posix.Signal.isDefault = _import : C_Signal.t * C_Int.t ref -> C_Int.t C_Errno.t +Posix.Signal.isIgnore = _import : C_Signal.t * C_Int.t ref -> C_Int.t C_Errno.t +Posix.Signal.isPending = _import : GCState.t * C_Signal.t -> C_Int.t +Posix.Signal.isPendingGC = _import : GCState.t -> C_Int.t +Posix.Signal.resetPending = _import : GCState.t -> unit +Posix.Signal.sigaddset = _import : Word8.t array * C_Signal.t -> C_Int.t C_Errno.t +Posix.Signal.sigdelset = _import : Word8.t array * C_Signal.t -> C_Int.t C_Errno.t +Posix.Signal.sigemptyset = _import : Word8.t array -> C_Int.t C_Errno.t +Posix.Signal.sigfillset = _import : Word8.t array -> C_Int.t C_Errno.t +Posix.Signal.sigismember = _import : Word8.t vector * C_Signal.t -> C_Int.t C_Errno.t +Posix.Signal.sigprocmask = _import : C_Int.t * Word8.t vector * Word8.t array -> C_Int.t C_Errno.t +Posix.Signal.sigsuspend = _import : Word8.t vector -> unit +Posix.SysDB.Group.getGId = _import : unit -> C_GId.t +Posix.SysDB.Group.getMem = _import : unit -> C_StringArray.t +Posix.SysDB.Group.getName = _import : unit -> C_String.t +Posix.SysDB.Passwd.getDir = _import : unit -> C_String.t +Posix.SysDB.Passwd.getGId = _import : unit -> C_GId.t +Posix.SysDB.Passwd.getName = _import : unit -> C_String.t +Posix.SysDB.Passwd.getShell = _import : unit -> C_String.t +Posix.SysDB.Passwd.getUId = _import : unit -> C_UId.t +Posix.SysDB.getgrgid = _import : C_GId.t -> C_Int.t C_Errno.t +Posix.SysDB.getgrnam = _import : NullString8.t -> C_Int.t C_Errno.t +Posix.SysDB.getpwnam = _import : NullString8.t -> C_Int.t C_Errno.t +Posix.SysDB.getpwuid = _import : C_GId.t -> C_Int.t C_Errno.t Posix.TTY.B0 = _const : C_Speed.t Posix.TTY.B110 = _const : C_Speed.t Posix.TTY.B1200 = _const : C_Speed.t @@ -711,28 +711,28 @@ Posix.TTY.TC.TCOON = _const : C_Int.t Posix.TTY.TC.TCSADRAIN = _const : C_Int.t Posix.TTY.TC.TCSAFLUSH = _const : C_Int.t Posix.TTY.TC.TCSANOW = _const : C_Int.t -Posix.TTY.TC.drain = _import PRIVATE : C_Fd.t -> C_Int.t C_Errno.t -Posix.TTY.TC.flow = _import PRIVATE : C_Fd.t * C_Int.t -> C_Int.t C_Errno.t -Posix.TTY.TC.flush = _import PRIVATE : C_Fd.t * C_Int.t -> C_Int.t C_Errno.t -Posix.TTY.TC.getattr = _import PRIVATE : C_Fd.t -> C_Int.t C_Errno.t -Posix.TTY.TC.getpgrp = _import PRIVATE : C_Fd.t -> C_PId.t C_Errno.t -Posix.TTY.TC.sendbreak = _import PRIVATE : C_Fd.t * C_Int.t -> C_Int.t C_Errno.t -Posix.TTY.TC.setattr = _import PRIVATE : C_Fd.t * C_Int.t -> C_Int.t C_Errno.t -Posix.TTY.TC.setpgrp = _import PRIVATE : C_Fd.t * C_PId.t -> C_Int.t C_Errno.t -Posix.TTY.Termios.cfGetISpeed = _import PRIVATE : unit -> C_Speed.t -Posix.TTY.Termios.cfGetOSpeed = _import PRIVATE : unit -> C_Speed.t -Posix.TTY.Termios.cfSetISpeed = _import PRIVATE : C_Speed.t -> C_Int.t C_Errno.t -Posix.TTY.Termios.cfSetOSpeed = _import PRIVATE : C_Speed.t -> C_Int.t C_Errno.t -Posix.TTY.Termios.getCC = _import PRIVATE : C_CC.t array -> unit -Posix.TTY.Termios.getCFlag = _import PRIVATE : unit -> C_TCFlag.t -Posix.TTY.Termios.getIFlag = _import PRIVATE : unit -> C_TCFlag.t -Posix.TTY.Termios.getLFlag = _import PRIVATE : unit -> C_TCFlag.t -Posix.TTY.Termios.getOFlag = _import PRIVATE : unit -> C_TCFlag.t -Posix.TTY.Termios.setCC = _import PRIVATE : C_CC.t array -> unit -Posix.TTY.Termios.setCFlag = _import PRIVATE : C_TCFlag.t -> unit -Posix.TTY.Termios.setIFlag = _import PRIVATE : C_TCFlag.t -> unit -Posix.TTY.Termios.setLFlag = _import PRIVATE : C_TCFlag.t -> unit -Posix.TTY.Termios.setOFlag = _import PRIVATE : C_TCFlag.t -> unit +Posix.TTY.TC.drain = _import : C_Fd.t -> C_Int.t C_Errno.t +Posix.TTY.TC.flow = _import : C_Fd.t * C_Int.t -> C_Int.t C_Errno.t +Posix.TTY.TC.flush = _import : C_Fd.t * C_Int.t -> C_Int.t C_Errno.t +Posix.TTY.TC.getattr = _import : C_Fd.t -> C_Int.t C_Errno.t +Posix.TTY.TC.getpgrp = _import : C_Fd.t -> C_PId.t C_Errno.t +Posix.TTY.TC.sendbreak = _import : C_Fd.t * C_Int.t -> C_Int.t C_Errno.t +Posix.TTY.TC.setattr = _import : C_Fd.t * C_Int.t -> C_Int.t C_Errno.t +Posix.TTY.TC.setpgrp = _import : C_Fd.t * C_PId.t -> C_Int.t C_Errno.t +Posix.TTY.Termios.cfGetISpeed = _import : unit -> C_Speed.t +Posix.TTY.Termios.cfGetOSpeed = _import : unit -> C_Speed.t +Posix.TTY.Termios.cfSetISpeed = _import : C_Speed.t -> C_Int.t C_Errno.t +Posix.TTY.Termios.cfSetOSpeed = _import : C_Speed.t -> C_Int.t C_Errno.t +Posix.TTY.Termios.getCC = _import : C_CC.t array -> unit +Posix.TTY.Termios.getCFlag = _import : unit -> C_TCFlag.t +Posix.TTY.Termios.getIFlag = _import : unit -> C_TCFlag.t +Posix.TTY.Termios.getLFlag = _import : unit -> C_TCFlag.t +Posix.TTY.Termios.getOFlag = _import : unit -> C_TCFlag.t +Posix.TTY.Termios.setCC = _import : C_CC.t array -> unit +Posix.TTY.Termios.setCFlag = _import : C_TCFlag.t -> unit +Posix.TTY.Termios.setIFlag = _import : C_TCFlag.t -> unit +Posix.TTY.Termios.setLFlag = _import : C_TCFlag.t -> unit +Posix.TTY.Termios.setOFlag = _import : C_TCFlag.t -> unit Posix.TTY.V.NCCS = _const : C_Int.t Posix.TTY.V.VEOF = _const : C_Int.t Posix.TTY.V.VEOL = _const : C_Int.t @@ -766,22 +766,22 @@ Socket.Ctl.SO_SNDBUF = _const : C_Int.t Socket.Ctl.SO_SNDLOWAT = _const : C_Int.t Socket.Ctl.SO_SNDTIMEO = _const : C_Int.t Socket.Ctl.SO_TYPE = _const : C_Int.t -Socket.Ctl.getATMARK = _import PRIVATE : C_Sock.t * C_Int.t ref -> C_Int.t C_Errno.t -Socket.Ctl.getNREAD = _import PRIVATE : C_Sock.t * C_Int.t ref -> C_Int.t C_Errno.t -Socket.Ctl.getPeerName = _import PRIVATE : C_Sock.t * Word8.t array * C_Socklen.t ref -> C_Int.t C_Errno.t -Socket.Ctl.getSockName = _import PRIVATE : C_Sock.t * Word8.t array * C_Socklen.t ref -> C_Int.t C_Errno.t -Socket.Ctl.getSockOptC_Int = _import PRIVATE : C_Sock.t * C_Int.t * C_Int.t * C_Int.t ref -> C_Int.t C_Errno.t -Socket.Ctl.getSockOptC_Linger = _import PRIVATE : C_Sock.t * C_Int.t * C_Int.t * C_Int.t ref * C_Int.t ref -> C_Int.t C_Errno.t -Socket.Ctl.setSockOptC_Int = _import PRIVATE : C_Sock.t * C_Int.t * C_Int.t * C_Int.t -> C_Int.t C_Errno.t -Socket.Ctl.setSockOptC_Linger = _import PRIVATE : C_Sock.t * C_Int.t * C_Int.t * C_Int.t * C_Int.t -> C_Int.t C_Errno.t -Socket.GenericSock.socket = _import PRIVATE : C_Int.t * C_Int.t * C_Int.t -> C_Int.t C_Errno.t -Socket.GenericSock.socketPair = _import PRIVATE : C_Int.t * C_Int.t * C_Int.t * C_Int.t array -> C_Int.t C_Errno.t +Socket.Ctl.getATMARK = _import : C_Sock.t * C_Int.t ref -> C_Int.t C_Errno.t +Socket.Ctl.getNREAD = _import : C_Sock.t * C_Int.t ref -> C_Int.t C_Errno.t +Socket.Ctl.getPeerName = _import : C_Sock.t * Word8.t array * C_Socklen.t ref -> C_Int.t C_Errno.t +Socket.Ctl.getSockName = _import : C_Sock.t * Word8.t array * C_Socklen.t ref -> C_Int.t C_Errno.t +Socket.Ctl.getSockOptC_Int = _import : C_Sock.t * C_Int.t * C_Int.t * C_Int.t ref -> C_Int.t C_Errno.t +Socket.Ctl.getSockOptC_Linger = _import : C_Sock.t * C_Int.t * C_Int.t * C_Int.t ref * C_Int.t ref -> C_Int.t C_Errno.t +Socket.Ctl.setSockOptC_Int = _import : C_Sock.t * C_Int.t * C_Int.t * C_Int.t -> C_Int.t C_Errno.t +Socket.Ctl.setSockOptC_Linger = _import : C_Sock.t * C_Int.t * C_Int.t * C_Int.t * C_Int.t -> C_Int.t C_Errno.t +Socket.GenericSock.socket = _import : C_Int.t * C_Int.t * C_Int.t -> C_Int.t C_Errno.t +Socket.GenericSock.socketPair = _import : C_Int.t * C_Int.t * C_Int.t * C_Int.t array -> C_Int.t C_Errno.t Socket.INetSock.Ctl.IPPROTO_TCP = _const : C_Int.t Socket.INetSock.Ctl.TCP_NODELAY = _const : C_Int.t -Socket.INetSock.fromAddr = _import PRIVATE : Word8.t vector -> unit -Socket.INetSock.getInAddr = _import PRIVATE : Word8.t array -> unit -Socket.INetSock.getPort = _import PRIVATE : unit -> Word16.t -Socket.INetSock.toAddr = _import PRIVATE : Word8.t vector * Word16.t * Word8.t array * C_Socklen.t ref -> unit +Socket.INetSock.fromAddr = _import : Word8.t vector -> unit +Socket.INetSock.getInAddr = _import : Word8.t array -> unit +Socket.INetSock.getPort = _import : unit -> Word16.t +Socket.INetSock.toAddr = _import : Word8.t vector * Word16.t * Word8.t array * C_Socklen.t ref -> unit Socket.MSG_CTRUNC = _const : C_Int.t Socket.MSG_DONTROUTE = _const : C_Int.t Socket.MSG_DONTWAIT = _const : C_Int.t @@ -797,329 +797,329 @@ Socket.SOCK.DGRAM = _const : C_Int.t Socket.SOCK.RAW = _const : C_Int.t Socket.SOCK.SEQPACKET = _const : C_Int.t Socket.SOCK.STREAM = _const : C_Int.t -Socket.UnixSock.fromAddr = _import PRIVATE : Word8.t vector * Char8.t array * C_Size.t -> unit -Socket.UnixSock.pathLen = _import PRIVATE : Word8.t vector -> C_Size.t -Socket.UnixSock.toAddr = _import PRIVATE : NullString8.t * C_Size.t * Word8.t array * C_Socklen.t ref -> unit -Socket.accept = _import PRIVATE : C_Sock.t * Word8.t array * C_Socklen.t ref -> C_Int.t C_Errno.t -Socket.bind = _import PRIVATE : C_Sock.t * Word8.t vector * C_Socklen.t -> C_Int.t C_Errno.t -Socket.close = _import PRIVATE : C_Sock.t -> C_Int.t C_Errno.t -Socket.connect = _import PRIVATE : C_Sock.t * Word8.t vector * C_Socklen.t -> C_Int.t C_Errno.t -Socket.familyOfAddr = _import PRIVATE : Word8.t vector -> C_Int.t -Socket.getTimeout_sec = _import PRIVATE : unit -> C_Time.t -Socket.getTimeout_usec = _import PRIVATE : unit -> C_SUSeconds.t -Socket.listen = _import PRIVATE : C_Sock.t * C_Int.t -> C_Int.t C_Errno.t -Socket.recv = _import PRIVATE : C_Sock.t * Word8.t array * C_Int.t * C_Size.t * C_Int.t -> C_SSize.t C_Errno.t -Socket.recvFrom = _import PRIVATE : C_Sock.t * Word8.t array * C_Int.t * C_Size.t * C_Int.t * Word8.t array * C_Socklen.t ref -> C_SSize.t C_Errno.t -Socket.select = _import PRIVATE : C_Fd.t vector * C_Fd.t vector * C_Fd.t vector * C_Int.t array * C_Int.t array * C_Int.t array -> C_Int.t C_Errno.t -Socket.sendArr = _import PRIVATE : C_Sock.t * Word8.t array * C_Int.t * C_Size.t * C_Int.t -> C_SSize.t C_Errno.t -Socket.sendArrTo = _import PRIVATE : C_Sock.t * Word8.t array * C_Int.t * C_Size.t * C_Int.t * Word8.t vector * C_Socklen.t -> C_SSize.t C_Errno.t -Socket.sendVec = _import PRIVATE : C_Sock.t * Word8.t vector * C_Int.t * C_Size.t * C_Int.t -> C_SSize.t C_Errno.t -Socket.sendVecTo = _import PRIVATE : C_Sock.t * Word8.t vector * C_Int.t * C_Size.t * C_Int.t * Word8.t vector * C_Socklen.t -> C_SSize.t C_Errno.t -Socket.setTimeout = _import PRIVATE : C_Time.t * C_SUSeconds.t -> unit -Socket.setTimeoutNull = _import PRIVATE : unit -> unit -Socket.shutdown = _import PRIVATE : C_Sock.t * C_Int.t -> C_Int.t C_Errno.t +Socket.UnixSock.fromAddr = _import : Word8.t vector * Char8.t array * C_Size.t -> unit +Socket.UnixSock.pathLen = _import : Word8.t vector -> C_Size.t +Socket.UnixSock.toAddr = _import : NullString8.t * C_Size.t * Word8.t array * C_Socklen.t ref -> unit +Socket.accept = _import : C_Sock.t * Word8.t array * C_Socklen.t ref -> C_Int.t C_Errno.t +Socket.bind = _import : C_Sock.t * Word8.t vector * C_Socklen.t -> C_Int.t C_Errno.t +Socket.close = _import : C_Sock.t -> C_Int.t C_Errno.t +Socket.connect = _import : C_Sock.t * Word8.t vector * C_Socklen.t -> C_Int.t C_Errno.t +Socket.familyOfAddr = _import : Word8.t vector -> C_Int.t +Socket.getTimeout_sec = _import : unit -> C_Time.t +Socket.getTimeout_usec = _import : unit -> C_SUSeconds.t +Socket.listen = _import : C_Sock.t * C_Int.t -> C_Int.t C_Errno.t +Socket.recv = _import : C_Sock.t * Word8.t array * C_Int.t * C_Size.t * C_Int.t -> C_SSize.t C_Errno.t +Socket.recvFrom = _import : C_Sock.t * Word8.t array * C_Int.t * C_Size.t * C_Int.t * Word8.t array * C_Socklen.t ref -> C_SSize.t C_Errno.t +Socket.select = _import : C_Fd.t vector * C_Fd.t vector * C_Fd.t vector * C_Int.t array * C_Int.t array * C_Int.t array -> C_Int.t C_Errno.t +Socket.sendArr = _import : C_Sock.t * Word8.t array * C_Int.t * C_Size.t * C_Int.t -> C_SSize.t C_Errno.t +Socket.sendArrTo = _import : C_Sock.t * Word8.t array * C_Int.t * C_Size.t * C_Int.t * Word8.t vector * C_Socklen.t -> C_SSize.t C_Errno.t +Socket.sendVec = _import : C_Sock.t * Word8.t vector * C_Int.t * C_Size.t * C_Int.t -> C_SSize.t C_Errno.t +Socket.sendVecTo = _import : C_Sock.t * Word8.t vector * C_Int.t * C_Size.t * C_Int.t * Word8.t vector * C_Socklen.t -> C_SSize.t C_Errno.t +Socket.setTimeout = _import : C_Time.t * C_SUSeconds.t -> unit +Socket.setTimeoutNull = _import : unit -> unit +Socket.shutdown = _import : C_Sock.t * C_Int.t -> C_Int.t C_Errno.t Socket.sockAddrStorageLen = _const : C_Size.t -Stdio.print = _import PRIVATE : String8.t -> unit -Stdio.printStderr = _import PRIVATE : String8.t -> unit -Stdio.printStdout = _import PRIVATE : String8.t -> unit -Time.getTimeOfDay = _import PRIVATE : C_Time.t ref * C_SUSeconds.t ref -> C_Int.t -Windows.Process.create = _import PRIVATE : NullString8.t * NullString8.t * NullString8.t * C_Fd.t * C_Fd.t * C_Fd.t -> C_PId.t C_Errno.t -Windows.Process.createNull = _import PRIVATE : NullString8.t * NullString8.t * C_Fd.t * C_Fd.t * C_Fd.t -> C_PId.t C_Errno.t -Windows.Process.getexitcode = _import PRIVATE : C_PId.t * C_Status.t ref -> C_Int.t C_Errno.t -Windows.Process.terminate = _import PRIVATE : C_PId.t * C_Signal.t -> C_Int.t C_Errno.t +Stdio.print = _import : String8.t -> unit +Stdio.printStderr = _import : String8.t -> unit +Stdio.printStdout = _import : String8.t -> unit +Time.getTimeOfDay = _import : C_Time.t ref * C_SUSeconds.t ref -> C_Int.t +Windows.Process.create = _import : NullString8.t * NullString8.t * NullString8.t * C_Fd.t * C_Fd.t * C_Fd.t -> C_PId.t C_Errno.t +Windows.Process.createNull = _import : NullString8.t * NullString8.t * C_Fd.t * C_Fd.t * C_Fd.t -> C_PId.t C_Errno.t +Windows.Process.getexitcode = _import : C_PId.t * C_Status.t ref -> C_Int.t C_Errno.t +Windows.Process.terminate = _import : C_PId.t * C_Signal.t -> C_Int.t C_Errno.t ## -Real32.Math.acos = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.Math.asin = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.Math.atan = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.Math.atan2 = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * Real32.t -> Real32.t -Real32.Math.cos = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.Math.cosh = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t +Real32.Math.acos = _import INLINE : Real32.t -> Real32.t +Real32.Math.asin = _import INLINE : Real32.t -> Real32.t +Real32.Math.atan = _import INLINE : Real32.t -> Real32.t +Real32.Math.atan2 = _import INLINE : Real32.t * Real32.t -> Real32.t +Real32.Math.cos = _import INLINE : Real32.t -> Real32.t +Real32.Math.cosh = _import INLINE : Real32.t -> Real32.t Real32.Math.e = _symbol : Real32.t -Real32.Math.exp = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.Math.ln = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.Math.log10 = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t +Real32.Math.exp = _import INLINE : Real32.t -> Real32.t +Real32.Math.ln = _import INLINE : Real32.t -> Real32.t +Real32.Math.log10 = _import INLINE : Real32.t -> Real32.t Real32.Math.pi = _symbol : Real32.t -Real32.Math.pow = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * Real32.t -> Real32.t -Real32.Math.sin = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.Math.sinh = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.Math.sqrt = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.Math.tan = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.Math.tanh = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.abs = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.add = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * Real32.t -> Real32.t -Real32.castToWord32 = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Word32.t -Real32.div = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * Real32.t -> Real32.t -Real32.equal = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * Real32.t -> Bool.t -Real32.fetch = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t ref -> Real32.t -Real32.frexp = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * C_Int.t ref -> Real32.t -Real32.gdtoa = _import PRIVATE : Real32.t * C_Int.t * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t -Real32.ldexp = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * C_Int.t -> Real32.t -Real32.le = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * Real32.t -> Bool.t -Real32.lt = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * Real32.t -> Bool.t -Real32.modf = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * Real32.t ref -> Real32.t -Real32.move = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t ref * Real32.t ref -> unit -Real32.mul = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * Real32.t -> Real32.t -Real32.muladd = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * Real32.t * Real32.t -> Real32.t -Real32.mulsub = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * Real32.t * Real32.t -> Real32.t -Real32.neg = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.realCeil = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.realFloor = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.realTrunc = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.rndToReal32 = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.rndToReal64 = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real64.t -Real32.rndToWordS16 = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Int16.t -Real32.rndToWordS32 = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Int32.t -Real32.rndToWordS64 = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Int64.t -Real32.rndToWordS8 = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Int8.t -Real32.rndToWordU16 = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Word16.t -Real32.rndToWordU32 = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Word32.t -Real32.rndToWordU64 = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Word64.t -Real32.rndToWordU8 = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Word8.t -Real32.round = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t -> Real32.t -Real32.store = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t ref * Real32.t -> unit -Real32.strtor = _import PRIVATE : NullString8.t * C_Int.t -> Real32.t -Real32.sub = _import MLTON_CODEGEN_STATIC_INLINE : Real32.t * Real32.t -> Real32.t -Real64.Math.acos = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.Math.asin = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.Math.atan = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.Math.atan2 = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * Real64.t -> Real64.t -Real64.Math.cos = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.Math.cosh = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t +Real32.Math.pow = _import INLINE : Real32.t * Real32.t -> Real32.t +Real32.Math.sin = _import INLINE : Real32.t -> Real32.t +Real32.Math.sinh = _import INLINE : Real32.t -> Real32.t +Real32.Math.sqrt = _import INLINE : Real32.t -> Real32.t +Real32.Math.tan = _import INLINE : Real32.t -> Real32.t +Real32.Math.tanh = _import INLINE : Real32.t -> Real32.t +Real32.abs = _import INLINE : Real32.t -> Real32.t +Real32.add = _import INLINE : Real32.t * Real32.t -> Real32.t +Real32.castToWord32 = _import INLINE : Real32.t -> Word32.t +Real32.div = _import INLINE : Real32.t * Real32.t -> Real32.t +Real32.equal = _import INLINE : Real32.t * Real32.t -> Bool.t +Real32.fetch = _import INLINE : Real32.t ref -> Real32.t +Real32.frexp = _import INLINE : Real32.t * C_Int.t ref -> Real32.t +Real32.gdtoa = _import : Real32.t * C_Int.t * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t +Real32.ldexp = _import INLINE : Real32.t * C_Int.t -> Real32.t +Real32.le = _import INLINE : Real32.t * Real32.t -> Bool.t +Real32.lt = _import INLINE : Real32.t * Real32.t -> Bool.t +Real32.modf = _import INLINE : Real32.t * Real32.t ref -> Real32.t +Real32.move = _import INLINE : Real32.t ref * Real32.t ref -> unit +Real32.mul = _import INLINE : Real32.t * Real32.t -> Real32.t +Real32.muladd = _import INLINE : Real32.t * Real32.t * Real32.t -> Real32.t +Real32.mulsub = _import INLINE : Real32.t * Real32.t * Real32.t -> Real32.t +Real32.neg = _import INLINE : Real32.t -> Real32.t +Real32.realCeil = _import INLINE : Real32.t -> Real32.t +Real32.realFloor = _import INLINE : Real32.t -> Real32.t +Real32.realTrunc = _import INLINE : Real32.t -> Real32.t +Real32.rndToReal32 = _import INLINE : Real32.t -> Real32.t +Real32.rndToReal64 = _import INLINE : Real32.t -> Real64.t +Real32.rndToWordS16 = _import INLINE : Real32.t -> Int16.t +Real32.rndToWordS32 = _import INLINE : Real32.t -> Int32.t +Real32.rndToWordS64 = _import INLINE : Real32.t -> Int64.t +Real32.rndToWordS8 = _import INLINE : Real32.t -> Int8.t +Real32.rndToWordU16 = _import INLINE : Real32.t -> Word16.t +Real32.rndToWordU32 = _import INLINE : Real32.t -> Word32.t +Real32.rndToWordU64 = _import INLINE : Real32.t -> Word64.t +Real32.rndToWordU8 = _import INLINE : Real32.t -> Word8.t +Real32.round = _import INLINE : Real32.t -> Real32.t +Real32.store = _import INLINE : Real32.t ref * Real32.t -> unit +Real32.strtor = _import : NullString8.t * C_Int.t -> Real32.t +Real32.sub = _import INLINE : Real32.t * Real32.t -> Real32.t +Real64.Math.acos = _import INLINE : Real64.t -> Real64.t +Real64.Math.asin = _import INLINE : Real64.t -> Real64.t +Real64.Math.atan = _import INLINE : Real64.t -> Real64.t +Real64.Math.atan2 = _import INLINE : Real64.t * Real64.t -> Real64.t +Real64.Math.cos = _import INLINE : Real64.t -> Real64.t +Real64.Math.cosh = _import INLINE : Real64.t -> Real64.t Real64.Math.e = _symbol : Real64.t -Real64.Math.exp = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.Math.ln = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.Math.log10 = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t +Real64.Math.exp = _import INLINE : Real64.t -> Real64.t +Real64.Math.ln = _import INLINE : Real64.t -> Real64.t +Real64.Math.log10 = _import INLINE : Real64.t -> Real64.t Real64.Math.pi = _symbol : Real64.t -Real64.Math.pow = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * Real64.t -> Real64.t -Real64.Math.sin = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.Math.sinh = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.Math.sqrt = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.Math.tan = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.Math.tanh = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.abs = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.add = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * Real64.t -> Real64.t -Real64.castToWord64 = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Word64.t -Real64.div = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * Real64.t -> Real64.t -Real64.equal = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * Real64.t -> Bool.t -Real64.fetch = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t ref -> Real64.t -Real64.frexp = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * C_Int.t ref -> Real64.t -Real64.gdtoa = _import PRIVATE : Real64.t * C_Int.t * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t -Real64.ldexp = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * C_Int.t -> Real64.t -Real64.le = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * Real64.t -> Bool.t -Real64.lt = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * Real64.t -> Bool.t -Real64.modf = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * Real64.t ref -> Real64.t -Real64.move = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t ref * Real64.t ref -> unit -Real64.mul = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * Real64.t -> Real64.t -Real64.muladd = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * Real64.t * Real64.t -> Real64.t -Real64.mulsub = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * Real64.t * Real64.t -> Real64.t -Real64.neg = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.realCeil = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.realFloor = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.realTrunc = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.rndToReal32 = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real32.t -Real64.rndToReal64 = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.rndToWordS16 = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Int16.t -Real64.rndToWordS32 = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Int32.t -Real64.rndToWordS64 = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Int64.t -Real64.rndToWordS8 = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Int8.t -Real64.rndToWordU16 = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Word16.t -Real64.rndToWordU32 = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Word32.t -Real64.rndToWordU64 = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Word64.t -Real64.rndToWordU8 = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Word8.t -Real64.round = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t -> Real64.t -Real64.store = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t ref * Real64.t -> unit -Real64.strtor = _import PRIVATE : NullString8.t * C_Int.t -> Real64.t -Real64.sub = _import MLTON_CODEGEN_STATIC_INLINE : Real64.t * Real64.t -> Real64.t -Word16.add = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Word16.t -Word16.andb = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Word16.t -Word16.equal = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Bool.t -Word16.lshift = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word32.t -> Word16.t -Word16.neg = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t -> Word16.t -Word16.notb = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t -> Word16.t -Word16.orb = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Word16.t -Word16.rol = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word32.t -> Word16.t -Word16.ror = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word32.t -> Word16.t -Word16.sub = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Word16.t -Word16.xorb = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Word16.t -Word32.add = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Word32.t -Word32.andb = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Word32.t -Word32.castToReal32 = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t -> Real32.t -Word32.equal = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Bool.t -Word32.lshift = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Word32.t -Word32.neg = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t -> Word32.t -Word32.notb = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t -> Word32.t -Word32.orb = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Word32.t -Word32.rol = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Word32.t -Word32.ror = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Word32.t -Word32.sub = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Word32.t -Word32.xorb = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Word32.t -Word64.add = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Word64.t -Word64.andb = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Word64.t -Word64.castToReal64 = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t -> Real64.t -Word64.equal = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Bool.t -Word64.fetch = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t ref -> Word64.t -Word64.lshift = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word32.t -> Word64.t -Word64.move = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t ref * Word64.t ref -> unit -Word64.neg = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t -> Word64.t -Word64.notb = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t -> Word64.t -Word64.orb = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Word64.t -Word64.rol = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word32.t -> Word64.t -Word64.ror = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word32.t -> Word64.t -Word64.store = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t ref * Word64.t -> unit -Word64.sub = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Word64.t -Word64.xorb = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Word64.t -Word8.add = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Word8.t -Word8.andb = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Word8.t -Word8.equal = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Bool.t -Word8.lshift = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word32.t -> Word8.t -Word8.neg = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t -> Word8.t -Word8.notb = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t -> Word8.t -Word8.orb = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Word8.t -Word8.rol = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word32.t -> Word8.t -Word8.ror = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word32.t -> Word8.t -Word8.sub = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Word8.t -Word8.xorb = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Word8.t -WordS16.addCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t * Int16.t -> Bool.t -WordS16.extdToWord16 = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t -> Word16.t -WordS16.extdToWord32 = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t -> Word32.t -WordS16.extdToWord64 = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t -> Word64.t -WordS16.extdToWord8 = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t -> Word8.t -WordS16.ge = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t * Int16.t -> Bool.t -WordS16.gt = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t * Int16.t -> Bool.t -WordS16.le = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t * Int16.t -> Bool.t -WordS16.lt = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t * Int16.t -> Bool.t -WordS16.mul = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t * Int16.t -> Int16.t -WordS16.mulCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t * Int16.t -> Bool.t -WordS16.negCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t -> Bool.t -WordS16.quot = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t * Int16.t -> Int16.t -WordS16.rem = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t * Int16.t -> Int16.t -WordS16.rndToReal32 = _import PRIVATE : Int16.t -> Real32.t -WordS16.rndToReal64 = _import PRIVATE : Int16.t -> Real64.t -WordS16.rshift = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t * Word32.t -> Int16.t -WordS16.subCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int16.t * Int16.t -> Bool.t -WordS32.addCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t * Int32.t -> Bool.t -WordS32.extdToWord16 = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t -> Word16.t -WordS32.extdToWord32 = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t -> Word32.t -WordS32.extdToWord64 = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t -> Word64.t -WordS32.extdToWord8 = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t -> Word8.t -WordS32.ge = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t * Int32.t -> Bool.t -WordS32.gt = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t * Int32.t -> Bool.t -WordS32.le = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t * Int32.t -> Bool.t -WordS32.lt = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t * Int32.t -> Bool.t -WordS32.mul = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t * Int32.t -> Int32.t -WordS32.mulCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t * Int32.t -> Bool.t -WordS32.negCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t -> Bool.t -WordS32.quot = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t * Int32.t -> Int32.t -WordS32.rem = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t * Int32.t -> Int32.t -WordS32.rndToReal32 = _import PRIVATE : Int32.t -> Real32.t -WordS32.rndToReal64 = _import PRIVATE : Int32.t -> Real64.t -WordS32.rshift = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t * Word32.t -> Int32.t -WordS32.subCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int32.t * Int32.t -> Bool.t -WordS64.addCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t * Int64.t -> Bool.t -WordS64.extdToWord16 = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t -> Word16.t -WordS64.extdToWord32 = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t -> Word32.t -WordS64.extdToWord64 = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t -> Word64.t -WordS64.extdToWord8 = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t -> Word8.t -WordS64.ge = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t * Int64.t -> Bool.t -WordS64.gt = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t * Int64.t -> Bool.t -WordS64.le = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t * Int64.t -> Bool.t -WordS64.lt = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t * Int64.t -> Bool.t -WordS64.mul = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t * Int64.t -> Int64.t -WordS64.mulCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t * Int64.t -> Bool.t -WordS64.negCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t -> Bool.t -WordS64.quot = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t * Int64.t -> Int64.t -WordS64.rem = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t * Int64.t -> Int64.t -WordS64.rndToReal32 = _import PRIVATE : Int64.t -> Real32.t -WordS64.rndToReal64 = _import PRIVATE : Int64.t -> Real64.t -WordS64.rshift = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t * Word32.t -> Int64.t -WordS64.subCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int64.t * Int64.t -> Bool.t -WordS8.addCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t * Int8.t -> Bool.t -WordS8.extdToWord16 = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t -> Word16.t -WordS8.extdToWord32 = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t -> Word32.t -WordS8.extdToWord64 = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t -> Word64.t -WordS8.extdToWord8 = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t -> Word8.t -WordS8.ge = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t * Int8.t -> Bool.t -WordS8.gt = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t * Int8.t -> Bool.t -WordS8.le = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t * Int8.t -> Bool.t -WordS8.lt = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t * Int8.t -> Bool.t -WordS8.mul = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t * Int8.t -> Int8.t -WordS8.mulCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t * Int8.t -> Bool.t -WordS8.negCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t -> Bool.t -WordS8.quot = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t * Int8.t -> Int8.t -WordS8.rem = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t * Int8.t -> Int8.t -WordS8.rndToReal32 = _import PRIVATE : Int8.t -> Real32.t -WordS8.rndToReal64 = _import PRIVATE : Int8.t -> Real64.t -WordS8.rshift = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t * Word32.t -> Int8.t -WordS8.subCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Int8.t * Int8.t -> Bool.t -WordU16.addCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Bool.t -WordU16.extdToWord16 = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t -> Word16.t -WordU16.extdToWord32 = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t -> Word32.t -WordU16.extdToWord64 = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t -> Word64.t -WordU16.extdToWord8 = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t -> Word8.t -WordU16.ge = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Bool.t -WordU16.gt = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Bool.t -WordU16.le = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Bool.t -WordU16.lt = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Bool.t -WordU16.mul = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Word16.t -WordU16.mulCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Bool.t -WordU16.negCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t -> Bool.t -WordU16.quot = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Word16.t -WordU16.rem = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Word16.t -WordU16.rndToReal32 = _import PRIVATE : Word16.t -> Real32.t -WordU16.rndToReal64 = _import PRIVATE : Word16.t -> Real64.t -WordU16.rshift = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word32.t -> Word16.t -WordU16.subCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word16.t * Word16.t -> Bool.t -WordU32.addCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Bool.t -WordU32.extdToWord16 = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t -> Word16.t -WordU32.extdToWord32 = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t -> Word32.t -WordU32.extdToWord64 = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t -> Word64.t -WordU32.extdToWord8 = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t -> Word8.t -WordU32.ge = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Bool.t -WordU32.gt = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Bool.t -WordU32.le = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Bool.t -WordU32.lt = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Bool.t -WordU32.mul = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Word32.t -WordU32.mulCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Bool.t -WordU32.negCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t -> Bool.t -WordU32.quot = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Word32.t -WordU32.rem = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Word32.t -WordU32.rndToReal32 = _import PRIVATE : Word32.t -> Real32.t -WordU32.rndToReal64 = _import PRIVATE : Word32.t -> Real64.t -WordU32.rshift = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Word32.t -WordU32.subCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word32.t * Word32.t -> Bool.t -WordU64.addCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Bool.t -WordU64.extdToWord16 = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t -> Word16.t -WordU64.extdToWord32 = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t -> Word32.t -WordU64.extdToWord64 = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t -> Word64.t -WordU64.extdToWord8 = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t -> Word8.t -WordU64.ge = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Bool.t -WordU64.gt = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Bool.t -WordU64.le = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Bool.t -WordU64.lt = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Bool.t -WordU64.mul = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Word64.t -WordU64.mulCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Bool.t -WordU64.negCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t -> Bool.t -WordU64.quot = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Word64.t -WordU64.rem = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Word64.t -WordU64.rndToReal32 = _import PRIVATE : Word64.t -> Real32.t -WordU64.rndToReal64 = _import PRIVATE : Word64.t -> Real64.t -WordU64.rshift = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word32.t -> Word64.t -WordU64.subCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word64.t * Word64.t -> Bool.t -WordU8.addCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Bool.t -WordU8.extdToWord16 = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t -> Word16.t -WordU8.extdToWord32 = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t -> Word32.t -WordU8.extdToWord64 = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t -> Word64.t -WordU8.extdToWord8 = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t -> Word8.t -WordU8.ge = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Bool.t -WordU8.gt = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Bool.t -WordU8.le = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Bool.t -WordU8.lt = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Bool.t -WordU8.mul = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Word8.t -WordU8.mulCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Bool.t -WordU8.negCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t -> Bool.t -WordU8.quot = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Word8.t -WordU8.rem = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Word8.t -WordU8.rndToReal32 = _import PRIVATE : Word8.t -> Real32.t -WordU8.rndToReal64 = _import PRIVATE : Word8.t -> Real64.t -WordU8.rshift = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word32.t -> Word8.t -WordU8.subCheckP = _import MLTON_CODEGEN_STATIC_INLINE : Word8.t * Word8.t -> Bool.t +Real64.Math.pow = _import INLINE : Real64.t * Real64.t -> Real64.t +Real64.Math.sin = _import INLINE : Real64.t -> Real64.t +Real64.Math.sinh = _import INLINE : Real64.t -> Real64.t +Real64.Math.sqrt = _import INLINE : Real64.t -> Real64.t +Real64.Math.tan = _import INLINE : Real64.t -> Real64.t +Real64.Math.tanh = _import INLINE : Real64.t -> Real64.t +Real64.abs = _import INLINE : Real64.t -> Real64.t +Real64.add = _import INLINE : Real64.t * Real64.t -> Real64.t +Real64.castToWord64 = _import INLINE : Real64.t -> Word64.t +Real64.div = _import INLINE : Real64.t * Real64.t -> Real64.t +Real64.equal = _import INLINE : Real64.t * Real64.t -> Bool.t +Real64.fetch = _import INLINE : Real64.t ref -> Real64.t +Real64.frexp = _import INLINE : Real64.t * C_Int.t ref -> Real64.t +Real64.gdtoa = _import : Real64.t * C_Int.t * C_Int.t * C_Int.t * C_Int.t ref -> C_String.t +Real64.ldexp = _import INLINE : Real64.t * C_Int.t -> Real64.t +Real64.le = _import INLINE : Real64.t * Real64.t -> Bool.t +Real64.lt = _import INLINE : Real64.t * Real64.t -> Bool.t +Real64.modf = _import INLINE : Real64.t * Real64.t ref -> Real64.t +Real64.move = _import INLINE : Real64.t ref * Real64.t ref -> unit +Real64.mul = _import INLINE : Real64.t * Real64.t -> Real64.t +Real64.muladd = _import INLINE : Real64.t * Real64.t * Real64.t -> Real64.t +Real64.mulsub = _import INLINE : Real64.t * Real64.t * Real64.t -> Real64.t +Real64.neg = _import INLINE : Real64.t -> Real64.t +Real64.realCeil = _import INLINE : Real64.t -> Real64.t +Real64.realFloor = _import INLINE : Real64.t -> Real64.t +Real64.realTrunc = _import INLINE : Real64.t -> Real64.t +Real64.rndToReal32 = _import INLINE : Real64.t -> Real32.t +Real64.rndToReal64 = _import INLINE : Real64.t -> Real64.t +Real64.rndToWordS16 = _import INLINE : Real64.t -> Int16.t +Real64.rndToWordS32 = _import INLINE : Real64.t -> Int32.t +Real64.rndToWordS64 = _import INLINE : Real64.t -> Int64.t +Real64.rndToWordS8 = _import INLINE : Real64.t -> Int8.t +Real64.rndToWordU16 = _import INLINE : Real64.t -> Word16.t +Real64.rndToWordU32 = _import INLINE : Real64.t -> Word32.t +Real64.rndToWordU64 = _import INLINE : Real64.t -> Word64.t +Real64.rndToWordU8 = _import INLINE : Real64.t -> Word8.t +Real64.round = _import INLINE : Real64.t -> Real64.t +Real64.store = _import INLINE : Real64.t ref * Real64.t -> unit +Real64.strtor = _import : NullString8.t * C_Int.t -> Real64.t +Real64.sub = _import INLINE : Real64.t * Real64.t -> Real64.t +Word16.add = _import INLINE : Word16.t * Word16.t -> Word16.t +Word16.andb = _import INLINE : Word16.t * Word16.t -> Word16.t +Word16.equal = _import INLINE : Word16.t * Word16.t -> Bool.t +Word16.lshift = _import INLINE : Word16.t * Word32.t -> Word16.t +Word16.neg = _import INLINE : Word16.t -> Word16.t +Word16.notb = _import INLINE : Word16.t -> Word16.t +Word16.orb = _import INLINE : Word16.t * Word16.t -> Word16.t +Word16.rol = _import INLINE : Word16.t * Word32.t -> Word16.t +Word16.ror = _import INLINE : Word16.t * Word32.t -> Word16.t +Word16.sub = _import INLINE : Word16.t * Word16.t -> Word16.t +Word16.xorb = _import INLINE : Word16.t * Word16.t -> Word16.t +Word32.add = _import INLINE : Word32.t * Word32.t -> Word32.t +Word32.andb = _import INLINE : Word32.t * Word32.t -> Word32.t +Word32.castToReal32 = _import INLINE : Word32.t -> Real32.t +Word32.equal = _import INLINE : Word32.t * Word32.t -> Bool.t +Word32.lshift = _import INLINE : Word32.t * Word32.t -> Word32.t +Word32.neg = _import INLINE : Word32.t -> Word32.t +Word32.notb = _import INLINE : Word32.t -> Word32.t +Word32.orb = _import INLINE : Word32.t * Word32.t -> Word32.t +Word32.rol = _import INLINE : Word32.t * Word32.t -> Word32.t +Word32.ror = _import INLINE : Word32.t * Word32.t -> Word32.t +Word32.sub = _import INLINE : Word32.t * Word32.t -> Word32.t +Word32.xorb = _import INLINE : Word32.t * Word32.t -> Word32.t +Word64.add = _import INLINE : Word64.t * Word64.t -> Word64.t +Word64.andb = _import INLINE : Word64.t * Word64.t -> Word64.t +Word64.castToReal64 = _import INLINE : Word64.t -> Real64.t +Word64.equal = _import INLINE : Word64.t * Word64.t -> Bool.t +Word64.fetch = _import INLINE : Word64.t ref -> Word64.t +Word64.lshift = _import INLINE : Word64.t * Word32.t -> Word64.t +Word64.move = _import INLINE : Word64.t ref * Word64.t ref -> unit +Word64.neg = _import INLINE : Word64.t -> Word64.t +Word64.notb = _import INLINE : Word64.t -> Word64.t +Word64.orb = _import INLINE : Word64.t * Word64.t -> Word64.t +Word64.rol = _import INLINE : Word64.t * Word32.t -> Word64.t +Word64.ror = _import INLINE : Word64.t * Word32.t -> Word64.t +Word64.store = _import INLINE : Word64.t ref * Word64.t -> unit +Word64.sub = _import INLINE : Word64.t * Word64.t -> Word64.t +Word64.xorb = _import INLINE : Word64.t * Word64.t -> Word64.t +Word8.add = _import INLINE : Word8.t * Word8.t -> Word8.t +Word8.andb = _import INLINE : Word8.t * Word8.t -> Word8.t +Word8.equal = _import INLINE : Word8.t * Word8.t -> Bool.t +Word8.lshift = _import INLINE : Word8.t * Word32.t -> Word8.t +Word8.neg = _import INLINE : Word8.t -> Word8.t +Word8.notb = _import INLINE : Word8.t -> Word8.t +Word8.orb = _import INLINE : Word8.t * Word8.t -> Word8.t +Word8.rol = _import INLINE : Word8.t * Word32.t -> Word8.t +Word8.ror = _import INLINE : Word8.t * Word32.t -> Word8.t +Word8.sub = _import INLINE : Word8.t * Word8.t -> Word8.t +Word8.xorb = _import INLINE : Word8.t * Word8.t -> Word8.t +WordS16.addCheckP = _import INLINE : Int16.t * Int16.t -> Bool.t +WordS16.extdToWord16 = _import INLINE : Int16.t -> Word16.t +WordS16.extdToWord32 = _import INLINE : Int16.t -> Word32.t +WordS16.extdToWord64 = _import INLINE : Int16.t -> Word64.t +WordS16.extdToWord8 = _import INLINE : Int16.t -> Word8.t +WordS16.ge = _import INLINE : Int16.t * Int16.t -> Bool.t +WordS16.gt = _import INLINE : Int16.t * Int16.t -> Bool.t +WordS16.le = _import INLINE : Int16.t * Int16.t -> Bool.t +WordS16.lt = _import INLINE : Int16.t * Int16.t -> Bool.t +WordS16.mul = _import INLINE : Int16.t * Int16.t -> Int16.t +WordS16.mulCheckP = _import INLINE : Int16.t * Int16.t -> Bool.t +WordS16.negCheckP = _import INLINE : Int16.t -> Bool.t +WordS16.quot = _import INLINE : Int16.t * Int16.t -> Int16.t +WordS16.rem = _import INLINE : Int16.t * Int16.t -> Int16.t +WordS16.rndToReal32 = _import : Int16.t -> Real32.t +WordS16.rndToReal64 = _import : Int16.t -> Real64.t +WordS16.rshift = _import INLINE : Int16.t * Word32.t -> Int16.t +WordS16.subCheckP = _import INLINE : Int16.t * Int16.t -> Bool.t +WordS32.addCheckP = _import INLINE : Int32.t * Int32.t -> Bool.t +WordS32.extdToWord16 = _import INLINE : Int32.t -> Word16.t +WordS32.extdToWord32 = _import INLINE : Int32.t -> Word32.t +WordS32.extdToWord64 = _import INLINE : Int32.t -> Word64.t +WordS32.extdToWord8 = _import INLINE : Int32.t -> Word8.t +WordS32.ge = _import INLINE : Int32.t * Int32.t -> Bool.t +WordS32.gt = _import INLINE : Int32.t * Int32.t -> Bool.t +WordS32.le = _import INLINE : Int32.t * Int32.t -> Bool.t +WordS32.lt = _import INLINE : Int32.t * Int32.t -> Bool.t +WordS32.mul = _import INLINE : Int32.t * Int32.t -> Int32.t +WordS32.mulCheckP = _import INLINE : Int32.t * Int32.t -> Bool.t +WordS32.negCheckP = _import INLINE : Int32.t -> Bool.t +WordS32.quot = _import INLINE : Int32.t * Int32.t -> Int32.t +WordS32.rem = _import INLINE : Int32.t * Int32.t -> Int32.t +WordS32.rndToReal32 = _import : Int32.t -> Real32.t +WordS32.rndToReal64 = _import : Int32.t -> Real64.t +WordS32.rshift = _import INLINE : Int32.t * Word32.t -> Int32.t +WordS32.subCheckP = _import INLINE : Int32.t * Int32.t -> Bool.t +WordS64.addCheckP = _import INLINE : Int64.t * Int64.t -> Bool.t +WordS64.extdToWord16 = _import INLINE : Int64.t -> Word16.t +WordS64.extdToWord32 = _import INLINE : Int64.t -> Word32.t +WordS64.extdToWord64 = _import INLINE : Int64.t -> Word64.t +WordS64.extdToWord8 = _import INLINE : Int64.t -> Word8.t +WordS64.ge = _import INLINE : Int64.t * Int64.t -> Bool.t +WordS64.gt = _import INLINE : Int64.t * Int64.t -> Bool.t +WordS64.le = _import INLINE : Int64.t * Int64.t -> Bool.t +WordS64.lt = _import INLINE : Int64.t * Int64.t -> Bool.t +WordS64.mul = _import INLINE : Int64.t * Int64.t -> Int64.t +WordS64.mulCheckP = _import INLINE : Int64.t * Int64.t -> Bool.t +WordS64.negCheckP = _import INLINE : Int64.t -> Bool.t +WordS64.quot = _import INLINE : Int64.t * Int64.t -> Int64.t +WordS64.rem = _import INLINE : Int64.t * Int64.t -> Int64.t +WordS64.rndToReal32 = _import : Int64.t -> Real32.t +WordS64.rndToReal64 = _import : Int64.t -> Real64.t +WordS64.rshift = _import INLINE : Int64.t * Word32.t -> Int64.t +WordS64.subCheckP = _import INLINE : Int64.t * Int64.t -> Bool.t +WordS8.addCheckP = _import INLINE : Int8.t * Int8.t -> Bool.t +WordS8.extdToWord16 = _import INLINE : Int8.t -> Word16.t +WordS8.extdToWord32 = _import INLINE : Int8.t -> Word32.t +WordS8.extdToWord64 = _import INLINE : Int8.t -> Word64.t +WordS8.extdToWord8 = _import INLINE : Int8.t -> Word8.t +WordS8.ge = _import INLINE : Int8.t * Int8.t -> Bool.t +WordS8.gt = _import INLINE : Int8.t * Int8.t -> Bool.t +WordS8.le = _import INLINE : Int8.t * Int8.t -> Bool.t +WordS8.lt = _import INLINE : Int8.t * Int8.t -> Bool.t +WordS8.mul = _import INLINE : Int8.t * Int8.t -> Int8.t +WordS8.mulCheckP = _import INLINE : Int8.t * Int8.t -> Bool.t +WordS8.negCheckP = _import INLINE : Int8.t -> Bool.t +WordS8.quot = _import INLINE : Int8.t * Int8.t -> Int8.t +WordS8.rem = _import INLINE : Int8.t * Int8.t -> Int8.t +WordS8.rndToReal32 = _import : Int8.t -> Real32.t +WordS8.rndToReal64 = _import : Int8.t -> Real64.t +WordS8.rshift = _import INLINE : Int8.t * Word32.t -> Int8.t +WordS8.subCheckP = _import INLINE : Int8.t * Int8.t -> Bool.t +WordU16.addCheckP = _import INLINE : Word16.t * Word16.t -> Bool.t +WordU16.extdToWord16 = _import INLINE : Word16.t -> Word16.t +WordU16.extdToWord32 = _import INLINE : Word16.t -> Word32.t +WordU16.extdToWord64 = _import INLINE : Word16.t -> Word64.t +WordU16.extdToWord8 = _import INLINE : Word16.t -> Word8.t +WordU16.ge = _import INLINE : Word16.t * Word16.t -> Bool.t +WordU16.gt = _import INLINE : Word16.t * Word16.t -> Bool.t +WordU16.le = _import INLINE : Word16.t * Word16.t -> Bool.t +WordU16.lt = _import INLINE : Word16.t * Word16.t -> Bool.t +WordU16.mul = _import INLINE : Word16.t * Word16.t -> Word16.t +WordU16.mulCheckP = _import INLINE : Word16.t * Word16.t -> Bool.t +WordU16.negCheckP = _import INLINE : Word16.t -> Bool.t +WordU16.quot = _import INLINE : Word16.t * Word16.t -> Word16.t +WordU16.rem = _import INLINE : Word16.t * Word16.t -> Word16.t +WordU16.rndToReal32 = _import : Word16.t -> Real32.t +WordU16.rndToReal64 = _import : Word16.t -> Real64.t +WordU16.rshift = _import INLINE : Word16.t * Word32.t -> Word16.t +WordU16.subCheckP = _import INLINE : Word16.t * Word16.t -> Bool.t +WordU32.addCheckP = _import INLINE : Word32.t * Word32.t -> Bool.t +WordU32.extdToWord16 = _import INLINE : Word32.t -> Word16.t +WordU32.extdToWord32 = _import INLINE : Word32.t -> Word32.t +WordU32.extdToWord64 = _import INLINE : Word32.t -> Word64.t +WordU32.extdToWord8 = _import INLINE : Word32.t -> Word8.t +WordU32.ge = _import INLINE : Word32.t * Word32.t -> Bool.t +WordU32.gt = _import INLINE : Word32.t * Word32.t -> Bool.t +WordU32.le = _import INLINE : Word32.t * Word32.t -> Bool.t +WordU32.lt = _import INLINE : Word32.t * Word32.t -> Bool.t +WordU32.mul = _import INLINE : Word32.t * Word32.t -> Word32.t +WordU32.mulCheckP = _import INLINE : Word32.t * Word32.t -> Bool.t +WordU32.negCheckP = _import INLINE : Word32.t -> Bool.t +WordU32.quot = _import INLINE : Word32.t * Word32.t -> Word32.t +WordU32.rem = _import INLINE : Word32.t * Word32.t -> Word32.t +WordU32.rndToReal32 = _import : Word32.t -> Real32.t +WordU32.rndToReal64 = _import : Word32.t -> Real64.t +WordU32.rshift = _import INLINE : Word32.t * Word32.t -> Word32.t +WordU32.subCheckP = _import INLINE : Word32.t * Word32.t -> Bool.t +WordU64.addCheckP = _import INLINE : Word64.t * Word64.t -> Bool.t +WordU64.extdToWord16 = _import INLINE : Word64.t -> Word16.t +WordU64.extdToWord32 = _import INLINE : Word64.t -> Word32.t +WordU64.extdToWord64 = _import INLINE : Word64.t -> Word64.t +WordU64.extdToWord8 = _import INLINE : Word64.t -> Word8.t +WordU64.ge = _import INLINE : Word64.t * Word64.t -> Bool.t +WordU64.gt = _import INLINE : Word64.t * Word64.t -> Bool.t +WordU64.le = _import INLINE : Word64.t * Word64.t -> Bool.t +WordU64.lt = _import INLINE : Word64.t * Word64.t -> Bool.t +WordU64.mul = _import INLINE : Word64.t * Word64.t -> Word64.t +WordU64.mulCheckP = _import INLINE : Word64.t * Word64.t -> Bool.t +WordU64.negCheckP = _import INLINE : Word64.t -> Bool.t +WordU64.quot = _import INLINE : Word64.t * Word64.t -> Word64.t +WordU64.rem = _import INLINE : Word64.t * Word64.t -> Word64.t +WordU64.rndToReal32 = _import : Word64.t -> Real32.t +WordU64.rndToReal64 = _import : Word64.t -> Real64.t +WordU64.rshift = _import INLINE : Word64.t * Word32.t -> Word64.t +WordU64.subCheckP = _import INLINE : Word64.t * Word64.t -> Bool.t +WordU8.addCheckP = _import INLINE : Word8.t * Word8.t -> Bool.t +WordU8.extdToWord16 = _import INLINE : Word8.t -> Word16.t +WordU8.extdToWord32 = _import INLINE : Word8.t -> Word32.t +WordU8.extdToWord64 = _import INLINE : Word8.t -> Word64.t +WordU8.extdToWord8 = _import INLINE : Word8.t -> Word8.t +WordU8.ge = _import INLINE : Word8.t * Word8.t -> Bool.t +WordU8.gt = _import INLINE : Word8.t * Word8.t -> Bool.t +WordU8.le = _import INLINE : Word8.t * Word8.t -> Bool.t +WordU8.lt = _import INLINE : Word8.t * Word8.t -> Bool.t +WordU8.mul = _import INLINE : Word8.t * Word8.t -> Word8.t +WordU8.mulCheckP = _import INLINE : Word8.t * Word8.t -> Bool.t +WordU8.negCheckP = _import INLINE : Word8.t -> Bool.t +WordU8.quot = _import INLINE : Word8.t * Word8.t -> Word8.t +WordU8.rem = _import INLINE : Word8.t * Word8.t -> Word8.t +WordU8.rndToReal32 = _import : Word8.t -> Real32.t +WordU8.rndToReal64 = _import : Word8.t -> Real64.t +WordU8.rshift = _import INLINE : Word8.t * Word32.t -> Word8.t +WordU8.subCheckP = _import INLINE : Word8.t * Word8.t -> Bool.t diff --git a/runtime/gen/basis-ffi.h b/runtime/gen/basis-ffi.h index 9fdeb6bd9f..ac83e54492 100644 --- a/runtime/gen/basis-ffi.h +++ b/runtime/gen/basis-ffi.h @@ -749,108 +749,108 @@ PRIVATE extern const C_Int_t Posix_TTY_V_VSTART; PRIVATE extern const C_Int_t Posix_TTY_V_VSTOP; PRIVATE extern const C_Int_t Posix_TTY_V_VSUSP; PRIVATE extern const C_Int_t Posix_TTY_V_VTIME; -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_abs(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_add(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Real32_castToWord32(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_div(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Real32_equal(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_fetch(Ref(Real32_t)); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_frexp(Real32_t,Ref(C_Int_t)); +PRIVATE INLINE Real32_t Real32_abs(Real32_t); +PRIVATE INLINE Real32_t Real32_add(Real32_t,Real32_t); +PRIVATE INLINE Word32_t Real32_castToWord32(Real32_t); +PRIVATE INLINE Real32_t Real32_div(Real32_t,Real32_t); +PRIVATE INLINE Bool_t Real32_equal(Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_fetch(Ref(Real32_t)); +PRIVATE INLINE Real32_t Real32_frexp(Real32_t,Ref(C_Int_t)); PRIVATE C_String_t Real32_gdtoa(Real32_t,C_Int_t,C_Int_t,C_Int_t,Ref(C_Int_t)); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_ldexp(Real32_t,C_Int_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Real32_le(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Real32_lt(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_acos(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_asin(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_atan(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_atan2(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_cos(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_cosh(Real32_t); +PRIVATE INLINE Real32_t Real32_ldexp(Real32_t,C_Int_t); +PRIVATE INLINE Bool_t Real32_le(Real32_t,Real32_t); +PRIVATE INLINE Bool_t Real32_lt(Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_Math_acos(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_asin(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_atan(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_atan2(Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_Math_cos(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_cosh(Real32_t); PRIVATE extern Real32_t Real32_Math_e; -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_exp(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_ln(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_log10(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_exp(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_ln(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_log10(Real32_t); PRIVATE extern Real32_t Real32_Math_pi; -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_pow(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_sin(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_sinh(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_sqrt(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_tan(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_Math_tanh(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_modf(Real32_t,Ref(Real32_t)); -MLTON_CODEGEN_STATIC_INLINE void Real32_move(Ref(Real32_t),Ref(Real32_t)); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_mul(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_muladd(Real32_t,Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_mulsub(Real32_t,Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_neg(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_realCeil(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_realFloor(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_realTrunc(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_rndToReal32(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real32_rndToReal64(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Int16_t Real32_rndToWordS16(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Int32_t Real32_rndToWordS32(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Int64_t Real32_rndToWordS64(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Int8_t Real32_rndToWordS8(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Real32_rndToWordU16(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Real32_rndToWordU32(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Real32_rndToWordU64(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Real32_rndToWordU8(Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_round(Real32_t); -MLTON_CODEGEN_STATIC_INLINE void Real32_store(Ref(Real32_t),Real32_t); +PRIVATE INLINE Real32_t Real32_Math_pow(Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_Math_sin(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_sinh(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_sqrt(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_tan(Real32_t); +PRIVATE INLINE Real32_t Real32_Math_tanh(Real32_t); +PRIVATE INLINE Real32_t Real32_modf(Real32_t,Ref(Real32_t)); +PRIVATE INLINE void Real32_move(Ref(Real32_t),Ref(Real32_t)); +PRIVATE INLINE Real32_t Real32_mul(Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_muladd(Real32_t,Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_mulsub(Real32_t,Real32_t,Real32_t); +PRIVATE INLINE Real32_t Real32_neg(Real32_t); +PRIVATE INLINE Real32_t Real32_realCeil(Real32_t); +PRIVATE INLINE Real32_t Real32_realFloor(Real32_t); +PRIVATE INLINE Real32_t Real32_realTrunc(Real32_t); +PRIVATE INLINE Real32_t Real32_rndToReal32(Real32_t); +PRIVATE INLINE Real64_t Real32_rndToReal64(Real32_t); +PRIVATE INLINE Int16_t Real32_rndToWordS16(Real32_t); +PRIVATE INLINE Int32_t Real32_rndToWordS32(Real32_t); +PRIVATE INLINE Int64_t Real32_rndToWordS64(Real32_t); +PRIVATE INLINE Int8_t Real32_rndToWordS8(Real32_t); +PRIVATE INLINE Word16_t Real32_rndToWordU16(Real32_t); +PRIVATE INLINE Word32_t Real32_rndToWordU32(Real32_t); +PRIVATE INLINE Word64_t Real32_rndToWordU64(Real32_t); +PRIVATE INLINE Word8_t Real32_rndToWordU8(Real32_t); +PRIVATE INLINE Real32_t Real32_round(Real32_t); +PRIVATE INLINE void Real32_store(Ref(Real32_t),Real32_t); PRIVATE Real32_t Real32_strtor(NullString8_t,C_Int_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real32_sub(Real32_t,Real32_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_abs(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_add(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Real64_castToWord64(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_div(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Real64_equal(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_fetch(Ref(Real64_t)); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_frexp(Real64_t,Ref(C_Int_t)); +PRIVATE INLINE Real32_t Real32_sub(Real32_t,Real32_t); +PRIVATE INLINE Real64_t Real64_abs(Real64_t); +PRIVATE INLINE Real64_t Real64_add(Real64_t,Real64_t); +PRIVATE INLINE Word64_t Real64_castToWord64(Real64_t); +PRIVATE INLINE Real64_t Real64_div(Real64_t,Real64_t); +PRIVATE INLINE Bool_t Real64_equal(Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_fetch(Ref(Real64_t)); +PRIVATE INLINE Real64_t Real64_frexp(Real64_t,Ref(C_Int_t)); PRIVATE C_String_t Real64_gdtoa(Real64_t,C_Int_t,C_Int_t,C_Int_t,Ref(C_Int_t)); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_ldexp(Real64_t,C_Int_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Real64_le(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Real64_lt(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_acos(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_asin(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_atan(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_atan2(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_cos(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_cosh(Real64_t); +PRIVATE INLINE Real64_t Real64_ldexp(Real64_t,C_Int_t); +PRIVATE INLINE Bool_t Real64_le(Real64_t,Real64_t); +PRIVATE INLINE Bool_t Real64_lt(Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_Math_acos(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_asin(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_atan(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_atan2(Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_Math_cos(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_cosh(Real64_t); PRIVATE extern Real64_t Real64_Math_e; -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_exp(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_ln(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_log10(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_exp(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_ln(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_log10(Real64_t); PRIVATE extern Real64_t Real64_Math_pi; -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_pow(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_sin(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_sinh(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_sqrt(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_tan(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_Math_tanh(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_modf(Real64_t,Ref(Real64_t)); -MLTON_CODEGEN_STATIC_INLINE void Real64_move(Ref(Real64_t),Ref(Real64_t)); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_mul(Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_muladd(Real64_t,Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_mulsub(Real64_t,Real64_t,Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_neg(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_realCeil(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_realFloor(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_realTrunc(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Real64_rndToReal32(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_rndToReal64(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Int16_t Real64_rndToWordS16(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Int32_t Real64_rndToWordS32(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Int64_t Real64_rndToWordS64(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Int8_t Real64_rndToWordS8(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Real64_rndToWordU16(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Real64_rndToWordU32(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Real64_rndToWordU64(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Real64_rndToWordU8(Real64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_round(Real64_t); -MLTON_CODEGEN_STATIC_INLINE void Real64_store(Ref(Real64_t),Real64_t); +PRIVATE INLINE Real64_t Real64_Math_pow(Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_Math_sin(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_sinh(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_sqrt(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_tan(Real64_t); +PRIVATE INLINE Real64_t Real64_Math_tanh(Real64_t); +PRIVATE INLINE Real64_t Real64_modf(Real64_t,Ref(Real64_t)); +PRIVATE INLINE void Real64_move(Ref(Real64_t),Ref(Real64_t)); +PRIVATE INLINE Real64_t Real64_mul(Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_muladd(Real64_t,Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_mulsub(Real64_t,Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_neg(Real64_t); +PRIVATE INLINE Real64_t Real64_realCeil(Real64_t); +PRIVATE INLINE Real64_t Real64_realFloor(Real64_t); +PRIVATE INLINE Real64_t Real64_realTrunc(Real64_t); +PRIVATE INLINE Real32_t Real64_rndToReal32(Real64_t); +PRIVATE INLINE Real64_t Real64_rndToReal64(Real64_t); +PRIVATE INLINE Int16_t Real64_rndToWordS16(Real64_t); +PRIVATE INLINE Int32_t Real64_rndToWordS32(Real64_t); +PRIVATE INLINE Int64_t Real64_rndToWordS64(Real64_t); +PRIVATE INLINE Int8_t Real64_rndToWordS8(Real64_t); +PRIVATE INLINE Word16_t Real64_rndToWordU16(Real64_t); +PRIVATE INLINE Word32_t Real64_rndToWordU32(Real64_t); +PRIVATE INLINE Word64_t Real64_rndToWordU64(Real64_t); +PRIVATE INLINE Word8_t Real64_rndToWordU8(Real64_t); +PRIVATE INLINE Real64_t Real64_round(Real64_t); +PRIVATE INLINE void Real64_store(Ref(Real64_t),Real64_t); PRIVATE Real64_t Real64_strtor(NullString8_t,C_Int_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Real64_sub(Real64_t,Real64_t); +PRIVATE INLINE Real64_t Real64_sub(Real64_t,Real64_t); PRIVATE C_Errno_t(C_Int_t) Socket_accept(C_Sock_t,Array(Word8_t),Ref(C_Socklen_t)); PRIVATE extern const C_Int_t Socket_AF_INET; PRIVATE extern const C_Int_t Socket_AF_INET6; @@ -933,197 +933,197 @@ PRIVATE C_Errno_t(C_PId_t) Windows_Process_create(NullString8_t,NullString8_t,Nu PRIVATE C_Errno_t(C_PId_t) Windows_Process_createNull(NullString8_t,NullString8_t,C_Fd_t,C_Fd_t,C_Fd_t); PRIVATE C_Errno_t(C_Int_t) Windows_Process_getexitcode(C_PId_t,Ref(C_Status_t)); PRIVATE C_Errno_t(C_Int_t) Windows_Process_terminate(C_PId_t,C_Signal_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_add(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_andb(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Word16_equal(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_lshift(Word16_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_neg(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_notb(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_orb(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_rol(Word16_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_ror(Word16_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_sub(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t Word16_xorb(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_add(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_andb(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Real32_t Word32_castToReal32(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Word32_equal(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_lshift(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_neg(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_notb(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_orb(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_rol(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_ror(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_sub(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t Word32_xorb(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_add(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_andb(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Real64_t Word64_castToReal64(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Word64_equal(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_fetch(Ref(Word64_t)); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_lshift(Word64_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE void Word64_move(Ref(Word64_t),Ref(Word64_t)); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_neg(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_notb(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_orb(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_rol(Word64_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_ror(Word64_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE void Word64_store(Ref(Word64_t),Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_sub(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t Word64_xorb(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_add(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_andb(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t Word8_equal(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_lshift(Word8_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_neg(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_notb(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_orb(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_rol(Word8_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_ror(Word8_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_sub(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t Word8_xorb(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_addCheckP(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordS16_extdToWord16(Int16_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordS16_extdToWord32(Int16_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordS16_extdToWord64(Int16_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordS16_extdToWord8(Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_ge(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_gt(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_le(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_lt(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Int16_t WordS16_mul(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_mulCheckP(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_negCheckP(Int16_t); -MLTON_CODEGEN_STATIC_INLINE Int16_t WordS16_quot(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Int16_t WordS16_rem(Int16_t,Int16_t); +PRIVATE INLINE Word16_t Word16_add(Word16_t,Word16_t); +PRIVATE INLINE Word16_t Word16_andb(Word16_t,Word16_t); +PRIVATE INLINE Bool_t Word16_equal(Word16_t,Word16_t); +PRIVATE INLINE Word16_t Word16_lshift(Word16_t,Word32_t); +PRIVATE INLINE Word16_t Word16_neg(Word16_t); +PRIVATE INLINE Word16_t Word16_notb(Word16_t); +PRIVATE INLINE Word16_t Word16_orb(Word16_t,Word16_t); +PRIVATE INLINE Word16_t Word16_rol(Word16_t,Word32_t); +PRIVATE INLINE Word16_t Word16_ror(Word16_t,Word32_t); +PRIVATE INLINE Word16_t Word16_sub(Word16_t,Word16_t); +PRIVATE INLINE Word16_t Word16_xorb(Word16_t,Word16_t); +PRIVATE INLINE Word32_t Word32_add(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_andb(Word32_t,Word32_t); +PRIVATE INLINE Real32_t Word32_castToReal32(Word32_t); +PRIVATE INLINE Bool_t Word32_equal(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_lshift(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_neg(Word32_t); +PRIVATE INLINE Word32_t Word32_notb(Word32_t); +PRIVATE INLINE Word32_t Word32_orb(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_rol(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_ror(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_sub(Word32_t,Word32_t); +PRIVATE INLINE Word32_t Word32_xorb(Word32_t,Word32_t); +PRIVATE INLINE Word64_t Word64_add(Word64_t,Word64_t); +PRIVATE INLINE Word64_t Word64_andb(Word64_t,Word64_t); +PRIVATE INLINE Real64_t Word64_castToReal64(Word64_t); +PRIVATE INLINE Bool_t Word64_equal(Word64_t,Word64_t); +PRIVATE INLINE Word64_t Word64_fetch(Ref(Word64_t)); +PRIVATE INLINE Word64_t Word64_lshift(Word64_t,Word32_t); +PRIVATE INLINE void Word64_move(Ref(Word64_t),Ref(Word64_t)); +PRIVATE INLINE Word64_t Word64_neg(Word64_t); +PRIVATE INLINE Word64_t Word64_notb(Word64_t); +PRIVATE INLINE Word64_t Word64_orb(Word64_t,Word64_t); +PRIVATE INLINE Word64_t Word64_rol(Word64_t,Word32_t); +PRIVATE INLINE Word64_t Word64_ror(Word64_t,Word32_t); +PRIVATE INLINE void Word64_store(Ref(Word64_t),Word64_t); +PRIVATE INLINE Word64_t Word64_sub(Word64_t,Word64_t); +PRIVATE INLINE Word64_t Word64_xorb(Word64_t,Word64_t); +PRIVATE INLINE Word8_t Word8_add(Word8_t,Word8_t); +PRIVATE INLINE Word8_t Word8_andb(Word8_t,Word8_t); +PRIVATE INLINE Bool_t Word8_equal(Word8_t,Word8_t); +PRIVATE INLINE Word8_t Word8_lshift(Word8_t,Word32_t); +PRIVATE INLINE Word8_t Word8_neg(Word8_t); +PRIVATE INLINE Word8_t Word8_notb(Word8_t); +PRIVATE INLINE Word8_t Word8_orb(Word8_t,Word8_t); +PRIVATE INLINE Word8_t Word8_rol(Word8_t,Word32_t); +PRIVATE INLINE Word8_t Word8_ror(Word8_t,Word32_t); +PRIVATE INLINE Word8_t Word8_sub(Word8_t,Word8_t); +PRIVATE INLINE Word8_t Word8_xorb(Word8_t,Word8_t); +PRIVATE INLINE Bool_t WordS16_addCheckP(Int16_t,Int16_t); +PRIVATE INLINE Word16_t WordS16_extdToWord16(Int16_t); +PRIVATE INLINE Word32_t WordS16_extdToWord32(Int16_t); +PRIVATE INLINE Word64_t WordS16_extdToWord64(Int16_t); +PRIVATE INLINE Word8_t WordS16_extdToWord8(Int16_t); +PRIVATE INLINE Bool_t WordS16_ge(Int16_t,Int16_t); +PRIVATE INLINE Bool_t WordS16_gt(Int16_t,Int16_t); +PRIVATE INLINE Bool_t WordS16_le(Int16_t,Int16_t); +PRIVATE INLINE Bool_t WordS16_lt(Int16_t,Int16_t); +PRIVATE INLINE Int16_t WordS16_mul(Int16_t,Int16_t); +PRIVATE INLINE Bool_t WordS16_mulCheckP(Int16_t,Int16_t); +PRIVATE INLINE Bool_t WordS16_negCheckP(Int16_t); +PRIVATE INLINE Int16_t WordS16_quot(Int16_t,Int16_t); +PRIVATE INLINE Int16_t WordS16_rem(Int16_t,Int16_t); PRIVATE Real32_t WordS16_rndToReal32(Int16_t); PRIVATE Real64_t WordS16_rndToReal64(Int16_t); -MLTON_CODEGEN_STATIC_INLINE Int16_t WordS16_rshift(Int16_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS16_subCheckP(Int16_t,Int16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_addCheckP(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordS32_extdToWord16(Int32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordS32_extdToWord32(Int32_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordS32_extdToWord64(Int32_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordS32_extdToWord8(Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_ge(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_gt(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_le(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_lt(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Int32_t WordS32_mul(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_mulCheckP(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_negCheckP(Int32_t); -MLTON_CODEGEN_STATIC_INLINE Int32_t WordS32_quot(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Int32_t WordS32_rem(Int32_t,Int32_t); +PRIVATE INLINE Int16_t WordS16_rshift(Int16_t,Word32_t); +PRIVATE INLINE Bool_t WordS16_subCheckP(Int16_t,Int16_t); +PRIVATE INLINE Bool_t WordS32_addCheckP(Int32_t,Int32_t); +PRIVATE INLINE Word16_t WordS32_extdToWord16(Int32_t); +PRIVATE INLINE Word32_t WordS32_extdToWord32(Int32_t); +PRIVATE INLINE Word64_t WordS32_extdToWord64(Int32_t); +PRIVATE INLINE Word8_t WordS32_extdToWord8(Int32_t); +PRIVATE INLINE Bool_t WordS32_ge(Int32_t,Int32_t); +PRIVATE INLINE Bool_t WordS32_gt(Int32_t,Int32_t); +PRIVATE INLINE Bool_t WordS32_le(Int32_t,Int32_t); +PRIVATE INLINE Bool_t WordS32_lt(Int32_t,Int32_t); +PRIVATE INLINE Int32_t WordS32_mul(Int32_t,Int32_t); +PRIVATE INLINE Bool_t WordS32_mulCheckP(Int32_t,Int32_t); +PRIVATE INLINE Bool_t WordS32_negCheckP(Int32_t); +PRIVATE INLINE Int32_t WordS32_quot(Int32_t,Int32_t); +PRIVATE INLINE Int32_t WordS32_rem(Int32_t,Int32_t); PRIVATE Real32_t WordS32_rndToReal32(Int32_t); PRIVATE Real64_t WordS32_rndToReal64(Int32_t); -MLTON_CODEGEN_STATIC_INLINE Int32_t WordS32_rshift(Int32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS32_subCheckP(Int32_t,Int32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_addCheckP(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordS64_extdToWord16(Int64_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordS64_extdToWord32(Int64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordS64_extdToWord64(Int64_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordS64_extdToWord8(Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_ge(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_gt(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_le(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_lt(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Int64_t WordS64_mul(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_mulCheckP(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_negCheckP(Int64_t); -MLTON_CODEGEN_STATIC_INLINE Int64_t WordS64_quot(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Int64_t WordS64_rem(Int64_t,Int64_t); +PRIVATE INLINE Int32_t WordS32_rshift(Int32_t,Word32_t); +PRIVATE INLINE Bool_t WordS32_subCheckP(Int32_t,Int32_t); +PRIVATE INLINE Bool_t WordS64_addCheckP(Int64_t,Int64_t); +PRIVATE INLINE Word16_t WordS64_extdToWord16(Int64_t); +PRIVATE INLINE Word32_t WordS64_extdToWord32(Int64_t); +PRIVATE INLINE Word64_t WordS64_extdToWord64(Int64_t); +PRIVATE INLINE Word8_t WordS64_extdToWord8(Int64_t); +PRIVATE INLINE Bool_t WordS64_ge(Int64_t,Int64_t); +PRIVATE INLINE Bool_t WordS64_gt(Int64_t,Int64_t); +PRIVATE INLINE Bool_t WordS64_le(Int64_t,Int64_t); +PRIVATE INLINE Bool_t WordS64_lt(Int64_t,Int64_t); +PRIVATE INLINE Int64_t WordS64_mul(Int64_t,Int64_t); +PRIVATE INLINE Bool_t WordS64_mulCheckP(Int64_t,Int64_t); +PRIVATE INLINE Bool_t WordS64_negCheckP(Int64_t); +PRIVATE INLINE Int64_t WordS64_quot(Int64_t,Int64_t); +PRIVATE INLINE Int64_t WordS64_rem(Int64_t,Int64_t); PRIVATE Real32_t WordS64_rndToReal32(Int64_t); PRIVATE Real64_t WordS64_rndToReal64(Int64_t); -MLTON_CODEGEN_STATIC_INLINE Int64_t WordS64_rshift(Int64_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS64_subCheckP(Int64_t,Int64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_addCheckP(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordS8_extdToWord16(Int8_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordS8_extdToWord32(Int8_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordS8_extdToWord64(Int8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordS8_extdToWord8(Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_ge(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_gt(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_le(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_lt(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Int8_t WordS8_mul(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_mulCheckP(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_negCheckP(Int8_t); -MLTON_CODEGEN_STATIC_INLINE Int8_t WordS8_quot(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Int8_t WordS8_rem(Int8_t,Int8_t); +PRIVATE INLINE Int64_t WordS64_rshift(Int64_t,Word32_t); +PRIVATE INLINE Bool_t WordS64_subCheckP(Int64_t,Int64_t); +PRIVATE INLINE Bool_t WordS8_addCheckP(Int8_t,Int8_t); +PRIVATE INLINE Word16_t WordS8_extdToWord16(Int8_t); +PRIVATE INLINE Word32_t WordS8_extdToWord32(Int8_t); +PRIVATE INLINE Word64_t WordS8_extdToWord64(Int8_t); +PRIVATE INLINE Word8_t WordS8_extdToWord8(Int8_t); +PRIVATE INLINE Bool_t WordS8_ge(Int8_t,Int8_t); +PRIVATE INLINE Bool_t WordS8_gt(Int8_t,Int8_t); +PRIVATE INLINE Bool_t WordS8_le(Int8_t,Int8_t); +PRIVATE INLINE Bool_t WordS8_lt(Int8_t,Int8_t); +PRIVATE INLINE Int8_t WordS8_mul(Int8_t,Int8_t); +PRIVATE INLINE Bool_t WordS8_mulCheckP(Int8_t,Int8_t); +PRIVATE INLINE Bool_t WordS8_negCheckP(Int8_t); +PRIVATE INLINE Int8_t WordS8_quot(Int8_t,Int8_t); +PRIVATE INLINE Int8_t WordS8_rem(Int8_t,Int8_t); PRIVATE Real32_t WordS8_rndToReal32(Int8_t); PRIVATE Real64_t WordS8_rndToReal64(Int8_t); -MLTON_CODEGEN_STATIC_INLINE Int8_t WordS8_rshift(Int8_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordS8_subCheckP(Int8_t,Int8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_addCheckP(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU16_extdToWord16(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU16_extdToWord32(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU16_extdToWord64(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU16_extdToWord8(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_ge(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_gt(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_le(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_lt(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU16_mul(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_mulCheckP(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_negCheckP(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU16_quot(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU16_rem(Word16_t,Word16_t); +PRIVATE INLINE Int8_t WordS8_rshift(Int8_t,Word32_t); +PRIVATE INLINE Bool_t WordS8_subCheckP(Int8_t,Int8_t); +PRIVATE INLINE Bool_t WordU16_addCheckP(Word16_t,Word16_t); +PRIVATE INLINE Word16_t WordU16_extdToWord16(Word16_t); +PRIVATE INLINE Word32_t WordU16_extdToWord32(Word16_t); +PRIVATE INLINE Word64_t WordU16_extdToWord64(Word16_t); +PRIVATE INLINE Word8_t WordU16_extdToWord8(Word16_t); +PRIVATE INLINE Bool_t WordU16_ge(Word16_t,Word16_t); +PRIVATE INLINE Bool_t WordU16_gt(Word16_t,Word16_t); +PRIVATE INLINE Bool_t WordU16_le(Word16_t,Word16_t); +PRIVATE INLINE Bool_t WordU16_lt(Word16_t,Word16_t); +PRIVATE INLINE Word16_t WordU16_mul(Word16_t,Word16_t); +PRIVATE INLINE Bool_t WordU16_mulCheckP(Word16_t,Word16_t); +PRIVATE INLINE Bool_t WordU16_negCheckP(Word16_t); +PRIVATE INLINE Word16_t WordU16_quot(Word16_t,Word16_t); +PRIVATE INLINE Word16_t WordU16_rem(Word16_t,Word16_t); PRIVATE Real32_t WordU16_rndToReal32(Word16_t); PRIVATE Real64_t WordU16_rndToReal64(Word16_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU16_rshift(Word16_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU16_subCheckP(Word16_t,Word16_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_addCheckP(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU32_extdToWord16(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU32_extdToWord32(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU32_extdToWord64(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU32_extdToWord8(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_ge(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_gt(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_le(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_lt(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU32_mul(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_mulCheckP(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_negCheckP(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU32_quot(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU32_rem(Word32_t,Word32_t); +PRIVATE INLINE Word16_t WordU16_rshift(Word16_t,Word32_t); +PRIVATE INLINE Bool_t WordU16_subCheckP(Word16_t,Word16_t); +PRIVATE INLINE Bool_t WordU32_addCheckP(Word32_t,Word32_t); +PRIVATE INLINE Word16_t WordU32_extdToWord16(Word32_t); +PRIVATE INLINE Word32_t WordU32_extdToWord32(Word32_t); +PRIVATE INLINE Word64_t WordU32_extdToWord64(Word32_t); +PRIVATE INLINE Word8_t WordU32_extdToWord8(Word32_t); +PRIVATE INLINE Bool_t WordU32_ge(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU32_gt(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU32_le(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU32_lt(Word32_t,Word32_t); +PRIVATE INLINE Word32_t WordU32_mul(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU32_mulCheckP(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU32_negCheckP(Word32_t); +PRIVATE INLINE Word32_t WordU32_quot(Word32_t,Word32_t); +PRIVATE INLINE Word32_t WordU32_rem(Word32_t,Word32_t); PRIVATE Real32_t WordU32_rndToReal32(Word32_t); PRIVATE Real64_t WordU32_rndToReal64(Word32_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU32_rshift(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU32_subCheckP(Word32_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_addCheckP(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU64_extdToWord16(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU64_extdToWord32(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU64_extdToWord64(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU64_extdToWord8(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_ge(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_gt(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_le(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_lt(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU64_mul(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_mulCheckP(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_negCheckP(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU64_quot(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU64_rem(Word64_t,Word64_t); +PRIVATE INLINE Word32_t WordU32_rshift(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU32_subCheckP(Word32_t,Word32_t); +PRIVATE INLINE Bool_t WordU64_addCheckP(Word64_t,Word64_t); +PRIVATE INLINE Word16_t WordU64_extdToWord16(Word64_t); +PRIVATE INLINE Word32_t WordU64_extdToWord32(Word64_t); +PRIVATE INLINE Word64_t WordU64_extdToWord64(Word64_t); +PRIVATE INLINE Word8_t WordU64_extdToWord8(Word64_t); +PRIVATE INLINE Bool_t WordU64_ge(Word64_t,Word64_t); +PRIVATE INLINE Bool_t WordU64_gt(Word64_t,Word64_t); +PRIVATE INLINE Bool_t WordU64_le(Word64_t,Word64_t); +PRIVATE INLINE Bool_t WordU64_lt(Word64_t,Word64_t); +PRIVATE INLINE Word64_t WordU64_mul(Word64_t,Word64_t); +PRIVATE INLINE Bool_t WordU64_mulCheckP(Word64_t,Word64_t); +PRIVATE INLINE Bool_t WordU64_negCheckP(Word64_t); +PRIVATE INLINE Word64_t WordU64_quot(Word64_t,Word64_t); +PRIVATE INLINE Word64_t WordU64_rem(Word64_t,Word64_t); PRIVATE Real32_t WordU64_rndToReal32(Word64_t); PRIVATE Real64_t WordU64_rndToReal64(Word64_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU64_rshift(Word64_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU64_subCheckP(Word64_t,Word64_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_addCheckP(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word16_t WordU8_extdToWord16(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word32_t WordU8_extdToWord32(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word64_t WordU8_extdToWord64(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU8_extdToWord8(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_ge(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_gt(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_le(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_lt(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU8_mul(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_mulCheckP(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_negCheckP(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU8_quot(Word8_t,Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU8_rem(Word8_t,Word8_t); +PRIVATE INLINE Word64_t WordU64_rshift(Word64_t,Word32_t); +PRIVATE INLINE Bool_t WordU64_subCheckP(Word64_t,Word64_t); +PRIVATE INLINE Bool_t WordU8_addCheckP(Word8_t,Word8_t); +PRIVATE INLINE Word16_t WordU8_extdToWord16(Word8_t); +PRIVATE INLINE Word32_t WordU8_extdToWord32(Word8_t); +PRIVATE INLINE Word64_t WordU8_extdToWord64(Word8_t); +PRIVATE INLINE Word8_t WordU8_extdToWord8(Word8_t); +PRIVATE INLINE Bool_t WordU8_ge(Word8_t,Word8_t); +PRIVATE INLINE Bool_t WordU8_gt(Word8_t,Word8_t); +PRIVATE INLINE Bool_t WordU8_le(Word8_t,Word8_t); +PRIVATE INLINE Bool_t WordU8_lt(Word8_t,Word8_t); +PRIVATE INLINE Word8_t WordU8_mul(Word8_t,Word8_t); +PRIVATE INLINE Bool_t WordU8_mulCheckP(Word8_t,Word8_t); +PRIVATE INLINE Bool_t WordU8_negCheckP(Word8_t); +PRIVATE INLINE Word8_t WordU8_quot(Word8_t,Word8_t); +PRIVATE INLINE Word8_t WordU8_rem(Word8_t,Word8_t); PRIVATE Real32_t WordU8_rndToReal32(Word8_t); PRIVATE Real64_t WordU8_rndToReal64(Word8_t); -MLTON_CODEGEN_STATIC_INLINE Word8_t WordU8_rshift(Word8_t,Word32_t); -MLTON_CODEGEN_STATIC_INLINE Bool_t WordU8_subCheckP(Word8_t,Word8_t); +PRIVATE INLINE Word8_t WordU8_rshift(Word8_t,Word32_t); +PRIVATE INLINE Bool_t WordU8_subCheckP(Word8_t,Word8_t); #endif /* _MLTON_BASIS_FFI_H_ */ diff --git a/runtime/gen/basis-ffi.sml b/runtime/gen/basis-ffi.sml index ada190a03c..1997ca7146 100644 --- a/runtime/gen/basis-ffi.sml +++ b/runtime/gen/basis-ffi.sml @@ -909,118 +909,118 @@ end structure Real32 = struct type t = Real32.t -val abs = _import "Real32_abs" private : Real32.t -> Real32.t; -val add = _import "Real32_add" private : Real32.t * Real32.t -> Real32.t; -val castToWord32 = _import "Real32_castToWord32" private : Real32.t -> Word32.t; -val div = _import "Real32_div" private : Real32.t * Real32.t -> Real32.t; -val equal = _import "Real32_equal" private : Real32.t * Real32.t -> Bool.t; -val fetch = _import "Real32_fetch" private : (Real32.t) ref -> Real32.t; -val frexp = _import "Real32_frexp" private : Real32.t * (C_Int.t) ref -> Real32.t; +val abs = _import "Real32_abs" private inline : Real32.t -> Real32.t; +val add = _import "Real32_add" private inline : Real32.t * Real32.t -> Real32.t; +val castToWord32 = _import "Real32_castToWord32" private inline : Real32.t -> Word32.t; +val div = _import "Real32_div" private inline : Real32.t * Real32.t -> Real32.t; +val equal = _import "Real32_equal" private inline : Real32.t * Real32.t -> Bool.t; +val fetch = _import "Real32_fetch" private inline : (Real32.t) ref -> Real32.t; +val frexp = _import "Real32_frexp" private inline : Real32.t * (C_Int.t) ref -> Real32.t; val gdtoa = _import "Real32_gdtoa" private : Real32.t * C_Int.t * C_Int.t * C_Int.t * (C_Int.t) ref -> C_String.t; -val ldexp = _import "Real32_ldexp" private : Real32.t * C_Int.t -> Real32.t; -val le = _import "Real32_le" private : Real32.t * Real32.t -> Bool.t; -val lt = _import "Real32_lt" private : Real32.t * Real32.t -> Bool.t; +val ldexp = _import "Real32_ldexp" private inline : Real32.t * C_Int.t -> Real32.t; +val le = _import "Real32_le" private inline : Real32.t * Real32.t -> Bool.t; +val lt = _import "Real32_lt" private inline : Real32.t * Real32.t -> Bool.t; structure Math = struct -val acos = _import "Real32_Math_acos" private : Real32.t -> Real32.t; -val asin = _import "Real32_Math_asin" private : Real32.t -> Real32.t; -val atan = _import "Real32_Math_atan" private : Real32.t -> Real32.t; -val atan2 = _import "Real32_Math_atan2" private : Real32.t * Real32.t -> Real32.t; -val cos = _import "Real32_Math_cos" private : Real32.t -> Real32.t; -val cosh = _import "Real32_Math_cosh" private : Real32.t -> Real32.t; +val acos = _import "Real32_Math_acos" private inline : Real32.t -> Real32.t; +val asin = _import "Real32_Math_asin" private inline : Real32.t -> Real32.t; +val atan = _import "Real32_Math_atan" private inline : Real32.t -> Real32.t; +val atan2 = _import "Real32_Math_atan2" private inline : Real32.t * Real32.t -> Real32.t; +val cos = _import "Real32_Math_cos" private inline : Real32.t -> Real32.t; +val cosh = _import "Real32_Math_cosh" private inline : Real32.t -> Real32.t; val (eGet, eSet) = _symbol "Real32_Math_e" private : (unit -> (Real32.t)) * ((Real32.t) -> unit); -val exp = _import "Real32_Math_exp" private : Real32.t -> Real32.t; -val ln = _import "Real32_Math_ln" private : Real32.t -> Real32.t; -val log10 = _import "Real32_Math_log10" private : Real32.t -> Real32.t; +val exp = _import "Real32_Math_exp" private inline : Real32.t -> Real32.t; +val ln = _import "Real32_Math_ln" private inline : Real32.t -> Real32.t; +val log10 = _import "Real32_Math_log10" private inline : Real32.t -> Real32.t; val (piGet, piSet) = _symbol "Real32_Math_pi" private : (unit -> (Real32.t)) * ((Real32.t) -> unit); -val pow = _import "Real32_Math_pow" private : Real32.t * Real32.t -> Real32.t; -val sin = _import "Real32_Math_sin" private : Real32.t -> Real32.t; -val sinh = _import "Real32_Math_sinh" private : Real32.t -> Real32.t; -val sqrt = _import "Real32_Math_sqrt" private : Real32.t -> Real32.t; -val tan = _import "Real32_Math_tan" private : Real32.t -> Real32.t; -val tanh = _import "Real32_Math_tanh" private : Real32.t -> Real32.t; -end -val modf = _import "Real32_modf" private : Real32.t * (Real32.t) ref -> Real32.t; -val move = _import "Real32_move" private : (Real32.t) ref * (Real32.t) ref -> unit; -val mul = _import "Real32_mul" private : Real32.t * Real32.t -> Real32.t; -val muladd = _import "Real32_muladd" private : Real32.t * Real32.t * Real32.t -> Real32.t; -val mulsub = _import "Real32_mulsub" private : Real32.t * Real32.t * Real32.t -> Real32.t; -val neg = _import "Real32_neg" private : Real32.t -> Real32.t; -val realCeil = _import "Real32_realCeil" private : Real32.t -> Real32.t; -val realFloor = _import "Real32_realFloor" private : Real32.t -> Real32.t; -val realTrunc = _import "Real32_realTrunc" private : Real32.t -> Real32.t; -val rndToReal32 = _import "Real32_rndToReal32" private : Real32.t -> Real32.t; -val rndToReal64 = _import "Real32_rndToReal64" private : Real32.t -> Real64.t; -val rndToWordS16 = _import "Real32_rndToWordS16" private : Real32.t -> Int16.t; -val rndToWordS32 = _import "Real32_rndToWordS32" private : Real32.t -> Int32.t; -val rndToWordS64 = _import "Real32_rndToWordS64" private : Real32.t -> Int64.t; -val rndToWordS8 = _import "Real32_rndToWordS8" private : Real32.t -> Int8.t; -val rndToWordU16 = _import "Real32_rndToWordU16" private : Real32.t -> Word16.t; -val rndToWordU32 = _import "Real32_rndToWordU32" private : Real32.t -> Word32.t; -val rndToWordU64 = _import "Real32_rndToWordU64" private : Real32.t -> Word64.t; -val rndToWordU8 = _import "Real32_rndToWordU8" private : Real32.t -> Word8.t; -val round = _import "Real32_round" private : Real32.t -> Real32.t; -val store = _import "Real32_store" private : (Real32.t) ref * Real32.t -> unit; +val pow = _import "Real32_Math_pow" private inline : Real32.t * Real32.t -> Real32.t; +val sin = _import "Real32_Math_sin" private inline : Real32.t -> Real32.t; +val sinh = _import "Real32_Math_sinh" private inline : Real32.t -> Real32.t; +val sqrt = _import "Real32_Math_sqrt" private inline : Real32.t -> Real32.t; +val tan = _import "Real32_Math_tan" private inline : Real32.t -> Real32.t; +val tanh = _import "Real32_Math_tanh" private inline : Real32.t -> Real32.t; +end +val modf = _import "Real32_modf" private inline : Real32.t * (Real32.t) ref -> Real32.t; +val move = _import "Real32_move" private inline : (Real32.t) ref * (Real32.t) ref -> unit; +val mul = _import "Real32_mul" private inline : Real32.t * Real32.t -> Real32.t; +val muladd = _import "Real32_muladd" private inline : Real32.t * Real32.t * Real32.t -> Real32.t; +val mulsub = _import "Real32_mulsub" private inline : Real32.t * Real32.t * Real32.t -> Real32.t; +val neg = _import "Real32_neg" private inline : Real32.t -> Real32.t; +val realCeil = _import "Real32_realCeil" private inline : Real32.t -> Real32.t; +val realFloor = _import "Real32_realFloor" private inline : Real32.t -> Real32.t; +val realTrunc = _import "Real32_realTrunc" private inline : Real32.t -> Real32.t; +val rndToReal32 = _import "Real32_rndToReal32" private inline : Real32.t -> Real32.t; +val rndToReal64 = _import "Real32_rndToReal64" private inline : Real32.t -> Real64.t; +val rndToWordS16 = _import "Real32_rndToWordS16" private inline : Real32.t -> Int16.t; +val rndToWordS32 = _import "Real32_rndToWordS32" private inline : Real32.t -> Int32.t; +val rndToWordS64 = _import "Real32_rndToWordS64" private inline : Real32.t -> Int64.t; +val rndToWordS8 = _import "Real32_rndToWordS8" private inline : Real32.t -> Int8.t; +val rndToWordU16 = _import "Real32_rndToWordU16" private inline : Real32.t -> Word16.t; +val rndToWordU32 = _import "Real32_rndToWordU32" private inline : Real32.t -> Word32.t; +val rndToWordU64 = _import "Real32_rndToWordU64" private inline : Real32.t -> Word64.t; +val rndToWordU8 = _import "Real32_rndToWordU8" private inline : Real32.t -> Word8.t; +val round = _import "Real32_round" private inline : Real32.t -> Real32.t; +val store = _import "Real32_store" private inline : (Real32.t) ref * Real32.t -> unit; val strtor = _import "Real32_strtor" private : NullString8.t * C_Int.t -> Real32.t; -val sub = _import "Real32_sub" private : Real32.t * Real32.t -> Real32.t; +val sub = _import "Real32_sub" private inline : Real32.t * Real32.t -> Real32.t; end structure Real64 = struct type t = Real64.t -val abs = _import "Real64_abs" private : Real64.t -> Real64.t; -val add = _import "Real64_add" private : Real64.t * Real64.t -> Real64.t; -val castToWord64 = _import "Real64_castToWord64" private : Real64.t -> Word64.t; -val div = _import "Real64_div" private : Real64.t * Real64.t -> Real64.t; -val equal = _import "Real64_equal" private : Real64.t * Real64.t -> Bool.t; -val fetch = _import "Real64_fetch" private : (Real64.t) ref -> Real64.t; -val frexp = _import "Real64_frexp" private : Real64.t * (C_Int.t) ref -> Real64.t; +val abs = _import "Real64_abs" private inline : Real64.t -> Real64.t; +val add = _import "Real64_add" private inline : Real64.t * Real64.t -> Real64.t; +val castToWord64 = _import "Real64_castToWord64" private inline : Real64.t -> Word64.t; +val div = _import "Real64_div" private inline : Real64.t * Real64.t -> Real64.t; +val equal = _import "Real64_equal" private inline : Real64.t * Real64.t -> Bool.t; +val fetch = _import "Real64_fetch" private inline : (Real64.t) ref -> Real64.t; +val frexp = _import "Real64_frexp" private inline : Real64.t * (C_Int.t) ref -> Real64.t; val gdtoa = _import "Real64_gdtoa" private : Real64.t * C_Int.t * C_Int.t * C_Int.t * (C_Int.t) ref -> C_String.t; -val ldexp = _import "Real64_ldexp" private : Real64.t * C_Int.t -> Real64.t; -val le = _import "Real64_le" private : Real64.t * Real64.t -> Bool.t; -val lt = _import "Real64_lt" private : Real64.t * Real64.t -> Bool.t; +val ldexp = _import "Real64_ldexp" private inline : Real64.t * C_Int.t -> Real64.t; +val le = _import "Real64_le" private inline : Real64.t * Real64.t -> Bool.t; +val lt = _import "Real64_lt" private inline : Real64.t * Real64.t -> Bool.t; structure Math = struct -val acos = _import "Real64_Math_acos" private : Real64.t -> Real64.t; -val asin = _import "Real64_Math_asin" private : Real64.t -> Real64.t; -val atan = _import "Real64_Math_atan" private : Real64.t -> Real64.t; -val atan2 = _import "Real64_Math_atan2" private : Real64.t * Real64.t -> Real64.t; -val cos = _import "Real64_Math_cos" private : Real64.t -> Real64.t; -val cosh = _import "Real64_Math_cosh" private : Real64.t -> Real64.t; +val acos = _import "Real64_Math_acos" private inline : Real64.t -> Real64.t; +val asin = _import "Real64_Math_asin" private inline : Real64.t -> Real64.t; +val atan = _import "Real64_Math_atan" private inline : Real64.t -> Real64.t; +val atan2 = _import "Real64_Math_atan2" private inline : Real64.t * Real64.t -> Real64.t; +val cos = _import "Real64_Math_cos" private inline : Real64.t -> Real64.t; +val cosh = _import "Real64_Math_cosh" private inline : Real64.t -> Real64.t; val (eGet, eSet) = _symbol "Real64_Math_e" private : (unit -> (Real64.t)) * ((Real64.t) -> unit); -val exp = _import "Real64_Math_exp" private : Real64.t -> Real64.t; -val ln = _import "Real64_Math_ln" private : Real64.t -> Real64.t; -val log10 = _import "Real64_Math_log10" private : Real64.t -> Real64.t; +val exp = _import "Real64_Math_exp" private inline : Real64.t -> Real64.t; +val ln = _import "Real64_Math_ln" private inline : Real64.t -> Real64.t; +val log10 = _import "Real64_Math_log10" private inline : Real64.t -> Real64.t; val (piGet, piSet) = _symbol "Real64_Math_pi" private : (unit -> (Real64.t)) * ((Real64.t) -> unit); -val pow = _import "Real64_Math_pow" private : Real64.t * Real64.t -> Real64.t; -val sin = _import "Real64_Math_sin" private : Real64.t -> Real64.t; -val sinh = _import "Real64_Math_sinh" private : Real64.t -> Real64.t; -val sqrt = _import "Real64_Math_sqrt" private : Real64.t -> Real64.t; -val tan = _import "Real64_Math_tan" private : Real64.t -> Real64.t; -val tanh = _import "Real64_Math_tanh" private : Real64.t -> Real64.t; -end -val modf = _import "Real64_modf" private : Real64.t * (Real64.t) ref -> Real64.t; -val move = _import "Real64_move" private : (Real64.t) ref * (Real64.t) ref -> unit; -val mul = _import "Real64_mul" private : Real64.t * Real64.t -> Real64.t; -val muladd = _import "Real64_muladd" private : Real64.t * Real64.t * Real64.t -> Real64.t; -val mulsub = _import "Real64_mulsub" private : Real64.t * Real64.t * Real64.t -> Real64.t; -val neg = _import "Real64_neg" private : Real64.t -> Real64.t; -val realCeil = _import "Real64_realCeil" private : Real64.t -> Real64.t; -val realFloor = _import "Real64_realFloor" private : Real64.t -> Real64.t; -val realTrunc = _import "Real64_realTrunc" private : Real64.t -> Real64.t; -val rndToReal32 = _import "Real64_rndToReal32" private : Real64.t -> Real32.t; -val rndToReal64 = _import "Real64_rndToReal64" private : Real64.t -> Real64.t; -val rndToWordS16 = _import "Real64_rndToWordS16" private : Real64.t -> Int16.t; -val rndToWordS32 = _import "Real64_rndToWordS32" private : Real64.t -> Int32.t; -val rndToWordS64 = _import "Real64_rndToWordS64" private : Real64.t -> Int64.t; -val rndToWordS8 = _import "Real64_rndToWordS8" private : Real64.t -> Int8.t; -val rndToWordU16 = _import "Real64_rndToWordU16" private : Real64.t -> Word16.t; -val rndToWordU32 = _import "Real64_rndToWordU32" private : Real64.t -> Word32.t; -val rndToWordU64 = _import "Real64_rndToWordU64" private : Real64.t -> Word64.t; -val rndToWordU8 = _import "Real64_rndToWordU8" private : Real64.t -> Word8.t; -val round = _import "Real64_round" private : Real64.t -> Real64.t; -val store = _import "Real64_store" private : (Real64.t) ref * Real64.t -> unit; +val pow = _import "Real64_Math_pow" private inline : Real64.t * Real64.t -> Real64.t; +val sin = _import "Real64_Math_sin" private inline : Real64.t -> Real64.t; +val sinh = _import "Real64_Math_sinh" private inline : Real64.t -> Real64.t; +val sqrt = _import "Real64_Math_sqrt" private inline : Real64.t -> Real64.t; +val tan = _import "Real64_Math_tan" private inline : Real64.t -> Real64.t; +val tanh = _import "Real64_Math_tanh" private inline : Real64.t -> Real64.t; +end +val modf = _import "Real64_modf" private inline : Real64.t * (Real64.t) ref -> Real64.t; +val move = _import "Real64_move" private inline : (Real64.t) ref * (Real64.t) ref -> unit; +val mul = _import "Real64_mul" private inline : Real64.t * Real64.t -> Real64.t; +val muladd = _import "Real64_muladd" private inline : Real64.t * Real64.t * Real64.t -> Real64.t; +val mulsub = _import "Real64_mulsub" private inline : Real64.t * Real64.t * Real64.t -> Real64.t; +val neg = _import "Real64_neg" private inline : Real64.t -> Real64.t; +val realCeil = _import "Real64_realCeil" private inline : Real64.t -> Real64.t; +val realFloor = _import "Real64_realFloor" private inline : Real64.t -> Real64.t; +val realTrunc = _import "Real64_realTrunc" private inline : Real64.t -> Real64.t; +val rndToReal32 = _import "Real64_rndToReal32" private inline : Real64.t -> Real32.t; +val rndToReal64 = _import "Real64_rndToReal64" private inline : Real64.t -> Real64.t; +val rndToWordS16 = _import "Real64_rndToWordS16" private inline : Real64.t -> Int16.t; +val rndToWordS32 = _import "Real64_rndToWordS32" private inline : Real64.t -> Int32.t; +val rndToWordS64 = _import "Real64_rndToWordS64" private inline : Real64.t -> Int64.t; +val rndToWordS8 = _import "Real64_rndToWordS8" private inline : Real64.t -> Int8.t; +val rndToWordU16 = _import "Real64_rndToWordU16" private inline : Real64.t -> Word16.t; +val rndToWordU32 = _import "Real64_rndToWordU32" private inline : Real64.t -> Word32.t; +val rndToWordU64 = _import "Real64_rndToWordU64" private inline : Real64.t -> Word64.t; +val rndToWordU8 = _import "Real64_rndToWordU8" private inline : Real64.t -> Word8.t; +val round = _import "Real64_round" private inline : Real64.t -> Real64.t; +val store = _import "Real64_store" private inline : (Real64.t) ref * Real64.t -> unit; val strtor = _import "Real64_strtor" private : NullString8.t * C_Int.t -> Real64.t; -val sub = _import "Real64_sub" private : Real64.t * Real64.t -> Real64.t; +val sub = _import "Real64_sub" private inline : Real64.t * Real64.t -> Real64.t; end structure Socket = struct @@ -1143,235 +1143,235 @@ end structure Word16 = struct type t = Word16.t -val add = _import "Word16_add" private : Word16.t * Word16.t -> Word16.t; -val andb = _import "Word16_andb" private : Word16.t * Word16.t -> Word16.t; -val equal = _import "Word16_equal" private : Word16.t * Word16.t -> Bool.t; -val lshift = _import "Word16_lshift" private : Word16.t * Word32.t -> Word16.t; -val neg = _import "Word16_neg" private : Word16.t -> Word16.t; -val notb = _import "Word16_notb" private : Word16.t -> Word16.t; -val orb = _import "Word16_orb" private : Word16.t * Word16.t -> Word16.t; -val rol = _import "Word16_rol" private : Word16.t * Word32.t -> Word16.t; -val ror = _import "Word16_ror" private : Word16.t * Word32.t -> Word16.t; -val sub = _import "Word16_sub" private : Word16.t * Word16.t -> Word16.t; -val xorb = _import "Word16_xorb" private : Word16.t * Word16.t -> Word16.t; +val add = _import "Word16_add" private inline : Word16.t * Word16.t -> Word16.t; +val andb = _import "Word16_andb" private inline : Word16.t * Word16.t -> Word16.t; +val equal = _import "Word16_equal" private inline : Word16.t * Word16.t -> Bool.t; +val lshift = _import "Word16_lshift" private inline : Word16.t * Word32.t -> Word16.t; +val neg = _import "Word16_neg" private inline : Word16.t -> Word16.t; +val notb = _import "Word16_notb" private inline : Word16.t -> Word16.t; +val orb = _import "Word16_orb" private inline : Word16.t * Word16.t -> Word16.t; +val rol = _import "Word16_rol" private inline : Word16.t * Word32.t -> Word16.t; +val ror = _import "Word16_ror" private inline : Word16.t * Word32.t -> Word16.t; +val sub = _import "Word16_sub" private inline : Word16.t * Word16.t -> Word16.t; +val xorb = _import "Word16_xorb" private inline : Word16.t * Word16.t -> Word16.t; end structure Word32 = struct type t = Word32.t -val add = _import "Word32_add" private : Word32.t * Word32.t -> Word32.t; -val andb = _import "Word32_andb" private : Word32.t * Word32.t -> Word32.t; -val castToReal32 = _import "Word32_castToReal32" private : Word32.t -> Real32.t; -val equal = _import "Word32_equal" private : Word32.t * Word32.t -> Bool.t; -val lshift = _import "Word32_lshift" private : Word32.t * Word32.t -> Word32.t; -val neg = _import "Word32_neg" private : Word32.t -> Word32.t; -val notb = _import "Word32_notb" private : Word32.t -> Word32.t; -val orb = _import "Word32_orb" private : Word32.t * Word32.t -> Word32.t; -val rol = _import "Word32_rol" private : Word32.t * Word32.t -> Word32.t; -val ror = _import "Word32_ror" private : Word32.t * Word32.t -> Word32.t; -val sub = _import "Word32_sub" private : Word32.t * Word32.t -> Word32.t; -val xorb = _import "Word32_xorb" private : Word32.t * Word32.t -> Word32.t; +val add = _import "Word32_add" private inline : Word32.t * Word32.t -> Word32.t; +val andb = _import "Word32_andb" private inline : Word32.t * Word32.t -> Word32.t; +val castToReal32 = _import "Word32_castToReal32" private inline : Word32.t -> Real32.t; +val equal = _import "Word32_equal" private inline : Word32.t * Word32.t -> Bool.t; +val lshift = _import "Word32_lshift" private inline : Word32.t * Word32.t -> Word32.t; +val neg = _import "Word32_neg" private inline : Word32.t -> Word32.t; +val notb = _import "Word32_notb" private inline : Word32.t -> Word32.t; +val orb = _import "Word32_orb" private inline : Word32.t * Word32.t -> Word32.t; +val rol = _import "Word32_rol" private inline : Word32.t * Word32.t -> Word32.t; +val ror = _import "Word32_ror" private inline : Word32.t * Word32.t -> Word32.t; +val sub = _import "Word32_sub" private inline : Word32.t * Word32.t -> Word32.t; +val xorb = _import "Word32_xorb" private inline : Word32.t * Word32.t -> Word32.t; end structure Word64 = struct type t = Word64.t -val add = _import "Word64_add" private : Word64.t * Word64.t -> Word64.t; -val andb = _import "Word64_andb" private : Word64.t * Word64.t -> Word64.t; -val castToReal64 = _import "Word64_castToReal64" private : Word64.t -> Real64.t; -val equal = _import "Word64_equal" private : Word64.t * Word64.t -> Bool.t; -val fetch = _import "Word64_fetch" private : (Word64.t) ref -> Word64.t; -val lshift = _import "Word64_lshift" private : Word64.t * Word32.t -> Word64.t; -val move = _import "Word64_move" private : (Word64.t) ref * (Word64.t) ref -> unit; -val neg = _import "Word64_neg" private : Word64.t -> Word64.t; -val notb = _import "Word64_notb" private : Word64.t -> Word64.t; -val orb = _import "Word64_orb" private : Word64.t * Word64.t -> Word64.t; -val rol = _import "Word64_rol" private : Word64.t * Word32.t -> Word64.t; -val ror = _import "Word64_ror" private : Word64.t * Word32.t -> Word64.t; -val store = _import "Word64_store" private : (Word64.t) ref * Word64.t -> unit; -val sub = _import "Word64_sub" private : Word64.t * Word64.t -> Word64.t; -val xorb = _import "Word64_xorb" private : Word64.t * Word64.t -> Word64.t; +val add = _import "Word64_add" private inline : Word64.t * Word64.t -> Word64.t; +val andb = _import "Word64_andb" private inline : Word64.t * Word64.t -> Word64.t; +val castToReal64 = _import "Word64_castToReal64" private inline : Word64.t -> Real64.t; +val equal = _import "Word64_equal" private inline : Word64.t * Word64.t -> Bool.t; +val fetch = _import "Word64_fetch" private inline : (Word64.t) ref -> Word64.t; +val lshift = _import "Word64_lshift" private inline : Word64.t * Word32.t -> Word64.t; +val move = _import "Word64_move" private inline : (Word64.t) ref * (Word64.t) ref -> unit; +val neg = _import "Word64_neg" private inline : Word64.t -> Word64.t; +val notb = _import "Word64_notb" private inline : Word64.t -> Word64.t; +val orb = _import "Word64_orb" private inline : Word64.t * Word64.t -> Word64.t; +val rol = _import "Word64_rol" private inline : Word64.t * Word32.t -> Word64.t; +val ror = _import "Word64_ror" private inline : Word64.t * Word32.t -> Word64.t; +val store = _import "Word64_store" private inline : (Word64.t) ref * Word64.t -> unit; +val sub = _import "Word64_sub" private inline : Word64.t * Word64.t -> Word64.t; +val xorb = _import "Word64_xorb" private inline : Word64.t * Word64.t -> Word64.t; end structure Word8 = struct type t = Word8.t -val add = _import "Word8_add" private : Word8.t * Word8.t -> Word8.t; -val andb = _import "Word8_andb" private : Word8.t * Word8.t -> Word8.t; -val equal = _import "Word8_equal" private : Word8.t * Word8.t -> Bool.t; -val lshift = _import "Word8_lshift" private : Word8.t * Word32.t -> Word8.t; -val neg = _import "Word8_neg" private : Word8.t -> Word8.t; -val notb = _import "Word8_notb" private : Word8.t -> Word8.t; -val orb = _import "Word8_orb" private : Word8.t * Word8.t -> Word8.t; -val rol = _import "Word8_rol" private : Word8.t * Word32.t -> Word8.t; -val ror = _import "Word8_ror" private : Word8.t * Word32.t -> Word8.t; -val sub = _import "Word8_sub" private : Word8.t * Word8.t -> Word8.t; -val xorb = _import "Word8_xorb" private : Word8.t * Word8.t -> Word8.t; +val add = _import "Word8_add" private inline : Word8.t * Word8.t -> Word8.t; +val andb = _import "Word8_andb" private inline : Word8.t * Word8.t -> Word8.t; +val equal = _import "Word8_equal" private inline : Word8.t * Word8.t -> Bool.t; +val lshift = _import "Word8_lshift" private inline : Word8.t * Word32.t -> Word8.t; +val neg = _import "Word8_neg" private inline : Word8.t -> Word8.t; +val notb = _import "Word8_notb" private inline : Word8.t -> Word8.t; +val orb = _import "Word8_orb" private inline : Word8.t * Word8.t -> Word8.t; +val rol = _import "Word8_rol" private inline : Word8.t * Word32.t -> Word8.t; +val ror = _import "Word8_ror" private inline : Word8.t * Word32.t -> Word8.t; +val sub = _import "Word8_sub" private inline : Word8.t * Word8.t -> Word8.t; +val xorb = _import "Word8_xorb" private inline : Word8.t * Word8.t -> Word8.t; end structure WordS16 = struct -val addCheckP = _import "WordS16_addCheckP" private : Int16.t * Int16.t -> Bool.t; -val extdToWord16 = _import "WordS16_extdToWord16" private : Int16.t -> Word16.t; -val extdToWord32 = _import "WordS16_extdToWord32" private : Int16.t -> Word32.t; -val extdToWord64 = _import "WordS16_extdToWord64" private : Int16.t -> Word64.t; -val extdToWord8 = _import "WordS16_extdToWord8" private : Int16.t -> Word8.t; -val ge = _import "WordS16_ge" private : Int16.t * Int16.t -> Bool.t; -val gt = _import "WordS16_gt" private : Int16.t * Int16.t -> Bool.t; -val le = _import "WordS16_le" private : Int16.t * Int16.t -> Bool.t; -val lt = _import "WordS16_lt" private : Int16.t * Int16.t -> Bool.t; -val mul = _import "WordS16_mul" private : Int16.t * Int16.t -> Int16.t; -val mulCheckP = _import "WordS16_mulCheckP" private : Int16.t * Int16.t -> Bool.t; -val negCheckP = _import "WordS16_negCheckP" private : Int16.t -> Bool.t; -val quot = _import "WordS16_quot" private : Int16.t * Int16.t -> Int16.t; -val rem = _import "WordS16_rem" private : Int16.t * Int16.t -> Int16.t; +val addCheckP = _import "WordS16_addCheckP" private inline : Int16.t * Int16.t -> Bool.t; +val extdToWord16 = _import "WordS16_extdToWord16" private inline : Int16.t -> Word16.t; +val extdToWord32 = _import "WordS16_extdToWord32" private inline : Int16.t -> Word32.t; +val extdToWord64 = _import "WordS16_extdToWord64" private inline : Int16.t -> Word64.t; +val extdToWord8 = _import "WordS16_extdToWord8" private inline : Int16.t -> Word8.t; +val ge = _import "WordS16_ge" private inline : Int16.t * Int16.t -> Bool.t; +val gt = _import "WordS16_gt" private inline : Int16.t * Int16.t -> Bool.t; +val le = _import "WordS16_le" private inline : Int16.t * Int16.t -> Bool.t; +val lt = _import "WordS16_lt" private inline : Int16.t * Int16.t -> Bool.t; +val mul = _import "WordS16_mul" private inline : Int16.t * Int16.t -> Int16.t; +val mulCheckP = _import "WordS16_mulCheckP" private inline : Int16.t * Int16.t -> Bool.t; +val negCheckP = _import "WordS16_negCheckP" private inline : Int16.t -> Bool.t; +val quot = _import "WordS16_quot" private inline : Int16.t * Int16.t -> Int16.t; +val rem = _import "WordS16_rem" private inline : Int16.t * Int16.t -> Int16.t; val rndToReal32 = _import "WordS16_rndToReal32" private : Int16.t -> Real32.t; val rndToReal64 = _import "WordS16_rndToReal64" private : Int16.t -> Real64.t; -val rshift = _import "WordS16_rshift" private : Int16.t * Word32.t -> Int16.t; -val subCheckP = _import "WordS16_subCheckP" private : Int16.t * Int16.t -> Bool.t; +val rshift = _import "WordS16_rshift" private inline : Int16.t * Word32.t -> Int16.t; +val subCheckP = _import "WordS16_subCheckP" private inline : Int16.t * Int16.t -> Bool.t; end structure WordS32 = struct -val addCheckP = _import "WordS32_addCheckP" private : Int32.t * Int32.t -> Bool.t; -val extdToWord16 = _import "WordS32_extdToWord16" private : Int32.t -> Word16.t; -val extdToWord32 = _import "WordS32_extdToWord32" private : Int32.t -> Word32.t; -val extdToWord64 = _import "WordS32_extdToWord64" private : Int32.t -> Word64.t; -val extdToWord8 = _import "WordS32_extdToWord8" private : Int32.t -> Word8.t; -val ge = _import "WordS32_ge" private : Int32.t * Int32.t -> Bool.t; -val gt = _import "WordS32_gt" private : Int32.t * Int32.t -> Bool.t; -val le = _import "WordS32_le" private : Int32.t * Int32.t -> Bool.t; -val lt = _import "WordS32_lt" private : Int32.t * Int32.t -> Bool.t; -val mul = _import "WordS32_mul" private : Int32.t * Int32.t -> Int32.t; -val mulCheckP = _import "WordS32_mulCheckP" private : Int32.t * Int32.t -> Bool.t; -val negCheckP = _import "WordS32_negCheckP" private : Int32.t -> Bool.t; -val quot = _import "WordS32_quot" private : Int32.t * Int32.t -> Int32.t; -val rem = _import "WordS32_rem" private : Int32.t * Int32.t -> Int32.t; +val addCheckP = _import "WordS32_addCheckP" private inline : Int32.t * Int32.t -> Bool.t; +val extdToWord16 = _import "WordS32_extdToWord16" private inline : Int32.t -> Word16.t; +val extdToWord32 = _import "WordS32_extdToWord32" private inline : Int32.t -> Word32.t; +val extdToWord64 = _import "WordS32_extdToWord64" private inline : Int32.t -> Word64.t; +val extdToWord8 = _import "WordS32_extdToWord8" private inline : Int32.t -> Word8.t; +val ge = _import "WordS32_ge" private inline : Int32.t * Int32.t -> Bool.t; +val gt = _import "WordS32_gt" private inline : Int32.t * Int32.t -> Bool.t; +val le = _import "WordS32_le" private inline : Int32.t * Int32.t -> Bool.t; +val lt = _import "WordS32_lt" private inline : Int32.t * Int32.t -> Bool.t; +val mul = _import "WordS32_mul" private inline : Int32.t * Int32.t -> Int32.t; +val mulCheckP = _import "WordS32_mulCheckP" private inline : Int32.t * Int32.t -> Bool.t; +val negCheckP = _import "WordS32_negCheckP" private inline : Int32.t -> Bool.t; +val quot = _import "WordS32_quot" private inline : Int32.t * Int32.t -> Int32.t; +val rem = _import "WordS32_rem" private inline : Int32.t * Int32.t -> Int32.t; val rndToReal32 = _import "WordS32_rndToReal32" private : Int32.t -> Real32.t; val rndToReal64 = _import "WordS32_rndToReal64" private : Int32.t -> Real64.t; -val rshift = _import "WordS32_rshift" private : Int32.t * Word32.t -> Int32.t; -val subCheckP = _import "WordS32_subCheckP" private : Int32.t * Int32.t -> Bool.t; +val rshift = _import "WordS32_rshift" private inline : Int32.t * Word32.t -> Int32.t; +val subCheckP = _import "WordS32_subCheckP" private inline : Int32.t * Int32.t -> Bool.t; end structure WordS64 = struct -val addCheckP = _import "WordS64_addCheckP" private : Int64.t * Int64.t -> Bool.t; -val extdToWord16 = _import "WordS64_extdToWord16" private : Int64.t -> Word16.t; -val extdToWord32 = _import "WordS64_extdToWord32" private : Int64.t -> Word32.t; -val extdToWord64 = _import "WordS64_extdToWord64" private : Int64.t -> Word64.t; -val extdToWord8 = _import "WordS64_extdToWord8" private : Int64.t -> Word8.t; -val ge = _import "WordS64_ge" private : Int64.t * Int64.t -> Bool.t; -val gt = _import "WordS64_gt" private : Int64.t * Int64.t -> Bool.t; -val le = _import "WordS64_le" private : Int64.t * Int64.t -> Bool.t; -val lt = _import "WordS64_lt" private : Int64.t * Int64.t -> Bool.t; -val mul = _import "WordS64_mul" private : Int64.t * Int64.t -> Int64.t; -val mulCheckP = _import "WordS64_mulCheckP" private : Int64.t * Int64.t -> Bool.t; -val negCheckP = _import "WordS64_negCheckP" private : Int64.t -> Bool.t; -val quot = _import "WordS64_quot" private : Int64.t * Int64.t -> Int64.t; -val rem = _import "WordS64_rem" private : Int64.t * Int64.t -> Int64.t; +val addCheckP = _import "WordS64_addCheckP" private inline : Int64.t * Int64.t -> Bool.t; +val extdToWord16 = _import "WordS64_extdToWord16" private inline : Int64.t -> Word16.t; +val extdToWord32 = _import "WordS64_extdToWord32" private inline : Int64.t -> Word32.t; +val extdToWord64 = _import "WordS64_extdToWord64" private inline : Int64.t -> Word64.t; +val extdToWord8 = _import "WordS64_extdToWord8" private inline : Int64.t -> Word8.t; +val ge = _import "WordS64_ge" private inline : Int64.t * Int64.t -> Bool.t; +val gt = _import "WordS64_gt" private inline : Int64.t * Int64.t -> Bool.t; +val le = _import "WordS64_le" private inline : Int64.t * Int64.t -> Bool.t; +val lt = _import "WordS64_lt" private inline : Int64.t * Int64.t -> Bool.t; +val mul = _import "WordS64_mul" private inline : Int64.t * Int64.t -> Int64.t; +val mulCheckP = _import "WordS64_mulCheckP" private inline : Int64.t * Int64.t -> Bool.t; +val negCheckP = _import "WordS64_negCheckP" private inline : Int64.t -> Bool.t; +val quot = _import "WordS64_quot" private inline : Int64.t * Int64.t -> Int64.t; +val rem = _import "WordS64_rem" private inline : Int64.t * Int64.t -> Int64.t; val rndToReal32 = _import "WordS64_rndToReal32" private : Int64.t -> Real32.t; val rndToReal64 = _import "WordS64_rndToReal64" private : Int64.t -> Real64.t; -val rshift = _import "WordS64_rshift" private : Int64.t * Word32.t -> Int64.t; -val subCheckP = _import "WordS64_subCheckP" private : Int64.t * Int64.t -> Bool.t; +val rshift = _import "WordS64_rshift" private inline : Int64.t * Word32.t -> Int64.t; +val subCheckP = _import "WordS64_subCheckP" private inline : Int64.t * Int64.t -> Bool.t; end structure WordS8 = struct -val addCheckP = _import "WordS8_addCheckP" private : Int8.t * Int8.t -> Bool.t; -val extdToWord16 = _import "WordS8_extdToWord16" private : Int8.t -> Word16.t; -val extdToWord32 = _import "WordS8_extdToWord32" private : Int8.t -> Word32.t; -val extdToWord64 = _import "WordS8_extdToWord64" private : Int8.t -> Word64.t; -val extdToWord8 = _import "WordS8_extdToWord8" private : Int8.t -> Word8.t; -val ge = _import "WordS8_ge" private : Int8.t * Int8.t -> Bool.t; -val gt = _import "WordS8_gt" private : Int8.t * Int8.t -> Bool.t; -val le = _import "WordS8_le" private : Int8.t * Int8.t -> Bool.t; -val lt = _import "WordS8_lt" private : Int8.t * Int8.t -> Bool.t; -val mul = _import "WordS8_mul" private : Int8.t * Int8.t -> Int8.t; -val mulCheckP = _import "WordS8_mulCheckP" private : Int8.t * Int8.t -> Bool.t; -val negCheckP = _import "WordS8_negCheckP" private : Int8.t -> Bool.t; -val quot = _import "WordS8_quot" private : Int8.t * Int8.t -> Int8.t; -val rem = _import "WordS8_rem" private : Int8.t * Int8.t -> Int8.t; +val addCheckP = _import "WordS8_addCheckP" private inline : Int8.t * Int8.t -> Bool.t; +val extdToWord16 = _import "WordS8_extdToWord16" private inline : Int8.t -> Word16.t; +val extdToWord32 = _import "WordS8_extdToWord32" private inline : Int8.t -> Word32.t; +val extdToWord64 = _import "WordS8_extdToWord64" private inline : Int8.t -> Word64.t; +val extdToWord8 = _import "WordS8_extdToWord8" private inline : Int8.t -> Word8.t; +val ge = _import "WordS8_ge" private inline : Int8.t * Int8.t -> Bool.t; +val gt = _import "WordS8_gt" private inline : Int8.t * Int8.t -> Bool.t; +val le = _import "WordS8_le" private inline : Int8.t * Int8.t -> Bool.t; +val lt = _import "WordS8_lt" private inline : Int8.t * Int8.t -> Bool.t; +val mul = _import "WordS8_mul" private inline : Int8.t * Int8.t -> Int8.t; +val mulCheckP = _import "WordS8_mulCheckP" private inline : Int8.t * Int8.t -> Bool.t; +val negCheckP = _import "WordS8_negCheckP" private inline : Int8.t -> Bool.t; +val quot = _import "WordS8_quot" private inline : Int8.t * Int8.t -> Int8.t; +val rem = _import "WordS8_rem" private inline : Int8.t * Int8.t -> Int8.t; val rndToReal32 = _import "WordS8_rndToReal32" private : Int8.t -> Real32.t; val rndToReal64 = _import "WordS8_rndToReal64" private : Int8.t -> Real64.t; -val rshift = _import "WordS8_rshift" private : Int8.t * Word32.t -> Int8.t; -val subCheckP = _import "WordS8_subCheckP" private : Int8.t * Int8.t -> Bool.t; +val rshift = _import "WordS8_rshift" private inline : Int8.t * Word32.t -> Int8.t; +val subCheckP = _import "WordS8_subCheckP" private inline : Int8.t * Int8.t -> Bool.t; end structure WordU16 = struct -val addCheckP = _import "WordU16_addCheckP" private : Word16.t * Word16.t -> Bool.t; -val extdToWord16 = _import "WordU16_extdToWord16" private : Word16.t -> Word16.t; -val extdToWord32 = _import "WordU16_extdToWord32" private : Word16.t -> Word32.t; -val extdToWord64 = _import "WordU16_extdToWord64" private : Word16.t -> Word64.t; -val extdToWord8 = _import "WordU16_extdToWord8" private : Word16.t -> Word8.t; -val ge = _import "WordU16_ge" private : Word16.t * Word16.t -> Bool.t; -val gt = _import "WordU16_gt" private : Word16.t * Word16.t -> Bool.t; -val le = _import "WordU16_le" private : Word16.t * Word16.t -> Bool.t; -val lt = _import "WordU16_lt" private : Word16.t * Word16.t -> Bool.t; -val mul = _import "WordU16_mul" private : Word16.t * Word16.t -> Word16.t; -val mulCheckP = _import "WordU16_mulCheckP" private : Word16.t * Word16.t -> Bool.t; -val negCheckP = _import "WordU16_negCheckP" private : Word16.t -> Bool.t; -val quot = _import "WordU16_quot" private : Word16.t * Word16.t -> Word16.t; -val rem = _import "WordU16_rem" private : Word16.t * Word16.t -> Word16.t; +val addCheckP = _import "WordU16_addCheckP" private inline : Word16.t * Word16.t -> Bool.t; +val extdToWord16 = _import "WordU16_extdToWord16" private inline : Word16.t -> Word16.t; +val extdToWord32 = _import "WordU16_extdToWord32" private inline : Word16.t -> Word32.t; +val extdToWord64 = _import "WordU16_extdToWord64" private inline : Word16.t -> Word64.t; +val extdToWord8 = _import "WordU16_extdToWord8" private inline : Word16.t -> Word8.t; +val ge = _import "WordU16_ge" private inline : Word16.t * Word16.t -> Bool.t; +val gt = _import "WordU16_gt" private inline : Word16.t * Word16.t -> Bool.t; +val le = _import "WordU16_le" private inline : Word16.t * Word16.t -> Bool.t; +val lt = _import "WordU16_lt" private inline : Word16.t * Word16.t -> Bool.t; +val mul = _import "WordU16_mul" private inline : Word16.t * Word16.t -> Word16.t; +val mulCheckP = _import "WordU16_mulCheckP" private inline : Word16.t * Word16.t -> Bool.t; +val negCheckP = _import "WordU16_negCheckP" private inline : Word16.t -> Bool.t; +val quot = _import "WordU16_quot" private inline : Word16.t * Word16.t -> Word16.t; +val rem = _import "WordU16_rem" private inline : Word16.t * Word16.t -> Word16.t; val rndToReal32 = _import "WordU16_rndToReal32" private : Word16.t -> Real32.t; val rndToReal64 = _import "WordU16_rndToReal64" private : Word16.t -> Real64.t; -val rshift = _import "WordU16_rshift" private : Word16.t * Word32.t -> Word16.t; -val subCheckP = _import "WordU16_subCheckP" private : Word16.t * Word16.t -> Bool.t; +val rshift = _import "WordU16_rshift" private inline : Word16.t * Word32.t -> Word16.t; +val subCheckP = _import "WordU16_subCheckP" private inline : Word16.t * Word16.t -> Bool.t; end structure WordU32 = struct -val addCheckP = _import "WordU32_addCheckP" private : Word32.t * Word32.t -> Bool.t; -val extdToWord16 = _import "WordU32_extdToWord16" private : Word32.t -> Word16.t; -val extdToWord32 = _import "WordU32_extdToWord32" private : Word32.t -> Word32.t; -val extdToWord64 = _import "WordU32_extdToWord64" private : Word32.t -> Word64.t; -val extdToWord8 = _import "WordU32_extdToWord8" private : Word32.t -> Word8.t; -val ge = _import "WordU32_ge" private : Word32.t * Word32.t -> Bool.t; -val gt = _import "WordU32_gt" private : Word32.t * Word32.t -> Bool.t; -val le = _import "WordU32_le" private : Word32.t * Word32.t -> Bool.t; -val lt = _import "WordU32_lt" private : Word32.t * Word32.t -> Bool.t; -val mul = _import "WordU32_mul" private : Word32.t * Word32.t -> Word32.t; -val mulCheckP = _import "WordU32_mulCheckP" private : Word32.t * Word32.t -> Bool.t; -val negCheckP = _import "WordU32_negCheckP" private : Word32.t -> Bool.t; -val quot = _import "WordU32_quot" private : Word32.t * Word32.t -> Word32.t; -val rem = _import "WordU32_rem" private : Word32.t * Word32.t -> Word32.t; +val addCheckP = _import "WordU32_addCheckP" private inline : Word32.t * Word32.t -> Bool.t; +val extdToWord16 = _import "WordU32_extdToWord16" private inline : Word32.t -> Word16.t; +val extdToWord32 = _import "WordU32_extdToWord32" private inline : Word32.t -> Word32.t; +val extdToWord64 = _import "WordU32_extdToWord64" private inline : Word32.t -> Word64.t; +val extdToWord8 = _import "WordU32_extdToWord8" private inline : Word32.t -> Word8.t; +val ge = _import "WordU32_ge" private inline : Word32.t * Word32.t -> Bool.t; +val gt = _import "WordU32_gt" private inline : Word32.t * Word32.t -> Bool.t; +val le = _import "WordU32_le" private inline : Word32.t * Word32.t -> Bool.t; +val lt = _import "WordU32_lt" private inline : Word32.t * Word32.t -> Bool.t; +val mul = _import "WordU32_mul" private inline : Word32.t * Word32.t -> Word32.t; +val mulCheckP = _import "WordU32_mulCheckP" private inline : Word32.t * Word32.t -> Bool.t; +val negCheckP = _import "WordU32_negCheckP" private inline : Word32.t -> Bool.t; +val quot = _import "WordU32_quot" private inline : Word32.t * Word32.t -> Word32.t; +val rem = _import "WordU32_rem" private inline : Word32.t * Word32.t -> Word32.t; val rndToReal32 = _import "WordU32_rndToReal32" private : Word32.t -> Real32.t; val rndToReal64 = _import "WordU32_rndToReal64" private : Word32.t -> Real64.t; -val rshift = _import "WordU32_rshift" private : Word32.t * Word32.t -> Word32.t; -val subCheckP = _import "WordU32_subCheckP" private : Word32.t * Word32.t -> Bool.t; +val rshift = _import "WordU32_rshift" private inline : Word32.t * Word32.t -> Word32.t; +val subCheckP = _import "WordU32_subCheckP" private inline : Word32.t * Word32.t -> Bool.t; end structure WordU64 = struct -val addCheckP = _import "WordU64_addCheckP" private : Word64.t * Word64.t -> Bool.t; -val extdToWord16 = _import "WordU64_extdToWord16" private : Word64.t -> Word16.t; -val extdToWord32 = _import "WordU64_extdToWord32" private : Word64.t -> Word32.t; -val extdToWord64 = _import "WordU64_extdToWord64" private : Word64.t -> Word64.t; -val extdToWord8 = _import "WordU64_extdToWord8" private : Word64.t -> Word8.t; -val ge = _import "WordU64_ge" private : Word64.t * Word64.t -> Bool.t; -val gt = _import "WordU64_gt" private : Word64.t * Word64.t -> Bool.t; -val le = _import "WordU64_le" private : Word64.t * Word64.t -> Bool.t; -val lt = _import "WordU64_lt" private : Word64.t * Word64.t -> Bool.t; -val mul = _import "WordU64_mul" private : Word64.t * Word64.t -> Word64.t; -val mulCheckP = _import "WordU64_mulCheckP" private : Word64.t * Word64.t -> Bool.t; -val negCheckP = _import "WordU64_negCheckP" private : Word64.t -> Bool.t; -val quot = _import "WordU64_quot" private : Word64.t * Word64.t -> Word64.t; -val rem = _import "WordU64_rem" private : Word64.t * Word64.t -> Word64.t; +val addCheckP = _import "WordU64_addCheckP" private inline : Word64.t * Word64.t -> Bool.t; +val extdToWord16 = _import "WordU64_extdToWord16" private inline : Word64.t -> Word16.t; +val extdToWord32 = _import "WordU64_extdToWord32" private inline : Word64.t -> Word32.t; +val extdToWord64 = _import "WordU64_extdToWord64" private inline : Word64.t -> Word64.t; +val extdToWord8 = _import "WordU64_extdToWord8" private inline : Word64.t -> Word8.t; +val ge = _import "WordU64_ge" private inline : Word64.t * Word64.t -> Bool.t; +val gt = _import "WordU64_gt" private inline : Word64.t * Word64.t -> Bool.t; +val le = _import "WordU64_le" private inline : Word64.t * Word64.t -> Bool.t; +val lt = _import "WordU64_lt" private inline : Word64.t * Word64.t -> Bool.t; +val mul = _import "WordU64_mul" private inline : Word64.t * Word64.t -> Word64.t; +val mulCheckP = _import "WordU64_mulCheckP" private inline : Word64.t * Word64.t -> Bool.t; +val negCheckP = _import "WordU64_negCheckP" private inline : Word64.t -> Bool.t; +val quot = _import "WordU64_quot" private inline : Word64.t * Word64.t -> Word64.t; +val rem = _import "WordU64_rem" private inline : Word64.t * Word64.t -> Word64.t; val rndToReal32 = _import "WordU64_rndToReal32" private : Word64.t -> Real32.t; val rndToReal64 = _import "WordU64_rndToReal64" private : Word64.t -> Real64.t; -val rshift = _import "WordU64_rshift" private : Word64.t * Word32.t -> Word64.t; -val subCheckP = _import "WordU64_subCheckP" private : Word64.t * Word64.t -> Bool.t; +val rshift = _import "WordU64_rshift" private inline : Word64.t * Word32.t -> Word64.t; +val subCheckP = _import "WordU64_subCheckP" private inline : Word64.t * Word64.t -> Bool.t; end structure WordU8 = struct -val addCheckP = _import "WordU8_addCheckP" private : Word8.t * Word8.t -> Bool.t; -val extdToWord16 = _import "WordU8_extdToWord16" private : Word8.t -> Word16.t; -val extdToWord32 = _import "WordU8_extdToWord32" private : Word8.t -> Word32.t; -val extdToWord64 = _import "WordU8_extdToWord64" private : Word8.t -> Word64.t; -val extdToWord8 = _import "WordU8_extdToWord8" private : Word8.t -> Word8.t; -val ge = _import "WordU8_ge" private : Word8.t * Word8.t -> Bool.t; -val gt = _import "WordU8_gt" private : Word8.t * Word8.t -> Bool.t; -val le = _import "WordU8_le" private : Word8.t * Word8.t -> Bool.t; -val lt = _import "WordU8_lt" private : Word8.t * Word8.t -> Bool.t; -val mul = _import "WordU8_mul" private : Word8.t * Word8.t -> Word8.t; -val mulCheckP = _import "WordU8_mulCheckP" private : Word8.t * Word8.t -> Bool.t; -val negCheckP = _import "WordU8_negCheckP" private : Word8.t -> Bool.t; -val quot = _import "WordU8_quot" private : Word8.t * Word8.t -> Word8.t; -val rem = _import "WordU8_rem" private : Word8.t * Word8.t -> Word8.t; +val addCheckP = _import "WordU8_addCheckP" private inline : Word8.t * Word8.t -> Bool.t; +val extdToWord16 = _import "WordU8_extdToWord16" private inline : Word8.t -> Word16.t; +val extdToWord32 = _import "WordU8_extdToWord32" private inline : Word8.t -> Word32.t; +val extdToWord64 = _import "WordU8_extdToWord64" private inline : Word8.t -> Word64.t; +val extdToWord8 = _import "WordU8_extdToWord8" private inline : Word8.t -> Word8.t; +val ge = _import "WordU8_ge" private inline : Word8.t * Word8.t -> Bool.t; +val gt = _import "WordU8_gt" private inline : Word8.t * Word8.t -> Bool.t; +val le = _import "WordU8_le" private inline : Word8.t * Word8.t -> Bool.t; +val lt = _import "WordU8_lt" private inline : Word8.t * Word8.t -> Bool.t; +val mul = _import "WordU8_mul" private inline : Word8.t * Word8.t -> Word8.t; +val mulCheckP = _import "WordU8_mulCheckP" private inline : Word8.t * Word8.t -> Bool.t; +val negCheckP = _import "WordU8_negCheckP" private inline : Word8.t -> Bool.t; +val quot = _import "WordU8_quot" private inline : Word8.t * Word8.t -> Word8.t; +val rem = _import "WordU8_rem" private inline : Word8.t * Word8.t -> Word8.t; val rndToReal32 = _import "WordU8_rndToReal32" private : Word8.t -> Real32.t; val rndToReal64 = _import "WordU8_rndToReal64" private : Word8.t -> Real64.t; -val rshift = _import "WordU8_rshift" private : Word8.t * Word32.t -> Word8.t; -val subCheckP = _import "WordU8_subCheckP" private : Word8.t * Word8.t -> Bool.t; +val rshift = _import "WordU8_rshift" private inline : Word8.t * Word32.t -> Word8.t; +val subCheckP = _import "WordU8_subCheckP" private inline : Word8.t * Word8.t -> Bool.t; end end end diff --git a/runtime/gen/gen-basis-ffi.sml b/runtime/gen/gen-basis-ffi.sml index 3e807f99bf..53a6cc851b 100644 --- a/runtime/gen/gen-basis-ffi.sml +++ b/runtime/gen/gen-basis-ffi.sml @@ -1,4 +1,5 @@ -(* Copyright (C) 2004-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh +(* Copyright (C) 2019 Matthew Fluet. + * Copyright (C) 2004-2006, 2008 Henry Cejtin, Matthew Fluet, Suresh * Jagannathan, and Stephen Weeks. * * MLton is released under a HPND-style license. @@ -188,7 +189,8 @@ structure Entry = ";"] | Import {attrs, name, ty = {args, ret}} => String.concat - [attrs, + ["PRIVATE ", + attrs, if String.size attrs > 0 then " " else "", Type.toC ret, " ", @@ -220,7 +222,10 @@ structure Entry = Name.last name, " = _import \"", Name.toC name, - "\" private : ", + "\" private ", + if List.exists (fn s => s = "INLINE") (String.tokens Char.isSpace attrs) + then "inline " else "", + ": ", String.concatWith " * " (List.map Type.toML args), " -> ", Type.toML ret, diff --git a/runtime/platform.h b/runtime/platform.h index b7231a0838..25ae0fb0dc 100644 --- a/runtime/platform.h +++ b/runtime/platform.h @@ -90,8 +90,8 @@ #include "gc.h" -#ifndef MLTON_CODEGEN_STATIC_INLINE -#define MLTON_CODEGEN_STATIC_INLINE PRIVATE +#ifndef INLINE +#define INLINE #endif #include "basis-ffi.h" From 4f2d213749dd1e9be40202d78d00809afabf671f Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 1 Aug 2019 07:07:27 -0400 Subject: [PATCH 087/102] Mark primitive and Basis Library functions as `__attribute__((always_inline))` Although the functions are small and marked `inline`, clang at -O1 does not inline the functions (even with the `-finline-functions` option). --- include/c-chunk.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/include/c-chunk.h b/include/c-chunk.h index fb3d75e790..05143998d3 100644 --- a/include/c-chunk.h +++ b/include/c-chunk.h @@ -42,7 +42,7 @@ /* ------------------------------------------------- */ #ifndef INLINE -#define INLINE inline +#define INLINE __attribute__((always_inline)) inline #endif #include "basis/coerce.h" #include "basis/cpointer.h" From d1df0de8c00829d9edc0e2442437ec1ff2c072c2 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 8 Aug 2019 13:33:11 -0400 Subject: [PATCH 088/102] Use `-chunkify simple` for a `ControlFlags.Chunkify.simpleDefault` --- mlton/control/control-flags.sml | 29 +++++++++++++++++++---------- 1 file changed, 19 insertions(+), 10 deletions(-) diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index 721fc72063..85b635c49b 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -73,6 +73,13 @@ structure Chunkify = singC: bool, singR: bool} + val simpleDefault = + Simple {mainFns = true, + sccC = true, + sccR = true, + singC = true, + singR = true} + fun toString c = case c of Coalesce {limit} => concat ["coalesce", Int.toString limit] @@ -106,16 +113,18 @@ structure Chunkify = str "func" *> pure Func, str "one" *> pure One, str "simple" *> - cbrack (ffield ("mainFns", bool) >>= (fn mainFns => - nfield ("sccC", bool) >>= (fn sccC => - nfield ("sccR", bool) >>= (fn sccR => - nfield ("singC", bool) >>= (fn singC => - nfield ("singR", bool) >>= (fn singR => - pure (Simple {mainFns = mainFns, - sccC = sccC, - sccR = sccR, - singC = singC, - singR = singR})))))))] + (cbrack (ffield ("mainFns", bool) >>= (fn mainFns => + nfield ("sccC", bool) >>= (fn sccC => + nfield ("sccR", bool) >>= (fn sccR => + nfield ("singC", bool) >>= (fn singC => + nfield ("singR", bool) >>= (fn singR => + pure (Simple {mainFns = mainFns, + sccC = sccC, + sccR = sccR, + singC = singC, + singR = singR}))))))) + <|> + pure simpleDefault)] <* failing next in case parseString (p, s) of From 6b738b8719dc71499b557ce7c8c8066e7d8b81e7 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 8 Aug 2019 15:08:31 -0400 Subject: [PATCH 089/102] Add `-codegen-fuse-op-and-chk {false|true}` compile-time flag It appears that GCC (and, to a lesser extent) Clang/LLVM do not always successfully fuse adjacent `Word_` and `Word{S,U}_CheckP` primitives. The performance results reported at https://github.com/MLton/mlton/pull/273 and https://github.com/MLton/mlton/pull/292 suggest that this does not always have significant impact, but a close look at the `md5` benchmark shows that the native codegen significantly outperforms the C codegen with gcc-9 due to redundant arithmetic computations (one for `Word{S,U}_CheckP` and another for `Word_`). This flag will be used to enable explicit fusing of adjacent `Word_` and `Word{S,U}_CheckP` primitives in the codegens. --- mlton/control/control-flags.sig | 3 +++ mlton/control/control-flags.sml | 5 ++++- mlton/main/main.fun | 2 ++ 3 files changed, 9 insertions(+), 1 deletion(-) diff --git a/mlton/control/control-flags.sig b/mlton/control/control-flags.sig index 45ad6b429d..6f25b31343 100644 --- a/mlton/control/control-flags.sig +++ b/mlton/control/control-flags.sig @@ -77,6 +77,9 @@ signature CONTROL_FLAGS = (* whether or not to use comments in codegen *) val codegenComments: int ref + (* whether or not to fuse `op` and `opCheckP` primitives in codegen *) + val codegenFuseOpAndChk: bool ref + val contifyIntoMain: bool ref (* Generate an executable with debugging info. *) diff --git a/mlton/control/control-flags.sml b/mlton/control/control-flags.sml index 85b635c49b..df383ce86e 100644 --- a/mlton/control/control-flags.sml +++ b/mlton/control/control-flags.sml @@ -190,7 +190,10 @@ val codegen = control {name = "codegen", val codegenComments = control {name = "codegen comments", default = 0, toString = Int.toString} - + +val codegenFuseOpAndChk = control {name = "fuse `op` and `opCheckP` primitives in codegen", + default = false, + toString = Bool.toString} val contifyIntoMain = control {name = "contifyIntoMain", default = false, diff --git a/mlton/main/main.fun b/mlton/main/main.fun index f7b6e2ec62..b9bc10a16c 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -332,6 +332,8 @@ fun makeOptions {usage} = | NONE => usage (concat ["invalid -codegen flag: ", s]))))), (Expert, "codegen-comments", " ", "level of comments (0)", intRef codegenComments), + (Expert, "codegen-fuse-op-and-chk", " {false|true}", "fuse `op` and `opCheckP` primitives in codegen", + boolRef codegenFuseOpAndChk), (Normal, "const", " ' '", "set compile-time constant", SpaceString (fn s => case String.tokens (s, Char.isSpace) of From 3d1e89ccfec002a3f0ff6d46c4241a275e80c04f Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 8 Aug 2019 18:28:54 -0400 Subject: [PATCH 090/102] Add `Word{S,U}_{add,mul,neg,sub}AndCheck` fns to `Word-ops.h` It appears that GCC (and, to a lesser extent) Clang/LLVM do not always successfully fuse adjacent `Word_` and `Word{S,U}_CheckP` primitives. The performance results reported at https://github.com/MLton/mlton/pull/273 and https://github.com/MLton/mlton/pull/292 suggest that this does not always have significant impact, but a close look at the `md5` benchmark shows that the native codegen significantly outperforms the C codegen with gcc-9 due to redundant arithmetic computations (one for `Word{S,U}_CheckP` and another for `Word_`). These functions compute both the arithmetic result and a boolean indicating overflow (using `__builtin__overflow`). They will be used for explicit fusing of adjacent `Word_` and `Word{S,U}_CheckP` primitives in the C codegen for `-codegen-fuse-op-and-check true`. --- runtime/basis/Word/Word-ops.h | 28 +++++++++++++++++++++++++--- 1 file changed, 25 insertions(+), 3 deletions(-) diff --git a/runtime/basis/Word/Word-ops.h b/runtime/basis/Word/Word-ops.h index ee43ba4d56..b15d7549b6 100644 --- a/runtime/basis/Word/Word-ops.h +++ b/runtime/basis/Word/Word-ops.h @@ -35,6 +35,16 @@ binaryOvflOp (U##size, name) binaryOvflChk (S##size, name) \ binaryOvflChk (U##size, name) +#define binaryOvflOpAndChk(kind, name) \ + PRIVATE INLINE \ + void Word##kind##_##name##AndCheck (Word##kind w1, Word##kind w2, Word##kind *rw, Bool *rb) { \ + *rb = __builtin_##name##_overflow(w1, w2, rw); \ + } + +#define bothBinaryOvflOpAndChk(size, name) \ +binaryOvflOpAndChk (S##size, name) \ +binaryOvflOpAndChk (U##size, name) + #define compare(kind, name, op) \ PRIVATE INLINE \ Bool Word##kind##_##name (Word##kind w1, Word##kind w2) { \ @@ -60,6 +70,12 @@ compare (U##size, name, op) return __builtin_sub_overflow(0, w, &res); \ } +#define negOvflOpAndChk(kind) \ + PRIVATE INLINE \ + void Word##kind##_negAndCheck (Word##kind w, Word##kind *rw, Bool *rb) { \ + *rb = __builtin_sub_overflow(0, w, rw); \ + } + #define rol(size) \ PRIVATE INLINE \ Word##size Word##size##_rol (Word##size w1, Word32 w2) { \ @@ -78,7 +94,7 @@ compare (U##size, name, op) return (Word##kind)(w1 op w2); \ } -#define unary(kind, name, op) \ +#define unary(kind, name, op) \ PRIVATE INLINE \ Word##kind Word##kind##_##name (Word##kind w) { \ return (Word##kind)(op w); \ @@ -105,6 +121,7 @@ compare (U##size, name, op) #define all(size) \ binaryOvflOp (size, add) \ bothBinaryOvflChk (size, add) \ +bothBinaryOvflOpAndChk (size, add) \ binary (size, andb, &) \ compare (size, equal, ==) \ bothCompare (size, ge, >=) \ @@ -114,9 +131,12 @@ shift (size, lshift, <<) \ bothCompare (size, lt, <) \ bothBinaryOvflOp (size, mul) \ bothBinaryOvflChk (size, mul) \ +bothBinaryOvflOpAndChk (size, mul) \ negOvflOp (size) \ negOvflChk (S##size) \ negOvflChk (U##size) \ +negOvflOpAndChk (S##size) \ +negOvflOpAndChk (U##size) \ unary (size, notb, ~) \ bothBinary (size, quot, /) \ bothBinary (size, rem, %) \ @@ -134,6 +154,7 @@ shift (S##size, rshift, >>) \ shift (U##size, rshift, >>) \ binaryOvflOp (size, sub) \ bothBinaryOvflChk (size, sub) \ +bothBinaryOvflOpAndChk (size, sub) \ binary (size, xorb, ^) all (8) @@ -149,12 +170,13 @@ misaligned(64) #undef shift #undef ror #undef rol -#undef negOvfl +#undef negOvflOpAndChk #undef negOvflChk #undef negOvflOp #undef bothCompare #undef compare -#undef bothBinaryOvfl +#undef bothBinaryOvflOpAndChk +#undef binaryOvflOpAndChk #undef bothBinaryOvflChk #undef binaryOvflChk #undef bothBinaryOvflOp From 68f8512b6b9caab6948d273ddf8cc7a917c53a3f Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Thu, 8 Aug 2019 21:20:33 -0400 Subject: [PATCH 091/102] Implement `-codegen-fuse-op-and-check true` for C codegen It appears that GCC (and, to a lesser extent) Clang/LLVM do not always successfully fuse adjacent `Word_` and `Word{S,U}_CheckP` primitives. The performance results reported at https://github.com/MLton/mlton/pull/273 and https://github.com/MLton/mlton/pull/292 suggest that this does not always have significant impact, but a close look at the `md5` benchmark shows that the native codegen significantly outperforms the C codegen with gcc-9 due to redundant arithmetic computations (one for `Word{S,U}_CheckP` and another for `Word_`). (Note: Because the final md5 state is not used by the `md5` benchmark program, MLton actually optimizes out most of the md5 computation. What is left is a lot of arithmetic from `PackWord32Little.subVec` to check for indices that should raise `Subscript`.) For example, with `-codegen-fuse-op-and-check false` and gcc-9, the `transform` function of `md5` has the following assembly: movl %r9d, %r10d subl $1, %r10d jo .L650 leal -1(%r8), %r10d movl %r10d, %r12d addl %r10d, %edx jo .L650 addl %r10d, %r11d cmpl %eax, %r11d jnb .L656 movl %ebp, %edx addl $1, %edx jo .L659 leal 1(%rcx), %edx movl %edx, %r11d imull %r9d, %r11d jo .L650 imull %r8d, %edx movl %edx, %r11d addl %r10d, %r11d jo .L650 leal (%rdx,%r10), %r11d cmpl %eax, %r11d jnb .L665 What seems to have happened is that gcc has arranged for equivalent values to be in `%r8` and `%r9`. In the first three lines, there is an implementation of `WordS32_subCheckP (X, 1)` using `subl/jo`, while in the fourth line, there is an implementation of `Word32_sub (X, 1)` using `lea` with an offset of `-1`. Notice that `%r10` is used for the result of both, so the fourth line is redundant (the value is already in `%r10`). On the other hand, with `-codegen-fuse-op-and-check true` and gcc-9, the `transform` function of `md5` has the following assembly: movl %r8d, %r9d subl $1, %r9d jo .L645 addl %r9d, %ecx jo .L645 cmpl %edx, %ecx jnb .L651 movl %eax, %ecx addl $1, %ecx jo .L654 imull %r8d, %ecx jo .L645 addl %r9d, %ecx jo .L645 cmpl %edx, %ecx jnb .L660 --- mlton/codegen/c-codegen/c-codegen.fun | 111 +++++++++++++++++++++++++- 1 file changed, 110 insertions(+), 1 deletion(-) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 48f6543bff..f29a1520ce 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1132,6 +1132,112 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, in outputStatement s end + fun outputStatementsFuseOpAndChk statements = + Vector.foreachi + (statements, fn (i, s1) => + let + fun default () = outputStatement s1 + in + case s1 of + Statement.PrimApp {args = args1, dst = SOME dst1, prim = prim1} => + let + fun fuse chk = + (case Vector.sub (statements, i + 1) of + s2 as Statement.PrimApp {args = args2, dst = SOME dst2, prim = prim2} => + if Vector.equals (args1, args2, Operand.equals) + andalso chk prim2 + then let + val name = + String.substituteFirst + (Prim.toString prim2, + {substring = "CheckP", + replacement = "AndCheck"}) + val _ = + if !Control.codegenComments > 1 + then (print "\t/* " + ; print (Layout.toString (Statement.layout s1)) + ; print " */\n" + ; print "\t/* " + ; print (Layout.toString (Statement.layout s2)) + ; print " */\n") + else () + val _ = print "\t" + val _ = + print (C.call (name, + Vector.toListMap (args1, fetchOperand) @ + [addr (operandToString dst1), + addr (operandToString dst2)])) + in + () + end + else default () + | _ => default ()) + handle Subscript => default () + fun skip chk = + (case Vector.sub (statements, i - 1) of + Statement.PrimApp {args = args2, dst = SOME _, prim = prim2} => + if Vector.equals (args1, args2, Operand.equals) + andalso chk prim2 + then () + else default () + | _ => default ()) + handle Subscript => default () + in + case Prim.name prim1 of + Prim.Name.Word_add ws1 => + fuse (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_addCheckP (ws2, _) => + WordSize.equals (ws1, ws2) + | _ => false) + | Prim.Name.Word_addCheckP (ws1, _) => + skip (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_add ws2 => + WordSize.equals (ws1, ws2) + | _ => false) + | Prim.Name.Word_mul (ws1, {signed = signed1}) => + fuse (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_mulCheckP (ws2, {signed = signed2}) => + WordSize.equals (ws1, ws2) + andalso Bool.equals (signed1, signed2) + | _ => false) + | Prim.Name.Word_mulCheckP (ws1, {signed = signed1}) => + skip (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_mul (ws2, {signed = signed2}) => + WordSize.equals (ws1, ws2) + andalso Bool.equals (signed1, signed2) + | _ => false) + | Prim.Name.Word_neg ws1 => + fuse (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_negCheckP (ws2, _) => + WordSize.equals (ws1, ws2) + | _ => false) + | Prim.Name.Word_negCheckP (ws1, _) => + skip (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_neg ws2 => + WordSize.equals (ws1, ws2) + | _ => false) + | Prim.Name.Word_sub ws1 => + fuse (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_subCheckP (ws2, _) => + WordSize.equals (ws1, ws2) + | _ => false) + | Prim.Name.Word_subCheckP (ws1, _) => + skip (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_sub ws2 => + WordSize.equals (ws1, ws2) + | _ => false) + | _ => default () + end + | _ => default () + end) fun outputBlock (Block.T {kind, label, statements, transfer, ...}) = let val _ = prints [Label.toString label, ":\n"] @@ -1157,7 +1263,10 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, | Kind.Func _ => () | Kind.Handler {frameInfo, ...} => pop frameInfo | Kind.Jump => () - val _ = Vector.foreach (statements, outputStatement) + val _ = + if !Control.codegenFuseOpAndChk + then outputStatementsFuseOpAndChk statements + else Vector.foreach (statements, outputStatement) val _ = outputTransfer transfer val _ = print "\n" in From d7853bce4f920f85255ff20c727e902e00bcf42a Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 16 Aug 2019 06:49:23 -0400 Subject: [PATCH 092/102] Obscure returns from `Chunk` fns in C and LLVM codegens On some small programs (with all `Chunk` fns in the same compilation unit), Clang could observe that all `Chunk` fns return the value `-2` (arising from a C call with no return point). With this knowledge, it would replace a tail call from one `Chunk` fn to a `Chunk` fn with a non-tail call and an explicit `ret -2`. Breaking the tail call and not performing tail-call optimization leads to unbounded C stack growth and segmentation faults. LLVM could make the same optimization, but the LLVM codegen did not exhibit the same problem (perhaps it requires a specific LLVM optimization pass that is requested by Clang at `-O1`, but not included by default by opt at `-O2`). Obscuring the manifest result value by using a function call seems to prevent the problem (though, Clang could observe that all `Chunk` fns return the value `MLton_unreachable()` and make the same transformation, but presumable propagating a function call is considered more expensive than propagating a constant). It could arise again with aggressive link-time optimization. --- include/c-common.h | 3 ++ include/c-main.h | 3 ++ mlton/codegen/c-codegen/c-codegen.fun | 6 ++-- mlton/codegen/llvm-codegen/llvm-codegen.fun | 40 +++++++++++++++++---- 4 files changed, 44 insertions(+), 8 deletions(-) diff --git a/include/c-common.h b/include/c-common.h index 753a746ba0..065b07cd32 100644 --- a/include/c-common.h +++ b/include/c-common.h @@ -27,4 +27,7 @@ typedef uintptr_t ChunkFn_t (CPointer, CPointer, CPointer, uintptr_t); typedef ChunkFn_t *ChunkFnPtr_t; +PRIVATE uintptr_t MLton_unreachable(); +PRIVATE uintptr_t Thread_returnToC(); + #endif /* #ifndef _C_COMMON_H_ */ diff --git a/include/c-main.h b/include/c-main.h index 97c80abd1d..157cd24f71 100644 --- a/include/c-main.h +++ b/include/c-main.h @@ -26,6 +26,8 @@ static inline uintptr_t getNextBlockFromStackTop (GC_state s) { return *(uintptr_t*)(s->stackTop - GC_RETURNADDRESS_SIZE); } +PRIVATE uintptr_t MLton_unreachable() { return -2; } + PRIVATE extern ChunkFnPtr_t const nextChunks[]; static inline void MLton_trampoline (GC_state s, uintptr_t nextBlock, bool mayReturnToC) { @@ -35,6 +37,7 @@ static inline void MLton_trampoline (GC_state s, uintptr_t nextBlock, bool mayRe } #define MLtonCallFromC() \ +PRIVATE uintptr_t Thread_returnToC() { return -1; } \ static void MLton_callFromC (CPointer localOpArgsResPtr) { \ uintptr_t nextBlock; \ GC_state s = MLton_gcState(); \ diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index f29a1520ce..4539e7216d 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -991,7 +991,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, (push (return, size); flushFrontier (); flushStackTop (); - print "\treturn (uintptr_t)-1;\n") + print "\treturn "; + print (C.call ("Thread_returnToC", []))) | CCall {args, func, return} => let val CFunction.T {return = returnTy, target, ...} = func @@ -1047,7 +1048,8 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, if CFunction.maySwitchThreadsFrom func then indJump (false, true, NONE) else (case return of - NONE => print "\treturn (uintptr_t)-2;\n" + NONE => (print "\treturn " + ; print (C.call ("MLton_unreachable", []))) | SOME {return, ...} => gotoLabel (return, {tab = true})) in () diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 57c5cf5ba2..fa2036c19a 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -162,7 +162,6 @@ structure LLVM = Type.Word (WordX.size w)) fun zero ws = word (WordX.zero ws) fun negOne ws = word (WordX.fromIntInf (~1, ws)) - fun negTwo ws = word (WordX.fromIntInf (~2, ws)) end structure Instr = struct @@ -1355,10 +1354,24 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, {target = CFunction.Target.Direct "Thread_returnToC", ...}, return = SOME {return, size = SOME size}, ...} => - (push (return, size); - flushFrontier (); - flushStackTop (); - $(ret (LLVM.Value.negOne (WordSize.cpointer ())))) + let + val _ = push (return, size) + val _ = flushFrontier (); + val _ = flushStackTop (); + val tmp = newTemp (LLVM.Type.uintptr ()) + val fnptr = + LLVM.ModuleContext.addFnDecl + (mc, "@Thread_returnToC", + {argTys = [], + resTy = LLVM.Type.uintptr (), + vis = SOME "hidden"}) + val _ = $(call {dst = tmp, + tail = NONE, cconv = NONE, + fnptr = fnptr, args = []}) + val _ = $(ret tmp) + in + () + end | Transfer.CCall {args, func, return} => let val CFunction.T {return = returnTy, target, symbolScope, ...} = func @@ -1407,7 +1420,22 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, fnptr = fnptr, args = args}) val _ = case return of - NONE => $(ret (LLVM.Value.negTwo (WordSize.cpointer ()))) + NONE => + let + val tmp = newTemp (LLVM.Type.uintptr ()) + val fnptr = + LLVM.ModuleContext.addFnDecl + (mc, "@MLton_unreachable", + {argTys = [], + resTy = LLVM.Type.uintptr (), + vis = SOME "hidden"}) + val _ = $(call {dst = tmp, + tail = NONE, cconv = NONE, + fnptr = fnptr, args = []}) + val _ = $(ret tmp) + in + () + end | SOME {return, ...} => let val _ = if CFunction.modifiesFrontier func then cacheFrontier () else () From 82c019f4f49615a58827f2a13c9a83df034ecad9 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 16 Aug 2019 11:09:54 -0400 Subject: [PATCH 093/102] Add comments about fusing of adjacent `Word_` and `Word{S,U}_CheckP` primitives --- basis-library/primitive/prim1.sml | 7 +++++++ mlton/codegen/amd64-codegen/amd64-simplify.fun | 4 ++++ mlton/codegen/c-codegen/c-codegen.fun | 4 ++++ mlton/codegen/x86-codegen/x86-simplify.fun | 4 ++++ 4 files changed, 19 insertions(+) diff --git a/basis-library/primitive/prim1.sml b/basis-library/primitive/prim1.sml index 11e2e5da54..725f0b9642 100644 --- a/basis-library/primitive/prim1.sml +++ b/basis-library/primitive/prim1.sml @@ -52,6 +52,13 @@ structure Exn = exception Span exception Subscript + (* Fusing of adjacent `Word_` and `Word{S,U}_CheckP` primitives + * by the codegens depends on the relative order of `!a` and `?a`; + * see: + * - /mlton/codegen/amd64-codegen/amd64-simplify.fun:elimALRedundant + * - /mlton/codegen/c-codegen/c-codegen.fun:outputStatementsFuseOpAndChk + * - /mlton/codegen/x86-codegen/x86-simplify.fun:elimALRedundant + *) val mkOverflow: ('a -> 'b) * ('a -> bool) -> ('a -> 'b) = fn (!, ?) => fn a => let val r = ! a diff --git a/mlton/codegen/amd64-codegen/amd64-simplify.fun b/mlton/codegen/amd64-codegen/amd64-simplify.fun index 7401c88d14..883f976752 100644 --- a/mlton/codegen/amd64-codegen/amd64-simplify.fun +++ b/mlton/codegen/amd64-codegen/amd64-simplify.fun @@ -3246,6 +3246,10 @@ struct val (callback,elimALRedundant_msg) = make_callback_msg "elimALRedundant" in + (* Fusing of adjacent `Word_` and `Word{S,U}_CheckP` + * primitives depends on the relative order of `!a` and `?a` + * in /basis-library/primitive/prim1.sml:mkOverflow + *) val elimALRedundant : optimization = {template = template, rewriter = rewriter, diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 4539e7216d..956b61dbac 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1134,6 +1134,10 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, in outputStatement s end + (* Fusing of adjacent `Word_` and `Word{S,U}_CheckP` + * primitives depends on the relative order of `!a` and `?a` + * in /basis-library/primitive/prim1.sml:mkOverflow + *) fun outputStatementsFuseOpAndChk statements = Vector.foreachi (statements, fn (i, s1) => diff --git a/mlton/codegen/x86-codegen/x86-simplify.fun b/mlton/codegen/x86-codegen/x86-simplify.fun index 5336db5293..b74b7d2edd 100644 --- a/mlton/codegen/x86-codegen/x86-simplify.fun +++ b/mlton/codegen/x86-codegen/x86-simplify.fun @@ -3336,6 +3336,10 @@ struct val (callback,elimALRedundant_msg) = make_callback_msg "elimALRedundant" in + (* Fusing of adjacent `Word_` and `Word{S,U}_CheckP` + * primitives depends on the relative order of `!a` and `?a` + * in /basis-library/primitive/prim1.sml:mkOverflow + *) val elimALRedundant : optimization = {template = template, rewriter = rewriter, From 44de25ddaf8d066d56e07c3425fd882efeb39706 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 16 Aug 2019 11:59:09 -0400 Subject: [PATCH 094/102] Eliminate redundant debug flags in `compileC` and `compileS` --- mlton/main/main.fun | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) diff --git a/mlton/main/main.fun b/mlton/main/main.fun index b9bc10a16c..94289d2045 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -1157,14 +1157,7 @@ fun commandLine (args: string list): unit = then opt :: ac else ac) val asOpts = addTargetOpts asOpts - val asOpts = if !debug - then "-Wa,-g" :: asOpts - else asOpts val ccOpts = addTargetOpts ccOpts - val ccOpts = ("-I" ^ targetIncDir) :: ccOpts - val ccOpts = if !debug - then "-g" :: "-DASSERT=1" :: ccOpts - else ccOpts val linkOpts = addTargetOpts linkOpts val linkOpts = if !debugRuntime then "-lmlton-gdb" :: "-lgdtoa-gdb" :: linkOpts @@ -1373,7 +1366,6 @@ fun commandLine (args: string list): unit = atMLtons := Vector.fromList (tokenize (rev ("--" :: (!runtimeArgs)))) - val (ccDebug, asDebug) = (["-g", "-DASSERT=1"], "-Wa,-g") fun compileO (inputs: File.t list): unit = let val output = @@ -1473,11 +1465,13 @@ fun commandLine (args: string list): unit = List.concat [tl cc, [ "-c" ], + if !debug + then [ "-g", "-DASSERT=1" ] else [], if !format = Executable then [] else [ "-DLIBNAME=" ^ !libname ], if positionIndependent then [ "-fPIC", "-DPIC" ] else [], - if !debug then ccDebug else [], + [ "-I" ^ targetIncDir ], ccOpts, ["-o", output], [input]]) @@ -1493,7 +1487,7 @@ fun commandLine (args: string list): unit = List.concat [tl cc, ["-c"], - if !debug then [asDebug] else [], + if !debug then [ "-Wa,-g" ] else [], asOpts, ["-o", output], [input]]) From 79e7c8126c07cd8ae03ad859338ff1d211e0d091 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 16 Aug 2019 11:59:50 -0400 Subject: [PATCH 095/102] Add `-relocation-model=pic` to `llc` options when `positionIndependent` See MLton/mlton#190 and MLton/mlton#191 On systems (e.g., gcc 7.04 on Ubuntu 18.04) that error when linking PIC and non-PIC code, the default behavior of `llc` to generate non-PIC code leads to link-time errors. --- mlton/main/main.fun | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/mlton/main/main.fun b/mlton/main/main.fun index 94289d2045..d36aeb11fa 100644 --- a/mlton/main/main.fun +++ b/mlton/main/main.fun @@ -1517,8 +1517,10 @@ fun commandLine (args: string list): unit = System.system (llvm_llc, List.concat - [llvm_llcOpts, - ["-filetype=obj"], + [["-filetype=obj"], + if positionIndependent + then [ "-relocation-model=pic" ] else [], + llvm_llcOpts, ["-o", output], [optBC]]) in From 61de560b08ce46298d3a8b427a01f3b9cde264aa Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 16 Aug 2019 12:31:17 -0400 Subject: [PATCH 096/102] Implement `-codegen-fuse-op-and-check true` for LLVM codegen --- basis-library/primitive/prim1.sml | 1 + mlton/codegen/llvm-codegen/llvm-codegen.fun | 148 +++++++++++++++++++- 2 files changed, 147 insertions(+), 2 deletions(-) diff --git a/basis-library/primitive/prim1.sml b/basis-library/primitive/prim1.sml index 725f0b9642..ed5963af94 100644 --- a/basis-library/primitive/prim1.sml +++ b/basis-library/primitive/prim1.sml @@ -57,6 +57,7 @@ structure Exn = * see: * - /mlton/codegen/amd64-codegen/amd64-simplify.fun:elimALRedundant * - /mlton/codegen/c-codegen/c-codegen.fun:outputStatementsFuseOpAndChk + * - /mlton/codegen/llvm-codegen/llvm-codegen.fun:outputStatementsFuseOpAndChk * - /mlton/codegen/x86-codegen/x86-simplify.fun:elimALRedundant *) val mkOverflow: ('a -> 'b) * ('a -> bool) -> ('a -> 'b) = diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index fa2036c19a..324a0a7f8c 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -688,6 +688,45 @@ fun primApp (prim: 'a Prim.t): ({args: LLVM.Value.t list, end fun implementsPrim (p: 'a Prim.t): bool = Option.isSome (primApp p) +fun primAppOpAndCheck {args: LLVM.Value.t list, + prim: 'a Prim.t, + mc: LLVM.ModuleContext.t, + newTemp: LLVM.Type.t -> LLVM.Value.t, + $ : LLVM.Instr.t -> unit}: LLVM.Value.t * LLVM.Value.t = + let + open LLVM.Instr + fun intrinsic (name, argTys, resTy, mc) = + LLVM.ModuleContext.addFnDecl (mc, "@llvm." ^ name, {argTys = argTys, resTy = resTy, vis = NONE}) + fun doit' (oper, ws, fargs) = + let + val args = fargs args + val atys = List.map (args, #2) + val wty = LLVM.Type.Word ws + val sty = LLVM.Type.Struct (false, [wty, LLVM.Type.bool]) + val name = concat [oper, ".with.overflow.i", WordSize.toString ws] + val fnptr = intrinsic (name, atys, sty, mc) + val tmps = newTemp sty + val res1 = newTemp wty + val tmpb = newTemp LLVM.Type.bool + val res2 = newTemp (LLVM.Type.Word WordSize.bool) + val _ = $(call {dst = tmps, tail = NONE, cconv = NONE, fnptr = fnptr, args = args}) + val _ = $(xval {dst = res1, src = tmps, args = ["0"]}) + val _ = $(xval {dst = tmpb, src = tmps, args = ["1"]}) + val _ = $(zext {dst = res2, src = tmpb}) + in + (res1, res2) + end + fun doit (oper, ws) = doit' (oper, ws, fn args => args) + datatype z = datatype Prim.Name.t + in + case Prim.name prim of + Word_addCheckP (ws, {signed}) => doit (if signed then "sadd" else "uadd", ws) + | Word_mulCheckP (ws, {signed}) => doit (if signed then "smul" else "umul", ws) + | Word_negCheckP (ws, {signed}) => doit' (if signed then "ssub" else "usub", ws, fn args => (LLVM.Value.zero ws)::args) + | Word_subCheckP (ws, {signed}) => doit (if signed then "ssub" else "usub", ws) + | _ => Error.bug "LLVMCodegen.primAppOpAndChk" + end + fun aamd (oper, mc) = case !Control.llvmAAMD of Control.LLVMAliasAnalysisMetaData.None => NONE @@ -1498,7 +1537,109 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, in outputStatement s end - + (* Fusing of adjacent `Word_` and `Word{S,U}_CheckP` + * primitives depends on the relative order of `!a` and `?a` + * in /basis-library/primitive/prim1.sml:mkOverflow + *) + fun outputStatementsFuseOpAndChk statements = + Vector.foreachi + (statements, fn (i, s1) => + let + fun default () = outputStatement s1 + in + case s1 of + Statement.PrimApp {args = args1, dst = SOME dst1, prim = prim1} => + let + fun fuse chk = + (case Vector.sub (statements, i + 1) of + s2 as Statement.PrimApp {args = args2, dst = SOME dst2, prim = prim2} => + if Vector.equals (args1, args2, Operand.equals) + andalso chk prim2 + then let + val _ = + if !Control.codegenComments > 1 + then (tbprintsln ["; ", Layout.toString (Statement.layout s1)] + ; tbprintsln ["; ", Layout.toString (Statement.layout s2)]) + else () + val args = operandsToRValues args1 + val (res1, res2) = + primAppOpAndCheck + {args = args, prim = prim2, mc = mc, newTemp = newTemp, $ = $} + val (_, storeDst1) = operandToLValue dst1 + val _ = $(storeDst1 {src = res1}) + val (_, storeDst2) = operandToLValue dst2 + val _ = $(storeDst2 {src = res2}) + in + () + end + else default () + | _ => default ()) + handle Subscript => default () + fun skip chk = + (case Vector.sub (statements, i - 1) of + Statement.PrimApp {args = args2, dst = SOME _, prim = prim2} => + if Vector.equals (args1, args2, Operand.equals) + andalso chk prim2 + then () + else default () + | _ => default ()) + handle Subscript => default () + in + case Prim.name prim1 of + Prim.Name.Word_add ws1 => + fuse (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_addCheckP (ws2, _) => + WordSize.equals (ws1, ws2) + | _ => false) + | Prim.Name.Word_addCheckP (ws1, _) => + skip (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_add ws2 => + WordSize.equals (ws1, ws2) + | _ => false) + | Prim.Name.Word_mul (ws1, {signed = signed1}) => + fuse (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_mulCheckP (ws2, {signed = signed2}) => + WordSize.equals (ws1, ws2) + andalso Bool.equals (signed1, signed2) + | _ => false) + | Prim.Name.Word_mulCheckP (ws1, {signed = signed1}) => + skip (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_mul (ws2, {signed = signed2}) => + WordSize.equals (ws1, ws2) + andalso Bool.equals (signed1, signed2) + | _ => false) + | Prim.Name.Word_neg ws1 => + fuse (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_negCheckP (ws2, _) => + WordSize.equals (ws1, ws2) + | _ => false) + | Prim.Name.Word_negCheckP (ws1, _) => + skip (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_neg ws2 => + WordSize.equals (ws1, ws2) + | _ => false) + | Prim.Name.Word_sub ws1 => + fuse (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_subCheckP (ws2, _) => + WordSize.equals (ws1, ws2) + | _ => false) + | Prim.Name.Word_subCheckP (ws1, _) => + skip (fn prim2 => + case Prim.name prim2 of + Prim.Name.Word_sub ws2 => + WordSize.equals (ws1, ws2) + | _ => false) + | _ => default () + end + | _ => default () + end) fun outputBlock (Block.T {kind, label, statements, transfer, ...}) = let val _ = printsln [Label.toString label, ":"] @@ -1523,7 +1664,10 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, | Kind.Func _ => () | Kind.Handler {frameInfo, ...} => pop frameInfo | Kind.Jump => () - val _ = Vector.foreach (statements, outputStatement) + val _ = + if !Control.codegenFuseOpAndChk + then outputStatementsFuseOpAndChk statements + else Vector.foreach (statements, outputStatement) val _ = outputTransfer transfer val _ = print "\n" in From 53631992f4d1f67807c5d97c36910b10278a4d07 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Sat, 17 Aug 2019 20:52:16 -0400 Subject: [PATCH 097/102] Use manifest temps for `Word{S,U}_AndCheck` calls in C codegen When a Machine IR temp is used as a destination for `Word{S,U}_AndCheck`, by having its address taken, Clang sometimes fails to turn the `alloca` introduced for the C local variable into an SSA variable. Moreover, Clang introduces `@llvm.lifetime.{start,end}` intrinsic calls at chunk entry and exit; the call at the chunk exit (although they are no-ops) inhibit tail call optimization. Using a manifest temporary C local variable for the results of `Word{S,U}_AndCheck` and then copying them into Machine IR destination operands seems avoid the problem. --- mlton/codegen/c-codegen/c-codegen.fun | 106 +++++++++++++++++--------- 1 file changed, 68 insertions(+), 38 deletions(-) diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 956b61dbac..7e7ea7b616 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1151,31 +1151,53 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, (case Vector.sub (statements, i + 1) of s2 as Statement.PrimApp {args = args2, dst = SOME dst2, prim = prim2} => if Vector.equals (args1, args2, Operand.equals) - andalso chk prim2 - then let - val name = - String.substituteFirst - (Prim.toString prim2, - {substring = "CheckP", - replacement = "AndCheck"}) - val _ = - if !Control.codegenComments > 1 - then (print "\t/* " - ; print (Layout.toString (Statement.layout s1)) - ; print " */\n" - ; print "\t/* " - ; print (Layout.toString (Statement.layout s2)) - ; print " */\n") - else () - val _ = print "\t" - val _ = - print (C.call (name, - Vector.toListMap (args1, fetchOperand) @ - [addr (operandToString dst1), - addr (operandToString dst2)])) - in - () - end + then (case chk prim2 of + NONE => default () + | SOME (ws, {signed}) => + let + val name = + String.substituteFirst + (Prim.toString prim2, + {substring = "CheckP", + replacement = "AndCheck"}) + val _ = + if !Control.codegenComments > 1 + then (print "\t/* " + ; print (Layout.toString (Statement.layout s1)) + ; print " */\n" + ; print "\t/* " + ; print (Layout.toString (Statement.layout s2)) + ; print " */\n") + else () + val _ = print "\t{\n" + val _ = print "\tWord" + val _ = print (if signed then "S" else "U") + val _ = print (WordSize.toString ws) + val _ = print " w;\n" + val _ = print "\tBool b;\n" + val _ = print "\t" + val _ = + print (C.call (name, + Vector.toListMap (args1, fetchOperand) @ + ["&w", "&b"])) + val _ = print "\t" + val _ = + print (move {dst = operandToString dst1, + dstIsMem = Operand.isMem dst1, + src = "w", + srcIsMem = false, + ty = Operand.ty dst1}) + val _ = print "\t" + val _ = + print (move {dst = operandToString dst2, + dstIsMem = Operand.isMem dst2, + src = "b", + srcIsMem = false, + ty = Operand.ty dst2}) + val _ = print "\t}\n" + in + () + end) else default () | _ => default ()) handle Subscript => default () @@ -1193,9 +1215,11 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, Prim.Name.Word_add ws1 => fuse (fn prim2 => case Prim.name prim2 of - Prim.Name.Word_addCheckP (ws2, _) => - WordSize.equals (ws1, ws2) - | _ => false) + Prim.Name.Word_addCheckP (z as (ws2, _)) => + if WordSize.equals (ws1, ws2) + then SOME z + else NONE + | _ => NONE) | Prim.Name.Word_addCheckP (ws1, _) => skip (fn prim2 => case Prim.name prim2 of @@ -1205,10 +1229,12 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, | Prim.Name.Word_mul (ws1, {signed = signed1}) => fuse (fn prim2 => case Prim.name prim2 of - Prim.Name.Word_mulCheckP (ws2, {signed = signed2}) => - WordSize.equals (ws1, ws2) - andalso Bool.equals (signed1, signed2) - | _ => false) + Prim.Name.Word_mulCheckP (z as (ws2, {signed = signed2})) => + if WordSize.equals (ws1, ws2) + andalso Bool.equals (signed1, signed2) + then SOME z + else NONE + | _ => NONE) | Prim.Name.Word_mulCheckP (ws1, {signed = signed1}) => skip (fn prim2 => case Prim.name prim2 of @@ -1219,9 +1245,11 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, | Prim.Name.Word_neg ws1 => fuse (fn prim2 => case Prim.name prim2 of - Prim.Name.Word_negCheckP (ws2, _) => - WordSize.equals (ws1, ws2) - | _ => false) + Prim.Name.Word_negCheckP (z as (ws2, _)) => + if WordSize.equals (ws1, ws2) + then SOME z + else NONE + | _ => NONE) | Prim.Name.Word_negCheckP (ws1, _) => skip (fn prim2 => case Prim.name prim2 of @@ -1231,9 +1259,11 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, ...}, | Prim.Name.Word_sub ws1 => fuse (fn prim2 => case Prim.name prim2 of - Prim.Name.Word_subCheckP (ws2, _) => - WordSize.equals (ws1, ws2) - | _ => false) + Prim.Name.Word_subCheckP (z as (ws2, _)) => + if WordSize.equals (ws1, ws2) + then SOME z + else NONE + | _ => NONE) | Prim.Name.Word_subCheckP (ws1, _) => skip (fn prim2 => case Prim.name prim2 of From 74b77ea5fa61aeeeae280c6ad816cb777db1b225 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 5 Nov 2019 08:09:35 -0500 Subject: [PATCH 098/102] Avoid `fneg` LLVM instruction (not present prior to LLVM 8.0) --- mlton/codegen/llvm-codegen/llvm-codegen.fun | 17 +++++++++++++++-- 1 file changed, 15 insertions(+), 2 deletions(-) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 324a0a7f8c..6d613d3726 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -156,6 +156,7 @@ structure LLVM = fun real r = (RealX.toString (r, {suffix = false}), Type.Real (RealX.size r)) + fun fnegZero rs = ("-0.0", Type.Real rs) (* fun undef ty = ("undef", ty) *) fun word w = (IntInf.toString (WordX.toIntInf w), @@ -649,12 +650,24 @@ fun primApp (prim: 'a Prim.t): ({args: LLVM.Value.t list, | Real_mulsub rs => SOME (fn {args, mc, newTemp, $} => let fun mk args = {args = args, mc = mc, newTemp = newTemp, $ = $} - val tmp = realNary ("fneg", rs) (mk [nth (args, 2)]) + val tmp = + if false + then realNary ("fneg", rs) (mk [nth (args, 2)]) + else realNary ("fsub", rs) (mk [LLVM.Value.fnegZero rs, nth (args, 2)]) val res = realMath ("fma", rs) (mk [nth (args, 0), nth (args, 1), tmp]) in res end) - | Real_neg rs => SOME (realNary ("fneg", rs)) + | Real_neg rs => SOME (fn {args, mc, newTemp, $} => + let + fun mk args = {args = args, mc = mc, newTemp = newTemp, $ = $} + val res = + if false + then realNary ("fneg", rs) (mk [nth (args, 0)]) + else realNary ("fsub", rs) (mk [LLVM.Value.fnegZero rs, nth (args, 0)]) + in + res + end) | Real_qequal rs => SOME (realCompare ("ueq", rs)) | Real_rndToReal (_, rs) => SOME (conv (fpresize, LLVM.Type.Real rs)) | Real_rndToWord (_, ws, {signed}) => SOME (conv (if signed then fptosi else fptoui, LLVM.Type.Word ws)) From 0d46a8537a680577c273928c8cc8f920d5433dfd Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 19 Nov 2019 13:53:41 -0500 Subject: [PATCH 099/102] Make `-codegen-fuse-op-and-chk true` for C & LLVM order independent Fusing of adjacent `Word_` and `Word{S,U}_CheckP` primitives in the C and LLVM codegens will now occur in either order. --- basis-library/primitive/prim1.sml | 2 +- mlton/codegen/c-codegen/c-codegen.fun | 74 ++++++------- mlton/codegen/llvm-codegen/llvm-codegen.fun | 116 +++++++++++--------- 3 files changed, 101 insertions(+), 91 deletions(-) diff --git a/basis-library/primitive/prim1.sml b/basis-library/primitive/prim1.sml index ed5963af94..322c285c6d 100644 --- a/basis-library/primitive/prim1.sml +++ b/basis-library/primitive/prim1.sml @@ -53,7 +53,7 @@ structure Exn = exception Subscript (* Fusing of adjacent `Word_` and `Word{S,U}_CheckP` primitives - * by the codegens depends on the relative order of `!a` and `?a`; + * by the codegens may depend on the relative order of `!a` and `?a`; * see: * - /mlton/codegen/amd64-codegen/amd64-simplify.fun:elimALRedundant * - /mlton/codegen/c-codegen/c-codegen.fun:outputStatementsFuseOpAndChk diff --git a/mlton/codegen/c-codegen/c-codegen.fun b/mlton/codegen/c-codegen/c-codegen.fun index 2f116606ab..5364a3a3f9 100644 --- a/mlton/codegen/c-codegen/c-codegen.fun +++ b/mlton/codegen/c-codegen/c-codegen.fun @@ -1270,15 +1270,16 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, statics, ... outputStatement s end (* Fusing of adjacent `Word_` and `Word{S,U}_CheckP` - * primitives depends on the relative order of `!a` and `?a` + * primitives *does not* depend on the relative order of `!a` and `?a` * in /basis-library/primitive/prim1.sml:mkOverflow *) fun outputStatementsFuseOpAndChk statements = - Vector.foreachi - (statements, fn (i, s1) => + (ignore o Vector.foldi) + (statements, false, fn (i, s1, skip) => let - fun default () = outputStatement s1 + fun default () = (outputStatement s1; false) in + if skip then false else case s1 of Statement.PrimApp {args = args1, dst = SOME dst1, prim = prim1} => let @@ -1288,11 +1289,11 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, statics, ... if Vector.equals (args1, args2, Operand.equals) then (case chk prim2 of NONE => default () - | SOME (ws, {signed}) => + | SOME (prim, (ws, {signed})) => let val name = String.substituteFirst - (Prim.toString prim2, + (Prim.toString prim, {substring = "CheckP", replacement = "AndCheck"}) val _ = @@ -1331,20 +1332,11 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, statics, ... ty = Operand.ty dst2}) val _ = print "\t}\n" in - () + true end) else default () | _ => default ()) handle Subscript => default () - fun skip chk = - (case Vector.sub (statements, i - 1) of - Statement.PrimApp {args = args2, dst = SOME _, prim = prim2} => - if Vector.equals (args1, args2, Operand.equals) - andalso chk prim2 - then () - else default () - | _ => default ()) - handle Subscript => default () in case Prim.name prim1 of Prim.Name.Word_add ws1 => @@ -1352,59 +1344,67 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, statics, ... case Prim.name prim2 of Prim.Name.Word_addCheckP (z as (ws2, _)) => if WordSize.equals (ws1, ws2) - then SOME z + then SOME (prim2, z) else NONE | _ => NONE) - | Prim.Name.Word_addCheckP (ws1, _) => - skip (fn prim2 => + | Prim.Name.Word_addCheckP (z as (ws1, _)) => + fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_add ws2 => - WordSize.equals (ws1, ws2) - | _ => false) + if WordSize.equals (ws1, ws2) + then SOME (prim1, z) + else NONE + | _ => NONE) | Prim.Name.Word_mul (ws1, {signed = signed1}) => fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_mulCheckP (z as (ws2, {signed = signed2})) => if WordSize.equals (ws1, ws2) andalso Bool.equals (signed1, signed2) - then SOME z + then SOME (prim2, z) else NONE | _ => NONE) - | Prim.Name.Word_mulCheckP (ws1, {signed = signed1}) => - skip (fn prim2 => + | Prim.Name.Word_mulCheckP (z as (ws1, {signed = signed1})) => + fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_mul (ws2, {signed = signed2}) => - WordSize.equals (ws1, ws2) - andalso Bool.equals (signed1, signed2) - | _ => false) + if WordSize.equals (ws1, ws2) + andalso Bool.equals (signed1, signed2) + then SOME (prim1, z) + else NONE + | _ => NONE) | Prim.Name.Word_neg ws1 => fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_negCheckP (z as (ws2, _)) => if WordSize.equals (ws1, ws2) - then SOME z + then SOME (prim2, z) else NONE | _ => NONE) - | Prim.Name.Word_negCheckP (ws1, _) => - skip (fn prim2 => + | Prim.Name.Word_negCheckP (z as (ws1, _)) => + fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_neg ws2 => - WordSize.equals (ws1, ws2) - | _ => false) + if WordSize.equals (ws1, ws2) + then SOME (prim1, z) + else NONE + | _ => NONE) | Prim.Name.Word_sub ws1 => fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_subCheckP (z as (ws2, _)) => if WordSize.equals (ws1, ws2) - then SOME z + then SOME (prim2, z) else NONE | _ => NONE) - | Prim.Name.Word_subCheckP (ws1, _) => - skip (fn prim2 => + | Prim.Name.Word_subCheckP (z as (ws1, _)) => + fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_sub ws2 => - WordSize.equals (ws1, ws2) - | _ => false) + if WordSize.equals (ws1, ws2) + then SOME (prim1, z) + else NONE + | _ => NONE) | _ => default () end | _ => default () diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 16e4a409ce..1a9eb9353c 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -1600,15 +1600,16 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, statics, ... outputStatement s end (* Fusing of adjacent `Word_` and `Word{S,U}_CheckP` - * primitives depends on the relative order of `!a` and `?a` + * primitives *does not* depends on the relative order of `!a` and `?a` * in /basis-library/primitive/prim1.sml:mkOverflow *) fun outputStatementsFuseOpAndChk statements = - Vector.foreachi - (statements, fn (i, s1) => + (ignore o Vector.foldi) + (statements, false, fn (i, s1, skip) => let - fun default () = outputStatement s1 + fun default () = (outputStatement s1; false) in + if skip then false else case s1 of Statement.PrimApp {args = args1, dst = SOME dst1, prim = prim1} => let @@ -1616,33 +1617,26 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, statics, ... (case Vector.sub (statements, i + 1) of s2 as Statement.PrimApp {args = args2, dst = SOME dst2, prim = prim2} => if Vector.equals (args1, args2, Operand.equals) - andalso chk prim2 - then let - val _ = - if !Control.codegenComments > 1 - then (tbprintsln ["; ", Layout.toString (Statement.layout s1)] - ; tbprintsln ["; ", Layout.toString (Statement.layout s2)]) - else () - val args = operandsToRValues args1 - val (res1, res2) = - primAppOpAndCheck - {args = args, prim = prim2, mc = mc, newTemp = newTemp, $ = $} - val (_, storeDst1) = operandToLValue dst1 - val _ = $(storeDst1 {src = res1}) - val (_, storeDst2) = operandToLValue dst2 - val _ = $(storeDst2 {src = res2}) - in - () - end - else default () - | _ => default ()) - handle Subscript => default () - fun skip chk = - (case Vector.sub (statements, i - 1) of - Statement.PrimApp {args = args2, dst = SOME _, prim = prim2} => - if Vector.equals (args1, args2, Operand.equals) - andalso chk prim2 - then () + then (case chk prim2 of + NONE=> default () + | SOME prim => + let + val _ = + if !Control.codegenComments > 1 + then (tbprintsln ["; ", Layout.toString (Statement.layout s1)] + ; tbprintsln ["; ", Layout.toString (Statement.layout s2)]) + else () + val args = operandsToRValues args1 + val (res1, res2) = + primAppOpAndCheck + {args = args, prim = prim, mc = mc, newTemp = newTemp, $ = $} + val (_, storeDst1) = operandToLValue dst1 + val _ = $(storeDst1 {src = res1}) + val (_, storeDst2) = operandToLValue dst2 + val _ = $(storeDst2 {src = res2}) + in + true + end) else default () | _ => default ()) handle Subscript => default () @@ -1652,52 +1646,68 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, statics, ... fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_addCheckP (ws2, _) => - WordSize.equals (ws1, ws2) - | _ => false) + if WordSize.equals (ws1, ws2) + then SOME prim2 + else NONE + | _ => NONE) | Prim.Name.Word_addCheckP (ws1, _) => - skip (fn prim2 => + fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_add ws2 => - WordSize.equals (ws1, ws2) - | _ => false) + if WordSize.equals (ws1, ws2) + then SOME prim1 + else NONE + | _ => NONE) | Prim.Name.Word_mul (ws1, {signed = signed1}) => fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_mulCheckP (ws2, {signed = signed2}) => - WordSize.equals (ws1, ws2) - andalso Bool.equals (signed1, signed2) - | _ => false) + if WordSize.equals (ws1, ws2) + andalso Bool.equals (signed1, signed2) + then SOME prim2 + else NONE + | _ => NONE) | Prim.Name.Word_mulCheckP (ws1, {signed = signed1}) => - skip (fn prim2 => + fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_mul (ws2, {signed = signed2}) => - WordSize.equals (ws1, ws2) - andalso Bool.equals (signed1, signed2) - | _ => false) + if WordSize.equals (ws1, ws2) + andalso Bool.equals (signed1, signed2) + then SOME prim1 + else NONE + | _ => NONE) | Prim.Name.Word_neg ws1 => fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_negCheckP (ws2, _) => - WordSize.equals (ws1, ws2) - | _ => false) + if WordSize.equals (ws1, ws2) + then SOME prim2 + else NONE + | _ => NONE) | Prim.Name.Word_negCheckP (ws1, _) => - skip (fn prim2 => + fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_neg ws2 => - WordSize.equals (ws1, ws2) - | _ => false) + if WordSize.equals (ws1, ws2) + then SOME prim1 + else NONE + | _ => NONE) | Prim.Name.Word_sub ws1 => fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_subCheckP (ws2, _) => - WordSize.equals (ws1, ws2) - | _ => false) + if WordSize.equals (ws1, ws2) + then SOME prim2 + else NONE + | _ => NONE) | Prim.Name.Word_subCheckP (ws1, _) => - skip (fn prim2 => + fuse (fn prim2 => case Prim.name prim2 of Prim.Name.Word_sub ws2 => - WordSize.equals (ws1, ws2) - | _ => false) + if WordSize.equals (ws1, ws2) + then SOME prim1 + else NONE + | _ => NONE) | _ => default () end | _ => default () From 695320d351163669c8bf2d43db1d7c1020a8116c Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 19 Nov 2019 16:35:43 -0500 Subject: [PATCH 100/102] Use `@llvm.expect.i` in LLVM codegen for `Switch.T` with `expect` --- mlton/codegen/llvm-codegen/llvm-codegen.fun | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index 1a9eb9353c..ce53a49e42 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -1567,9 +1567,26 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, statics, ... prim = Prim.cpointerAdd}) ; rtrans raisesTo) | Transfer.Return {returnsTo} => rtrans returnsTo - | Transfer.Switch (Switch.T {cases, default, test, ...}) => + | Transfer.Switch (Switch.T {cases, default, expect, test, ...}) => let val test = operandToRValue test + val test = + case expect of + NONE => test + | SOME w => + let + val ws = WordX.size w + val wty = LLVM.Type.Word ws + val name = concat ["@llvm.expect.i", WordSize.toString ws] + val fnptr = + LLVM.ModuleContext.addFnDecl + (mc, name, {argTys = [wty, wty], resTy = wty, vis = NONE}) + val tmp = newTemp wty + val args = [test, LLVM.Value.word w] + val _ = $(call {dst = tmp, tail = NONE, cconv = NONE, fnptr = fnptr, args = args}) + in + tmp + end val (default, extra) = case default of SOME d => (d, fn () => ()) From 62bf6f8f39beea29740decc6b07374fc5729abdc Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Tue, 19 Nov 2019 16:40:38 -0500 Subject: [PATCH 101/102] Add and use `LLVMCodegen.LLVM.ModuleContext.intrinsic` --- mlton/codegen/llvm-codegen/llvm-codegen.fun | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/mlton/codegen/llvm-codegen/llvm-codegen.fun b/mlton/codegen/llvm-codegen/llvm-codegen.fun index ce53a49e42..340e4e0fa8 100644 --- a/mlton/codegen/llvm-codegen/llvm-codegen.fun +++ b/mlton/codegen/llvm-codegen/llvm-codegen.fun @@ -436,6 +436,8 @@ structure LLVM = fun addMetaData (T {metaData, ...}, md) = HashTable.lookupOrInsert (metaData, md, fn () => "!" ^ Int.toString (HashTable.size metaData)) + fun intrinsic (mc, name, {argTys, resTy}) = + addFnDecl (mc, "@llvm." ^ name, {argTys = argTys, resTy = resTy, vis = NONE}) end end @@ -472,8 +474,6 @@ fun primApp (prim: 'a Prim.t): ({args: LLVM.Value.t list, let open LLVM.Instr val nth = List.nth - fun intrinsic (name, argTys, resTy, mc) = - LLVM.ModuleContext.addFnDecl (mc, "@llvm." ^ name, {argTys = argTys, resTy = resTy, vis = NONE}) fun compare oper {args, mc = _, newTemp, $} = let val tmp = newTemp LLVM.Type.bool @@ -507,7 +507,7 @@ fun primApp (prim: 'a Prim.t): ({args: LLVM.Value.t list, val atys = List.map (args, #2) val rty = LLVM.Type.Real rs val name = concat [oper, ".f", RealSize.toString rs] - val fnptr = intrinsic (name, atys, rty, mc) + val fnptr = LLVM.ModuleContext.intrinsic (mc, name, {argTys = atys, resTy = rty}) val res = newTemp rty val _ = $(call {dst = res, tail = NONE, cconv = NONE, fnptr = fnptr, args = args}) in @@ -532,7 +532,7 @@ fun primApp (prim: 'a Prim.t): ({args: LLVM.Value.t list, val wty = LLVM.Type.Word ws val sty = LLVM.Type.Struct (false, [wty, LLVM.Type.bool]) val name = concat [oper, ".with.overflow.i", WordSize.toString ws] - val fnptr = intrinsic (name, atys, sty, mc) + val fnptr = LLVM.ModuleContext.intrinsic (mc, name, {argTys = atys, resTy = sty}) val tmps = newTemp sty val tmpb = newTemp LLVM.Type.bool val res = newTemp (LLVM.Type.Word WordSize.bool) @@ -559,7 +559,7 @@ fun primApp (prim: 'a Prim.t): ({args: LLVM.Value.t list, val atys = [wty, wty, wty] val rty = wty val name = concat [oper, ".i", WordSize.toString ws] - val fnptr = intrinsic (name, atys, rty, mc) + val fnptr = LLVM.ModuleContext.intrinsic (mc, name, {argTys = atys, resTy = rty}) val arg1 = newTemp wty val res = newTemp wty val _ = $(resize {dst = arg1, src = nth (args, 1), signed = false}) @@ -708,8 +708,6 @@ fun primAppOpAndCheck {args: LLVM.Value.t list, $ : LLVM.Instr.t -> unit}: LLVM.Value.t * LLVM.Value.t = let open LLVM.Instr - fun intrinsic (name, argTys, resTy, mc) = - LLVM.ModuleContext.addFnDecl (mc, "@llvm." ^ name, {argTys = argTys, resTy = resTy, vis = NONE}) fun doit' (oper, ws, fargs) = let val args = fargs args @@ -717,7 +715,7 @@ fun primAppOpAndCheck {args: LLVM.Value.t list, val wty = LLVM.Type.Word ws val sty = LLVM.Type.Struct (false, [wty, LLVM.Type.bool]) val name = concat [oper, ".with.overflow.i", WordSize.toString ws] - val fnptr = intrinsic (name, atys, sty, mc) + val fnptr = LLVM.ModuleContext.intrinsic (mc, name, {argTys = atys, resTy = sty}) val tmps = newTemp sty val res1 = newTemp wty val tmpb = newTemp LLVM.Type.bool @@ -1577,10 +1575,10 @@ fun output {program as Machine.Program.T {chunks, frameInfos, main, statics, ... let val ws = WordX.size w val wty = LLVM.Type.Word ws - val name = concat ["@llvm.expect.i", WordSize.toString ws] + val name = concat ["expect.i", WordSize.toString ws] val fnptr = - LLVM.ModuleContext.addFnDecl - (mc, name, {argTys = [wty, wty], resTy = wty, vis = NONE}) + LLVM.ModuleContext.intrinsic + (mc, name, {argTys = [wty, wty], resTy = wty}) val tmp = newTemp wty val args = [test, LLVM.Value.word w] val _ = $(call {dst = tmp, tail = NONE, cconv = NONE, fnptr = fnptr, args = args}) From 29ae87cc096a42501700102de9eb9f4f14e75907 Mon Sep 17 00:00:00 2001 From: Matthew Fluet Date: Fri, 22 Nov 2019 06:11:41 -0500 Subject: [PATCH 102/102] Update `CHANGELOG.adoc` --- CHANGELOG.adoc | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/CHANGELOG.adoc b/CHANGELOG.adoc index 1906b7a846..81a0acd250 100644 --- a/CHANGELOG.adoc +++ b/CHANGELOG.adoc @@ -8,6 +8,10 @@ Here are the changes from version 20180206 to version YYYYMMDD. === Details +* 2019-11-22 + ** Many updates and improvements to C and LLVM codegens. See + https://github.com/MLton/mlton/pull/351 for details. + * 2019-11-05 ** Change `OS.IO.poll` to not be restarted when interrupted by a signal. (This is consistent with `Socket.select`.)