From 418812519e520f7a844f1cb62bef4025f325c5fd Mon Sep 17 00:00:00 2001 From: Pranav Sharma Date: Wed, 11 Feb 2026 11:31:09 -0500 Subject: [PATCH 1/5] Add File interface changes- Signature with records, Write interface, mmap and virtual memory changes to support the interfaces. --- basis-library/mpl/file.sig | 4 ++++ basis-library/mpl/file.sml | 35 ++++++++++++++++++++++++++++ basis-library/primitive/prim-mpl.sml | 4 ++++ runtime/gc/virtual-memory.c | 5 ++++ runtime/platform.h | 1 + runtime/platform/mmap.c | 4 ++++ runtime/platform/use-mmap.c | 4 ++++ 7 files changed, 57 insertions(+) diff --git a/basis-library/mpl/file.sig b/basis-library/mpl/file.sig index 4e61e7962..bd168cb6c 100644 --- a/basis-library/mpl/file.sig +++ b/basis-library/mpl/file.sig @@ -11,6 +11,7 @@ sig exception Closed val openFile: string -> t + val openFileWriteable: string -> int -> {file : t, file_size: int} val closeFile: t -> unit val size: t -> int @@ -21,4 +22,7 @@ sig val readChars: t -> int -> char ArraySlice.slice -> unit val readWord8s: t -> int -> Word8.word ArraySlice.slice -> unit + val writeChar : {file: t, file_offset: int, array_slice_offset: int} -> char -> unit + val writeWord8s : {file: t, file_offset: int, array_slice_offset: int} -> Word8.word ArraySlice.slice -> unit + end diff --git a/basis-library/mpl/file.sml b/basis-library/mpl/file.sml index 53be8c9a9..689638aff 100644 --- a/basis-library/mpl/file.sml +++ b/basis-library/mpl/file.sml @@ -34,6 +34,20 @@ struct (ptr, size, ref true) end + fun openFileWriteable path final_size = + let + open Posix.FileSys + val file = createf (path, O_RDWR, O.append, S.flags [S.irusr, S.iwusr, S.irgrp, S.iroth]) + val fileSize = Position.toInt (ST.size (fstat file)) + val size = final_size + fileSize + val fd = C_Int.fromInt (SysWord.toInt (fdToWord file)) + val _ = ftruncate (file, Position.fromInt size) + val ptr = mmapFileWriteable (fd, C_Size.fromInt size) + in + Posix.IO.close file; + {file = (ptr, size, ref true), file_size = fileSize} + end + fun closeFile (ptr, size, stillOpen) = if !stillOpen then (release (ptr, C_Size.fromInt size); stillOpen := false) @@ -88,4 +102,25 @@ struct raise Closed end + fun writeChar {file = (ptr, size, stillOpen), file_offset = fileSize, array_slice_offset = i} c = + if !stillOpen andalso i >= 0 andalso i < size then + MLton.Pointer.setWord8 (ptr, i + fileSize, Primitive.Char8.idToWord8 c) + else if i < 0 orelse i >= size then + raise Subscript + else + raise Closed + + fun writeWord8s {file = (ptr, size, stillOpen), file_offset = file_offset, array_slice_offset = i} slice = + let + val (arr, j, n) = ArraySlice.base slice + val start = MLtonPointer.add (ptr, Word.fromInt file_offset) + in + if !stillOpen andalso i >= 0 andalso file_offset + (n - i) <= size then + copyWord8sFromBuffer (start, arr, C_Size.fromInt (i + j), C_Size.fromInt (n - i)) + else if i < 0 orelse i + n > size then + raise Subscript + else + raise Closed + end + end diff --git a/basis-library/primitive/prim-mpl.sml b/basis-library/primitive/prim-mpl.sml index 299174adc..b68542cdd 100644 --- a/basis-library/primitive/prim-mpl.sml +++ b/basis-library/primitive/prim-mpl.sml @@ -16,8 +16,12 @@ struct Pointer.t * Char8.t array * C_Size.word * C_Size.word -> unit; val copyWord8sToBuffer = _import "GC_memcpyToBuffer" runtime private: Pointer.t * Word8.word array * C_Size.word * C_Size.word -> unit; + val copyWord8sFromBuffer = _import "GC_memcpyFromBuffer" runtime private: + Pointer.t * Word8.word array * C_Size.word * C_Size.word -> unit; val mmapFileReadable = _import "GC_mmapFileReadable" runtime private: C_Int.int * C_Size.word -> Pointer.t; + val mmapFileWriteable = _import "GC_mmapFileWriteable" runtime private: + C_Int.int * C_Size.word -> Pointer.t; val release = _import "GC_release" runtime private: Pointer.t * C_Size.word -> unit; end diff --git a/runtime/gc/virtual-memory.c b/runtime/gc/virtual-memory.c index e7c33db7a..1f547c5c7 100644 --- a/runtime/gc/virtual-memory.c +++ b/runtime/gc/virtual-memory.c @@ -36,6 +36,11 @@ void GC_memcpyToBuffer(pointer src, pointer buffer, size_t offset, size_t length GC_memcpy(src, buffer + offset, length); } +void GC_memcpyFromBuffer(pointer des, pointer buffer, size_t offset, size_t length) { + GC_memcpy(buffer + offset, des, length); +} + + static inline void GC_memmove (pointer src, pointer dst, size_t size) { if (DEBUG_DETAILED) fprintf (stderr, "GC_memmove ("FMTPTR", "FMTPTR", %"PRIuMAX")\n", diff --git a/runtime/platform.h b/runtime/platform.h index 4fe528296..33d7ec0c5 100644 --- a/runtime/platform.h +++ b/runtime/platform.h @@ -127,6 +127,7 @@ PRIVATE __attribute__ ((noreturn)) void MLton_heapCheckTooLarge (void); PRIVATE void GC_displayMem (void); PRIVATE void GC_memcpyToBuffer(pointer src, pointer buffer, size_t offset, size_t length); +PRIVATE void GC_memcpyFromBuffer(pointer des, pointer buffer, size_t offset, size_t length); PRIVATE void *GC_mmapFileReadable (int fd, size_t size); PRIVATE void *GC_mmapAnon (void *start, size_t length); diff --git a/runtime/platform/mmap.c b/runtime/platform/mmap.c index 9c34c9c61..c76068214 100644 --- a/runtime/platform/mmap.c +++ b/runtime/platform/mmap.c @@ -2,6 +2,10 @@ static inline void *mmapFileReadable (int fd, size_t size) { return mmap (0, size, PROT_READ, MAP_PRIVATE, fd, 0); } +static inline void *mmapFileWriteable (int fd, size_t size) { + return mmap (0, size, PROT_WRITE, MAP_SHARED, fd, 0); +} + static inline void *mmapAnonFlags (void *start, size_t length, int flags) { return mmap (start, length, PROT_READ | PROT_WRITE, MAP_PRIVATE | MAP_ANON | flags, -1, 0); diff --git a/runtime/platform/use-mmap.c b/runtime/platform/use-mmap.c index 6cb5b35ac..d128c8902 100644 --- a/runtime/platform/use-mmap.c +++ b/runtime/platform/use-mmap.c @@ -8,6 +8,10 @@ void *GC_mmapFileReadable (int fd, size_t size) { return mmapFileReadable(fd, size); } +void *GC_mmapFileWriteable (int fd, size_t size) { + return mmapFileWriteable(fd, size); +} + void *GC_mmapAnon (void *start, size_t length) { return mmapAnon (start, length); } From f894a164bd6305bebde91f6c801f6cd53b123da2 Mon Sep 17 00:00:00 2001 From: Pranav Sharma Date: Wed, 11 Feb 2026 11:39:09 -0500 Subject: [PATCH 2/5] Add example --- examples/lib/WriteFile.sml | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) create mode 100644 examples/lib/WriteFile.sml diff --git a/examples/lib/WriteFile.sml b/examples/lib/WriteFile.sml new file mode 100644 index 000000000..2e58ec455 --- /dev/null +++ b/examples/lib/WriteFile.sml @@ -0,0 +1,24 @@ +structure WriteFile: +sig + val writeBinSeq: {filename: string, content: Word8.word Seq.t} -> unit +end = +struct + + fun writeBinSeq {filename, content} = + let + val n = Seq.length content + val {file, file_size = oldSize} = MPL.File.openFileWriteable filename n + val k = 10000 + val m = 1 + (n-1) div k + in + ForkJoin.parfor 1 (0, m) (fn i => + let + val lo = i*k + val hi = Int.min ((i+1)*k, n) + in + MPL.File.writeWord8s { file = file , file_offset = oldSize + lo, array_slice_offset = 0} (Seq.subseq content (lo, hi-lo)) + end + ); + MPL.File.closeFile file + end +end \ No newline at end of file From c9a5c24e21a4ddb0995e876f3719d72e84539270 Mon Sep 17 00:00:00 2001 From: Pranav Sharma Date: Tue, 17 Feb 2026 08:13:39 -0500 Subject: [PATCH 3/5] Add handling for read only and write only modes --- basis-library/mpl/file.sml | 49 ++++++++++++++++++++++---------------- 1 file changed, 28 insertions(+), 21 deletions(-) diff --git a/basis-library/mpl/file.sml b/basis-library/mpl/file.sml index 689638aff..3e8cef65b 100644 --- a/basis-library/mpl/file.sml +++ b/basis-library/mpl/file.sml @@ -13,14 +13,17 @@ struct structure C_Int = C_Int end - type t = MLton.Pointer.t * int * bool ref + datatype FileState = OpenRead | OpenReadWrite | FileClosed + + type t = MLton.Pointer.t * int * FileState ref exception Closed + exception WrongFilePermission open Primitive.MPL.File fun size (ptr, sz, stillOpen) = - if !stillOpen then sz else raise Closed + if !stillOpen = OpenRead orelse !stillOpen = OpenReadWrite then sz else raise Closed fun openFile path = let @@ -31,26 +34,26 @@ struct val ptr = mmapFileReadable (fd, C_Size.fromInt size) in Posix.IO.close file; - (ptr, size, ref true) + (ptr, size, ref OpenRead) end - fun openFileWriteable path final_size = + fun openFileWriteable path buffer_size = let open Posix.FileSys val file = createf (path, O_RDWR, O.append, S.flags [S.irusr, S.iwusr, S.irgrp, S.iroth]) - val fileSize = Position.toInt (ST.size (fstat file)) - val size = final_size + fileSize + val original_size = Position.toInt (ST.size (fstat file)) + val final_size = buffer_size + original_size val fd = C_Int.fromInt (SysWord.toInt (fdToWord file)) - val _ = ftruncate (file, Position.fromInt size) - val ptr = mmapFileWriteable (fd, C_Size.fromInt size) + val _ = ftruncate (file, Position.fromInt final_size) + val ptr = mmapFileWriteable (fd, C_Size.fromInt final_size) in Posix.IO.close file; - {file = (ptr, size, ref true), file_size = fileSize} + {file = (ptr, final_size, ref OpenReadWrite), file_size = original_size} end fun closeFile (ptr, size, stillOpen) = - if !stillOpen then - (release (ptr, C_Size.fromInt size); stillOpen := false) + if !stillOpen = OpenRead orelse !stillOpen = OpenReadWrite then + (release (ptr, C_Size.fromInt size); stillOpen := FileClosed) else raise Closed @@ -61,7 +64,7 @@ struct Char.chr (Word8.toInt (MLton.Pointer.getWord8 (ptr, i))) fun readChar (ptr, size, stillOpen) (i: int) = - if !stillOpen andalso i >= 0 andalso i < size then + if !stillOpen = OpenRead orelse !stillOpen = OpenReadWrite andalso i >= 0 andalso i < size then unsafeReadChar (ptr, size, stillOpen) i else if i < 0 orelse i >= size then raise Subscript @@ -69,7 +72,7 @@ struct raise Closed fun readWord8 (ptr, size, stillOpen) (i: int) = - if !stillOpen andalso i >= 0 andalso i < size then + if !stillOpen = OpenRead orelse !stillOpen = OpenReadWrite andalso i >= 0 andalso i < size then unsafeReadWord8 (ptr, size, stillOpen) i else if i < 0 orelse i >= size then raise Subscript @@ -81,7 +84,7 @@ struct val (arr, j, n) = ArraySlice.base slice val start = MLtonPointer.add (ptr, Word.fromInt i) in - if !stillOpen andalso i >= 0 andalso i+n <= size then + if !stillOpen = OpenRead orelse !stillOpen = OpenReadWrite andalso i >= 0 andalso i+n <= size then copyCharsToBuffer (start, arr, C_Size.fromInt j, C_Size.fromInt n) else if i < 0 orelse i+n > size then raise Subscript @@ -94,7 +97,7 @@ struct val (arr, j, n) = ArraySlice.base slice val start = MLtonPointer.add (ptr, Word.fromInt i) in - if !stillOpen andalso i >= 0 andalso i+n <= size then + if !stillOpen = OpenRead orelse !stillOpen = OpenReadWrite andalso i >= 0 andalso i+n <= size then copyWord8sToBuffer (start, arr, C_Size.fromInt j, C_Size.fromInt n) else if i < 0 orelse i+n > size then raise Subscript @@ -102,23 +105,27 @@ struct raise Closed end - fun writeChar {file = (ptr, size, stillOpen), file_offset = fileSize, array_slice_offset = i} c = - if !stillOpen andalso i >= 0 andalso i < size then - MLton.Pointer.setWord8 (ptr, i + fileSize, Primitive.Char8.idToWord8 c) + fun writeChar {file = (ptr, size, stillOpen), file_offset = file_offset, array_slice_offset = i} c = + if !stillOpen = OpenReadWrite andalso i >= 0 andalso i < size then + MLton.Pointer.setWord8 (ptr, i + file_offset, Primitive.Char8.idToWord8 c) else if i < 0 orelse i >= size then raise Subscript - else - raise Closed + else if !stillOpen = OpenRead then + raise WrongFilePermission + else + raise Closed fun writeWord8s {file = (ptr, size, stillOpen), file_offset = file_offset, array_slice_offset = i} slice = let val (arr, j, n) = ArraySlice.base slice val start = MLtonPointer.add (ptr, Word.fromInt file_offset) in - if !stillOpen andalso i >= 0 andalso file_offset + (n - i) <= size then + if !stillOpen = OpenReadWrite andalso i >= 0 andalso file_offset + (n - i) <= size then copyWord8sFromBuffer (start, arr, C_Size.fromInt (i + j), C_Size.fromInt (n - i)) else if i < 0 orelse i + n > size then raise Subscript + else if !stillOpen = OpenRead then + raise WrongFilePermission else raise Closed end From 0ea337903661f1c6781ae2f3c3104080fcf89ecc Mon Sep 17 00:00:00 2001 From: Pranav Sharma Date: Tue, 17 Feb 2026 09:13:51 -0500 Subject: [PATCH 4/5] Fix interfaces and remove shortcircuiting bug from readfiles and fix file permissions for readwrite mode --- basis-library/mpl/file.sig | 4 ++-- basis-library/mpl/file.sml | 46 +++++++++++++++++++------------------- examples/lib/WriteFile.sml | 2 +- 3 files changed, 26 insertions(+), 26 deletions(-) diff --git a/basis-library/mpl/file.sig b/basis-library/mpl/file.sig index bd168cb6c..a21fddfa8 100644 --- a/basis-library/mpl/file.sig +++ b/basis-library/mpl/file.sig @@ -22,7 +22,7 @@ sig val readChars: t -> int -> char ArraySlice.slice -> unit val readWord8s: t -> int -> Word8.word ArraySlice.slice -> unit - val writeChar : {file: t, file_offset: int, array_slice_offset: int} -> char -> unit - val writeWord8s : {file: t, file_offset: int, array_slice_offset: int} -> Word8.word ArraySlice.slice -> unit + val writeChar : {file: t, file_offset: int} -> char -> unit + val writeWord8s : {file: t, file_offset: int} -> Word8.word ArraySlice.slice -> unit end diff --git a/basis-library/mpl/file.sml b/basis-library/mpl/file.sml index 3e8cef65b..c55b0f347 100644 --- a/basis-library/mpl/file.sml +++ b/basis-library/mpl/file.sml @@ -28,7 +28,7 @@ struct fun openFile path = let open Posix.FileSys - val file = openf (path, O_RDONLY, O.fromWord 0w0) + val file = openf (path, O_RDWR, O.fromWord 0w0) val size = Position.toInt (ST.size (fstat file)) val fd = C_Int.fromInt (SysWord.toInt (fdToWord file)) val ptr = mmapFileReadable (fd, C_Size.fromInt size) @@ -64,7 +64,7 @@ struct Char.chr (Word8.toInt (MLton.Pointer.getWord8 (ptr, i))) fun readChar (ptr, size, stillOpen) (i: int) = - if !stillOpen = OpenRead orelse !stillOpen = OpenReadWrite andalso i >= 0 andalso i < size then + if (!stillOpen = OpenRead orelse !stillOpen = OpenReadWrite) andalso i >= 0 andalso i < size then unsafeReadChar (ptr, size, stillOpen) i else if i < 0 orelse i >= size then raise Subscript @@ -72,7 +72,7 @@ struct raise Closed fun readWord8 (ptr, size, stillOpen) (i: int) = - if !stillOpen = OpenRead orelse !stillOpen = OpenReadWrite andalso i >= 0 andalso i < size then + if (!stillOpen = OpenRead orelse !stillOpen = OpenReadWrite) andalso i >= 0 andalso i < size then unsafeReadWord8 (ptr, size, stillOpen) i else if i < 0 orelse i >= size then raise Subscript @@ -84,7 +84,7 @@ struct val (arr, j, n) = ArraySlice.base slice val start = MLtonPointer.add (ptr, Word.fromInt i) in - if !stillOpen = OpenRead orelse !stillOpen = OpenReadWrite andalso i >= 0 andalso i+n <= size then + if (!stillOpen = OpenRead orelse !stillOpen = OpenReadWrite) andalso i >= 0 andalso i+n <= size then copyCharsToBuffer (start, arr, C_Size.fromInt j, C_Size.fromInt n) else if i < 0 orelse i+n > size then raise Subscript @@ -97,7 +97,7 @@ struct val (arr, j, n) = ArraySlice.base slice val start = MLtonPointer.add (ptr, Word.fromInt i) in - if !stillOpen = OpenRead orelse !stillOpen = OpenReadWrite andalso i >= 0 andalso i+n <= size then + if (!stillOpen = OpenRead orelse !stillOpen = OpenReadWrite) andalso i >= 0 andalso i+n <= size then copyWord8sToBuffer (start, arr, C_Size.fromInt j, C_Size.fromInt n) else if i < 0 orelse i+n > size then raise Subscript @@ -105,29 +105,29 @@ struct raise Closed end - fun writeChar {file = (ptr, size, stillOpen), file_offset = file_offset, array_slice_offset = i} c = - if !stillOpen = OpenReadWrite andalso i >= 0 andalso i < size then - MLton.Pointer.setWord8 (ptr, i + file_offset, Primitive.Char8.idToWord8 c) - else if i < 0 orelse i >= size then + fun writeChar {file = (ptr, size, stillOpen), file_offset = file_offset} c = + if !stillOpen = OpenReadWrite andalso file_offset >= 0 andalso file_offset < size then + MLton.Pointer.setWord8 (ptr, file_offset, Primitive.Char8.idToWord8 c) + else if file_offset < 0 orelse file_offset >= size then raise Subscript else if !stillOpen = OpenRead then raise WrongFilePermission else raise Closed - fun writeWord8s {file = (ptr, size, stillOpen), file_offset = file_offset, array_slice_offset = i} slice = - let - val (arr, j, n) = ArraySlice.base slice - val start = MLtonPointer.add (ptr, Word.fromInt file_offset) - in - if !stillOpen = OpenReadWrite andalso i >= 0 andalso file_offset + (n - i) <= size then - copyWord8sFromBuffer (start, arr, C_Size.fromInt (i + j), C_Size.fromInt (n - i)) - else if i < 0 orelse i + n > size then - raise Subscript - else if !stillOpen = OpenRead then - raise WrongFilePermission - else - raise Closed - end + fun writeWord8s {file = (ptr, size, stillOpen), file_offset} slice = + let + val (arr, j, n) = ArraySlice.base slice + val start = MLtonPointer.add (ptr, Word.fromInt file_offset) + in + if !stillOpen = OpenReadWrite andalso file_offset >= 0 andalso file_offset + n <= size then + copyWord8sFromBuffer (start, arr, C_Size.fromInt j, C_Size.fromInt n) + else if file_offset < 0 orelse file_offset + n > size then + raise Subscript + else if !stillOpen = OpenRead then + raise WrongFilePermission + else + raise Closed + end end diff --git a/examples/lib/WriteFile.sml b/examples/lib/WriteFile.sml index 2e58ec455..8cd4c2f6b 100644 --- a/examples/lib/WriteFile.sml +++ b/examples/lib/WriteFile.sml @@ -16,7 +16,7 @@ struct val lo = i*k val hi = Int.min ((i+1)*k, n) in - MPL.File.writeWord8s { file = file , file_offset = oldSize + lo, array_slice_offset = 0} (Seq.subseq content (lo, hi-lo)) + MPL.File.writeWord8s { file = file , file_offset = oldSize + lo} (Seq.subseq content (lo, hi-lo)) end ); MPL.File.closeFile file From 2c1ff5d908135ec1fefcbd892f4da7a8a273ef95 Mon Sep 17 00:00:00 2001 From: Pranav Sharma Date: Sun, 22 Feb 2026 08:55:42 -0500 Subject: [PATCH 5/5] Add error handling in case file mapping fails --- basis-library/mpl/file.sml | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/basis-library/mpl/file.sml b/basis-library/mpl/file.sml index c55b0f347..74f0d5eb1 100644 --- a/basis-library/mpl/file.sml +++ b/basis-library/mpl/file.sml @@ -19,6 +19,8 @@ struct exception Closed exception WrongFilePermission + exception MappingFailed of string + exception OpenFailed of string open Primitive.MPL.File @@ -28,10 +30,14 @@ struct fun openFile path = let open Posix.FileSys - val file = openf (path, O_RDWR, O.fromWord 0w0) + val file = openf (path, O_RDONLY, O.fromWord 0w0) val size = Position.toInt (ST.size (fstat file)) val fd = C_Int.fromInt (SysWord.toInt (fdToWord file)) val ptr = mmapFileReadable (fd, C_Size.fromInt size) + val _ = if ptr = Primitive.MLton.Pointer.null orelse ptr = Primitive.MLton.Pointer.fromWord(C_Size.fromInt (~1)) then + raise (MappingFailed "Failed to map file readable") + else + () in Posix.IO.close file; (ptr, size, ref OpenRead) @@ -46,6 +52,10 @@ struct val fd = C_Int.fromInt (SysWord.toInt (fdToWord file)) val _ = ftruncate (file, Position.fromInt final_size) val ptr = mmapFileWriteable (fd, C_Size.fromInt final_size) + val _ = if ptr = Primitive.MLton.Pointer.null orelse ptr = Primitive.MLton.Pointer.fromWord(C_Size.fromInt (~1)) then + raise (MappingFailed "Failed to map file writeable") + else + () in Posix.IO.close file; {file = (ptr, final_size, ref OpenReadWrite), file_size = original_size}