diff --git a/PolyML.sln b/PolyML.sln index 95fae06d..0cbb139b 100644 --- a/PolyML.sln +++ b/PolyML.sln @@ -1,206 +1,182 @@  Microsoft Visual Studio Solution File, Format Version 12.00 -# Visual Studio 14 -VisualStudioVersion = 14.0.25420.1 +# Visual Studio Version 16 +VisualStudioVersion = 16.0.28922.388 MinimumVisualStudioVersion = 10.0.40219.1 Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "PolyLib", "libpolyml\PolyLib.vcxproj", "{0BA5D5B5-F85B-4C49-8A27-67186FA68922}" - ProjectSection(ProjectDependencies) = postProject - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78} = {6D86BC6F-E74E-40C5-9881-F8BB606BCA78} - EndProjectSection EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "PolyML", "PolyML\PolyML.vcxproj", "{DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "PolyMainLib", "libpolymain\PolyMainLib.vcxproj", "{0326C47A-00AF-42CB-B87D-0369A241B570}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "PolyPerf", "PolyPerf\PolyPerf.vcxproj", "{D9F58E8D-5FCD-4401-8D88-0C28732BD77B}" EndProject Project("{930C7802-8A8C-48F9-8165-68863BCCD9DD}") = "wininstall", "wininstall\wininstall.wixproj", "{788BA1C9-699E-4F92-9FAF-C7437A419042}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "polyicon", "wininstall\polyicon\polyicon.vcxproj", "{D4DF6521-6183-4E24-A327-55C72519836E}" EndProject Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "PolyImport", "PolyImp\PolyImport.vcxproj", "{1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}" EndProject -Project("{8BC9CEB8-8B4A-11D0-8D11-00A0C91BC942}") = "libffi", "libpolyml\libffi\libffi.vcxproj", "{6D86BC6F-E74E-40C5-9881-F8BB606BCA78}" -EndProject Global GlobalSection(SolutionConfigurationPlatforms) = preSolution Debug|x64 = Debug|x64 Debug|x86 = Debug|x86 Debug32in64|x64 = Debug32in64|x64 Debug32in64|x86 = Debug32in64|x86 IntDebug|x64 = IntDebug|x64 IntDebug|x86 = IntDebug|x86 IntRelease|x64 = IntRelease|x64 IntRelease|x86 = IntRelease|x86 Release|x64 = Release|x64 Release|x86 = Release|x86 Release32in64|x64 = Release32in64|x64 Release32in64|x86 = Release32in64|x86 EndGlobalSection GlobalSection(ProjectConfigurationPlatforms) = postSolution {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Debug|x64.ActiveCfg = Debug|x64 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Debug|x64.Build.0 = Debug|x64 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Debug|x86.ActiveCfg = Debug|Win32 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Debug|x86.Build.0 = Debug|Win32 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Debug32in64|x64.ActiveCfg = Debug32in64|x64 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Debug32in64|x64.Build.0 = Debug32in64|x64 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Debug32in64|x86.ActiveCfg = Debug32in64|Win32 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.IntDebug|x64.ActiveCfg = IntDebug|x64 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.IntDebug|x64.Build.0 = IntDebug|x64 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.IntDebug|x86.ActiveCfg = IntDebug|Win32 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.IntDebug|x86.Build.0 = IntDebug|Win32 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.IntRelease|x64.ActiveCfg = IntRelease|x64 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.IntRelease|x64.Build.0 = IntRelease|x64 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.IntRelease|x86.ActiveCfg = IntRelease|Win32 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.IntRelease|x86.Build.0 = IntRelease|Win32 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Release|x64.ActiveCfg = Release|x64 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Release|x64.Build.0 = Release|x64 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Release|x86.ActiveCfg = Release|Win32 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Release|x86.Build.0 = Release|Win32 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Release32in64|x64.ActiveCfg = Release32in64|x64 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Release32in64|x64.Build.0 = Release32in64|x64 {0BA5D5B5-F85B-4C49-8A27-67186FA68922}.Release32in64|x86.ActiveCfg = Release32in64|Win32 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Debug|x64.ActiveCfg = Debug|x64 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Debug|x64.Build.0 = Debug|x64 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Debug|x86.ActiveCfg = Debug|Win32 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Debug|x86.Build.0 = Debug|Win32 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Debug32in64|x64.ActiveCfg = Debug32in64|x64 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Debug32in64|x64.Build.0 = Debug32in64|x64 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Debug32in64|x86.ActiveCfg = Debug32in64|Win32 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.IntDebug|x64.ActiveCfg = IntDebug|x64 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.IntDebug|x64.Build.0 = IntDebug|x64 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.IntDebug|x86.ActiveCfg = IntDebug|Win32 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.IntDebug|x86.Build.0 = IntDebug|Win32 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.IntRelease|x64.ActiveCfg = IntRelease|x64 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.IntRelease|x64.Build.0 = IntRelease|x64 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.IntRelease|x86.ActiveCfg = IntRelease|Win32 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.IntRelease|x86.Build.0 = IntRelease|Win32 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Release|x64.ActiveCfg = Release|x64 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Release|x64.Build.0 = Release|x64 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Release|x86.ActiveCfg = Release|Win32 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Release|x86.Build.0 = Release|Win32 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Release32in64|x64.ActiveCfg = Release32in64|x64 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Release32in64|x64.Build.0 = Release32in64|x64 {DF3B373E-67DF-4AB4-8B1E-F54C5810E2CF}.Release32in64|x86.ActiveCfg = Release32in64|Win32 {0326C47A-00AF-42CB-B87D-0369A241B570}.Debug|x64.ActiveCfg = Debug|x64 {0326C47A-00AF-42CB-B87D-0369A241B570}.Debug|x64.Build.0 = Debug|x64 {0326C47A-00AF-42CB-B87D-0369A241B570}.Debug|x86.ActiveCfg = Debug|Win32 {0326C47A-00AF-42CB-B87D-0369A241B570}.Debug|x86.Build.0 = Debug|Win32 {0326C47A-00AF-42CB-B87D-0369A241B570}.Debug32in64|x64.ActiveCfg = Debug32in64|x64 {0326C47A-00AF-42CB-B87D-0369A241B570}.Debug32in64|x64.Build.0 = Debug32in64|x64 {0326C47A-00AF-42CB-B87D-0369A241B570}.Debug32in64|x86.ActiveCfg = Debug32in64|Win32 {0326C47A-00AF-42CB-B87D-0369A241B570}.IntDebug|x64.ActiveCfg = IntDebug|x64 {0326C47A-00AF-42CB-B87D-0369A241B570}.IntDebug|x64.Build.0 = IntDebug|x64 {0326C47A-00AF-42CB-B87D-0369A241B570}.IntDebug|x86.ActiveCfg = IntDebug|Win32 {0326C47A-00AF-42CB-B87D-0369A241B570}.IntDebug|x86.Build.0 = IntDebug|Win32 {0326C47A-00AF-42CB-B87D-0369A241B570}.IntRelease|x64.ActiveCfg = IntRelease|x64 {0326C47A-00AF-42CB-B87D-0369A241B570}.IntRelease|x64.Build.0 = IntRelease|x64 {0326C47A-00AF-42CB-B87D-0369A241B570}.IntRelease|x86.ActiveCfg = IntRelease|Win32 {0326C47A-00AF-42CB-B87D-0369A241B570}.IntRelease|x86.Build.0 = IntRelease|Win32 {0326C47A-00AF-42CB-B87D-0369A241B570}.Release|x64.ActiveCfg = Release|x64 {0326C47A-00AF-42CB-B87D-0369A241B570}.Release|x64.Build.0 = Release|x64 {0326C47A-00AF-42CB-B87D-0369A241B570}.Release|x86.ActiveCfg = Release|Win32 {0326C47A-00AF-42CB-B87D-0369A241B570}.Release|x86.Build.0 = Release|Win32 {0326C47A-00AF-42CB-B87D-0369A241B570}.Release32in64|x64.ActiveCfg = Release32in64|x64 {0326C47A-00AF-42CB-B87D-0369A241B570}.Release32in64|x64.Build.0 = Release32in64|x64 {0326C47A-00AF-42CB-B87D-0369A241B570}.Release32in64|x86.ActiveCfg = Release32in64|Win32 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.Debug|x64.ActiveCfg = Debug|x64 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.Debug|x64.Build.0 = Debug|x64 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.Debug|x86.ActiveCfg = Debug|Win32 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.Debug|x86.Build.0 = Debug|Win32 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.Debug32in64|x64.ActiveCfg = Debug32in64|x64 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.Debug32in64|x86.ActiveCfg = Debug32in64|Win32 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.IntDebug|x64.ActiveCfg = Debug|x64 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.IntDebug|x64.Build.0 = Debug|x64 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.IntDebug|x86.ActiveCfg = Debug|Win32 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.IntDebug|x86.Build.0 = Debug|Win32 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.IntRelease|x64.ActiveCfg = Release|x64 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.IntRelease|x64.Build.0 = Release|x64 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.IntRelease|x86.ActiveCfg = Release|Win32 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.IntRelease|x86.Build.0 = Release|Win32 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.Release|x64.ActiveCfg = Release|x64 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.Release|x64.Build.0 = Release|x64 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.Release|x86.ActiveCfg = Release|Win32 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.Release|x86.Build.0 = Release|Win32 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.Release32in64|x64.ActiveCfg = Release32in64|x64 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.Release32in64|x64.Build.0 = Release32in64|x64 {D9F58E8D-5FCD-4401-8D88-0C28732BD77B}.Release32in64|x86.ActiveCfg = Release32in64|Win32 {788BA1C9-699E-4F92-9FAF-C7437A419042}.Debug|x64.ActiveCfg = Debug|x86 {788BA1C9-699E-4F92-9FAF-C7437A419042}.Debug|x86.ActiveCfg = Debug|x86 {788BA1C9-699E-4F92-9FAF-C7437A419042}.Debug32in64|x64.ActiveCfg = Debug|x64 {788BA1C9-699E-4F92-9FAF-C7437A419042}.Debug32in64|x86.ActiveCfg = Debug|x86 {788BA1C9-699E-4F92-9FAF-C7437A419042}.IntDebug|x64.ActiveCfg = Release|x86 {788BA1C9-699E-4F92-9FAF-C7437A419042}.IntDebug|x86.ActiveCfg = Debug|x86 {788BA1C9-699E-4F92-9FAF-C7437A419042}.IntRelease|x64.ActiveCfg = Release|x86 {788BA1C9-699E-4F92-9FAF-C7437A419042}.IntRelease|x86.ActiveCfg = Release|x86 {788BA1C9-699E-4F92-9FAF-C7437A419042}.Release|x64.ActiveCfg = Release|x64 {788BA1C9-699E-4F92-9FAF-C7437A419042}.Release|x64.Build.0 = Release|x64 {788BA1C9-699E-4F92-9FAF-C7437A419042}.Release|x86.ActiveCfg = Release|x86 {788BA1C9-699E-4F92-9FAF-C7437A419042}.Release|x86.Build.0 = Release|x86 {788BA1C9-699E-4F92-9FAF-C7437A419042}.Release32in64|x64.ActiveCfg = Release|x64 {788BA1C9-699E-4F92-9FAF-C7437A419042}.Release32in64|x64.Build.0 = Release|x64 {788BA1C9-699E-4F92-9FAF-C7437A419042}.Release32in64|x86.ActiveCfg = Release|x86 {D4DF6521-6183-4E24-A327-55C72519836E}.Debug|x64.ActiveCfg = Debug|x64 {D4DF6521-6183-4E24-A327-55C72519836E}.Debug|x86.ActiveCfg = Debug|Win32 {D4DF6521-6183-4E24-A327-55C72519836E}.Debug32in64|x64.ActiveCfg = Debug32in64|x64 {D4DF6521-6183-4E24-A327-55C72519836E}.Debug32in64|x86.ActiveCfg = Debug32in64|Win32 {D4DF6521-6183-4E24-A327-55C72519836E}.IntDebug|x64.ActiveCfg = Debug|x64 {D4DF6521-6183-4E24-A327-55C72519836E}.IntDebug|x86.ActiveCfg = Debug|Win32 {D4DF6521-6183-4E24-A327-55C72519836E}.IntRelease|x64.ActiveCfg = Release|x64 {D4DF6521-6183-4E24-A327-55C72519836E}.IntRelease|x86.ActiveCfg = Release|Win32 {D4DF6521-6183-4E24-A327-55C72519836E}.Release|x64.ActiveCfg = Release|x64 {D4DF6521-6183-4E24-A327-55C72519836E}.Release|x64.Build.0 = Release|x64 {D4DF6521-6183-4E24-A327-55C72519836E}.Release|x86.ActiveCfg = Release|Win32 {D4DF6521-6183-4E24-A327-55C72519836E}.Release|x86.Build.0 = Release|Win32 {D4DF6521-6183-4E24-A327-55C72519836E}.Release32in64|x64.ActiveCfg = Release32in64|x64 {D4DF6521-6183-4E24-A327-55C72519836E}.Release32in64|x64.Build.0 = Release32in64|x64 {D4DF6521-6183-4E24-A327-55C72519836E}.Release32in64|x86.ActiveCfg = Release32in64|Win32 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Debug|x64.ActiveCfg = Debug|x64 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Debug|x64.Build.0 = Debug|x64 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Debug|x86.ActiveCfg = Debug|Win32 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Debug|x86.Build.0 = Debug|Win32 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Debug32in64|x64.ActiveCfg = Debug32in64|x64 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Debug32in64|x64.Build.0 = Debug32in64|x64 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Debug32in64|x86.ActiveCfg = Debug32in64|Win32 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.IntDebug|x64.ActiveCfg = IntDebug|x64 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.IntDebug|x64.Build.0 = IntDebug|x64 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.IntDebug|x86.ActiveCfg = IntDebug|Win32 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.IntDebug|x86.Build.0 = IntDebug|Win32 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.IntRelease|x64.ActiveCfg = IntRelease|x64 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.IntRelease|x64.Build.0 = IntRelease|x64 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.IntRelease|x86.ActiveCfg = IntRelease|Win32 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.IntRelease|x86.Build.0 = IntRelease|Win32 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Release|x64.ActiveCfg = Release|x64 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Release|x64.Build.0 = Release|x64 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Release|x86.ActiveCfg = Release|Win32 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Release|x86.Build.0 = Release|Win32 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Release32in64|x64.ActiveCfg = Release32in64|x64 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Release32in64|x64.Build.0 = Release32in64|x64 {1BA3E7A2-D64F-4CE3-9FE5-7846B855C19F}.Release32in64|x86.ActiveCfg = Release32in64|Win32 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Debug|x64.ActiveCfg = Debug|x64 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Debug|x64.Build.0 = Debug|x64 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Debug|x86.ActiveCfg = Debug|Win32 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Debug|x86.Build.0 = Debug|Win32 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Debug32in64|x64.ActiveCfg = Debug32in64|x64 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Debug32in64|x64.Build.0 = Debug32in64|x64 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Debug32in64|x86.ActiveCfg = Debug32in64|Win32 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.IntDebug|x64.ActiveCfg = IntDebug|x64 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.IntDebug|x64.Build.0 = IntDebug|x64 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.IntDebug|x86.ActiveCfg = IntDebug|Win32 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.IntDebug|x86.Build.0 = IntDebug|Win32 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.IntRelease|x64.ActiveCfg = IntRelease|x64 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.IntRelease|x64.Build.0 = IntRelease|x64 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.IntRelease|x86.ActiveCfg = IntRelease|Win32 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.IntRelease|x86.Build.0 = IntRelease|Win32 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Release|x64.ActiveCfg = Release|x64 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Release|x64.Build.0 = Release|x64 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Release|x86.ActiveCfg = Release|Win32 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Release|x86.Build.0 = Release|Win32 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Release32in64|x64.ActiveCfg = Release32in64|x64 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Release32in64|x64.Build.0 = Release32in64|x64 - {6D86BC6F-E74E-40C5-9881-F8BB606BCA78}.Release32in64|x86.ActiveCfg = Release32in64|Win32 EndGlobalSection GlobalSection(SolutionProperties) = preSolution HideSolutionNode = FALSE EndGlobalSection + GlobalSection(ExtensibilityGlobals) = postSolution + SolutionGuid = {6A887FEB-7CBC-45F3-B955-CE757AE81106} + EndGlobalSection EndGlobal diff --git a/basis/Foreign.580.sml b/basis/Foreign.580.sml index 41ec054f..2cdfba5f 100644 --- a/basis/Foreign.580.sml +++ b/basis/Foreign.580.sml @@ -1,3590 +1,23 @@ (* Title: Foreign Function Interface: main part Author: David Matthews Copyright David Matthews 2015-16, 2018 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) -signature FOREIGN = -sig - exception Foreign of string - - structure Memory: - sig - eqtype volatileRef - val volatileRef: SysWord.word -> volatileRef - val setVolatileRef: volatileRef * SysWord.word -> unit - val getVolatileRef: volatileRef -> SysWord.word - - eqtype voidStar - val voidStar2Sysword: voidStar -> SysWord.word - val sysWord2VoidStar: SysWord.word -> voidStar - val null: voidStar - - val ++ : voidStar * word -> voidStar - val -- : voidStar * word -> voidStar - - (* Remember an address except across loads. *) - val memoise: ('a -> voidStar) ->'a -> unit -> voidStar - - exception Memory - - (* malloc - allocate memory. N.B. argument is the number of bytes. - Raises Memory exception if it cannot allocate. *) - val malloc: word -> voidStar - (* free - free allocated memory. *) - val free: voidStar -> unit - - val get8: voidStar * Word.word -> Word8.word - val get16: voidStar * Word.word -> Word.word - val get32: voidStar * Word.word -> Word32.word - val get64: voidStar * Word.word -> SysWord.word - val set8: voidStar * Word.word * Word8.word -> unit - val set16: voidStar * Word.word * Word.word -> unit - val set32: voidStar * Word.word * Word32.word -> unit - val set64: voidStar * Word.word * SysWord.word -> unit - - val getFloat: voidStar * Word.word -> real - val getDouble: voidStar * Word.word -> real - val setFloat: voidStar * Word.word * real -> unit - val setDouble: voidStar * Word.word * real -> unit - - val getAddress: voidStar * Word.word -> voidStar - val setAddress: voidStar * Word.word * voidStar -> unit - end - - structure System: - sig - type voidStar = Memory.voidStar - type externalSymbol - val loadLibrary: string -> voidStar - and loadExecutable: unit -> voidStar - and freeLibrary: voidStar -> unit - and getSymbol: voidStar * string -> voidStar - and externalFunctionSymbol: string -> externalSymbol - and externalDataSymbol: string -> externalSymbol - and addressOfExternal: externalSymbol -> voidStar - end - - structure LibFFI: - sig - eqtype abi - (* List of ABIs defined in libffi for this platform. *) - val abiList: (string * abi) list - (* The default Abi. *) - val abiDefault: abi - - (* Type codes. *) - val ffiTypeCodeVoid: Word.word - and ffiTypeCodeInt: Word.word - and ffiTypeCodeFloat: Word.word - and ffiTypeCodeDouble: Word.word - and ffiTypeCodeUInt8: Word.word - and ffiTypeCodeSInt8: Word.word - and ffiTypeCodeUInt16: Word.word - and ffiTypeCodeSInt16: Word.word - and ffiTypeCodeUInt32: Word.word - and ffiTypeCodeSInt32: Word.word - and ffiTypeCodeUInt64: Word.word - and ffiTypeCodeSInt64: Word.word - and ffiTypeCodeStruct: Word.word - and ffiTypeCodePointer: Word.word - - (* Predefined types. These are addresses so have to be reloaded - in each session. *) - eqtype ffiType - val ffiType2voidStar: ffiType -> Memory.voidStar - val voidStar2ffiType: Memory.voidStar -> ffiType - - val getFFItypeVoid: unit -> ffiType - and getFFItypeUint8: unit -> ffiType - and getFFItypeSint8: unit -> ffiType - and getFFItypeUint16: unit -> ffiType - and getFFItypeSint16: unit -> ffiType - and getFFItypeUint32: unit -> ffiType - and getFFItypeSint32: unit -> ffiType - and getFFItypeUint64: unit -> ffiType - and getFFItypeSint64: unit -> ffiType - and getFFItypeFloat: unit -> ffiType - and getFFItypeDouble: unit -> ffiType - and getFFItypePointer: unit -> ffiType - and getFFItypeUChar: unit -> ffiType - and getFFItypeSChar: unit -> ffiType - and getFFItypeUShort: unit -> ffiType - and getFFItypeSShort: unit -> ffiType - and getFFItypeUint: unit -> ffiType - and getFFItypeSint: unit -> ffiType - and getFFItypeUlong: unit -> ffiType - and getFFItypeSlong: unit -> ffiType - - val extractFFItype: - ffiType -> { size: word, align: word, typeCode: word, elements: ffiType list } - val createFFItype: - { size: word, align: word, typeCode: word, elements: ffiType list } -> ffiType - - eqtype cif - val cif2voidStar: cif -> Memory.voidStar - val voidStar2cif: Memory.voidStar -> cif - val createCIF: abi * ffiType * ffiType list -> cif - val callFunction: - { cif: cif, function: Memory.voidStar, result: Memory.voidStar, arguments: Memory.voidStar } -> unit - - val createCallback: - (Memory.voidStar * Memory.voidStar -> unit) * cif -> Memory.voidStar - val freeCallback: Memory.voidStar -> unit - end - - structure Error: - sig - type syserror = LibrarySupport.syserror - val getLastError: unit -> SysWord.word - val setLastError: SysWord.word -> unit - val fromWord: SysWord.word -> syserror - and toWord: syserror -> SysWord.word - end - - type library - type symbol - val loadLibrary: string -> library - val loadExecutable: unit -> library - val getSymbol: library -> string -> symbol - val symbolAsAddress: symbol -> Memory.voidStar - val externalFunctionSymbol: string -> symbol - and externalDataSymbol: string -> symbol - - structure LowLevel: - sig - type ctype = - { - size: Word.word, (* Size in bytes *) - align: Word.word, (* Alignment *) - ffiType: unit -> LibFFI.ffiType - } - - val cTypeVoid: ctype - and cTypePointer: ctype - and cTypeInt8: ctype - and cTypeChar: ctype - and cTypeUint8: ctype - and cTypeUchar: ctype - and cTypeInt16: ctype - and cTypeUint16: ctype - and cTypeInt32: ctype - and cTypeUint32: ctype - and cTypeInt64: ctype - and cTypeUint64: ctype - and cTypeInt: ctype - and cTypeUint: ctype - and cTypeLong: ctype - and cTypeUlong: ctype - and cTypeFloat: ctype - and cTypeDouble: ctype - - val cStruct: ctype list -> ctype - - val callwithAbi: LibFFI.abi -> ctype list -> ctype -> symbol -> Memory.voidStar list * Memory.voidStar -> unit - val call: ctype list -> ctype -> symbol -> Memory.voidStar list * Memory.voidStar -> unit - - val cFunctionWithAbi: - LibFFI.abi -> ctype list -> ctype -> (Memory.voidStar * Memory.voidStar -> unit) -> Memory.voidStar - val cFunction: - ctype list -> ctype -> (Memory.voidStar * Memory.voidStar -> unit) -> Memory.voidStar - end - - type 'a conversion - - val makeConversion: - { - load: Memory.voidStar -> 'a, (* Load a value from C memory *) - store: Memory.voidStar * 'a -> unit -> unit, (* Store value and return free function. *) - ctype: LowLevel.ctype - } -> 'a conversion - - val breakConversion: - 'a conversion -> - { - load: Memory.voidStar -> 'a, (* Load a value from C memory *) - store: Memory.voidStar * 'a -> unit -> unit, (* Store value and return free function. *) - ctype: LowLevel.ctype - } - - val cVoid: unit conversion - val cPointer: Memory.voidStar conversion - val cInt8: int conversion - val cUint8: int conversion - val cChar: char conversion - val cUchar: Word8.word conversion - val cInt16: int conversion - val cUint16: int conversion - val cInt32: int conversion - val cUint32: int conversion - val cInt64: int conversion - val cUint64: int conversion - val cInt32Large: LargeInt.int conversion - val cUint32Large: LargeInt.int conversion - val cInt64Large: LargeInt.int conversion - val cUint64Large: LargeInt.int conversion - val cShort: int conversion - val cUshort: int conversion - val cInt: int conversion - val cUint: int conversion - val cLong: int conversion - val cUlong: int conversion - val cIntLarge: LargeInt.int conversion - val cUintLarge: LargeInt.int conversion - val cLongLarge: LargeInt.int conversion - val cUlongLarge: LargeInt.int conversion - val cString: string conversion - val cByteArray: Word8Vector.vector conversion - val cFloat: real conversion - val cDouble: real conversion - - (* When a pointer e.g. a string may be null. *) - val cOptionPtr: 'a conversion -> 'a option conversion - - type 'a closure - - val cFunction: ('a->'b) closure conversion - - val buildClosure0withAbi: (unit -> 'a) * LibFFI.abi * unit * 'a conversion -> (unit -> 'a) closure - val buildClosure0: (unit -> 'a) * unit * 'a conversion -> (unit -> 'a) closure - val buildClosure1withAbi: ('a -> 'b) * LibFFI.abi * 'a conversion * 'b conversion -> ('a -> 'b) closure - val buildClosure1: ('a -> 'b) * 'a conversion * 'b conversion -> ('a -> 'b) closure - val buildClosure2withAbi: - ('a * 'b -> 'c) * LibFFI.abi * ('a conversion * 'b conversion) * 'c conversion -> ('a * 'b -> 'c) closure - val buildClosure2: ('a * 'b -> 'c) * ('a conversion * 'b conversion) * 'c conversion -> ('a * 'b -> 'c) closure - val buildClosure3withAbi: - ('a * 'b *'c -> 'd) * LibFFI.abi * ('a conversion * 'b conversion * 'c conversion) * 'd conversion -> - ('a * 'b *'c -> 'd) closure - val buildClosure3: ('a * 'b *'c -> 'd) * ('a conversion * 'b conversion * 'c conversion) * 'd conversion -> - ('a * 'b *'c -> 'd) closure - val buildClosure4withAbi: - ('a * 'b * 'c * 'd -> 'e) * LibFFI.abi * ('a conversion * 'b conversion * 'c conversion* 'd conversion) * 'e conversion -> - ('a * 'b * 'c * 'd -> 'e) closure - val buildClosure4: - ('a * 'b * 'c * 'd -> 'e) * ('a conversion * 'b conversion * 'c conversion* 'd conversion) * 'e conversion -> - ('a * 'b * 'c * 'd -> 'e) closure - val buildClosure5withAbi: - ('a * 'b * 'c * 'd * 'e -> 'f) * - LibFFI.abi * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion) * 'f conversion -> - ('a * 'b * 'c * 'd * 'e -> 'f) closure - val buildClosure5: - ('a * 'b * 'c * 'd * 'e -> 'f) * - ('a conversion * 'b conversion * 'c conversion* 'd conversion * 'e conversion) * 'f conversion -> - ('a * 'b * 'c * 'd * 'e -> 'f) closure - val buildClosure6withAbi: - ('a * 'b * 'c * 'd * 'e * 'f -> 'g) * LibFFI.abi * - ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion) * 'g conversion -> - ('a * 'b * 'c * 'd * 'e * 'f -> 'g) closure - val buildClosure6: - ('a * 'b * 'c * 'd * 'e * 'f -> 'g) * - ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion) * 'g conversion -> - ('a * 'b * 'c * 'd * 'e * 'f -> 'g) closure - - (* Remove the "free" from a conversion. Used if extra memory allocated - by the argument must not be freed when the function returns. *) - val permanent: 'a conversion -> 'a conversion - - (* Call by reference. *) - val cStar: 'a conversion -> 'a ref conversion - (* Pass a const pointer *) - val cConstStar: 'a conversion -> 'a conversion - - (* Fixed size vector. It is treated as a struct and passed by value or embedded in a structure. *) - val cVectorFixedSize: int * 'a conversion -> 'a vector conversion - (* Pass an ML vector as a pointer to a C array. *) - and cVectorPointer: 'a conversion -> 'a vector conversion - (* Pass an ML array as a pointer to a C array and, on return, update each element of - the ML array from the C array. *) - and cArrayPointer: 'a conversion -> 'a array conversion - - (* structs. *) - val cStruct2: 'a conversion * 'b conversion -> ('a * 'b) conversion - val cStruct3: 'a conversion * 'b conversion * 'c conversion -> ('a*'b*'c)conversion - val cStruct4: 'a conversion * 'b conversion * 'c conversion * 'd conversion -> ('a*'b*'c*'d)conversion - val cStruct5: 'a conversion * 'b conversion * 'c conversion * 'd conversion * - 'e conversion -> ('a*'b*'c*'d*'e)conversion - val cStruct6: 'a conversion * 'b conversion * 'c conversion * 'd conversion * - 'e conversion * 'f conversion -> ('a*'b*'c*'d*'e*'f)conversion - val cStruct7: 'a conversion * 'b conversion * 'c conversion * 'd conversion * - 'e conversion * 'f conversion * 'g conversion -> ('a*'b*'c*'d*'e*'f*'g)conversion - val cStruct8: 'a conversion * 'b conversion * 'c conversion * 'd conversion * - 'e conversion * 'f conversion * 'g conversion * 'h conversion -> ('a*'b*'c*'d*'e*'f*'g*'h)conversion - val cStruct9: 'a conversion * 'b conversion * 'c conversion * 'd conversion * - 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion -> - ('a*'b*'c*'d*'e*'f*'g*'h*'i)conversion - val cStruct10: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * - 'h conversion * 'i conversion * 'j conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j)conversion - val cStruct11: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * - 'h conversion * 'i conversion * 'j conversion * 'k conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k)conversion - val cStruct12: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * - 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion -> - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l)conversion - val cStruct13: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * - 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion -> - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m)conversion - val cStruct14: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * - 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion -> - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n)conversion - val cStruct15: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * - 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * - 'o conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o)conversion - val cStruct16: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * - 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * - 'o conversion * 'p conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p)conversion - val cStruct17: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * - 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * - 'o conversion * 'p conversion * 'q conversion -> - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q)conversion - val cStruct18: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * - 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * - 'o conversion * 'p conversion * 'q conversion * 'r conversion -> - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r)conversion - val cStruct19: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * - 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * - 'o conversion * 'p conversion * 'q conversion * 'r conversion * 's conversion -> - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r*'s)conversion - val cStruct20: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * - 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * - 'o conversion * 'p conversion * 'q conversion * 'r conversion * 's conversion * 't conversion -> - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r*'s*'t)conversion - - val buildCall0withAbi: LibFFI.abi * symbol * unit * 'a conversion -> unit -> 'a - val buildCall0: symbol * unit * 'a conversion -> unit -> 'a - val buildCall1withAbi: LibFFI.abi * symbol * 'a conversion * 'b conversion -> 'a -> 'b - val buildCall1: symbol * 'a conversion * 'b conversion -> 'a -> 'b - val buildCall2withAbi: - LibFFI.abi * symbol * ('a conversion * 'b conversion) * 'c conversion -> 'a * 'b -> 'c - val buildCall2: - symbol * ('a conversion * 'b conversion) * 'c conversion -> 'a * 'b -> 'c - val buildCall3withAbi: - LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion) * 'd conversion -> 'a * 'b * 'c -> 'd - val buildCall3: - symbol * ('a conversion * 'b conversion * 'c conversion) * 'd conversion -> 'a * 'b * 'c -> 'd - val buildCall4withAbi: - LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion) * 'e conversion -> - 'a * 'b * 'c * 'd -> 'e - val buildCall4: - symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion) * 'e conversion -> - 'a * 'b * 'c * 'd -> 'e - val buildCall5withAbi: - LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion) * 'f conversion -> - 'a * 'b * 'c * 'd * 'e -> 'f - val buildCall5: - symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion) * 'f conversion -> - 'a * 'b * 'c * 'd * 'e -> 'f - val buildCall6withAbi: - LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion) * - 'g conversion -> 'a * 'b * 'c * 'd * 'e * 'f -> 'g - val buildCall6: - symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion) * - 'g conversion -> 'a * 'b * 'c * 'd * 'e * 'f -> 'g - val buildCall7withAbi: - LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion) * - 'h conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g -> 'h - val buildCall7: - symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion) * - 'h conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g -> 'h - val buildCall8withAbi: - LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion) * - 'i conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h -> 'i - val buildCall8: - symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion) * - 'i conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h -> 'i - val buildCall9withAbi: - LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion * 'i conversion) * - 'j conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i -> 'j - val buildCall9: - symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion * 'i conversion) * - 'j conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i -> 'j - val buildCall10withAbi: - LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion) * - 'k conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j -> 'k - val buildCall10: - symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion) * - 'k conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j -> 'k - val buildCall11withAbi: - LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion) * - 'l conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k -> 'l - val buildCall11: - symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion) * - 'l conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k -> 'l - val buildCall12withAbi: - LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * - 'l conversion) * 'm conversion -> - 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l -> 'm - val buildCall12: - symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * - 'l conversion) * 'm conversion -> - 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l -> 'm - val buildCall13withAbi: - LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * - 'l conversion * 'm conversion) * - 'n conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm -> 'n - val buildCall13: - symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * - 'l conversion * 'm conversion) * - 'n conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm -> 'n - val buildCall14withAbi: - LibFFI.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * - 'l conversion * 'm conversion * 'n conversion) * - 'o conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm * 'n -> 'o - val buildCall14: - symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * - 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * - 'l conversion * 'm conversion * 'n conversion) * - 'o conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm * 'n -> 'o -end; - -structure Foreign:> FOREIGN = +structure Foreign = struct - fun id x = x exception Foreign = RunCall.Foreign - - open ForeignConstants - - structure Memory = ForeignMemory - infix 6 ++ -- - - (* Internal utility function. *) - fun alignUp(s, align) = Word.andb(s + align-0w1, ~ align) - - local - val ffiGeneralCall = RunCall.rtsCallFull2 "PolyFFIGeneral" - in - fun ffiGeneral(code: int, arg: 'a): 'b = RunCall.unsafeCast(ffiGeneralCall(RunCall.unsafeCast(code, arg))) - end - - structure System = - struct - type voidStar = Memory.voidStar - type externalSymbol = voidStar - fun loadLibrary(s: string): voidStar = ffiGeneral (2, s) - and loadExecutable(): voidStar = ffiGeneral (3, ()) - and freeLibrary(s: voidStar): unit = ffiGeneral (4, s) - and getSymbol(lib: voidStar, s: string): voidStar = ffiGeneral (5, (lib, s)) - - (* Create an external symbol object. The first word of this is filled in with the - address after the code is exported and linked. - On a small number of platforms different relocations are required for functions - and for data. *) - val externalFunctionSymbol: string -> externalSymbol = RunCall.rtsCallFull1 "PolyFFICreateExtFn" - and externalDataSymbol: string -> externalSymbol = RunCall.rtsCallFull1 "PolyFFICreateExtData" - - (* An external symbol is a memory cell containing the value in the first word - followed by the symbol name. Because the first word is the value it can - be treated as a Sysword.word value. - When it is created the value is zero and the address of the target is only - set once the symbol has been exported and the value set by the linker. *) - fun addressOfExternal(ext: externalSymbol): voidStar = - if Memory.voidStar2Sysword ext = 0w0 - then raise Foreign "External symbol has not been set" - else ext - end - - structure Error = - struct - type syserror = LibrarySupport.syserror - fun toWord (s: syserror): SysWord.word = RunCall.unsafeCast s - and fromWord (w: SysWord.word) : syserror = RunCall.unsafeCast w - local - val callGetError = RunCall.rtsCallFast1 "PolyFFIGetError" - in - fun getLastError(): SysWord.word = - let - val mem = RunCall.allocateByteMemory(0w1, 0wx41) - val () = callGetError mem - val () = RunCall.clearMutableBit mem - in - RunCall.unsafeCast mem - end - end - val setLastError: SysWord.word -> unit = RunCall.rtsCallFast1 "PolyFFISetError" - end - - structure LibFFI = - struct - type abi = Word.word - val abiList: (string * abi) list = ffiGeneral (50, ()) - - local - fun getConstant (n: int) : Word.word = ffiGeneral (51, n) - in - val abiDefault = getConstant 0 - - and ffiTypeCodeVoid = getConstant 1 - and ffiTypeCodeInt = getConstant 2 - and ffiTypeCodeFloat = getConstant 3 - and ffiTypeCodeDouble = getConstant 4 - and ffiTypeCodeUInt8 = getConstant 5 - and ffiTypeCodeSInt8 = getConstant 6 - and ffiTypeCodeUInt16 = getConstant 7 - and ffiTypeCodeSInt16 = getConstant 8 - and ffiTypeCodeUInt32 = getConstant 9 - and ffiTypeCodeSInt32 = getConstant 10 - and ffiTypeCodeUInt64 = getConstant 11 - and ffiTypeCodeSInt64 = getConstant 12 - and ffiTypeCodeStruct = getConstant 13 - and ffiTypeCodePointer = getConstant 14 - end - - type ffiType = Memory.voidStar - val ffiType2voidStar = id - and voidStar2ffiType = id - - local - fun getFFItype (n: int) (): ffiType = ffiGeneral (52, n) - in - val getFFItypeVoid = getFFItype 0 - and getFFItypeUint8 = getFFItype 1 - and getFFItypeSint8 = getFFItype 2 - and getFFItypeUint16 = getFFItype 3 - and getFFItypeSint16 = getFFItype 4 - and getFFItypeUint32 = getFFItype 5 - and getFFItypeSint32 = getFFItype 6 - and getFFItypeUint64 = getFFItype 7 - and getFFItypeSint64 = getFFItype 8 - and getFFItypeFloat = getFFItype 9 - and getFFItypeDouble = getFFItype 10 - and getFFItypePointer = getFFItype 11 - and getFFItypeUChar = getFFItype 12 - and getFFItypeSChar = getFFItype 13 - and getFFItypeUShort = getFFItype 14 - and getFFItypeSShort = getFFItype 15 - and getFFItypeUint = getFFItype 16 - and getFFItypeSint = getFFItype 17 - and getFFItypeUlong = getFFItype 18 - and getFFItypeSlong = getFFItype 19 - end - - fun extractFFItype (s: ffiType) = - let - val (size: word, align: word, typ: word, elem: Memory.voidStar) = - ffiGeneral (53, s) - (* Unpack the "elements". *) - open Memory - fun loadElements i = - let - val a = getAddress(elem, i) - in - if a = null - then [] - else a :: loadElements(i+0w1) - end - val elements = - if elem = sysWord2VoidStar 0w0 - then [] - else loadElements 0w0 - in - { size=size, align=align, typeCode = typ, elements = elements } - end - - (* Construct a new FFItype in allocated memory. *) - fun createFFItype { size: word, align: word, typeCode: word, elements: ffiType list }: ffiType = - ffiGeneral (54, (size, align, typeCode, elements)) - - type cif = Memory.voidStar - val cif2voidStar = id - and voidStar2cif = id - - (* Construct and prepare a CIF in allocated memory. *) - fun createCIF (abi: abi, resultType: ffiType, argTypes: ffiType list): cif = - ffiGeneral (55, (abi, resultType, argTypes)) - - (* Call a function. We have to pass some space for the result *) - fun callFunction - { cif: cif, function: Memory.voidStar, result: Memory.voidStar, arguments: Memory.voidStar }: unit = - ffiGeneral (56, (cif, function, result, arguments)) - - (* Create a callback. Returns the C function. *) - fun createCallback(f: Memory.voidStar * Memory.voidStar -> unit, cif: cif): Memory.voidStar = - ffiGeneral (57, (f, cif)) - - (* Free a callback. This takes the C function address returned by createCallback *) - fun freeCallback(cb: Memory.voidStar): unit = - ffiGeneral (58, cb) - end - - type library = unit -> Memory.voidStar - type symbol = unit -> Memory.voidStar - - (* Load the library but memoise it so if we reference the library in another - session we will reload it. We load the library immediately so that if - there is an error we get the error immediately. *) - fun loadLibrary (name: string): library = Memory.memoise System.loadLibrary name - and loadExecutable (): library = Memory.memoise System.loadExecutable () - - (* To get a symbol we memoise a function that forces a library load if necessary - and then gets the symbol. *) - fun getSymbol(lib: library) (name: string): symbol = - Memory.memoise (fn s => System.getSymbol(lib(), s)) name - - (* This forces the symbol to be loaded. The result is NOT memoised. *) - fun symbolAsAddress(s: symbol): Memory.voidStar = s() - - (* Create an external symbol. This can only be used after linking. *) - fun externalFunctionSymbol(name: string): symbol = - let - val r = System.externalFunctionSymbol name - in - fn () => System.addressOfExternal r - end - - and externalDataSymbol(name: string): symbol = - let - val r = System.externalDataSymbol name - in - fn () => System.addressOfExternal r - end - - structure LowLevel = - struct - type ctype = - { - size: Word.word, (* Size in bytes *) - align: Word.word, (* Alignment *) - ffiType: unit -> LibFFI.ffiType - } - - local - open LibFFI Memory - - val getffArg = - if ffiMinArgSize = 0w4 then Word32.toLargeWord o get32 - else if ffiMinArgSize = 0w8 then get64 - else raise Foreign ("Unable to load ffi_arg size=" ^ Word.toString ffiMinArgSize) - - in - val cTypeVoid = - { size= #size saVoid, align= #align saVoid, ffiType = memoise getFFItypeVoid () } - val cTypePointer = - { size= #size saPointer, align= #align saPointer, ffiType = memoise getFFItypePointer () } - val cTypeInt8 = - { size= #size saSint8, align= #align saSint8, ffiType = memoise getFFItypeSint8 () } - val cTypeChar = cTypeInt8 - val cTypeUint8 = - { size= #size saUint8, align= #align saUint8, ffiType = memoise getFFItypeUint8 () } - val cTypeUchar = cTypeUint8 - val cTypeInt16 = - { size= #size saSint16, align= #align saSint16, ffiType = memoise getFFItypeSint16 () } - val cTypeUint16 = - { size= #size saUint16, align= #align saUint16, ffiType = memoise getFFItypeUint16 () } - val cTypeInt32 = - { size= #size saSint32, align= #align saSint32, ffiType = memoise getFFItypeSint32 () } - val cTypeUint32 = - { size= #size saUint32, align= #align saUint32, ffiType = memoise getFFItypeUint32 () } - val cTypeInt64 = - { size= #size saSint64, align= #align saSint64, ffiType = memoise getFFItypeSint64 () } - val cTypeUint64 = - { size= #size saUint64, align= #align saUint64, ffiType = memoise getFFItypeUint64 () } - val cTypeInt = - { size= #size saSint, align= #align saSint, ffiType = memoise getFFItypeSint () } - val cTypeUint = - { size= #size saUint, align= #align saUint, ffiType = memoise getFFItypeUint () } - val cTypeLong = - { size= #size saSlong, align= #align saSlong, ffiType = memoise getFFItypeSlong () } - val cTypeUlong = - { size= #size saUlong, align= #align saUlong, ffiType = memoise getFFItypeUlong () } - val cTypeFloat = - { size= #size saFloat, align= #align saFloat, ffiType = memoise getFFItypeFloat () } - val cTypeDouble = - { size= #size saDouble, align= #align saDouble, ffiType = memoise getFFItypeDouble () } - - fun cStruct(fields: ctype list): ctype = - let - (* The total alignment is the maximum alignment of the fields. *) - val align = foldl(fn ({align, ...}, a) => Word.max(align, a)) 0w1 fields - (* Each field needs to be on its alignment. Finally we round up the size - to the total alignment. *) - val size = - alignUp(foldl(fn ({align, size, ...}, s) => alignUp(s, align) + size) 0w0 fields, align) - - val types = map #ffiType fields - - (* Make the type but only when it's used. *) - fun ffiType () = - LibFFI.createFFItype { - size = size, align = align, typeCode=LibFFI.ffiTypeCodeStruct, - elements = map (fn t => t()) types } - in - {align=align, size=size, ffiType=memoise ffiType ()} - end - - fun callwithAbi (abi: abi) (argTypes: ctype list) (resType: ctype): symbol -> voidStar list * voidStar -> unit = - let - (* Preparation when we create the function. *) - fun buildCif () = createCIF (abi, #ffiType resType (), map (fn {ffiType, ...} => ffiType ()) argTypes) - val cif: unit->cif = memoise buildCif () - val nArgs = List.length argTypes - val resSize = #size resType - - (* If the result size is smaller than ffiMinArgSize we have to - first store the result in a value of size ffiMinArgSize then copy - the result. This is a restriction of libffi. *) - fun smallSpace (fnAddr: unit->voidStar) (args, resMem) = - let - val _ = List.length args = nArgs orelse raise Foreign "Incorrect number of arguments" - val resultSize = alignUp(ffiMinArgSize, #align saPointer) - val argResVec = malloc(resultSize + #size saPointer * Word.fromInt nArgs) - val argLocn = argResVec ++ resultSize - val _ = List.foldl(fn (arg, n) => (setAddress(argLocn, n, arg); n+0w1)) 0w0 args - in - let - val () = callFunction { cif=cif(), function=fnAddr(), result = argResVec, arguments = argLocn} - val result: SysWord.word = getffArg(argResVec, 0w0) - in - (* Copy to the final location. Currently "void" has size 1 so if - the function has a void result we still copy one byte. *) - if #size resType = 0w1 - then set8(resMem, 0w0, Word8.fromLargeWord result) - else if #size resType = 0w2 - then set16(resMem, 0w0, Word.fromLargeWord result) - else if #size resType = 0w4 - then set32(resMem, 0w0, Word32.fromLargeWord result) - else raise Foreign "Unable to set result: wrong size"; - free argResVec - end handle exn => (free argResVec; raise exn) - end - - (* If we have enough space. *) - fun largeSpace (fnAddr: unit->voidStar) (args, resMem) = - let - val _ = List.length args = nArgs orelse raise Foreign "Incorrect number of arguments" - val argVec = - if nArgs = 0 then null else malloc(#size saPointer * Word.fromInt nArgs) - val _ = List.foldl(fn (arg, n) => (setAddress(argVec, n, arg); n+0w1)) 0w0 args - in - let - val () = callFunction { cif=cif(), function=fnAddr(), result = resMem, arguments = argVec} - in - free argVec - end handle exn => (free argVec; raise exn) - end - in - if resSize < ffiMinArgSize - then smallSpace - else largeSpace - end - - fun call x = callwithAbi abiDefault x (* Have to make it a fun to avoid value restriction *) - - (* Build a call-back function. Returns a function to take the actual ML function, - create a callback and then return the address. *) - fun cFunctionWithAbi (abi: abi) (argTypes: ctype list) (resType: ctype): - (voidStar * voidStar -> unit) -> voidStar = - let - fun buildCif () = createCIF (abi, #ffiType resType (), map (fn {ffiType, ...} => ffiType ()) argTypes) - val cif: unit->cif = memoise buildCif () - in - fn cbFun => createCallback(cbFun, cif()) - end - - fun cFunction x = cFunctionWithAbi abiDefault x - end - - end - - type 'a conversion = - { - load: Memory.voidStar -> 'a, (* Load a value from C memory *) - store: Memory.voidStar * 'a -> unit -> unit, (* Store a value in C memory *) - updateML: Memory.voidStar * 'a -> unit, (* Update ML value after call - only used in cStar. *) - updateC: Memory.voidStar * 'a -> unit, (* Update C value after callback - only used in cStar. *) - ctype: LowLevel.ctype - } - - fun makeConversion { load, store, ctype } = - { load = load, store = store, ctype = ctype, updateML = fn _ => (), updateC = fn _ => () } - - fun breakConversion({load, store, ctype, ... }: 'a conversion) = - { load = load, store = store, ctype = ctype } - - (* Conversions *) - local - open LibFFI Memory LowLevel - fun checkRangeShort(i, min, max) = if i < min orelse i > max then raise Overflow else i - fun checkRangeLong(i: LargeInt.int, min, max) = if i < min orelse i > max then raise Overflow else i - fun noFree _ = () (* None of these allocate extra memory or need to update. *) - in - val cVoid: unit conversion = - makeConversion{ load=fn _ => (), store=fn _ => noFree, ctype = cTypeVoid } - - (* cPointer should only be used to base other conversions on. *) - val cPointer: voidStar conversion = - makeConversion { load=fn a => getAddress(a, 0w0), store=fn(a, v) => (setAddress(a, 0w0, v); noFree), - ctype = cTypePointer } - - local - fun load(m: voidStar): int = Word8.toIntX(get8(m, 0w0)) - fun store(m: voidStar, i: int) = - (set8(m, 0w0, Word8.fromInt(checkRangeShort(i, ~128, 127))); noFree) - in - val cInt8: int conversion = - makeConversion { load=load, store=store, ctype = cTypeInt8 } - end - - local - (* Char is signed in C but unsigned in ML. *) - fun load(m: voidStar): char = Char.chr(Word8.toInt(get8(m, 0w0))) - fun store(m: voidStar, i: char) = - (set8(m, 0w0, Word8.fromInt(Char.ord i)); noFree) - in - val cChar: char conversion = - makeConversion{ load=load, store=store, ctype = cTypeChar } - end - - local - (* Uchar - convert as Word8.word. *) - fun load(m: voidStar): Word8.word = get8(m, 0w0) - fun store(m: voidStar, i: Word8.word) = (set8(m, 0w0, i); noFree) - in - val cUchar: Word8.word conversion = - makeConversion{ load=load, store=store, ctype = cTypeUchar } - end - - local - fun load(m: voidStar): int = Word8.toInt(get8(m, 0w0)) - fun store(m: voidStar, i: int) = - (set8(m, 0w0, Word8.fromInt(checkRangeShort(i, 0, 255))); noFree) - in - val cUint8: int conversion = - makeConversion{ load=load, store=store, ctype = cTypeUint8 } - end - - local - (* Because the word length is greater than the length returned by - get16 we have to do something special to get the sign bit correct. - That isn't necessary in the other cases. *) - fun load(m: voidStar): int = - let - (* Could be done with shifts *) - val r = Word.toInt(get16(m, 0w0)) - in - if r >= 32768 - then r - 65536 - else r - end - fun store(m: voidStar, i: int) = - (set16(m, 0w0, Word.fromInt(checkRangeShort(i, ~32768, 32767))); noFree) - in - val cInt16: int conversion = - makeConversion{ load=load, store=store, ctype = cTypeInt16 } - end - - local - fun load(m: voidStar): int = Word.toInt(get16(m, 0w0)) - fun store(m: voidStar, i: int) = - (set16(m, 0w0, Word.fromInt(checkRangeShort(i, 0, 65535))); noFree) - in - val cUint16: int conversion = - makeConversion{ load=load, store=store, ctype = cTypeUint16 } - end - - local - fun load(m: voidStar): int = Word32.toIntX(get32(m, 0w0)) - val checkRange = - if wordSize = 0w4 andalso isSome (Int.maxInt) - then fn i => i (* We're using fixed precision 31-bit - no check necessary. *) - else - let - (* These will overflow on fixed precision 31-bit. *) - val max32 = Int32.toInt(valOf Int32.maxInt) - val min32 = ~max32 - 1 - in - fn i => checkRangeShort(i, min32, max32) - end - fun store(m: voidStar, i: int) = - (set32(m, 0w0, Word32.fromInt(checkRange i)); noFree) - in - val cInt32: int conversion = - makeConversion{ load=load, store=store, ctype = cTypeInt32 } - end - - local - fun load(m: voidStar): LargeInt.int = Word32.toLargeIntX(get32(m, 0w0)) - fun store(m: voidStar, i: LargeInt.int) = - (set32(m, 0w0, Word32.fromLargeInt(checkRangeLong(i, ~2147483648, 2147483647))); noFree) - in - val cInt32Large: LargeInt.int conversion = - makeConversion{ load=load, store=store, ctype = cTypeInt32 } - end - - local - fun load(m: voidStar): int = Word32.toInt(get32(m, 0w0)) - val checkRange = - if wordSize = 0w4 andalso isSome (Int.maxInt) - then fn i => if i < 0 then raise Overflow else i (* Fixed precision 31-bit *) - else - let - (* This will overflow on fixed precision 31-bit. *) - val max32 = Int32.toInt(valOf Int32.maxInt) - val max32Unsigned = max32 * 2 + 1 - in - fn i => checkRangeShort(i, 0, max32Unsigned) - end - fun store(m: voidStar, i: int) = - (set32(m, 0w0, Word32.fromInt(checkRange i)); noFree) - in - val cUint32: int conversion = - makeConversion{ load=load, store=store, ctype = cTypeUint32 } - end - - local - fun load(m: voidStar): LargeInt.int = Word32.toLargeInt(get32(m, 0w0)) - fun store(m: voidStar, i: LargeInt.int) = - (set32(m, 0w0, Word32.fromLargeInt(checkRangeLong(i, 0, 4294967295))); noFree) - in - val cUint32Large: LargeInt.int conversion = - makeConversion{ load=load, store=store, ctype = cTypeUint32 } - end - - local - fun loadLarge(m: voidStar): LargeInt.int = - if sysWordSize = 0w4 - then - let - val v1 = get32(m, 0w0) and v2 = get32(m, 0w1) - in - if bigEndian - then IntInf.<<(Word32.toLargeIntX v1, 0w32) + Word32.toLargeInt v2 - else IntInf.<<(Word32.toLargeIntX v2, 0w32) + Word32.toLargeInt v1 - end - else SysWord.toLargeIntX(get64(m, 0w0)) - - fun loadShort(m: voidStar): int = - if sysWordSize = 0w4 - then Int.fromLarge(loadLarge m) - else SysWord.toIntX(get64(m, 0w0)) - - val max = IntInf.<<(1, 0w63) - 1 and min = ~ (IntInf.<<(1, 0w63)) - - fun storeLarge(m: voidStar, i: LargeInt.int) = - if sysWordSize = 0w4 - then - let - val _ = checkRangeLong(i, min, max) - val lo = Word32.fromLargeInt i and hi = Word32.fromLargeInt (IntInf.~>>(i, 0w32)) - in - if bigEndian - then (set32(m, 0w0, hi); set32(m, 0w1, lo)) - else (set32(m, 0w0, lo); set32(m, 0w1, hi)); - noFree - end - else (set64(m, 0w0, SysWord.fromLargeInt(checkRangeLong(i, min, max))); noFree) - - fun storeShort(m: voidStar, i: int) = - if sysWordSize = 0w4 orelse not (isSome Int.maxInt) - then (* 32-bit or arbitrary precision. *) storeLarge(m, LargeInt.fromInt i) - else (* Fixed precision 64-bit - no need for a range check. *) - (set64(m, 0w0, SysWord.fromInt i); noFree) - in - val cInt64: int conversion = - makeConversion{ load=loadShort, store=storeShort, ctype = cTypeInt64 } - and cInt64Large: LargeInt.int conversion = - makeConversion{ load=loadLarge, store=storeLarge, ctype = cTypeInt64 } - end - - local - fun loadLarge(m: voidStar): LargeInt.int = - if sysWordSize = 0w4 - then - let - val v1 = get32(m, 0w0) and v2 = get32(m, 0w1) - in - if bigEndian - then IntInf.<<(Word32.toLargeInt v1, 0w32) + Word32.toLargeInt v2 - else IntInf.<<(Word32.toLargeInt v2, 0w32) + Word32.toLargeInt v1 - end - else SysWord.toLargeInt(get64(m, 0w0)) - - fun loadShort(m: voidStar): int = - if wordSize = 0w4 - then Int.fromLarge(loadLarge m) - else SysWord.toInt(get64(m, 0w0)) - - val max = IntInf.<<(1, 0w64) - 1 - - fun storeLarge(m: voidStar, i: LargeInt.int) = - if sysWordSize = 0w4 - then - let - val _ = checkRangeLong(i, 0, max) - val lo = Word32.fromLargeInt i and hi = Word32.fromLargeInt (IntInf.~>>(i, 0w32)) - in - if bigEndian - then (set32(m, 0w0, hi); set32(m, 0w1, lo)) - else (set32(m, 0w0, lo); set32(m, 0w1, hi)); - noFree - end - else (set64(m, 0w0, SysWord.fromLargeInt(checkRangeLong(i, 0, max))); noFree) - - fun storeShort(m: voidStar, i: int) = - if sysWordSize = 0w4 orelse not (isSome Int.maxInt) - then (* 32-bit or arbitrary precision. *) storeLarge(m, LargeInt.fromInt i) - else if i < 0 (* Fixed precision 64-bit - just check it's not negative. *) - then raise Overflow - else (set64(m, 0w0, SysWord.fromInt i); noFree) - in - val cUint64: int conversion = - makeConversion{ load=loadShort, store=storeShort, ctype = cTypeUint64 } - and cUint64Large: LargeInt.int conversion = - makeConversion{ load=loadLarge, store=storeLarge, ctype = cTypeUint64 } - end - - local - fun load(m: voidStar): real = getFloat(m, 0w0) - fun store(m: voidStar, v: real) = (setFloat(m, 0w0, v); noFree) - in - val cFloat: real conversion = - makeConversion{ load=load, store=store, ctype = cTypeFloat } - end - - local - fun load(m: voidStar): real = getDouble(m, 0w0) - fun store(m: voidStar, v: real) = (setDouble(m, 0w0, v); noFree) - in - val cDouble: real conversion = - makeConversion{ load=load, store=store, ctype = cTypeDouble } - end - - val cShort = - if #size saSShort = #size saSint16 then cInt16 - (*else if #size saSShort = #size saSint32 then cInt32*) - else raise Foreign "Unable to find type for short" - - val cUshort = - if #size saUShort = #size saUint16 then cUint16 - (*else if #size saUShort = #size saUint32 then cUint32*) - else raise Foreign "Unable to find type for unsigned" - - val cInt = - (*if #size saSint = #size saSint16 then cInt16 - else *)if #size saSint = #size saSint32 then cInt32 - else if #size saSint = #size saSint64 then cInt64 - else raise Foreign "Unable to find type for int" - - val cIntLarge = - (*if #size saSint = #size saSint16 then cInt16 - else *)if #size saSint = #size saSint32 then cInt32Large - else if #size saSint = #size saSint64 then cInt64Large - else raise Foreign "Unable to find type for int" - - val cUint = - (*if #size saUint = #size saUint16 then cUint16 - else *)if #size saUint = #size saUint32 then cUint32 - else if #size saUint = #size saUint64 then cUint64 - else raise Foreign "Unable to find type for unsigned" - - val cUintLarge = - (*if #size saUint = #size saUint16 then cUint16 - else *)if #size saUint = #size saUint32 then cUint32Large - else if #size saUint = #size saUint64 then cUint64Large - else raise Foreign "Unable to find type for unsigned" - - val cLong = - (*if #size saSlong = #size saSint16 then cInt16 - else *)if #size saSlong = #size saSint32 then cInt32 - else if #size saSlong = #size saSint64 then cInt64 - else raise Foreign "Unable to find type for long" - - val cLongLarge = - (*if #size saSlong = #size saSint16 then cInt16 - else *)if #size saSlong = #size saSint32 then cInt32Large - else if #size saSlong = #size saSint64 then cInt64Large - else raise Foreign "Unable to find type for long" - - val cUlong = - (*if #size saUlong = #size saUint16 then cUint16 - else *)if #size saUlong = #size saUint32 then cUint32 - else if #size saUlong = #size saUint64 then cUint64 - else raise Foreign "Unable to find type for unsigned long" - - val cUlongLarge = - (*if #size saUlong = #size saUint16 then cUint16 - else *)if #size saUlong = #size saUint32 then cUint32Large - else if #size saUlong = #size saUint64 then cUint64Large - else raise Foreign "Unable to find type for unsigned long" - - local - fun load(s: voidStar): string = - let - (* The location contains the address of the string. *) - val sAddr = getAddress(s, 0w0) - fun sLen i = if get8(sAddr, i) = 0w0 then i else sLen(i+0w1) - val length = sLen 0w0 - fun loadChar i = - Char.chr(Word8.toInt(get8(sAddr, Word.fromInt i))) - in - CharVector.tabulate(Word.toInt length, loadChar) - end - - fun store(v: voidStar, s: string) = - let - val sLen = Word.fromInt(String.size s) - val sMem = malloc(sLen + 0w1) - val () = CharVector.appi(fn(i, ch) => set8(sMem, Word.fromInt i, Word8.fromInt(Char.ord ch))) s - val () = set8(sMem, sLen, 0w0) - in - setAddress(v, 0w0, sMem); - fn () => Memory.free sMem - end - - in - val cString: string conversion = - makeConversion { load=load, store=store, ctype = cTypePointer } - end - - (* This is used if we want to pass NULL rather than a pointer in some cases. *) - fun cOptionPtr({load, store, updateML, updateC, ctype}:'a conversion): 'a option conversion = - if #typeCode(extractFFItype(#ffiType ctype ())) <> ffiTypeCodePointer - then raise Foreign "cOptionPtr must be applied to a pointer type" - else - let - fun loadOpt(s: voidStar) = - if getAddress(s, 0w0) = null then NONE else SOME(load s) - - fun storeOpt(v: voidStar, NONE) = (setAddress(v, 0w0, null); fn _ => ()) - | storeOpt(v: voidStar, SOME s) = store(v, s) - - (* Do we have update here? *) - fun updateMLOpt(_, NONE) = () - | updateMLOpt(v: voidStar, SOME s) = updateML(v, s) - - fun updateCOpt(_, NONE) = () - | updateCOpt(v, SOME s) = updateC(v, s) - in - { load=loadOpt, store=storeOpt, updateML = updateMLOpt, - updateC = updateCOpt, ctype = cTypePointer } - end - - local - (* Word8Vector.vector to C array of bytes. It is only possible to - do this one way because conversion from a C array requires - us to know the size. *) - fun load _ = raise Foreign "cByteArray cannot convert from C to ML" - - fun store(v: voidStar, s: Word8Vector.vector) = - let - open Word8Vector - val sLen = Word.fromInt(length s) - val sMem = malloc sLen - val () = appi(fn(i, b) => set8(sMem, Word.fromInt i, b)) s - in - setAddress(v, 0w0, sMem); - fn () => Memory.free sMem - end - - in - val cByteArray: Word8Vector.vector conversion = - makeConversion{ load=load, store=store, ctype = cTypePointer } - end - end - - (* Remove the free part from the store fn. This is intended for situations - where an argument should not be deleted once the function completes. *) - fun permanent({load, store, ctype, updateML, updateC }: 'a conversion): 'a conversion = - let - fun storeP args = (ignore (store args); fn () => ()) - in - { load=load, store=storeP, updateML = updateML, updateC = updateC, ctype=ctype } - end - - val op ++ = Memory.++ - - fun cStruct2(a: 'a conversion, b: 'b conversion): ('a*'b)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ... }} = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {align=alignb, ... }} = b - - val offsetb = alignUp(sizea, alignb) - fun load s = (loada s, loadb(s ++ offsetb)) - and store (x, (a, b)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) - in - fn () => ( freea(); freeb() ) - end - and updateML(s, (a, b)) = (updateMLa(s, a); updateMLb(s ++ offsetb, b)) - and updateC(x, (a, b)) = - (updateCa(x, a); updateCb(x ++ offsetb, b)) - in - {load=load, store=store, updateML = updateML, updateC=updateC, ctype = LowLevel.cStruct[ctypea, ctypeb]} - end - - fun cStruct3(a: 'a conversion, b: 'b conversion, c: 'c conversion): ('a*'b*'c)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {align=alignc, ...} } = c - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - - fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc)) - and store (x, (a, b, c)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - in - fn () => ( freea(); freeb(); freec() ) - end - and updateML(s, (a, b, c)) = (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c)) - and updateC(x, (a, b, c)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec]} - end - - fun cStruct4(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion): ('a*'b*'c*'d)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {align=alignd, ...} } = d - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - - fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd)) - and store (x, (a, b, c, d)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) - in - fn () => ( freea(); freeb(); freec(); freed() ) - end - and updateML(s, (a, b, c, d)) = - (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); updateMLd(s ++ offsetd, d)) - and updateC(x, (a, b, c, d)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped]} - end - - fun cStruct5(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion): ('a*'b*'c*'d*'e)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {align=aligne, ...} } = e - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete)) - and store (x, (a, b, c, d, e)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) - in - fn () => ( freea(); freeb(); freec(); freed(); freee() ) - end - and updateML(s, (a, b, c, d, e)) = - (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); - updateMLd(s ++ offsetd, d); updateMLe(s ++ offsete, e)) - and updateC(x, (a, b, c, d, e)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee]} - end - - fun cStruct6(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion): ('a*'b*'c*'d*'e*'f)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {align=alignf, ...} } = f - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf)) - and store (x, (a, b, c, d, e, f)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - in - fn () => ( freea(); freeb(); freec(); freed(); freee(); freef() ) - end - and updateML(s, (a, b, c, d, e, f)) = - (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); updateMLd(s ++ offsetd, d); - updateMLe(s ++ offsete, e); updateMLf(s ++ offsetf, f)) - and updateC(x, (a, b, c, d, e, f)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef]} - end - - fun cStruct7(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion): ('a*'b*'c*'d*'e*'f*'g)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {align=aligng, ...} } = g - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg)) - and store (x, (a, b, c, d, e, f, g)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) - in - fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg() ) - end - and updateML(s, (a, b, c, d, e, f, g)) = - (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); updateMLd(s ++ offsetd, d); - updateMLe(s ++ offsete, e); updateMLf(s ++ offsetf, f); updateMLg(s ++ offsetg, g)) - and updateC(x, (a, b, c, d, e, f, g)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg]} - end - - fun cStruct8(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion): - ('a*'b*'c*'d*'e*'f*'g*'h)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g - and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {align=alignh, ...} } = h - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - val offseth = alignUp(offsetg + sizeg, alignh) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth)) - and store (x, (a, b, c, d, e, f, g, h)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) - in - fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh() ) - end - and updateML(s, (a, b, c, d, e, f, g, h)) = - (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); updateMLd(s ++ offsetd, d); - updateMLe(s ++ offsete, e); updateMLf(s ++ offsetf, f); updateMLg(s ++ offsetg, g); - updateMLh(s ++ offseth, h)) - and updateC(x, (a, b, c, d, e, f, g, h)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); - updateCh(x ++ offseth, h)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, - ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh]} - end - - fun cStruct9(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, - i: 'i conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g - and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h - and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {align=aligni, ...} } = i - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - val offseth = alignUp(offsetg + sizeg, alignh) - val offseti = alignUp(offseth + sizeh, aligni) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), - loadh(s ++ offseth), loadi(s ++ offseti)) - and store (x, (a, b, c, d, e, f, g, h, i)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) - in - fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei() ) - end - and updateML(s, (a, b, c, d, e, f, g, h, i)) = - (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); updateMLd(s ++ offsetd, d); - updateMLe(s ++ offsete, e); updateMLf(s ++ offsetf, f); updateMLg(s ++ offsetg, g); - updateMLh(s ++ offseth, h); updateMLi(s ++ offseti, i)) - and updateC(x, (a, b, c, d, e, f, g, h, i)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); - updateCh(x ++ offseth, h); updateCi(x ++ offseti, i)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, - ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei]} - end - - fun cStruct10(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, - i: 'i conversion, j: 'j conversion): - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g - and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h - and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i - and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {align=alignj, ...} } = j - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - val offseth = alignUp(offsetg + sizeg, alignh) - val offseti = alignUp(offseth + sizeh, aligni) - val offsetj = alignUp(offseti + sizei, alignj) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), - loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj)) - and store (x, (a, b, c, d, e, f, g, h, i, j)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) - and freej = storej(x ++ offsetj, j) - in - fn () => - ( - freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej() - ) - end - and updateML(x, (a, b, c, d, e, f, g, h, i, j)) = - (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); - updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); - updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j)) - and updateC(x, (a, b, c, d, e, f, g, h, i, j)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); - updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, - ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej]} - end - - fun cStruct11(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, - i: 'i conversion, j: 'j conversion, k: 'k conversion): - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g - and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h - and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i - and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j - and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {align=alignk, ...} } = k - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - val offseth = alignUp(offsetg + sizeg, alignh) - val offseti = alignUp(offseth + sizeh, aligni) - val offsetj = alignUp(offseti + sizei, alignj) - val offsetk = alignUp(offsetj + sizej, alignk) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), - loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), - loadk(s ++ offsetk)) - and store (x, (a, b, c, d, e, f, g, h, i, j, k)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) - and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) - in - fn () => - ( - freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); freek() - ) - end - and updateML(x, (a, b, c, d, e, f, g, h, i, j, k)) = - (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); - updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); - updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); - updateMLk(x ++ offsetk, k)) - and updateC(x, (a, b, c, d, e, f, g, h, i, j, k)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); - updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); - updateCk(x ++ offsetk, k)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, - ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, - ctypek]} - end - - fun cStruct12(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, - i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion): - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g - and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h - and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i - and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j - and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k - and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {align=alignl, ...} } = l - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - val offseth = alignUp(offsetg + sizeg, alignh) - val offseti = alignUp(offseth + sizeh, aligni) - val offsetj = alignUp(offseti + sizei, alignj) - val offsetk = alignUp(offsetj + sizej, alignk) - val offsetl = alignUp(offsetk + sizek, alignl) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), - loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), - loadk(s ++ offsetk), loadl(s ++ offsetl)) - and store (x, (a, b, c, d, e, f, g, h, i, j, k, l)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) - and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) - in - fn () => - ( - freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); freek(); freel() - ) - end - and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l)) = - (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); - updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); - updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); - updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l)) - and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); - updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); - updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, - ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, - ctypek, ctypel]} - end - - fun cStruct13(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, - i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, - m: 'm conversion): - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g - and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h - and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i - and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j - and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k - and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l - and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {align=alignm, ...} } = m - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - val offseth = alignUp(offsetg + sizeg, alignh) - val offseti = alignUp(offseth + sizeh, aligni) - val offsetj = alignUp(offseti + sizei, alignj) - val offsetk = alignUp(offsetj + sizej, alignk) - val offsetl = alignUp(offsetk + sizek, alignl) - val offsetm = alignUp(offsetl + sizel, alignm) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), - loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), - loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm)) - and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) - and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) - and freem = storem(x ++ offsetm, m) - in - fn () => - ( - freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); freek(); freel(); freem() - ) - end - and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m)) = - (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); - updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); - updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); - updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m)) - and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); - updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); - updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, - ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, - ctypek, ctypel, ctypem]} - end - - nonfix o - - fun cStruct14(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, - i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, - m: 'm conversion, n: 'n conversion): - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g - and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h - and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i - and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j - and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k - and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l - and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m - and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {align=alignn, ...} } = n - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - val offseth = alignUp(offsetg + sizeg, alignh) - val offseti = alignUp(offseth + sizeh, aligni) - val offsetj = alignUp(offseti + sizei, alignj) - val offsetk = alignUp(offsetj + sizej, alignk) - val offsetl = alignUp(offsetk + sizek, alignl) - val offsetm = alignUp(offsetl + sizel, alignm) - val offsetn = alignUp(offsetm + sizem, alignn) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), - loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), - loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), - loadn(s ++ offsetn)) - and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) - and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) - and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) - in - fn () => - ( - freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); freek(); freel(); freem(); - freen() - ) - end - and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n)) = - (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); - updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); - updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); - updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); - updateMLn(x ++ offsetn, n)) - and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); - updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); - updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); - updateCn(x ++ offsetn, n)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, - ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, - ctypek, ctypel, ctypem, ctypen]} - end - - fun cStruct15(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, - i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, - m: 'm conversion, n: 'n conversion, o: 'o conversion): - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g - and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h - and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i - and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j - and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k - and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l - and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m - and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n - and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {align=aligno, ...} } = o - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - val offseth = alignUp(offsetg + sizeg, alignh) - val offseti = alignUp(offseth + sizeh, aligni) - val offsetj = alignUp(offseti + sizei, alignj) - val offsetk = alignUp(offsetj + sizej, alignk) - val offsetl = alignUp(offsetk + sizek, alignl) - val offsetm = alignUp(offsetl + sizel, alignm) - val offsetn = alignUp(offsetm + sizem, alignn) - val offseto = alignUp(offsetn + sizen, aligno) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), - loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), - loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), - loadn(s ++ offsetn), loado(s ++ offseto)) - and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) - and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) - and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) - in - fn () => - ( - freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); freek(); freel(); freem(); - freen(); freeo() - ) - end - and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)) = - (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); - updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); - updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); - updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); - updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o)) - and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); - updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); - updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); - updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, - ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, - ctypek, ctypel, ctypem, ctypen, ctypeo]} - end - - fun cStruct16(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, - i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, - m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion): - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g - and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h - and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i - and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j - and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k - and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l - and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m - and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n - and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o - and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {align=alignp, ...} } = p - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - val offseth = alignUp(offsetg + sizeg, alignh) - val offseti = alignUp(offseth + sizeh, aligni) - val offsetj = alignUp(offseti + sizei, alignj) - val offsetk = alignUp(offsetj + sizej, alignk) - val offsetl = alignUp(offsetk + sizek, alignl) - val offsetm = alignUp(offsetl + sizel, alignm) - val offsetn = alignUp(offsetm + sizem, alignn) - val offseto = alignUp(offsetn + sizen, aligno) - val offsetp = alignUp(offseto + sizeo, alignp) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), - loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), - loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), - loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp)) - and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) - and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) - and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) - and freep = storep(x ++ offsetp, p) - in - fn () => - ( - freea(); freeb(); freec(); freed(); freee(); freef(); - freeg(); freeh(); freei(); freej(); freek(); freel(); - freem(); freen(); freeo(); freep() - ) - end - and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)) = - (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); - updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); - updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); - updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); - updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p)) - and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); - updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); - updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); - updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, - ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, - ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep]} - end - - fun cStruct17(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, - i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, - m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion, - q: 'q conversion): - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g - and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h - and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i - and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j - and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k - and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l - and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m - and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n - and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o - and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {size=sizep, align=alignp, ...} } = p - and {load=loadq, store=storeq, updateML=updateMLq, updateC=updateCq, ctype = ctypeq as {align=alignq, ...} } = q - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - val offseth = alignUp(offsetg + sizeg, alignh) - val offseti = alignUp(offseth + sizeh, aligni) - val offsetj = alignUp(offseti + sizei, alignj) - val offsetk = alignUp(offsetj + sizej, alignk) - val offsetl = alignUp(offsetk + sizek, alignl) - val offsetm = alignUp(offsetl + sizel, alignm) - val offsetn = alignUp(offsetm + sizem, alignn) - val offseto = alignUp(offsetn + sizen, aligno) - val offsetp = alignUp(offseto + sizeo, alignp) - val offsetq = alignUp(offsetp + sizep, alignq) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), - loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), - loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), - loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp), - loadq(s ++ offsetq)) - and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) - and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) - and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) - and freep = storep(x ++ offsetp, p) and freeq = storeq(x ++ offsetq, q) - in - fn () => - ( - freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); freek(); freel(); freem(); - freen(); freeo(); freep(); freeq() - ) - end - and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)) = - (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); - updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); - updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); - updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); - updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p); - updateMLq(x ++ offsetq, q)) - and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); - updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); - updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); - updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p); - updateCq(x ++ offsetq, q)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, - ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, - ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep, ctypeq]} - end - - fun cStruct18(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, - i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, - m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion, - q: 'q conversion, r: 'r conversion): - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g - and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h - and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i - and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j - and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k - and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l - and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m - and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n - and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o - and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {size=sizep, align=alignp, ...} } = p - and {load=loadq, store=storeq, updateML=updateMLq, updateC=updateCq, ctype = ctypeq as {size=sizeq, align=alignq, ...} } = q - and {load=loadr, store=storer, updateML=updateMLr, updateC=updateCr, ctype = ctyper as {align=alignr, ...} } = r - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - val offseth = alignUp(offsetg + sizeg, alignh) - val offseti = alignUp(offseth + sizeh, aligni) - val offsetj = alignUp(offseti + sizei, alignj) - val offsetk = alignUp(offsetj + sizej, alignk) - val offsetl = alignUp(offsetk + sizek, alignl) - val offsetm = alignUp(offsetl + sizel, alignm) - val offsetn = alignUp(offsetm + sizem, alignn) - val offseto = alignUp(offsetn + sizen, aligno) - val offsetp = alignUp(offseto + sizeo, alignp) - val offsetq = alignUp(offsetp + sizep, alignq) - val offsetr = alignUp(offsetq + sizeq, alignr) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), - loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), - loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), - loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp), - loadq(s ++ offsetq), loadr(s ++ offsetr)) - and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) - and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) - and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) - and freep = storep(x ++ offsetp, p) and freeq = storeq(x ++ offsetq, q) and freer = storer(x ++ offsetr, r) - in - fn () => - ( - freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); freek(); freel(); freem(); - freen(); freeo(); freep(); freeq(); freer() - ) - end - and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)) = - (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); - updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); - updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); - updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); - updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p); - updateMLq(x ++ offsetq, q); updateMLr(x ++ offsetr, r)) - and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); - updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); - updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); - updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p); - updateCq(x ++ offsetq, q); updateCr(x ++ offsetr, r)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, - ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, - ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep, ctypeq, ctyper]} - end - - fun cStruct19(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, - i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, - m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion, - q: 'q conversion, r: 'r conversion, s: 's conversion): - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r*'s)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g - and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h - and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i - and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j - and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k - and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l - and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m - and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n - and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o - and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {size=sizep, align=alignp, ...} } = p - and {load=loadq, store=storeq, updateML=updateMLq, updateC=updateCq, ctype = ctypeq as {size=sizeq, align=alignq, ...} } = q - and {load=loadr, store=storer, updateML=updateMLr, updateC=updateCr, ctype = ctyper as {size=sizer, align=alignr, ...} } = r - and {load=loads, store=stores, updateML=updateMLs, updateC=updateCs, ctype = ctypes as {align=aligns, ...} } = s - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - val offseth = alignUp(offsetg + sizeg, alignh) - val offseti = alignUp(offseth + sizeh, aligni) - val offsetj = alignUp(offseti + sizei, alignj) - val offsetk = alignUp(offsetj + sizej, alignk) - val offsetl = alignUp(offsetk + sizek, alignl) - val offsetm = alignUp(offsetl + sizel, alignm) - val offsetn = alignUp(offsetm + sizem, alignn) - val offseto = alignUp(offsetn + sizen, aligno) - val offsetp = alignUp(offseto + sizeo, alignp) - val offsetq = alignUp(offsetp + sizep, alignq) - val offsetr = alignUp(offsetq + sizeq, alignr) - val offsets = alignUp(offsetr + sizer, aligns) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), - loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), - loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), - loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp), - loadq(s ++ offsetq), loadr(s ++ offsetr), loads(s ++ offsets)) - and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) - and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) - and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) - and freep = storep(x ++ offsetp, p) and freeq = storeq(x ++ offsetq, q) and freer = storer(x ++ offsetr, r) - and frees = stores(x ++ offsets, s) - in - fn () => - ( - freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); freek(); freel(); freem(); - freen(); freeo(); freep(); freeq(); freer(); frees() - ) - end - and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)) = - (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); - updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); - updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); - updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); - updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p); - updateMLq(x ++ offsetq, q); updateMLr(x ++ offsetr, r); updateMLs(x ++ offsets, s)) - and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); - updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); - updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); - updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p); - updateCq(x ++ offsetq, q); updateCr(x ++ offsetr, r); updateCs(x ++ offsets, s)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, - ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, - ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep, ctypeq, ctyper, ctypes]} - end - - fun cStruct20(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, - e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, - i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, - m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion, - q: 'q conversion, r: 'r conversion, s: 's conversion, t: 't conversion): - ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r*'s*'t)conversion = - let - val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, ...} } = a - and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b - and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c - and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d - and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e - and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f - and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g - and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h - and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i - and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j - and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k - and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l - and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m - and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n - and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o - and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {size=sizep, align=alignp, ...} } = p - and {load=loadq, store=storeq, updateML=updateMLq, updateC=updateCq, ctype = ctypeq as {size=sizeq, align=alignq, ...} } = q - and {load=loadr, store=storer, updateML=updateMLr, updateC=updateCr, ctype = ctyper as {size=sizer, align=alignr, ...} } = r - and {load=loads, store=stores, updateML=updateMLs, updateC=updateCs, ctype = ctypes as {size=sizes, align=aligns, ...} } = s - and {load=loadt, store=storet, updateML=updateMLt, updateC=updateCt, ctype = ctypet as {align=alignt, ...} } = t - - val offsetb = alignUp(sizea, alignb) - val offsetc = alignUp(offsetb + sizeb, alignc) - val offsetd = alignUp(offsetc + sizec, alignd) - val offsete = alignUp(offsetd + sized, aligne) - val offsetf = alignUp(offsete + sizee, alignf) - val offsetg = alignUp(offsetf + sizef, aligng) - val offseth = alignUp(offsetg + sizeg, alignh) - val offseti = alignUp(offseth + sizeh, aligni) - val offsetj = alignUp(offseti + sizei, alignj) - val offsetk = alignUp(offsetj + sizej, alignk) - val offsetl = alignUp(offsetk + sizek, alignl) - val offsetm = alignUp(offsetl + sizel, alignm) - val offsetn = alignUp(offsetm + sizem, alignn) - val offseto = alignUp(offsetn + sizen, aligno) - val offsetp = alignUp(offseto + sizeo, alignp) - val offsetq = alignUp(offsetp + sizep, alignq) - val offsetr = alignUp(offsetq + sizeq, alignr) - val offsets = alignUp(offsetr + sizer, aligns) - val offsett = alignUp(offsets + sizes, alignt) - - fun load s = - (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), - loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), - loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), - loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), - loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp), - loadq(s ++ offsetq), loadr(s ++ offsetr), loads(s ++ offsets), loadt(s ++ offsett)) - and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)) = - let - val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) - and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) - and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) - and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) - and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) - and freep = storep(x ++ offsetp, p) and freeq = storeq(x ++ offsetq, q) and freer = storer(x ++ offsetr, r) - and frees = stores(x ++ offsets, s) and freet = storet(x ++ offsett, t) - in - fn () => - ( - freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); freek(); freel(); freem(); - freen(); freeo(); freep(); freeq(); freer(); frees(); freet() - ) - end - and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)) = - (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); - updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); - updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); - updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); - updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p); - updateMLq(x ++ offsetq, q); updateMLr(x ++ offsetr, r); updateMLs(x ++ offsets, s); updateMLt(x ++ offsett, t)) - and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)) = - (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); - updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); - updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); - updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); - updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p); - updateCq(x ++ offsetq, q); updateCr(x ++ offsetr, r); updateCs(x ++ offsets, s); updateCt(x ++ offsett, t)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, - ctype = LowLevel.cStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, - ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep, ctypeq, ctyper, ctypes, ctypet]} - end - - (* Conversion for call-by-reference. *) - local - open Memory LowLevel - in - fun cStar({load=loada, store=storea, ctype=ctypea, ...}: 'a conversion): 'a ref conversion = - let - fun store(m, ref s) = - let - (* When we pass a ref X into a cStar cX function we need to - allocate a memory cell big enough for a cX value. Then - we copy the current value of the ML into this. We set - the argument, a pointer, to the address of the cell. *) - val mem = malloc(#size ctypea) - val () = setAddress(m, 0w0, mem) - val freea = storea(mem, s) - in - fn () => (free mem; freea()) - end - - (* Called to update the ML value when the C . *) - fun updateML(m, s) = s := loada(getAddress(m, 0w0)) - - (* Used when an ML callback receives a cStar argument. *) - fun load s = ref(loada(getAddress(s, 0w0))) - - (* Used when a callback has returned to update the C value. - If storea allocates then there's nothing we can do. *) - fun updateC(m, ref s) = ignore(storea(getAddress(m, 0w0), s)) - in - {load=load, store=store, updateML=updateML, updateC=updateC, ctype = cTypePointer} - end - - (* Similar to cStar but without the need to update the result. *) - fun cConstStar({load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype=ctypea}: 'a conversion): 'a conversion = - let - fun load s = loada(getAddress(s, 0w0)) - - fun store(m, s) = - let - val mem = malloc(#size ctypea) - val () = setAddress(m, 0w0, mem) - val freea = storea(mem, s) - in - fn () => (free mem; freea()) - end - - (* Do we have to do anything here? Could we pass a const pointer - to a structure with variable fields? *) - fun updateML(m, s) = updateMLa(getAddress(m, 0w0), s) - and updateC(m, s) = updateCa(getAddress(m, 0w0), s) - in - {load=load, store=store, updateML=updateML, updateC=updateC, ctype = cTypePointer} - end - - (* Fixed size vector. It is treated as a struct and passed by value or embedded in a structure. *) - fun cVectorFixedSize(n, - {load=loadEl, store=storeEl, updateML=updateMLel, updateC=updateCel, - ctype={size=sizeEl, align=alignEl, ffiType=ffiTypeEl}, ...}: 'a conversion) - : 'a vector conversion = - let - val arraySize = sizeEl * Word.fromInt n - fun ffiTypeArray () = - LibFFI.createFFItype { - size = arraySize, align = alignEl, typeCode=LibFFI.ffiTypeCodeStruct, - elements = List.tabulate (n, fn _ => ffiTypeEl()) } - val arrayType = { size = arraySize, align = alignEl, ffiType = ffiTypeArray } - - fun load(v: voidStar): 'a vector = - Vector.tabulate(n, fn i => loadEl(v ++ Word.fromInt i)) - - fun store(v: voidStar, s: 'a vector) = - let - val sLen = Vector.length s - val _ = sLen <= n orelse raise Foreign "vector too long" - (* Store the values. Make a list of the free fns in case they allocate *) - val frees = Vector.foldli(fn(i, el, l) => storeEl(v ++ Word.fromInt i, el) :: l) [] s; - in - fn () => List.app (fn f => f()) frees - end - - (* If we have a ref in here we need to update *) - fun updateML(v, s) = Vector.appi(fn (i, el) => updateMLel(v ++ Word.fromInt i, el)) s - and updateC(v, s) = Vector.appi(fn (i, el) => updateCel(v ++ Word.fromInt i, el)) s - in - { load = load, store = store, updateML=updateML, updateC=updateC, ctype = arrayType } - end - - (* Pass an ML vector as a pointer to a C array. *) - fun cVectorPointer - ({store=storeEl, updateML=updateMLel, ctype={size=sizeEl, ...}, ...}: 'a conversion) - : 'a vector conversion = - let - (* We can't determine the size so can't construct a suitable ML value. *) - fun load _ = raise Foreign "Cannot return a cVectorPointer from C to ML" - - fun store(m, s) = - let - val mem = malloc(sizeEl * Word.fromInt(Vector.length s)) - val () = setAddress(m, 0w0, mem) - (* Store the values. Make a list of the free fns in case they allocate *) - val frees = Vector.foldli(fn(i, el, l) => storeEl(mem ++ (sizeEl * Word.fromInt i), el) :: l) [] s; - in - fn () => (List.app (fn f => f()) frees; free mem) - end - - (* This is only appropriate if the elements are refs. *) - fun updateML(v, s) = - let - val addr = getAddress(v, 0w0) - in - Vector.appi(fn (i, el) => updateMLel(addr ++ (sizeEl * Word.fromInt i), el)) s - end - (* updateC can't actually be used because we can't load a suitable value *) - and updateC _ = raise Foreign "Cannot return a cVectorPointer from C to ML" - in - {load=load, store=store, updateML=updateML, updateC=updateC, ctype = cTypePointer} - end - - (* Pass an ML array as a pointer to a C array and, on return, update each element of - the ML array from the C array. *) - fun cArrayPointer - ({load=loadEl, store=storeEl, ctype={size=sizeEl, ...}, ...}: 'a conversion) : 'a array conversion = - let - (* We can't determine the size so can't construct a suitable ML value. *) - fun load _ = raise Foreign "Cannot return a cArrayPointer from C to ML" - - fun store(m, s) = - let - val mem = malloc(sizeEl * Word.fromInt(Array.length s)) - val () = setAddress(m, 0w0, mem) - (* Store the values. Make a list of the free fns in case they allocate *) - val frees = Array.foldli(fn(i, el, l) => storeEl(mem ++ (sizeEl * Word.fromInt i), el) :: l) [] s; - in - fn () => (List.app (fn f => f()) frees; free mem) - end - - (* updateML is used after a C function returns. It needs to update each element. *) - fun updateML(v, s) = - let - val addr = getAddress(v, 0w0) - in - Array.modifyi(fn (i, _) => loadEl(addr ++ (sizeEl * Word.fromInt i))) s - end - - (* updateC can't actually be used because we can't load a suitable value *) - and updateC _ = raise Foreign "Cannot return a cArrayPointer from C to ML" - in - {load=load, store=store, updateML=updateML, updateC=updateC, ctype = cTypePointer} - end - end - - (* Calls with conversion. *) - (* Note: it may be possible to have general functions to compute offsets - but we don't do that because this way the compiler can compute the offsets - as constants during inline expansion. *) - local - open LibFFI Memory LowLevel - in - - fun buildCall0withAbi(abi: abi, fnAddr, (), {ctype = resType, load= resLoad, ...} : 'a conversion): unit->'a = - let - val callF = callwithAbi abi [] resType fnAddr - in - fn () => - let - val rMem = malloc(#size resType) - in - let - val () = callF([], rMem) - val result = resLoad rMem - in - free rMem; - result - end handle exn => (free rMem; raise exn) - end - end - - fun buildCall0(symbol, argTypes, resType) = buildCall0withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall1withAbi (abi: abi, fnAddr, - { ctype = argType, store = argStore, updateML = argUpdate, ...}: 'a conversion, - { ctype = resType, load= resLoad, ...}: 'b conversion): 'a ->'b = - let - val callF = callwithAbi abi [argType] resType fnAddr - (* Allocate space for argument(s) and result. - We can't use cStruct here because we only store the - argument before the call and load the result after. *) - val argOffset = alignUp(#size resType, #align argType) - val argSpace = argOffset + #size argType - in - fn x => - let - val rMem = malloc argSpace - val argAddr = rMem ++ argOffset - val freea = argStore (argAddr, x) - fun freeAll () = (freea(); free rMem) - in - let - val () = callF([argAddr], rMem) - val result = resLoad rMem - in - argUpdate (argAddr, x); - freeAll (); - result - end handle exn => (freeAll (); raise exn) - end - end - - fun buildCall1(symbol, argTypes, resType) = buildCall1withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall2withAbi (abi: abi, fnAddr, - ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, - { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion), - { ctype = resType, load= resLoad, ...}: 'c conversion): 'a * 'b -> 'c = - let - val callF = callwithAbi abi [arg1Type, arg2Type] resType fnAddr - val arg1Offset = alignUp(#size resType, #align arg1Type) - val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) - val argSpace = arg2Offset + #size arg2Type - in - fn (a, b) => - let - val rMem = malloc argSpace - val arg1Addr = rMem ++ arg1Offset - val arg2Addr = rMem ++ arg2Offset - val freea = arg1Store (arg1Addr, a) - val freeb = arg2Store (arg2Addr, b) - fun freeAll() = (freea(); freeb(); free rMem) - in - let - val () = callF([arg1Addr, arg2Addr], rMem) - val result = resLoad rMem - in - arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); - freeAll(); - result - end handle exn => (freeAll(); raise exn) - end - end - - fun buildCall2(symbol, argTypes, resType) = buildCall2withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall3withAbi (abi: abi, fnAddr, - ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, - { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, - { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion), - { ctype = resType, load= resLoad, ...}: 'd conversion): 'a * 'b *'c -> 'd = - let - val callF = callwithAbi abi [arg1Type, arg2Type, arg3Type] resType fnAddr - val arg1Offset = alignUp(#size resType, #align arg1Type) - val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) - val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) - val argSpace = arg3Offset + #size arg3Type - in - fn (a, b, c) => - let - val rMem = malloc argSpace - val arg1Addr = rMem ++ arg1Offset - val arg2Addr = rMem ++ arg2Offset - val arg3Addr = rMem ++ arg3Offset - val freea = arg1Store (arg1Addr, a) - val freeb = arg2Store (arg2Addr, b) - val freec = arg3Store (arg3Addr, c) - fun freeAll() = (freea(); freeb(); freec(); free rMem) - in - let - val () = callF([arg1Addr, arg2Addr, arg3Addr], rMem) - val result = resLoad rMem - in - arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); - freeAll(); - result - end handle exn => (freeAll(); raise exn) - end - end - - fun buildCall3(symbol, argTypes, resType) = buildCall3withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall4withAbi (abi: abi, fnAddr, - ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, - { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, - { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, - { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion), - { ctype = resType, load= resLoad, ...}: 'e conversion): 'a * 'b *'c * 'd -> 'e = - let - val callF = callwithAbi abi [arg1Type, arg2Type, arg3Type, arg4Type] resType fnAddr - val arg1Offset = alignUp(#size resType, #align arg1Type) - val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) - val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) - val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) - val argSpace = arg4Offset + #size arg4Type - in - fn (a, b, c, d) => - let - val rMem = malloc argSpace - val arg1Addr = rMem ++ arg1Offset - val arg2Addr = rMem ++ arg2Offset - val arg3Addr = rMem ++ arg3Offset - val arg4Addr = rMem ++ arg4Offset - val freea = arg1Store (arg1Addr, a) - val freeb = arg2Store (arg2Addr, b) - val freec = arg3Store (arg3Addr, c) - val freed = arg4Store (arg4Addr, d) - fun freeAll() = (freea(); freeb(); freec(); freed(); free rMem) - in - let - val () = callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr], rMem) - val result = resLoad rMem - in - arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); - arg4Update (arg4Addr, d); - freeAll(); - result - end handle exn => (freeAll(); raise exn) - end - end - - fun buildCall4(symbol, argTypes, resType) = buildCall4withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall5withAbi (abi: abi, fnAddr, - ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, - { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, - { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, - { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, - { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion), - { ctype = resType, load= resLoad, ...}: 'f conversion): 'a * 'b *'c * 'd * 'e -> 'f = - let - val callF = - callwithAbi abi [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type] resType fnAddr - val arg1Offset = alignUp(#size resType, #align arg1Type) - val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) - val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) - val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) - val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) - val argSpace = arg5Offset + #size arg5Type - in - fn (a, b, c, d, e) => - let - val rMem = malloc argSpace - val arg1Addr = rMem ++ arg1Offset - val arg2Addr = rMem ++ arg2Offset - val arg3Addr = rMem ++ arg3Offset - val arg4Addr = rMem ++ arg4Offset - val arg5Addr = rMem ++ arg5Offset - val freea = arg1Store (arg1Addr, a) - val freeb = arg2Store (arg2Addr, b) - val freec = arg3Store (arg3Addr, c) - val freed = arg4Store (arg4Addr, d) - val freee = arg5Store (arg5Addr, e) - fun freeAll() = - (freea(); freeb(); freec(); freed(); freee(); free rMem) - in - let - val () = callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr], rMem) - val result = resLoad rMem - in - arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); - arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); - freeAll(); - result - end handle exn => (freeAll(); raise exn) - end - end - - fun buildCall5(symbol, argTypes, resType) = buildCall5withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall6withAbi (abi: abi, fnAddr, - ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, - { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, - { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, - { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, - { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, - { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion), - { ctype = resType, load= resLoad, ...}: 'g conversion): 'a * 'b *'c * 'd * 'e * 'f -> 'g = - let - val callF = - callwithAbi abi [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type] resType fnAddr - val arg1Offset = alignUp(#size resType, #align arg1Type) - val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) - val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) - val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) - val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) - val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) - val argSpace = arg6Offset + #size arg6Type - in - fn (a, b, c, d, e, f) => - let - val rMem = malloc argSpace - val arg1Addr = rMem ++ arg1Offset - val arg2Addr = rMem ++ arg2Offset - val arg3Addr = rMem ++ arg3Offset - val arg4Addr = rMem ++ arg4Offset - val arg5Addr = rMem ++ arg5Offset - val arg6Addr = rMem ++ arg6Offset - val freea = arg1Store (arg1Addr, a) - val freeb = arg2Store (arg2Addr, b) - val freec = arg3Store (arg3Addr, c) - val freed = arg4Store (arg4Addr, d) - val freee = arg5Store (arg5Addr, e) - val freef = arg6Store (arg6Addr, f) - fun freeAll() = - (freea(); freeb(); freec(); freed(); freee(); freef(); free rMem) - in - let - val () = callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr , arg6Addr], rMem) - val result = resLoad rMem - in - arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); - arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); - freeAll(); - result - end handle exn => (freeAll(); raise exn) - end - end - - fun buildCall6(symbol, argTypes, resType) = buildCall6withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall7withAbi (abi: abi, fnAddr, - ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, - { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, - { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, - { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, - { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, - { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, - { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion), - { ctype = resType, load= resLoad, ...}: 'h conversion): - 'a * 'b *'c * 'd * 'e * 'f * 'g -> 'h = - let - val callF = - callwithAbi abi [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type] resType fnAddr - val arg1Offset = alignUp(#size resType, #align arg1Type) - val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) - val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) - val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) - val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) - val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) - val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) - val argSpace = arg7Offset + #size arg7Type - in - fn (a, b, c, d, e, f, g) => - let - val rMem = malloc argSpace - val arg1Addr = rMem ++ arg1Offset - val arg2Addr = rMem ++ arg2Offset - val arg3Addr = rMem ++ arg3Offset - val arg4Addr = rMem ++ arg4Offset - val arg5Addr = rMem ++ arg5Offset - val arg6Addr = rMem ++ arg6Offset - val arg7Addr = rMem ++ arg7Offset - val freea = arg1Store (arg1Addr, a) - val freeb = arg2Store (arg2Addr, b) - val freec = arg3Store (arg3Addr, c) - val freed = arg4Store (arg4Addr, d) - val freee = arg5Store (arg5Addr, e) - val freef = arg6Store (arg6Addr, f) - val freeg = arg7Store (arg7Addr, g) - fun freeAll() = - (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); free rMem) - in - let - val () = callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr], rMem) - val result = resLoad rMem - in - arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); - arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); - arg7Update (arg7Addr, g); - freeAll(); - result - end handle exn => (freeAll(); raise exn) - end - end - - fun buildCall7(symbol, argTypes, resType) = buildCall7withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall8withAbi (abi: abi, fnAddr, - ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, - { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, - { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, - { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, - { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, - { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, - { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, - { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion), - { ctype = resType, load= resLoad, ...}: 'i conversion): - 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h -> 'i = - let - val callF = - callwithAbi abi - [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, arg8Type] resType fnAddr - val arg1Offset = alignUp(#size resType, #align arg1Type) - val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) - val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) - val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) - val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) - val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) - val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) - val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) - val argSpace = arg8Offset + #size arg8Type - in - fn (a, b, c, d, e, f, g, h) => - let - val rMem = malloc argSpace - val arg1Addr = rMem ++ arg1Offset - val arg2Addr = rMem ++ arg2Offset - val arg3Addr = rMem ++ arg3Offset - val arg4Addr = rMem ++ arg4Offset - val arg5Addr = rMem ++ arg5Offset - val arg6Addr = rMem ++ arg6Offset - val arg7Addr = rMem ++ arg7Offset - val arg8Addr = rMem ++ arg8Offset - val freea = arg1Store (arg1Addr, a) - val freeb = arg2Store (arg2Addr, b) - val freec = arg3Store (arg3Addr, c) - val freed = arg4Store (arg4Addr, d) - val freee = arg5Store (arg5Addr, e) - val freef = arg6Store (arg6Addr, f) - val freeg = arg7Store (arg7Addr, g) - val freeh = arg8Store (arg8Addr, h) - fun freeAll() = - (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); free rMem) - in - let - val () = callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, arg8Addr], rMem) - val result = resLoad rMem - in - arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); - arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); - arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); - freeAll(); - result - end handle exn => (freeAll(); raise exn) - end - end - - fun buildCall8(symbol, argTypes, resType) = buildCall8withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall9withAbi (abi: abi, fnAddr, - ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, - { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, - { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, - { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, - { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, - { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, - { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, - { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion, - { ctype = arg9Type, store = arg9Store, updateML = arg9Update, ...}: 'i conversion), - { ctype = resType, load= resLoad, ...}: 'j conversion): - 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i -> 'j = - let - val callF = - callwithAbi abi - [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, arg8Type, arg9Type] - resType fnAddr - val arg1Offset = alignUp(#size resType, #align arg1Type) - val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) - val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) - val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) - val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) - val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) - val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) - val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) - val arg9Offset = alignUp(arg8Offset + #size arg8Type, #align arg9Type) - val argSpace = arg9Offset + #size arg9Type - in - fn (a, b, c, d, e, f, g, h, i) => - let - val rMem = malloc argSpace - val arg1Addr = rMem ++ arg1Offset - val arg2Addr = rMem ++ arg2Offset - val arg3Addr = rMem ++ arg3Offset - val arg4Addr = rMem ++ arg4Offset - val arg5Addr = rMem ++ arg5Offset - val arg6Addr = rMem ++ arg6Offset - val arg7Addr = rMem ++ arg7Offset - val arg8Addr = rMem ++ arg8Offset - val arg9Addr = rMem ++ arg9Offset - val freea = arg1Store (arg1Addr, a) - val freeb = arg2Store (arg2Addr, b) - val freec = arg3Store (arg3Addr, c) - val freed = arg4Store (arg4Addr, d) - val freee = arg5Store (arg5Addr, e) - val freef = arg6Store (arg6Addr, f) - val freeg = arg7Store (arg7Addr, g) - val freeh = arg8Store (arg8Addr, h) - val freei = arg9Store (arg9Addr, i) - fun freeAll() = - (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); free rMem) - in - let - val () = - callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, arg8Addr, arg9Addr], rMem) - val result = resLoad rMem - in - arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); - arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); - arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); arg9Update (arg9Addr, i); - freeAll(); - result - end handle exn => (freeAll(); raise exn) - end - end - - fun buildCall9(symbol, argTypes, resType) = buildCall9withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall10withAbi (abi: abi, fnAddr, - ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, - { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, - { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, - { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, - { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, - { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, - { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, - { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion, - { ctype = arg9Type, store = arg9Store, updateML = arg9Update, ...}: 'i conversion, - { ctype = arg10Type, store = arg10Store, updateML = arg10Update, ...}: 'j conversion), - { ctype = resType, load= resLoad, ...}: 'k conversion): - 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j -> 'k = - let - val callF = - callwithAbi abi - [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, - arg8Type, arg9Type, arg10Type] resType fnAddr - val arg1Offset = alignUp(#size resType, #align arg1Type) - val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) - val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) - val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) - val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) - val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) - val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) - val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) - val arg9Offset = alignUp(arg8Offset + #size arg8Type, #align arg9Type) - val arg10Offset = alignUp(arg9Offset + #size arg9Type, #align arg10Type) - val argSpace = arg10Offset + #size arg10Type - in - fn (a, b, c, d, e, f, g, h, i, j) => - let - val rMem = malloc argSpace - val arg1Addr = rMem ++ arg1Offset - val arg2Addr = rMem ++ arg2Offset - val arg3Addr = rMem ++ arg3Offset - val arg4Addr = rMem ++ arg4Offset - val arg5Addr = rMem ++ arg5Offset - val arg6Addr = rMem ++ arg6Offset - val arg7Addr = rMem ++ arg7Offset - val arg8Addr = rMem ++ arg8Offset - val arg9Addr = rMem ++ arg9Offset - val arg10Addr = rMem ++ arg10Offset - val freea = arg1Store (arg1Addr, a) - val freeb = arg2Store (arg2Addr, b) - val freec = arg3Store (arg3Addr, c) - val freed = arg4Store (arg4Addr, d) - val freee = arg5Store (arg5Addr, e) - val freef = arg6Store (arg6Addr, f) - val freeg = arg7Store (arg7Addr, g) - val freeh = arg8Store (arg8Addr, h) - val freei = arg9Store (arg9Addr, i) - val freej = arg10Store (arg10Addr, j) - fun freeAll() = - (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); free rMem) - in - let - val () = - callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, - arg8Addr, arg9Addr, arg10Addr], rMem) - val result = resLoad rMem - in - arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); - arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); - arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); arg9Update (arg9Addr, i); - arg10Update (arg10Addr, j); - freeAll(); - result - end handle exn => (freeAll(); raise exn) - end - end - - fun buildCall10(symbol, argTypes, resType) = buildCall10withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall11withAbi (abi: abi, fnAddr, - ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, - { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, - { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, - { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, - { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, - { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, - { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, - { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion, - { ctype = arg9Type, store = arg9Store, updateML = arg9Update, ...}: 'i conversion, - { ctype = arg10Type, store = arg10Store, updateML = arg10Update, ...}: 'j conversion, - { ctype = arg11Type, store = arg11Store, updateML = arg11Update, ...}: 'k conversion), - { ctype = resType, load= resLoad, ...}: 'l conversion): - 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k -> 'l = - let - val callF = - callwithAbi abi - [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, - arg8Type, arg9Type, arg10Type, arg11Type] resType fnAddr - val arg1Offset = alignUp(#size resType, #align arg1Type) - val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) - val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) - val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) - val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) - val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) - val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) - val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) - val arg9Offset = alignUp(arg8Offset + #size arg8Type, #align arg9Type) - val arg10Offset = alignUp(arg9Offset + #size arg9Type, #align arg10Type) - val arg11Offset = alignUp(arg10Offset + #size arg10Type, #align arg11Type) - val argSpace = arg11Offset + #size arg11Type - in - fn (a, b, c, d, e, f, g, h, i, j, k) => - let - val rMem = malloc argSpace - val arg1Addr = rMem ++ arg1Offset - val arg2Addr = rMem ++ arg2Offset - val arg3Addr = rMem ++ arg3Offset - val arg4Addr = rMem ++ arg4Offset - val arg5Addr = rMem ++ arg5Offset - val arg6Addr = rMem ++ arg6Offset - val arg7Addr = rMem ++ arg7Offset - val arg8Addr = rMem ++ arg8Offset - val arg9Addr = rMem ++ arg9Offset - val arg10Addr = rMem ++ arg10Offset - val arg11Addr = rMem ++ arg11Offset - val freea = arg1Store (arg1Addr, a) - val freeb = arg2Store (arg2Addr, b) - val freec = arg3Store (arg3Addr, c) - val freed = arg4Store (arg4Addr, d) - val freee = arg5Store (arg5Addr, e) - val freef = arg6Store (arg6Addr, f) - val freeg = arg7Store (arg7Addr, g) - val freeh = arg8Store (arg8Addr, h) - val freei = arg9Store (arg9Addr, i) - val freej = arg10Store (arg10Addr, j) - val freek = arg11Store (arg11Addr, k) - fun freeAll() = - (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); freek(); free rMem) - in - let - val () = - callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, - arg8Addr, arg9Addr, arg10Addr, arg11Addr], rMem) - val result = resLoad rMem - in - arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); - arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); - arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); arg9Update (arg9Addr, i); - arg10Update (arg10Addr, j); arg11Update (arg11Addr, k); - freeAll(); - result - end handle exn => (freeAll(); raise exn) - end - end - - fun buildCall11(symbol, argTypes, resType) = buildCall11withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall12withAbi (abi: abi, fnAddr, - ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, - { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, - { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, - { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, - { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, - { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, - { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, - { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion, - { ctype = arg9Type, store = arg9Store, updateML = arg9Update, ...}: 'i conversion, - { ctype = arg10Type, store = arg10Store, updateML = arg10Update, ...}: 'j conversion, - { ctype = arg11Type, store = arg11Store, updateML = arg11Update, ...}: 'k conversion, - { ctype = arg12Type, store = arg12Store, updateML = arg12Update, ...}: 'l conversion), - { ctype = resType, load= resLoad, ...}: 'm conversion): - 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l -> 'm = - let - val callF = - callwithAbi abi - [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, - arg8Type, arg9Type, arg10Type, arg11Type, arg12Type] resType fnAddr - val arg1Offset = alignUp(#size resType, #align arg1Type) - val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) - val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) - val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) - val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) - val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) - val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) - val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) - val arg9Offset = alignUp(arg8Offset + #size arg8Type, #align arg9Type) - val arg10Offset = alignUp(arg9Offset + #size arg9Type, #align arg10Type) - val arg11Offset = alignUp(arg10Offset + #size arg10Type, #align arg11Type) - val arg12Offset = alignUp(arg11Offset + #size arg11Type, #align arg12Type) - val argSpace = arg12Offset + #size arg12Type - in - fn (a, b, c, d, e, f, g, h, i, j, k, l) => - let - val rMem = malloc argSpace - val arg1Addr = rMem ++ arg1Offset - val arg2Addr = rMem ++ arg2Offset - val arg3Addr = rMem ++ arg3Offset - val arg4Addr = rMem ++ arg4Offset - val arg5Addr = rMem ++ arg5Offset - val arg6Addr = rMem ++ arg6Offset - val arg7Addr = rMem ++ arg7Offset - val arg8Addr = rMem ++ arg8Offset - val arg9Addr = rMem ++ arg9Offset - val arg10Addr = rMem ++ arg10Offset - val arg11Addr = rMem ++ arg11Offset - val arg12Addr = rMem ++ arg12Offset - val freea = arg1Store (arg1Addr, a) - val freeb = arg2Store (arg2Addr, b) - val freec = arg3Store (arg3Addr, c) - val freed = arg4Store (arg4Addr, d) - val freee = arg5Store (arg5Addr, e) - val freef = arg6Store (arg6Addr, f) - val freeg = arg7Store (arg7Addr, g) - val freeh = arg8Store (arg8Addr, h) - val freei = arg9Store (arg9Addr, i) - val freej = arg10Store (arg10Addr, j) - val freek = arg11Store (arg11Addr, k) - val freel = arg12Store (arg12Addr, l) - fun freeAll() = - (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); freek(); freel(); free rMem) - in - let - val () = - callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, - arg8Addr, arg9Addr, arg10Addr, arg11Addr, arg12Addr], rMem) - val result = resLoad rMem - in - arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); - arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); - arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); arg9Update (arg9Addr, i); - arg10Update (arg10Addr, j); arg11Update (arg11Addr, k); arg12Update (arg12Addr, l); - freeAll(); - result - end handle exn => (freeAll(); raise exn) - end - end - - fun buildCall12(symbol, argTypes, resType) = buildCall12withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall13withAbi (abi: abi, fnAddr, - ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, - { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, - { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, - { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, - { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, - { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, - { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, - { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion, - { ctype = arg9Type, store = arg9Store, updateML = arg9Update, ...}: 'i conversion, - { ctype = arg10Type, store = arg10Store, updateML = arg10Update, ...}: 'j conversion, - { ctype = arg11Type, store = arg11Store, updateML = arg11Update, ...}: 'k conversion, - { ctype = arg12Type, store = arg12Store, updateML = arg12Update, ...}: 'l conversion, - { ctype = arg13Type, store = arg13Store, updateML = arg13Update, ...}: 'm conversion), - { ctype = resType, load= resLoad, ...}: 'n conversion): - 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm -> 'n = - let - val callF = - callwithAbi abi - [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, - arg8Type, arg9Type, arg10Type, arg11Type, arg12Type, arg13Type] resType fnAddr - val arg1Offset = alignUp(#size resType, #align arg1Type) - val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) - val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) - val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) - val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) - val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) - val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) - val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) - val arg9Offset = alignUp(arg8Offset + #size arg8Type, #align arg9Type) - val arg10Offset = alignUp(arg9Offset + #size arg9Type, #align arg10Type) - val arg11Offset = alignUp(arg10Offset + #size arg10Type, #align arg11Type) - val arg12Offset = alignUp(arg11Offset + #size arg11Type, #align arg12Type) - val arg13Offset = alignUp(arg12Offset + #size arg12Type, #align arg13Type) - val argSpace = arg13Offset + #size arg13Type - in - fn (a, b, c, d, e, f, g, h, i, j, k, l, m) => - let - val rMem = malloc argSpace - val arg1Addr = rMem ++ arg1Offset - val arg2Addr = rMem ++ arg2Offset - val arg3Addr = rMem ++ arg3Offset - val arg4Addr = rMem ++ arg4Offset - val arg5Addr = rMem ++ arg5Offset - val arg6Addr = rMem ++ arg6Offset - val arg7Addr = rMem ++ arg7Offset - val arg8Addr = rMem ++ arg8Offset - val arg9Addr = rMem ++ arg9Offset - val arg10Addr = rMem ++ arg10Offset - val arg11Addr = rMem ++ arg11Offset - val arg12Addr = rMem ++ arg12Offset - val arg13Addr = rMem ++ arg13Offset - val freea = arg1Store (arg1Addr, a) - val freeb = arg2Store (arg2Addr, b) - val freec = arg3Store (arg3Addr, c) - val freed = arg4Store (arg4Addr, d) - val freee = arg5Store (arg5Addr, e) - val freef = arg6Store (arg6Addr, f) - val freeg = arg7Store (arg7Addr, g) - val freeh = arg8Store (arg8Addr, h) - val freei = arg9Store (arg9Addr, i) - val freej = arg10Store (arg10Addr, j) - val freek = arg11Store (arg11Addr, k) - val freel = arg12Store (arg12Addr, l) - val freem = arg13Store (arg13Addr, m) - fun freeAll() = - (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); freek(); freel(); freem(); free rMem) - in - let - val () = - callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, - arg8Addr, arg9Addr, arg10Addr, arg11Addr, arg12Addr, arg13Addr], rMem) - val result = resLoad rMem - in - arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); - arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); - arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); arg9Update (arg9Addr, i); - arg10Update (arg10Addr, j); arg11Update (arg11Addr, k); arg12Update (arg12Addr, l); - arg13Update (arg13Addr, m); - freeAll(); - result - end handle exn => (freeAll(); raise exn) - end - end - - fun buildCall13(symbol, argTypes, resType) = buildCall13withAbi (abiDefault, symbol, argTypes, resType) - - fun buildCall14withAbi (abi: abi, fnAddr, - ({ ctype = arg1Type, store = arg1Store, updateML = arg1Update, ...}: 'a conversion, - { ctype = arg2Type, store = arg2Store, updateML = arg2Update, ...}: 'b conversion, - { ctype = arg3Type, store = arg3Store, updateML = arg3Update, ...}: 'c conversion, - { ctype = arg4Type, store = arg4Store, updateML = arg4Update, ...}: 'd conversion, - { ctype = arg5Type, store = arg5Store, updateML = arg5Update, ...}: 'e conversion, - { ctype = arg6Type, store = arg6Store, updateML = arg6Update, ...}: 'f conversion, - { ctype = arg7Type, store = arg7Store, updateML = arg7Update, ...}: 'g conversion, - { ctype = arg8Type, store = arg8Store, updateML = arg8Update, ...}: 'h conversion, - { ctype = arg9Type, store = arg9Store, updateML = arg9Update, ...}: 'i conversion, - { ctype = arg10Type, store = arg10Store, updateML = arg10Update, ...}: 'j conversion, - { ctype = arg11Type, store = arg11Store, updateML = arg11Update, ...}: 'k conversion, - { ctype = arg12Type, store = arg12Store, updateML = arg12Update, ...}: 'l conversion, - { ctype = arg13Type, store = arg13Store, updateML = arg13Update, ...}: 'm conversion, - { ctype = arg14Type, store = arg14Store, updateML = arg14Update, ...}: 'n conversion), - { ctype = resType, load= resLoad, ...}: 'o conversion): - 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm * 'n -> 'o = - let - val callF = - callwithAbi abi - [arg1Type, arg2Type, arg3Type, arg4Type, arg5Type, arg6Type, arg7Type, - arg8Type, arg9Type, arg10Type, arg11Type, arg12Type, arg13Type, - arg14Type] resType fnAddr - val arg1Offset = alignUp(#size resType, #align arg1Type) - val arg2Offset = alignUp(arg1Offset + #size arg1Type, #align arg2Type) - val arg3Offset = alignUp(arg2Offset + #size arg2Type, #align arg3Type) - val arg4Offset = alignUp(arg3Offset + #size arg3Type, #align arg4Type) - val arg5Offset = alignUp(arg4Offset + #size arg4Type, #align arg5Type) - val arg6Offset = alignUp(arg5Offset + #size arg5Type, #align arg6Type) - val arg7Offset = alignUp(arg6Offset + #size arg6Type, #align arg7Type) - val arg8Offset = alignUp(arg7Offset + #size arg7Type, #align arg8Type) - val arg9Offset = alignUp(arg8Offset + #size arg8Type, #align arg9Type) - val arg10Offset = alignUp(arg9Offset + #size arg9Type, #align arg10Type) - val arg11Offset = alignUp(arg10Offset + #size arg10Type, #align arg11Type) - val arg12Offset = alignUp(arg11Offset + #size arg11Type, #align arg12Type) - val arg13Offset = alignUp(arg12Offset + #size arg12Type, #align arg13Type) - val arg14Offset = alignUp(arg13Offset + #size arg13Type, #align arg14Type) - val argSpace = arg14Offset + #size arg14Type - in - fn (a, b, c, d, e, f, g, h, i, j, k, l, m, n) => - let - val rMem = malloc argSpace - val arg1Addr = rMem ++ arg1Offset - val arg2Addr = rMem ++ arg2Offset - val arg3Addr = rMem ++ arg3Offset - val arg4Addr = rMem ++ arg4Offset - val arg5Addr = rMem ++ arg5Offset - val arg6Addr = rMem ++ arg6Offset - val arg7Addr = rMem ++ arg7Offset - val arg8Addr = rMem ++ arg8Offset - val arg9Addr = rMem ++ arg9Offset - val arg10Addr = rMem ++ arg10Offset - val arg11Addr = rMem ++ arg11Offset - val arg12Addr = rMem ++ arg12Offset - val arg13Addr = rMem ++ arg13Offset - val arg14Addr = rMem ++ arg14Offset - val freea = arg1Store (arg1Addr, a) - val freeb = arg2Store (arg2Addr, b) - val freec = arg3Store (arg3Addr, c) - val freed = arg4Store (arg4Addr, d) - val freee = arg5Store (arg5Addr, e) - val freef = arg6Store (arg6Addr, f) - val freeg = arg7Store (arg7Addr, g) - val freeh = arg8Store (arg8Addr, h) - val freei = arg9Store (arg9Addr, i) - val freej = arg10Store (arg10Addr, j) - val freek = arg11Store (arg11Addr, k) - val freel = arg12Store (arg12Addr, l) - val freem = arg13Store (arg13Addr, m) - val freen = arg14Store (arg14Addr, n) - fun freeAll() = - (freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); - freeh(); freei(); freej(); freek(); freel(); freem(); freen(); free rMem) - in - let - val () = - callF([arg1Addr, arg2Addr, arg3Addr, arg4Addr, arg5Addr, arg6Addr, arg7Addr, - arg8Addr, arg9Addr, arg10Addr, arg11Addr, arg12Addr, arg13Addr, arg14Addr], rMem) - val result = resLoad rMem - in - arg1Update(arg1Addr, a); arg2Update (arg2Addr, b); arg3Update (arg3Addr, c); - arg4Update (arg4Addr, d); arg5Update (arg5Addr, e); arg6Update (arg6Addr, f); - arg7Update (arg7Addr, g); arg8Update (arg8Addr, h); arg9Update (arg9Addr, i); - arg10Update (arg10Addr, j); arg11Update (arg11Addr, k); arg12Update (arg12Addr, l); - arg13Update (arg13Addr, m); arg14Update (arg14Addr, n); - freeAll(); - result - end handle exn => (freeAll(); raise exn) - end - end - - fun buildCall14(symbol, argTypes, resType) = buildCall14withAbi (abiDefault, symbol, argTypes, resType) - - end - - (* A closure is a memoised address. *) - type 'a closure = unit -> Memory.voidStar - - local - open Memory LowLevel - fun load _ = raise Foreign "Cannot return a closure" - (* "dememoise" the value when we store it. This means that the closure is actually - created when the value is first stored and then it is cached. *) - and store(v, cl: ('a->'b) closure) = (Memory.setAddress(v, 0w0, cl()); fn () => ()) - in - val cFunction: ('a->'b) closure conversion = - makeConversion { load=load, store=store, ctype = LowLevel.cTypePointer } - end - - local - open LibFFI Memory LowLevel - in - fun buildClosure0withAbi(f: unit-> 'a, abi: abi, (), resConv: 'a conversion): (unit->'a) closure = - let - fun callback (f: unit -> 'a) (_: voidStar, res: voidStar): unit = - ignore(#store resConv (res, f ())) - (* Ignore the result of #store resConv. What this means is if the - callback returns something, e.g. a string, that requires - dynamic allocation there will be a memory leak. *) - - val makeCallback = cFunctionWithAbi abi [] (#ctype resConv) - in - Memory.memoise (fn () => makeCallback(callback f)) () - end - - fun buildClosure0(f, argConv, resConv) = buildClosure0withAbi(f, abiDefault, argConv, resConv) - - fun buildClosure1withAbi (f: 'a -> 'b, abi: abi, argConv: 'a conversion, resConv: 'b conversion) : ('a -> 'b) closure = - let - fun callback (f: 'a -> 'b) (args: voidStar, res: voidStar): unit = - let - val arg1Addr = getAddress(args, 0w0) - val arg1 = #load argConv arg1Addr - val result = f arg1 - val () = #updateC argConv (arg1Addr, arg1) - in - ignore(#store resConv (res, result)) - end - - val makeCallback = cFunctionWithAbi abi [#ctype argConv] (#ctype resConv) - in - Memory.memoise (fn () => makeCallback(callback f)) () - end - - fun buildClosure1(f, argConv, resConv) = buildClosure1withAbi(f, abiDefault, argConv, resConv) - - fun buildClosure2withAbi - (f: 'a * 'b -> 'c, abi: abi, (arg1Conv: 'a conversion, arg2Conv: 'b conversion), resConv: 'c conversion) : - ('a * 'b -> 'c) closure = - let - fun callback (f: 'a *'b -> 'c) (args: voidStar, res: voidStar): unit = - let - val arg1Addr = getAddress(args, 0w0) - and arg2Addr = getAddress(args, 0w1) - val arg1 = #load arg1Conv arg1Addr - and arg2 = #load arg2Conv arg2Addr - - val result = f (arg1, arg2) - - val () = #updateC arg1Conv(arg1Addr, arg1) - and () = #updateC arg2Conv(arg2Addr, arg2) - in - ignore(#store resConv (res, result)) - end - - val argTypes = [#ctype arg1Conv, #ctype arg2Conv] - and resType = #ctype resConv - - val makeCallback = cFunctionWithAbi abi argTypes resType - in - Memory.memoise (fn () => makeCallback(callback f)) () - end - - fun buildClosure2(f, argConv, resConv) = buildClosure2withAbi(f, abiDefault, argConv, resConv) - - fun buildClosure3withAbi - (f, abi, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion), resConv: 'd conversion) = - let - fun callback (f: 'a *'b * 'c -> 'd) (args: voidStar, res: voidStar): unit = - let - val arg1Addr = getAddress(args, 0w0) - and arg2Addr = getAddress(args, 0w1) - and arg3Addr = getAddress(args, 0w2) - val arg1 = #load arg1Conv arg1Addr - and arg2 = #load arg2Conv arg2Addr - and arg3 = #load arg3Conv arg3Addr - - val result = f (arg1, arg2, arg3) - - val () = #updateC arg1Conv(arg1Addr, arg1) - and () = #updateC arg2Conv(arg2Addr, arg2) - and () = #updateC arg3Conv(arg3Addr, arg3) - in - ignore(#store resConv (res, result)) - end - - val argTypes = - [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv] - and resType = #ctype resConv - - val makeCallback = cFunctionWithAbi abi argTypes resType - in - Memory.memoise (fn () => makeCallback(callback f)) () - end - - fun buildClosure3(f, argConv, resConv) = buildClosure3withAbi(f, abiDefault, argConv, resConv) - - fun buildClosure4withAbi - (f, abi, - (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion), - resConv: 'e conversion) = - let - fun callback (f: 'a *'b * 'c * 'd -> 'e) (args: voidStar, res: voidStar): unit = - let - val arg1Addr = getAddress(args, 0w0) - and arg2Addr = getAddress(args, 0w1) - and arg3Addr = getAddress(args, 0w2) - and arg4Addr = getAddress(args, 0w3) - val arg1 = #load arg1Conv arg1Addr - and arg2 = #load arg2Conv arg2Addr - and arg3 = #load arg3Conv arg3Addr - and arg4 = #load arg4Conv arg4Addr - - val result = f (arg1, arg2, arg3, arg4) - - val () = #updateC arg1Conv(arg1Addr, arg1) - and () = #updateC arg2Conv(arg2Addr, arg2) - and () = #updateC arg3Conv(arg3Addr, arg3) - and () = #updateC arg4Conv(arg4Addr, arg4) - in - ignore(#store resConv (res, result)) - end - - val argTypes = - [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv] - and resType = #ctype resConv - - val makeCallback = cFunctionWithAbi abi argTypes resType - in - Memory.memoise (fn () => makeCallback(callback f)) () - end - - fun buildClosure4(f, argConv, resConv) = buildClosure4withAbi(f, abiDefault, argConv, resConv) - - fun buildClosure5withAbi - (f, abi, - (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, - arg4Conv: 'd conversion, arg5Conv: 'e conversion), - resConv: 'f conversion) = - let - fun callback (f: 'a *'b * 'c * 'd * 'e -> 'f) (args: voidStar, res: voidStar): unit = - let - val arg1Addr = getAddress(args, 0w0) - and arg2Addr = getAddress(args, 0w1) - and arg3Addr = getAddress(args, 0w2) - and arg4Addr = getAddress(args, 0w3) - and arg5Addr = getAddress(args, 0w4) - val arg1 = #load arg1Conv arg1Addr - and arg2 = #load arg2Conv arg2Addr - and arg3 = #load arg3Conv arg3Addr - and arg4 = #load arg4Conv arg4Addr - and arg5 = #load arg5Conv arg5Addr - - val result = f (arg1, arg2, arg3, arg4, arg5) - - val () = #updateC arg1Conv(arg1Addr, arg1) - and () = #updateC arg2Conv(arg2Addr, arg2) - and () = #updateC arg3Conv(arg3Addr, arg3) - and () = #updateC arg4Conv(arg4Addr, arg4) - and () = #updateC arg5Conv(arg5Addr, arg5) - in - ignore(#store resConv (res, result)) - end - - val argTypes = - [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, - #ctype arg4Conv, #ctype arg5Conv] - and resType = #ctype resConv - - val makeCallback = cFunctionWithAbi abi argTypes resType - in - Memory.memoise (fn () => makeCallback(callback f)) () - end - - fun buildClosure5(f, argConv, resConv) = buildClosure5withAbi(f, abiDefault, argConv, resConv) - - fun buildClosure6withAbi - (f, abi, - (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, - arg4Conv: 'd conversion, arg5Conv: 'e conversion, arg6Conv: 'f conversion), - resConv: 'g conversion) = - let - fun callback (f: 'a *'b * 'c * 'd * 'e * 'f -> 'g) (args: voidStar, res: voidStar): unit = - let - val arg1Addr = getAddress(args, 0w0) - and arg2Addr = getAddress(args, 0w1) - and arg3Addr = getAddress(args, 0w2) - and arg4Addr = getAddress(args, 0w3) - and arg5Addr = getAddress(args, 0w4) - and arg6Addr = getAddress(args, 0w5) - val arg1 = #load arg1Conv arg1Addr - and arg2 = #load arg2Conv arg2Addr - and arg3 = #load arg3Conv arg3Addr - and arg4 = #load arg4Conv arg4Addr - and arg5 = #load arg5Conv arg5Addr - and arg6 = #load arg6Conv arg6Addr - - val result = f (arg1, arg2, arg3, arg4, arg5, arg6) - - val () = #updateC arg1Conv(arg1Addr, arg1) - and () = #updateC arg2Conv(arg2Addr, arg2) - and () = #updateC arg3Conv(arg3Addr, arg3) - and () = #updateC arg4Conv(arg4Addr, arg4) - and () = #updateC arg5Conv(arg5Addr, arg5) - and () = #updateC arg6Conv(arg6Addr, arg6) - in - ignore(#store resConv (res, result)) - end - - val argTypes = - [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, - #ctype arg4Conv, #ctype arg5Conv, #ctype arg6Conv] - and resType = #ctype resConv - - val makeCallback = cFunctionWithAbi abi argTypes resType - in - Memory.memoise (fn () => makeCallback(callback f)) () - end - - fun buildClosure6(f, argConv, resConv) = buildClosure6withAbi(f, abiDefault, argConv, resConv) - - end end; diff --git a/basis/Foreign.sml b/basis/Foreign.sml index 6675b87c..9ce2bf00 100644 --- a/basis/Foreign.sml +++ b/basis/Foreign.sml @@ -1,2822 +1,2819 @@ (* Title: Foreign Function Interface: main part Author: David Matthews Copyright David Matthews 2015-16, 2018-19 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) signature FOREIGN = sig exception Foreign of string structure Memory: sig eqtype volatileRef val volatileRef: SysWord.word -> volatileRef val setVolatileRef: volatileRef * SysWord.word -> unit val getVolatileRef: volatileRef -> SysWord.word eqtype voidStar val voidStar2Sysword: voidStar -> SysWord.word val sysWord2VoidStar: SysWord.word -> voidStar val null: voidStar val ++ : voidStar * word -> voidStar val -- : voidStar * word -> voidStar (* Remember an address except across loads. *) val memoise: ('a -> voidStar) ->'a -> unit -> voidStar exception Memory (* malloc - allocate memory. N.B. argument is the number of bytes. Raises Memory exception if it cannot allocate. *) val malloc: word -> voidStar (* free - free allocated memory. *) val free: voidStar -> unit (* alloca: allocate temporary memory on the C-stack and call the function. The memory is deallocated when the function returns or raises and exception. *) val alloca: word * (voidStar -> 'a) -> 'a val get8: voidStar * Word.word -> Word8.word val get16: voidStar * Word.word -> Word.word val get32: voidStar * Word.word -> Word32.word val get64: voidStar * Word.word -> SysWord.word val set8: voidStar * Word.word * Word8.word -> unit val set16: voidStar * Word.word * Word.word -> unit val set32: voidStar * Word.word * Word32.word -> unit val set64: voidStar * Word.word * SysWord.word -> unit val getFloat: voidStar * Word.word -> real val getDouble: voidStar * Word.word -> real val setFloat: voidStar * Word.word * real -> unit val setDouble: voidStar * Word.word * real -> unit val getAddress: voidStar * Word.word -> voidStar val setAddress: voidStar * Word.word * voidStar -> unit end structure System: sig type voidStar = Memory.voidStar type externalSymbol val loadLibrary: string -> voidStar and loadExecutable: unit -> voidStar and freeLibrary: voidStar -> unit and getSymbol: voidStar * string -> voidStar and externalFunctionSymbol: string -> externalSymbol and externalDataSymbol: string -> externalSymbol and addressOfExternal: externalSymbol -> voidStar end structure Error: sig type syserror = LibrarySupport.syserror val getLastError: unit -> SysWord.word val setLastError: SysWord.word -> unit val fromWord: SysWord.word -> syserror and toWord: syserror -> SysWord.word end type library type symbol val loadLibrary: string -> library val loadExecutable: unit -> library val getSymbol: library -> string -> symbol val symbolAsAddress: symbol -> Memory.voidStar val externalFunctionSymbol: string -> symbol and externalDataSymbol: string -> symbol structure LowLevel: sig datatype cTypeForm = CTypeFloatingPt | CTypePointer | CTypeSignedInt | CTypeUnsignedInt | CTypeStruct of cType list | CTypeVoid withtype cType = { typeForm: cTypeForm, align: word, size: word } eqtype abi val abiList: (string * abi) list val abiDefault: abi val cTypeVoid: cType and cTypePointer: cType and cTypeInt8: cType and cTypeChar: cType and cTypeUint8: cType and cTypeUchar: cType and cTypeInt16: cType and cTypeUint16: cType and cTypeInt32: cType and cTypeUint32: cType and cTypeInt64: cType and cTypeUint64: cType and cTypeInt: cType and cTypeUint: cType and cTypeLong: cType and cTypeUlong: cType and cTypeFloat: cType and cTypeDouble: cType val cStruct: cType list -> cType val callwithAbi: abi -> cType list -> cType -> symbol -> Memory.voidStar * Memory.voidStar -> unit val call: cType list -> cType -> symbol -> Memory.voidStar * Memory.voidStar -> unit val cFunctionWithAbi: abi -> cType list -> cType -> (Memory.voidStar * Memory.voidStar -> unit) -> Memory.voidStar val cFunction: cType list -> cType -> (Memory.voidStar * Memory.voidStar -> unit) -> Memory.voidStar end type 'a conversion val makeConversion: { load: Memory.voidStar -> 'a, (* Load a value from C memory *) store: Memory.voidStar * 'a -> unit -> unit, (* Store value and return free function. *) ctype: LowLevel.cType } -> 'a conversion val breakConversion: 'a conversion -> { load: Memory.voidStar -> 'a, (* Load a value from C memory *) store: Memory.voidStar * 'a -> unit -> unit, (* Store value and return free function. *) ctype: LowLevel.cType } val cVoid: unit conversion val cPointer: Memory.voidStar conversion val cInt8: int conversion val cUint8: int conversion val cChar: char conversion val cUchar: Word8.word conversion val cInt16: int conversion val cUint16: int conversion val cInt32: int conversion val cUint32: int conversion val cInt64: int conversion val cUint64: int conversion val cInt32Large: LargeInt.int conversion val cUint32Large: LargeInt.int conversion val cInt64Large: LargeInt.int conversion val cUint64Large: LargeInt.int conversion val cShort: int conversion val cUshort: int conversion val cInt: int conversion val cUint: int conversion val cLong: int conversion val cUlong: int conversion val cIntLarge: LargeInt.int conversion val cUintLarge: LargeInt.int conversion val cLongLarge: LargeInt.int conversion val cUlongLarge: LargeInt.int conversion val cString: string conversion val cByteArray: Word8Vector.vector conversion val cFloat: real conversion val cDouble: real conversion (* When a pointer e.g. a string may be null. *) val cOptionPtr: 'a conversion -> 'a option conversion type 'a closure val cFunction: ('a->'b) closure conversion val buildClosure0withAbi: (unit -> 'a) * LowLevel.abi * unit * 'a conversion -> (unit -> 'a) closure val buildClosure0: (unit -> 'a) * unit * 'a conversion -> (unit -> 'a) closure val buildClosure1withAbi: ('a -> 'b) * LowLevel.abi * 'a conversion * 'b conversion -> ('a -> 'b) closure val buildClosure1: ('a -> 'b) * 'a conversion * 'b conversion -> ('a -> 'b) closure val buildClosure2withAbi: ('a * 'b -> 'c) * LowLevel.abi * ('a conversion * 'b conversion) * 'c conversion -> ('a * 'b -> 'c) closure val buildClosure2: ('a * 'b -> 'c) * ('a conversion * 'b conversion) * 'c conversion -> ('a * 'b -> 'c) closure val buildClosure3withAbi: ('a * 'b *'c -> 'd) * LowLevel.abi * ('a conversion * 'b conversion * 'c conversion) * 'd conversion -> ('a * 'b *'c -> 'd) closure val buildClosure3: ('a * 'b *'c -> 'd) * ('a conversion * 'b conversion * 'c conversion) * 'd conversion -> ('a * 'b *'c -> 'd) closure val buildClosure4withAbi: ('a * 'b * 'c * 'd -> 'e) * LowLevel.abi * ('a conversion * 'b conversion * 'c conversion* 'd conversion) * 'e conversion -> ('a * 'b * 'c * 'd -> 'e) closure val buildClosure4: ('a * 'b * 'c * 'd -> 'e) * ('a conversion * 'b conversion * 'c conversion* 'd conversion) * 'e conversion -> ('a * 'b * 'c * 'd -> 'e) closure val buildClosure5withAbi: ('a * 'b * 'c * 'd * 'e -> 'f) * LowLevel.abi * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion) * 'f conversion -> ('a * 'b * 'c * 'd * 'e -> 'f) closure val buildClosure5: ('a * 'b * 'c * 'd * 'e -> 'f) * ('a conversion * 'b conversion * 'c conversion* 'd conversion * 'e conversion) * 'f conversion -> ('a * 'b * 'c * 'd * 'e -> 'f) closure val buildClosure6withAbi: ('a * 'b * 'c * 'd * 'e * 'f -> 'g) * LowLevel.abi * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion) * 'g conversion -> ('a * 'b * 'c * 'd * 'e * 'f -> 'g) closure val buildClosure6: ('a * 'b * 'c * 'd * 'e * 'f -> 'g) * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion) * 'g conversion -> ('a * 'b * 'c * 'd * 'e * 'f -> 'g) closure (* Remove the "free" from a conversion. Used if extra memory allocated by the argument must not be freed when the function returns. *) val permanent: 'a conversion -> 'a conversion (* Call by reference. *) val cStar: 'a conversion -> 'a ref conversion (* Pass a const pointer *) val cConstStar: 'a conversion -> 'a conversion (* Fixed size vector. It is treated as a struct and passed by value or embedded in a structure. *) val cVectorFixedSize: int * 'a conversion -> 'a vector conversion (* Pass an ML vector as a pointer to a C array. *) and cVectorPointer: 'a conversion -> 'a vector conversion (* Pass an ML array as a pointer to a C array and, on return, update each element of the ML array from the C array. *) and cArrayPointer: 'a conversion -> 'a array conversion (* structs. *) val cStruct2: 'a conversion * 'b conversion -> ('a * 'b) conversion val cStruct3: 'a conversion * 'b conversion * 'c conversion -> ('a*'b*'c)conversion val cStruct4: 'a conversion * 'b conversion * 'c conversion * 'd conversion -> ('a*'b*'c*'d)conversion val cStruct5: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion -> ('a*'b*'c*'d*'e)conversion val cStruct6: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion -> ('a*'b*'c*'d*'e*'f)conversion val cStruct7: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion -> ('a*'b*'c*'d*'e*'f*'g)conversion val cStruct8: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion -> ('a*'b*'c*'d*'e*'f*'g*'h)conversion val cStruct9: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i)conversion val cStruct10: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j)conversion val cStruct11: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k)conversion val cStruct12: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l)conversion val cStruct13: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m)conversion val cStruct14: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n)conversion val cStruct15: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * 'o conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o)conversion val cStruct16: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * 'o conversion * 'p conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p)conversion val cStruct17: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * 'o conversion * 'p conversion * 'q conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q)conversion val cStruct18: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * 'o conversion * 'p conversion * 'q conversion * 'r conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r)conversion val cStruct19: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * 'o conversion * 'p conversion * 'q conversion * 'r conversion * 's conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r*'s)conversion val cStruct20: 'a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion * 'o conversion * 'p conversion * 'q conversion * 'r conversion * 's conversion * 't conversion -> ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r*'s*'t)conversion val buildCall0withAbi: LowLevel.abi * symbol * unit * 'a conversion -> unit -> 'a val buildCall0: symbol * unit * 'a conversion -> unit -> 'a val buildCall1withAbi: LowLevel.abi * symbol * 'a conversion * 'b conversion -> 'a -> 'b val buildCall1: symbol * 'a conversion * 'b conversion -> 'a -> 'b val buildCall2withAbi: LowLevel.abi * symbol * ('a conversion * 'b conversion) * 'c conversion -> 'a * 'b -> 'c val buildCall2: symbol * ('a conversion * 'b conversion) * 'c conversion -> 'a * 'b -> 'c val buildCall3withAbi: LowLevel.abi * symbol * ('a conversion * 'b conversion * 'c conversion) * 'd conversion -> 'a * 'b * 'c -> 'd val buildCall3: symbol * ('a conversion * 'b conversion * 'c conversion) * 'd conversion -> 'a * 'b * 'c -> 'd val buildCall4withAbi: LowLevel.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion) * 'e conversion -> 'a * 'b * 'c * 'd -> 'e val buildCall4: symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion) * 'e conversion -> 'a * 'b * 'c * 'd -> 'e val buildCall5withAbi: LowLevel.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion) * 'f conversion -> 'a * 'b * 'c * 'd * 'e -> 'f val buildCall5: symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion) * 'f conversion -> 'a * 'b * 'c * 'd * 'e -> 'f val buildCall6withAbi: LowLevel.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion) * 'g conversion -> 'a * 'b * 'c * 'd * 'e * 'f -> 'g val buildCall6: symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion) * 'g conversion -> 'a * 'b * 'c * 'd * 'e * 'f -> 'g val buildCall7withAbi: LowLevel.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion) * 'h conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g -> 'h val buildCall7: symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion) * 'h conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g -> 'h val buildCall8withAbi: LowLevel.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion) * 'i conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h -> 'i val buildCall8: symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion) * 'i conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h -> 'i val buildCall9withAbi: LowLevel.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion) * 'j conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i -> 'j val buildCall9: symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion) * 'j conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i -> 'j val buildCall10withAbi: LowLevel.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion) * 'k conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j -> 'k val buildCall10: symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion) * 'k conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j -> 'k val buildCall11withAbi: LowLevel.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion) * 'l conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k -> 'l val buildCall11: symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion) * 'l conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k -> 'l val buildCall12withAbi: LowLevel.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion) * 'm conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l -> 'm val buildCall12: symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion) * 'm conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l -> 'm val buildCall13withAbi: LowLevel.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion) * 'n conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm -> 'n val buildCall13: symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion) * 'n conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm -> 'n val buildCall14withAbi: LowLevel.abi * symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion) * 'o conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm * 'n -> 'o val buildCall14: symbol * ('a conversion * 'b conversion * 'c conversion * 'd conversion * 'e conversion * 'f conversion * 'g conversion * 'h conversion * 'i conversion * 'j conversion * 'k conversion * 'l conversion * 'm conversion * 'n conversion) * 'o conversion -> 'a * 'b * 'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm * 'n -> 'o end; structure Foreign:> FOREIGN = struct open Foreign open ForeignConstants structure Memory = ForeignMemory infix 6 ++ -- (* Internal utility function. *) fun alignUp(s, align) = Word.andb(s + align-0w1, ~ align) structure System = struct type voidStar = Memory.voidStar type externalSymbol = voidStar val loadLibrary: string -> voidStar = RunCall.rtsCallFull1 "PolyFFILoadLibrary" and loadExecutable: unit -> voidStar = RunCall.rtsCallFull0 "PolyFFILoadExecutable" and freeLibrary: voidStar -> unit = RunCall.rtsCallFull1 "PolyFFIUnloadLibrary" and getSymbol: voidStar * string -> voidStar = RunCall.rtsCallFull2 "PolyFFIGetSymbolAddress" (* Create an external symbol object. The first word of this is filled in with the address after the code is exported and linked. On a small number of platforms different relocations are required for functions and for data. *) val externalFunctionSymbol: string -> externalSymbol = RunCall.rtsCallFull1 "PolyFFICreateExtFn" and externalDataSymbol: string -> externalSymbol = RunCall.rtsCallFull1 "PolyFFICreateExtData" (* An external symbol is a memory cell containing the value in the first word followed by the symbol name. Because the first word is the value it can be treated as a Sysword.word value. When it is created the value is zero and the address of the target is only set once the symbol has been exported and the value set by the linker. *) fun addressOfExternal(ext: externalSymbol): voidStar = if Memory.voidStar2Sysword ext = 0w0 then raise Foreign "External symbol has not been set" else ext end structure Error = struct type syserror = LibrarySupport.syserror val toWord = LibrarySupport.syserrorToWord and fromWord = LibrarySupport.syserrorFromWord local val callGetError = RunCall.rtsCallFast1 "PolyFFIGetError" in fun getLastError(): SysWord.word = let val mem = RunCall.allocateByteMemory(0w1, 0wx41) val () = callGetError mem val () = RunCall.clearMutableBit mem in RunCall.unsafeCast mem end end val setLastError: SysWord.word -> unit = RunCall.rtsCallFast1 "PolyFFISetError" end type library = unit -> Memory.voidStar type symbol = unit -> Memory.voidStar (* Load the library but memoise it so if we reference the library in another session we will reload it. We load the library immediately so that if there is an error we get the error immediately. *) fun loadLibrary (name: string): library = Memory.memoise System.loadLibrary name and loadExecutable (): library = Memory.memoise System.loadExecutable () (* To get a symbol we memoise a function that forces a library load if necessary and then gets the symbol. *) fun getSymbol(lib: library) (name: string): symbol = Memory.memoise (fn s => System.getSymbol(lib(), s)) name (* This forces the symbol to be loaded. The result is NOT memoised. *) fun symbolAsAddress(s: symbol): Memory.voidStar = s() (* Create an external symbol. This can only be used after linking. *) fun externalFunctionSymbol(name: string): symbol = let val r = System.externalFunctionSymbol name in fn () => System.addressOfExternal r end and externalDataSymbol(name: string): symbol = let val r = System.externalDataSymbol name in fn () => System.addressOfExternal r end structure LowLevel = struct (* This must match the type in ForeignCall. *) datatype cTypeForm = CTypeFloatingPt | CTypePointer | CTypeSignedInt | CTypeUnsignedInt | CTypeStruct of cType list | CTypeVoid withtype cType = { typeForm: cTypeForm, align: word, size: word } type abi = Foreign.abi val abiList = Foreign.abiList (* One of the items in the list should be ("default", abi) *) val abiDefault = #2(valOf(List.find(fn ("default", _) => true | _ => false) abiList)) local open Memory in + (* Fixed size int-like types. *) val cTypeInt8 = { size= 0w1, align= 0w1, typeForm = CTypeSignedInt } val cTypeUint8 = { size= 0w1, align= 0w1, typeForm = CTypeUnsignedInt } val cTypeInt16 = { size= 0w2, align= 0w2, typeForm = CTypeSignedInt } val cTypeUint16 = { size= 0w2, align= 0w2, typeForm = CTypeUnsignedInt } val cTypeInt32 = { size= 0w4, align= 0w4, typeForm = CTypeSignedInt } val cTypeUint32 = { size= 0w4, align= 0w4, typeForm = CTypeUnsignedInt } val cTypeInt64 = { size= 0w8, align= 0w8, typeForm = CTypeSignedInt } val cTypeUint64 = { size= 0w8, align= 0w8, typeForm = CTypeUnsignedInt } - val cTypeChar = cTypeInt8 + + val cTypeChar = cTypeInt8 (* Apparently C99 defines sizeof(char) to be 1 *) val cTypeUchar = cTypeUint8 - (* The sizes of these are dependent on the ABI. *) - val cTypeVoid = - { size= #size saVoid, align= #align saVoid, typeForm = CTypeVoid } + + (* Void: doesn't really have a size but GCC treats it as 1. *) + val cTypeVoid = { size= 0w1, align= 0w1, typeForm = CTypeVoid } + (* Pointer - this is the same as the size of SysWord.word. *) val cTypePointer = - { size= #size saPointer, align= #align saPointer, typeForm = CTypePointer } + { size= LibrarySupport.sysWordSize, align= LibrarySupport.sysWordSize, typeForm = CTypePointer } + (* int: always size 4 on X86 but could be different on other platforms. *) val cTypeInt = - { size= #size saSint, align= #align saSint, typeForm = CTypeSignedInt } + { size= #size saInt, align= #align saInt, typeForm = CTypeSignedInt } val cTypeUint = - { size= #size saUint, align= #align saUint, typeForm = CTypeSignedInt } + { size= #size saInt, align= #align saInt, typeForm = CTypeSignedInt } + (* long: 8 bytes on X86/64 Unix but 4 on X86 Windows. *) val cTypeLong = - { size= #size saSlong, align= #align saSlong, typeForm = CTypeSignedInt } + { size= #size saLong, align= #align saLong, typeForm = CTypeSignedInt } val cTypeUlong = - { size= #size saUlong, align= #align saUlong, typeForm = CTypeSignedInt } + { size= #size saLong, align= #align saLong, typeForm = CTypeSignedInt } + (* Float: 4 on X86 *) val cTypeFloat = { size= #size saFloat, align= #align saFloat, typeForm = CTypeFloatingPt } + (* Double: 8 on X86 *) val cTypeDouble = { size= #size saDouble, align= #align saDouble, typeForm = CTypeFloatingPt } fun cStruct(fields: cType list): cType = let (* The total alignment is the maximum alignment of the fields. *) val align = foldl(fn ({align, ...}, a) => Word.max(align, a)) 0w1 fields (* Each field needs to be on its alignment. Finally we round up the size to the total alignment. *) val size = alignUp(foldl(fn ({align, size, ...}, s) => alignUp(s, align) + size) 0w0 fields, align) in {align=align, size=size, typeForm=CTypeStruct fields} end local fun getType (ctype: cType) : ctype = RunCall.unsafeCast ctype val callbackException: unit -> unit = RunCall.rtsCallFast0 "PolyFFICallbackException" in fun callwithAbi (abi: abi) (argTypes: cType list) (resType: cType): symbol -> voidStar * voidStar -> unit = let (* Compile the intermediate function. *) val functionCaller: LargeWord.word * LargeWord.word * LargeWord.word -> unit = (*Foreign.*)foreignCall(abi, List.map getType argTypes, getType resType) (* The result function. *) fun callFunction (fnAddr: unit->voidStar) (args, resMem) = functionCaller(voidStar2Sysword(fnAddr()), voidStar2Sysword args, voidStar2Sysword resMem) in callFunction end fun call x = callwithAbi abiDefault x (* Have to make it a fun to avoid value restriction *) (* Build a call-back function. Returns a function to take the actual ML function, create a callback and then return the address. *) fun cFunctionWithAbi (abi: abi) (argTypes: cType list) (resType: cType) (cbFun: voidStar * voidStar -> unit): voidStar = let fun callBack(args, resMem) = cbFun(sysWord2VoidStar args, sysWord2VoidStar resMem) handle _ => callbackException() val cCallBack = (*Foreign.*)buildCallBack(abi, List.map getType argTypes, getType resType) callBack in sysWord2VoidStar cCallBack end fun cFunction x = cFunctionWithAbi abiDefault x end end end type 'a conversion = { load: Memory.voidStar -> 'a, (* Load a value from C memory *) store: Memory.voidStar * 'a -> unit -> unit, (* Store a value in C memory *) updateML: Memory.voidStar * 'a -> unit, (* Update ML value after call - only used in cStar. *) updateC: Memory.voidStar * 'a -> unit, (* Update C value after callback - only used in cStar. *) ctype: LowLevel.cType } fun makeConversion { load, store, ctype } = { load = load, store = store, ctype = ctype, updateML = fn _ => (), updateC = fn _ => () } fun breakConversion({load, store, ctype, ... }: 'a conversion) = { load = load, store = store, ctype = ctype } (* Conversions *) local open Memory LowLevel fun checkRangeShort(i, min, max) = if i < min orelse i > max then raise Overflow else i fun checkRangeLong(i: LargeInt.int, min, max) = if i < min orelse i > max then raise Overflow else i (* Previously there was a "noFree" function and that was used for the fn _ => () cases. For some reason it wasn't optimised away so explicit fn values are used now. *) in val cVoid: unit conversion = makeConversion{ load=fn _ => (), store=fn _ => fn _ => (), ctype = cTypeVoid } (* cPointer should only be used to base other conversions on. *) val cPointer: voidStar conversion = makeConversion { load=fn a => getAddress(a, 0w0), store=fn(a, v) => (setAddress(a, 0w0, v); fn _ => ()), ctype = cTypePointer } local fun load(m: voidStar): int = Word8.toIntX(get8(m, 0w0)) fun store(m: voidStar, i: int) = (set8(m, 0w0, Word8.fromInt(checkRangeShort(i, ~128, 127))); fn _ => ()) in val cInt8: int conversion = makeConversion { load=load, store=store, ctype = cTypeInt8 } end local (* Char is signed in C but unsigned in ML. *) fun load(m: voidStar): char = Char.chr(Word8.toInt(get8(m, 0w0))) fun store(m: voidStar, i: char) = (set8(m, 0w0, Word8.fromInt(Char.ord i)); fn _ => ()) in val cChar: char conversion = makeConversion{ load=load, store=store, ctype = cTypeChar } end local (* Uchar - convert as Word8.word. *) fun load(m: voidStar): Word8.word = get8(m, 0w0) fun store(m: voidStar, i: Word8.word) = (set8(m, 0w0, i); fn _ => ()) in val cUchar: Word8.word conversion = makeConversion{ load=load, store=store, ctype = cTypeUchar } end local fun load(m: voidStar): int = Word8.toInt(get8(m, 0w0)) fun store(m: voidStar, i: int) = (set8(m, 0w0, Word8.fromInt(checkRangeShort(i, 0, 255))); fn _ => ()) in val cUint8: int conversion = makeConversion{ load=load, store=store, ctype = cTypeUint8 } end local (* Because the word length is greater than the length returned by get16 we have to do something special to get the sign bit correct. That isn't necessary in the other cases. *) fun load(m: voidStar): int = let (* Could be done with shifts *) val r = Word.toInt(get16(m, 0w0)) in if r >= 32768 then r - 65536 else r end fun store(m: voidStar, i: int) = (set16(m, 0w0, Word.fromInt(checkRangeShort(i, ~32768, 32767))); fn _ => ()) in val cInt16: int conversion = makeConversion{ load=load, store=store, ctype = cTypeInt16 } end local fun load(m: voidStar): int = Word.toInt(get16(m, 0w0)) fun store(m: voidStar, i: int) = (set16(m, 0w0, Word.fromInt(checkRangeShort(i, 0, 65535))); fn _ => ()) in val cUint16: int conversion = makeConversion{ load=load, store=store, ctype = cTypeUint16 } end local fun load(m: voidStar): int = Word32.toIntX(get32(m, 0w0)) val checkRange = if wordSize = 0w4 andalso isSome (Int.maxInt) then fn i => i (* We're using fixed precision 31-bit - no check necessary. *) else let (* These will overflow on fixed precision 31-bit. *) val max32 = Int32.toInt(valOf Int32.maxInt) val min32 = ~max32 - 1 in fn i => checkRangeShort(i, min32, max32) end fun store(m: voidStar, i: int) = (set32(m, 0w0, Word32.fromInt(checkRange i)); fn _ => ()) in val cInt32: int conversion = makeConversion{ load=load, store=store, ctype = cTypeInt32 } end local fun load(m: voidStar): LargeInt.int = Word32.toLargeIntX(get32(m, 0w0)) fun store(m: voidStar, i: LargeInt.int) = (set32(m, 0w0, Word32.fromLargeInt(checkRangeLong(i, ~2147483648, 2147483647))); fn _ => ()) in val cInt32Large: LargeInt.int conversion = makeConversion{ load=load, store=store, ctype = cTypeInt32 } end local fun load(m: voidStar): int = Word32.toInt(get32(m, 0w0)) val checkRange = if wordSize = 0w4 andalso isSome (Int.maxInt) then fn i => if i < 0 then raise Overflow else i (* Fixed precision 31-bit *) else let (* This will overflow on fixed precision 31-bit. *) val max32 = Int32.toInt(valOf Int32.maxInt) val max32Unsigned = max32 * 2 + 1 in fn i => checkRangeShort(i, 0, max32Unsigned) end fun store(m: voidStar, i: int) = (set32(m, 0w0, Word32.fromInt(checkRange i)); fn _ => ()) in val cUint32: int conversion = makeConversion{ load=load, store=store, ctype = cTypeUint32 } end local fun load(m: voidStar): LargeInt.int = Word32.toLargeInt(get32(m, 0w0)) fun store(m: voidStar, i: LargeInt.int) = (set32(m, 0w0, Word32.fromLargeInt(checkRangeLong(i, 0, 4294967295))); fn _ => ()) in val cUint32Large: LargeInt.int conversion = makeConversion{ load=load, store=store, ctype = cTypeUint32 } end local fun loadLarge(m: voidStar): LargeInt.int = if sysWordSize = 0w4 then let val v1 = get32(m, 0w0) and v2 = get32(m, 0w1) in if bigEndian then IntInf.<<(Word32.toLargeIntX v1, 0w32) + Word32.toLargeInt v2 else IntInf.<<(Word32.toLargeIntX v2, 0w32) + Word32.toLargeInt v1 end else SysWord.toLargeIntX(get64(m, 0w0)) fun loadShort(m: voidStar): int = if sysWordSize = 0w4 then Int.fromLarge(loadLarge m) else SysWord.toIntX(get64(m, 0w0)) val max = IntInf.<<(1, 0w63) - 1 and min = ~ (IntInf.<<(1, 0w63)) fun storeLarge(m: voidStar, i: LargeInt.int) = if sysWordSize = 0w4 then let val _ = checkRangeLong(i, min, max) val lo = Word32.fromLargeInt i and hi = Word32.fromLargeInt (IntInf.~>>(i, 0w32)) in if bigEndian then (set32(m, 0w0, hi); set32(m, 0w1, lo)) else (set32(m, 0w0, lo); set32(m, 0w1, hi)); fn _ => () end else (set64(m, 0w0, SysWord.fromLargeInt(checkRangeLong(i, min, max))); fn _ => ()) fun storeShort(m: voidStar, i: int) = if sysWordSize = 0w4 orelse not (isSome Int.maxInt) then (* 32-bit or arbitrary precision. *) storeLarge(m, LargeInt.fromInt i) else (* Fixed precision 64-bit - no need for a range check. *) (set64(m, 0w0, SysWord.fromInt i); fn _ => ()) in val cInt64: int conversion = makeConversion{ load=loadShort, store=storeShort, ctype = cTypeInt64 } and cInt64Large: LargeInt.int conversion = makeConversion{ load=loadLarge, store=storeLarge, ctype = cTypeInt64 } end local fun loadLarge(m: voidStar): LargeInt.int = if sysWordSize = 0w4 then let val v1 = get32(m, 0w0) and v2 = get32(m, 0w1) in if bigEndian then IntInf.<<(Word32.toLargeInt v1, 0w32) + Word32.toLargeInt v2 else IntInf.<<(Word32.toLargeInt v2, 0w32) + Word32.toLargeInt v1 end else SysWord.toLargeInt(get64(m, 0w0)) fun loadShort(m: voidStar): int = if wordSize = 0w4 then Int.fromLarge(loadLarge m) else SysWord.toInt(get64(m, 0w0)) val max = IntInf.<<(1, 0w64) - 1 fun storeLarge(m: voidStar, i: LargeInt.int) = if sysWordSize = 0w4 then let val _ = checkRangeLong(i, 0, max) val lo = Word32.fromLargeInt i and hi = Word32.fromLargeInt (IntInf.~>>(i, 0w32)) in if bigEndian then (set32(m, 0w0, hi); set32(m, 0w1, lo)) else (set32(m, 0w0, lo); set32(m, 0w1, hi)); fn _ => () end else (set64(m, 0w0, SysWord.fromLargeInt(checkRangeLong(i, 0, max))); fn _ => ()) fun storeShort(m: voidStar, i: int) = if sysWordSize = 0w4 orelse not (isSome Int.maxInt) then (* 32-bit or arbitrary precision. *) storeLarge(m, LargeInt.fromInt i) else if i < 0 (* Fixed precision 64-bit - just check it's not negative. *) then raise Overflow else (set64(m, 0w0, SysWord.fromInt i); fn _ => ()) in val cUint64: int conversion = makeConversion{ load=loadShort, store=storeShort, ctype = cTypeUint64 } and cUint64Large: LargeInt.int conversion = makeConversion{ load=loadLarge, store=storeLarge, ctype = cTypeUint64 } end local fun load(m: voidStar): real = getFloat(m, 0w0) fun store(m: voidStar, v: real) = (setFloat(m, 0w0, v); fn _ => ()) in val cFloat: real conversion = makeConversion{ load=load, store=store, ctype = cTypeFloat } end local fun load(m: voidStar): real = getDouble(m, 0w0) fun store(m: voidStar, v: real) = (setDouble(m, 0w0, v); fn _ => ()) in val cDouble: real conversion = makeConversion{ load=load, store=store, ctype = cTypeDouble } end val cShort = - if #size saSShort = #size saSint16 then cInt16 - (*else if #size saSShort = #size saSint32 then cInt32*) + if #size saShort = #size (#ctype cInt16) then cInt16 else raise Foreign "Unable to find type for short" val cUshort = - if #size saUShort = #size saUint16 then cUint16 - (*else if #size saUShort = #size saUint32 then cUint32*) + if #size saShort = #size (#ctype cUint16) then cUint16 else raise Foreign "Unable to find type for unsigned" val cInt = - (*if #size saSint = #size saSint16 then cInt16 - else *)if #size saSint = #size saSint32 then cInt32 - else if #size saSint = #size saSint64 then cInt64 + if #size saInt = #size (#ctype cInt32) then cInt32 + else if #size saInt = #size (#ctype cInt64) then cInt64 else raise Foreign "Unable to find type for int" val cIntLarge = - (*if #size saSint = #size saSint16 then cInt16 - else *)if #size saSint = #size saSint32 then cInt32Large - else if #size saSint = #size saSint64 then cInt64Large + if #size saInt = #size (#ctype cInt32Large) then cInt32Large + else if #size saInt = #size (#ctype cInt64Large) then cInt64Large else raise Foreign "Unable to find type for int" val cUint = - (*if #size saUint = #size saUint16 then cUint16 - else *)if #size saUint = #size saUint32 then cUint32 - else if #size saUint = #size saUint64 then cUint64 + if #size saInt = #size (#ctype cUint32) then cUint32 + else if #size saInt = #size (#ctype cUint64) then cUint64 else raise Foreign "Unable to find type for unsigned" val cUintLarge = - (*if #size saUint = #size saUint16 then cUint16 - else *)if #size saUint = #size saUint32 then cUint32Large - else if #size saUint = #size saUint64 then cUint64Large + if #size saInt = #size (#ctype cUint32Large) then cUint32Large + else if #size saInt = #size (#ctype cUint64Large) then cUint64Large else raise Foreign "Unable to find type for unsigned" val cLong = - (*if #size saSlong = #size saSint16 then cInt16 - else *)if #size saSlong = #size saSint32 then cInt32 - else if #size saSlong = #size saSint64 then cInt64 + if #size saLong = #size (#ctype cInt32) then cInt32 + else if #size saLong = #size (#ctype cInt64) then cInt64 else raise Foreign "Unable to find type for long" val cLongLarge = - (*if #size saSlong = #size saSint16 then cInt16 - else *)if #size saSlong = #size saSint32 then cInt32Large - else if #size saSlong = #size saSint64 then cInt64Large + if #size saLong = #size (#ctype cInt32Large) then cInt32Large + else if #size saLong = #size (#ctype cInt64Large) then cInt64Large else raise Foreign "Unable to find type for long" val cUlong = - (*if #size saUlong = #size saUint16 then cUint16 - else *)if #size saUlong = #size saUint32 then cUint32 - else if #size saUlong = #size saUint64 then cUint64 + if #size saLong = #size (#ctype cUint32) then cUint32 + else if #size saLong = #size (#ctype cUint64) then cUint64 else raise Foreign "Unable to find type for unsigned long" val cUlongLarge = - (*if #size saUlong = #size saUint16 then cUint16 - else *)if #size saUlong = #size saUint32 then cUint32Large - else if #size saUlong = #size saUint64 then cUint64Large + if #size saLong = #size (#ctype cUint32Large) then cUint32Large + else if #size saLong = #size (#ctype cUint64Large) then cUint64Large else raise Foreign "Unable to find type for unsigned long" local fun load(s: voidStar): string = let (* The location contains the address of the string. *) val sAddr = getAddress(s, 0w0) fun sLen i = if get8(sAddr, i) = 0w0 then i else sLen(i+0w1) val length = sLen 0w0 fun loadChar i = Char.chr(Word8.toInt(get8(sAddr, Word.fromInt i))) in CharVector.tabulate(Word.toInt length, loadChar) end fun store(v: voidStar, s: string) = let val sLen = Word.fromInt(String.size s) val sMem = malloc(sLen + 0w1) val () = CharVector.appi(fn(i, ch) => set8(sMem, Word.fromInt i, Word8.fromInt(Char.ord ch))) s val () = set8(sMem, sLen, 0w0) in setAddress(v, 0w0, sMem); fn () => Memory.free sMem end in val cString: string conversion = makeConversion { load=load, store=store, ctype = cTypePointer } end (* This is used if we want to pass NULL rather than a pointer in some cases. *) fun cOptionPtr({load, store, updateML, updateC, ctype={typeForm=CTypePointer, ...}}:'a conversion): 'a option conversion = let fun loadOpt(s: voidStar) = if getAddress(s, 0w0) = null then NONE else SOME(load s) fun storeOpt(v: voidStar, NONE) = (setAddress(v, 0w0, null); fn _ => ()) | storeOpt(v: voidStar, SOME s) = store(v, s) (* Do we have update here? *) fun updateMLOpt(_, NONE) = () | updateMLOpt(v: voidStar, SOME s) = updateML(v, s) fun updateCOpt(_, NONE) = () | updateCOpt(v, SOME s) = updateC(v, s) in { load=loadOpt, store=storeOpt, updateML = updateMLOpt, updateC = updateCOpt, ctype = cTypePointer } end | cOptionPtr _ = raise Foreign "cOptionPtr must be applied to a pointer type" local (* Word8Vector.vector to C array of bytes. It is only possible to do this one way because conversion from a C array requires us to know the size. *) fun load _ = raise Foreign "cByteArray cannot convert from C to ML" fun store(v: voidStar, s: Word8Vector.vector) = let open Word8Vector val sLen = Word.fromInt(length s) val sMem = malloc sLen val () = appi(fn(i, b) => set8(sMem, Word.fromInt i, b)) s in setAddress(v, 0w0, sMem); fn () => Memory.free sMem end in val cByteArray: Word8Vector.vector conversion = makeConversion{ load=load, store=store, ctype = cTypePointer } end end (* Remove the free part from the store fn. This is intended for situations where an argument should not be deleted once the function completes. *) fun permanent({load, store, ctype, updateML, updateC }: 'a conversion): 'a conversion = let fun storeP args = (ignore (store args); fn () => ()) in { load=load, store=storeP, updateML = updateML, updateC = updateC, ctype=ctype } end val op ++ = Memory.++ (* structs. These are also used when preparing arguments for function calls. The usual case is to apply these to existing conversions. We want the sizes and alignments to be compile-time constants and that means avoiding folds that will be compiled into loops. *) fun cStruct2(a: 'a conversion, b: 'b conversion): ('a*'b)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ... }} = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ... }} = b val offsetb = alignUp(sizea, alignb) fun load s = (loada s, loadb(s ++ offsetb)) and store (x, (a, b)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) in fn () => ( freea(); freeb() ) end and updateML(s, (a, b)) = (updateMLa(s, a); updateMLb(s ++ offsetb, b)) and updateC(x, (a, b)) = (updateCa(x, a); updateCb(x ++ offsetb, b)) (* These are frequently constants but if we use LowLevel.cStruct we use foldl and that doesn't reduce constants. *) val align = Word.max(aligna, alignb) val size = offsetb + sizeb val ctype = {align=align, size=size, typeForm=LowLevel.CTypeStruct[ctypea, ctypeb]} in {load=load, store=store, updateML = updateML, updateC=updateC, ctype = ctype} end fun cStruct3(a: 'a conversion, b: 'b conversion, c: 'c conversion): ('a*'b*'c)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc)) and store (x, (a, b, c)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) in fn () => ( freea(); freeb(); freec() ) end and updateML(s, (a, b, c)) = (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c)) and updateC(x, (a, b, c)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c)) val align = Word.max(aligna, Word.max(alignb, alignc)) val size = offsetc + sizec val typeForm = LowLevel.CTypeStruct [ctypea, ctypeb, ctypec] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct4(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion): ('a*'b*'c*'d)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd)) and store (x, (a, b, c, d)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) in fn () => ( freea(); freeb(); freec(); freed() ) end and updateML(s, (a, b, c, d)) = (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); updateMLd(s ++ offsetd, d)) and updateC(x, (a, b, c, d)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, alignd))) val size = offsetd + sized val typeForm = LowLevel.CTypeStruct [ctypea, ctypeb, ctypec, ctyped] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct5(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion): ('a*'b*'c*'d*'e)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete)) and store (x, (a, b, c, d, e)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) in fn () => ( freea(); freeb(); freec(); freed(); freee() ) end and updateML(s, (a, b, c, d, e)) = (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); updateMLd(s ++ offsetd, d); updateMLe(s ++ offsete, e)) and updateC(x, (a, b, c, d, e)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, aligne)))) val size = offsete + sizee val typeForm = LowLevel.CTypeStruct [ctypea, ctypeb, ctypec, ctyped, ctypee] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct6(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion): ('a*'b*'c*'d*'e*'f)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf)) and store (x, (a, b, c, d, e, f)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef() ) end and updateML(s, (a, b, c, d, e, f)) = (updateMLa(s, a); updateMLb(s ++ offsetb, b); updateMLc(s ++ offsetc, c); updateMLd(s ++ offsetd, d); updateMLe(s ++ offsete, e); updateMLf(s ++ offsetf, f)) and updateC(x, (a, b, c, d, e, f)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, alignf))))) val size = offsetf + sizef val typeForm = LowLevel.CTypeStruct [ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct7(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion): ('a*'b*'c*'d*'e*'f*'g)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg)) and store (x, (a, b, c, d, e, f, g)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg() ) end and updateML(x, (a, b, c, d, e, f, g)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g)) and updateC(x, (a, b, c, d, e, f, g)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, aligng)))))) val size = offsetg + sizeg val typeForm = LowLevel.CTypeStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct8(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion): ('a*'b*'c*'d*'e*'f*'g*'h)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) val offseth = alignUp(offsetg + sizeg, alignh) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth)) and store (x, (a, b, c, d, e, f, g, h)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh() ) end and updateML(x, (a, b, c, d, e, f, g, h)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); updateMLh(x ++ offseth, h)) and updateC(x, (a, b, c, d, e, f, g, h)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); updateCh(x ++ offseth, h)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, Word.max(aligng, alignh))))))) val size = offseth + sizeh val typeForm = LowLevel.CTypeStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct9(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, i: 'i conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) val offseth = alignUp(offsetg + sizeg, alignh) val offseti = alignUp(offseth + sizeh, aligni) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth), loadi(s ++ offseti)) and store (x, (a, b, c, d, e, f, g, h, i)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei() ) end and updateML(x, (a, b, c, d, e, f, g, h, i)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i)) and updateC(x, (a, b, c, d, e, f, g, h, i)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); updateCh(x ++ offseth, h); updateCi(x ++ offseti, i)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, Word.max(aligng, Word.max(alignh, aligni)))))))) val size = offseti + sizei val typeForm = LowLevel.CTypeStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct10(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, i: 'i conversion, j: 'j conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) val offseth = alignUp(offsetg + sizeg, alignh) val offseti = alignUp(offseth + sizeh, aligni) val offsetj = alignUp(offseti + sizei, alignj) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj)) and store (x, (a, b, c, d, e, f, g, h, i, j)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) and freej = storej(x ++ offsetj, j) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei(); freej() ) end and updateML(x, (a, b, c, d, e, f, g, h, i, j)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j)) and updateC(x, (a, b, c, d, e, f, g, h, i, j)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, Word.max(aligng, Word.max(alignh, Word.max(aligni, alignj))))))))) val size = offsetj + sizej val typeForm = LowLevel.CTypeStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct11(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, i: 'i conversion, j: 'j conversion, k: 'k conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) val offseth = alignUp(offsetg + sizeg, alignh) val offseti = alignUp(offseth + sizeh, aligni) val offsetj = alignUp(offseti + sizei, alignj) val offsetk = alignUp(offsetj + sizej, alignk) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), loadk(s ++ offsetk)) and store (x, (a, b, c, d, e, f, g, h, i, j, k)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei(); freej(); freek() ) end and updateML(x, (a, b, c, d, e, f, g, h, i, j, k)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); updateMLk(x ++ offsetk, k)) and updateC(x, (a, b, c, d, e, f, g, h, i, j, k)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); updateCk(x ++ offsetk, k)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, Word.max(aligng, Word.max(alignh, Word.max(aligni, Word.max(alignj, alignk)))))))))) val size = offsetk + sizek val typeForm = LowLevel.CTypeStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, ctypek] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct12(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) val offseth = alignUp(offsetg + sizeg, alignh) val offseti = alignUp(offseth + sizeh, aligni) val offsetj = alignUp(offseti + sizei, alignj) val offsetk = alignUp(offsetj + sizej, alignk) val offsetl = alignUp(offsetk + sizek, alignl) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), loadk(s ++ offsetk), loadl(s ++ offsetl)) and store (x, (a, b, c, d, e, f, g, h, i, j, k, l)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei(); freej(); freek(); freel() ) end and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l)) and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, Word.max(aligng, Word.max(alignh, Word.max(aligni, Word.max(alignj, Word.max(alignk, alignl))))))))))) val size = offsetl + sizel val typeForm = LowLevel.CTypeStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, ctypek, ctypel] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct13(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, m: 'm conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) val offseth = alignUp(offsetg + sizeg, alignh) val offseti = alignUp(offseth + sizeh, aligni) val offsetj = alignUp(offseti + sizei, alignj) val offsetk = alignUp(offsetj + sizej, alignk) val offsetl = alignUp(offsetk + sizek, alignl) val offsetm = alignUp(offsetl + sizel, alignm) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm)) and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) and freem = storem(x ++ offsetm, m) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei(); freej(); freek(); freel(); freem() ) end and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m)) and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, Word.max(aligng, Word.max(alignh, Word.max(aligni, Word.max(alignj, Word.max(alignk, Word.max(alignl, alignm)))))))))))) val size = offsetm + sizem val typeForm = LowLevel.CTypeStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, ctypek, ctypel, ctypem] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end nonfix o fun cStruct14(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, m: 'm conversion, n: 'n conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) val offseth = alignUp(offsetg + sizeg, alignh) val offseti = alignUp(offseth + sizeh, aligni) val offsetj = alignUp(offseti + sizei, alignj) val offsetk = alignUp(offsetj + sizej, alignk) val offsetl = alignUp(offsetk + sizek, alignl) val offsetm = alignUp(offsetl + sizel, alignm) val offsetn = alignUp(offsetm + sizem, alignn) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), loadn(s ++ offsetn)) and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei(); freej(); freek(); freel(); freem(); freen() ) end and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); updateMLn(x ++ offsetn, n)) and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); updateCn(x ++ offsetn, n)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, Word.max(aligng, Word.max(alignh, Word.max(aligni, Word.max(alignj, Word.max(alignk, Word.max(alignl, Word.max(alignm, alignn))))))))))))) val size = offsetn + sizen val typeForm = LowLevel.CTypeStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, ctypek, ctypel, ctypem, ctypen] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct15(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, m: 'm conversion, n: 'n conversion, o: 'o conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) val offseth = alignUp(offsetg + sizeg, alignh) val offseti = alignUp(offseth + sizeh, aligni) val offsetj = alignUp(offseti + sizei, alignj) val offsetk = alignUp(offsetj + sizej, alignk) val offsetl = alignUp(offsetk + sizek, alignl) val offsetm = alignUp(offsetl + sizel, alignm) val offsetn = alignUp(offsetm + sizem, alignn) val offseto = alignUp(offsetn + sizen, aligno) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), loadn(s ++ offsetn), loado(s ++ offseto)) and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei(); freej(); freek(); freel(); freem(); freen(); freeo() ) end and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o)) and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, Word.max(aligng, Word.max(alignh, Word.max(aligni, Word.max(alignj, Word.max(alignk, Word.max(alignl, Word.max(alignm, Word.max(alignn, aligno)))))))))))))) val size = offseto + sizeo val typeForm = LowLevel.CTypeStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, ctypek, ctypel, ctypem, ctypen, ctypeo] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct16(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {size=sizep, align=alignp, ...} } = p val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) val offseth = alignUp(offsetg + sizeg, alignh) val offseti = alignUp(offseth + sizeh, aligni) val offsetj = alignUp(offseti + sizei, alignj) val offsetk = alignUp(offsetj + sizej, alignk) val offsetl = alignUp(offsetk + sizek, alignl) val offsetm = alignUp(offsetl + sizel, alignm) val offsetn = alignUp(offsetm + sizem, alignn) val offseto = alignUp(offsetn + sizen, aligno) val offsetp = alignUp(offseto + sizeo, alignp) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp)) and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) and freep = storep(x ++ offsetp, p) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei(); freej(); freek(); freel(); freem(); freen(); freeo(); freep() ) end and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p)) and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, Word.max(aligng, Word.max(alignh, Word.max(aligni, Word.max(alignj, Word.max(alignk, Word.max(alignl, Word.max(alignm, Word.max(alignn, Word.max(aligno, alignp))))))))))))))) val size = offsetp + sizep val typeForm = LowLevel.CTypeStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct17(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion, q: 'q conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {size=sizep, align=alignp, ...} } = p and {load=loadq, store=storeq, updateML=updateMLq, updateC=updateCq, ctype = ctypeq as {size=sizeq, align=alignq, ...} } = q val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) val offseth = alignUp(offsetg + sizeg, alignh) val offseti = alignUp(offseth + sizeh, aligni) val offsetj = alignUp(offseti + sizei, alignj) val offsetk = alignUp(offsetj + sizej, alignk) val offsetl = alignUp(offsetk + sizek, alignl) val offsetm = alignUp(offsetl + sizel, alignm) val offsetn = alignUp(offsetm + sizem, alignn) val offseto = alignUp(offsetn + sizen, aligno) val offsetp = alignUp(offseto + sizeo, alignp) val offsetq = alignUp(offsetp + sizep, alignq) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp), loadq(s ++ offsetq)) and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) and freep = storep(x ++ offsetp, p) and freeq = storeq(x ++ offsetq, q) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei(); freej(); freek(); freel(); freem(); freen(); freeo(); freep(); freeq() ) end and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p); updateMLq(x ++ offsetq, q)) and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p); updateCq(x ++ offsetq, q)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, Word.max(aligng, Word.max(alignh, Word.max(aligni, Word.max(alignj, Word.max(alignk, Word.max(alignl, Word.max(alignm, Word.max(alignn, Word.max(aligno, Word.max(alignp, alignq)))))))))))))))) val size = offsetq + sizeq val typeForm = LowLevel.CTypeStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep, ctypeq] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct18(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion, q: 'q conversion, r: 'r conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {size=sizep, align=alignp, ...} } = p and {load=loadq, store=storeq, updateML=updateMLq, updateC=updateCq, ctype = ctypeq as {size=sizeq, align=alignq, ...} } = q and {load=loadr, store=storer, updateML=updateMLr, updateC=updateCr, ctype = ctyper as {size=sizer, align=alignr, ...} } = r val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) val offseth = alignUp(offsetg + sizeg, alignh) val offseti = alignUp(offseth + sizeh, aligni) val offsetj = alignUp(offseti + sizei, alignj) val offsetk = alignUp(offsetj + sizej, alignk) val offsetl = alignUp(offsetk + sizek, alignl) val offsetm = alignUp(offsetl + sizel, alignm) val offsetn = alignUp(offsetm + sizem, alignn) val offseto = alignUp(offsetn + sizen, aligno) val offsetp = alignUp(offseto + sizeo, alignp) val offsetq = alignUp(offsetp + sizep, alignq) val offsetr = alignUp(offsetq + sizeq, alignr) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp), loadq(s ++ offsetq), loadr(s ++ offsetr)) and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) and freep = storep(x ++ offsetp, p) and freeq = storeq(x ++ offsetq, q) and freer = storer(x ++ offsetr, r) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei(); freej(); freek(); freel(); freem(); freen(); freeo(); freep(); freeq(); freer() ) end and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p); updateMLq(x ++ offsetq, q); updateMLr(x ++ offsetr, r)) and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p); updateCq(x ++ offsetq, q); updateCr(x ++ offsetr, r)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, Word.max(aligng, Word.max(alignh, Word.max(aligni, Word.max(alignj, Word.max(alignk, Word.max(alignl, Word.max(alignm, Word.max(alignn, Word.max(aligno, Word.max(alignp, Word.max(alignq, alignr))))))))))))))))) val size = offsetr + sizer val typeForm = LowLevel.CTypeStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep, ctypeq, ctyper] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct19(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion, q: 'q conversion, r: 'r conversion, s: 's conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r*'s)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {size=sizep, align=alignp, ...} } = p and {load=loadq, store=storeq, updateML=updateMLq, updateC=updateCq, ctype = ctypeq as {size=sizeq, align=alignq, ...} } = q and {load=loadr, store=storer, updateML=updateMLr, updateC=updateCr, ctype = ctyper as {size=sizer, align=alignr, ...} } = r and {load=loads, store=stores, updateML=updateMLs, updateC=updateCs, ctype = ctypes as {size=sizes, align=aligns, ...} } = s val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) val offseth = alignUp(offsetg + sizeg, alignh) val offseti = alignUp(offseth + sizeh, aligni) val offsetj = alignUp(offseti + sizei, alignj) val offsetk = alignUp(offsetj + sizej, alignk) val offsetl = alignUp(offsetk + sizek, alignl) val offsetm = alignUp(offsetl + sizel, alignm) val offsetn = alignUp(offsetm + sizem, alignn) val offseto = alignUp(offsetn + sizen, aligno) val offsetp = alignUp(offseto + sizeo, alignp) val offsetq = alignUp(offsetp + sizep, alignq) val offsetr = alignUp(offsetq + sizeq, alignr) val offsets = alignUp(offsetr + sizer, aligns) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp), loadq(s ++ offsetq), loadr(s ++ offsetr), loads(s ++ offsets)) and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) and freep = storep(x ++ offsetp, p) and freeq = storeq(x ++ offsetq, q) and freer = storer(x ++ offsetr, r) and frees = stores(x ++ offsets, s) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei(); freej(); freek(); freel(); freem(); freen(); freeo(); freep(); freeq(); freer(); frees() ) end and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p); updateMLq(x ++ offsetq, q); updateMLr(x ++ offsetr, r); updateMLs(x ++ offsets, s)) and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p); updateCq(x ++ offsetq, q); updateCr(x ++ offsetr, r); updateCs(x ++ offsets, s)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, Word.max(aligng, Word.max(alignh, Word.max(aligni, Word.max(alignj, Word.max(alignk, Word.max(alignl, Word.max(alignm, Word.max(alignn, Word.max(aligno, Word.max(alignp, Word.max(alignq, Word.max(alignr, aligns)))))))))))))))))) val size = offsets + sizes val typeForm = LowLevel.CTypeStruct [ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep, ctypeq, ctyper, ctypes] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end fun cStruct20(a: 'a conversion, b: 'b conversion, c: 'c conversion, d: 'd conversion, e: 'e conversion, f: 'f conversion, g: 'g conversion, h: 'h conversion, i: 'i conversion, j: 'j conversion, k: 'k conversion, l: 'l conversion, m: 'm conversion, n: 'n conversion, o: 'o conversion, p: 'p conversion, q: 'q conversion, r: 'r conversion, s: 's conversion, t: 't conversion): ('a*'b*'c*'d*'e*'f*'g*'h*'i*'j*'k*'l*'m*'n*'o*'p*'q*'r*'s*'t)conversion = let val {load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype = ctypea as {size=sizea, align=aligna, ...} } = a and {load=loadb, store=storeb, updateML=updateMLb, updateC=updateCb, ctype = ctypeb as {size=sizeb, align=alignb, ...} } = b and {load=loadc, store=storec, updateML=updateMLc, updateC=updateCc, ctype = ctypec as {size=sizec, align=alignc, ...} } = c and {load=loadd, store=stored, updateML=updateMLd, updateC=updateCd, ctype = ctyped as {size=sized, align=alignd, ...} } = d and {load=loade, store=storee, updateML=updateMLe, updateC=updateCe, ctype = ctypee as {size=sizee, align=aligne, ...} } = e and {load=loadf, store=storef, updateML=updateMLf, updateC=updateCf, ctype = ctypef as {size=sizef, align=alignf, ...} } = f and {load=loadg, store=storeg, updateML=updateMLg, updateC=updateCg, ctype = ctypeg as {size=sizeg, align=aligng, ...} } = g and {load=loadh, store=storeh, updateML=updateMLh, updateC=updateCh, ctype = ctypeh as {size=sizeh, align=alignh, ...} } = h and {load=loadi, store=storei, updateML=updateMLi, updateC=updateCi, ctype = ctypei as {size=sizei, align=aligni, ...} } = i and {load=loadj, store=storej, updateML=updateMLj, updateC=updateCj, ctype = ctypej as {size=sizej, align=alignj, ...} } = j and {load=loadk, store=storek, updateML=updateMLk, updateC=updateCk, ctype = ctypek as {size=sizek, align=alignk, ...} } = k and {load=loadl, store=storel, updateML=updateMLl, updateC=updateCl, ctype = ctypel as {size=sizel, align=alignl, ...} } = l and {load=loadm, store=storem, updateML=updateMLm, updateC=updateCm, ctype = ctypem as {size=sizem, align=alignm, ...} } = m and {load=loadn, store=storen, updateML=updateMLn, updateC=updateCn, ctype = ctypen as {size=sizen, align=alignn, ...} } = n and {load=loado, store=storeo, updateML=updateMLo, updateC=updateCo, ctype = ctypeo as {size=sizeo, align=aligno, ...} } = o and {load=loadp, store=storep, updateML=updateMLp, updateC=updateCp, ctype = ctypep as {size=sizep, align=alignp, ...} } = p and {load=loadq, store=storeq, updateML=updateMLq, updateC=updateCq, ctype = ctypeq as {size=sizeq, align=alignq, ...} } = q and {load=loadr, store=storer, updateML=updateMLr, updateC=updateCr, ctype = ctyper as {size=sizer, align=alignr, ...} } = r and {load=loads, store=stores, updateML=updateMLs, updateC=updateCs, ctype = ctypes as {size=sizes, align=aligns, ...} } = s and {load=loadt, store=storet, updateML=updateMLt, updateC=updateCt, ctype = ctypet as {size=sizet, align=alignt, ...} } = t val offsetb = alignUp(sizea, alignb) val offsetc = alignUp(offsetb + sizeb, alignc) val offsetd = alignUp(offsetc + sizec, alignd) val offsete = alignUp(offsetd + sized, aligne) val offsetf = alignUp(offsete + sizee, alignf) val offsetg = alignUp(offsetf + sizef, aligng) val offseth = alignUp(offsetg + sizeg, alignh) val offseti = alignUp(offseth + sizeh, aligni) val offsetj = alignUp(offseti + sizei, alignj) val offsetk = alignUp(offsetj + sizej, alignk) val offsetl = alignUp(offsetk + sizek, alignl) val offsetm = alignUp(offsetl + sizel, alignm) val offsetn = alignUp(offsetm + sizem, alignn) val offseto = alignUp(offsetn + sizen, aligno) val offsetp = alignUp(offseto + sizeo, alignp) val offsetq = alignUp(offsetp + sizep, alignq) val offsetr = alignUp(offsetq + sizeq, alignr) val offsets = alignUp(offsetr + sizer, aligns) val offsett = alignUp(offsets + sizes, alignt) fun load s = (loada s, loadb(s ++ offsetb), loadc(s ++ offsetc), loadd(s ++ offsetd), loade(s ++ offsete), loadf(s ++ offsetf), loadg(s ++ offsetg), loadh(s ++ offseth), loadi(s ++ offseti), loadj(s ++ offsetj), loadk(s ++ offsetk), loadl(s ++ offsetl), loadm(s ++ offsetm), loadn(s ++ offsetn), loado(s ++ offseto), loadp(s ++ offsetp), loadq(s ++ offsetq), loadr(s ++ offsetr), loads(s ++ offsets), loadt(s ++ offsett)) and store (x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)) = let val freea = storea(x, a) and freeb = storeb(x ++ offsetb, b) and freec = storec(x ++ offsetc, c) and freed = stored(x ++ offsetd, d) and freee = storee(x ++ offsete, e) and freef = storef(x ++ offsetf, f) and freeg = storeg(x ++ offsetg, g) and freeh = storeh(x ++ offseth, h) and freei = storei(x ++ offseti, i) and freej = storej(x ++ offsetj, j) and freek = storek(x ++ offsetk, k) and freel = storel(x ++ offsetl, l) and freem = storem(x ++ offsetm, m) and freen = storen(x ++ offsetn, n) and freeo = storeo(x ++ offseto, o) and freep = storep(x ++ offsetp, p) and freeq = storeq(x ++ offsetq, q) and freer = storer(x ++ offsetr, r) and frees = stores(x ++ offsets, s) and freet = storet(x ++ offsett, t) in fn () => ( freea(); freeb(); freec(); freed(); freee(); freef(); freeg(); freeh(); freei(); freej(); freek(); freel(); freem(); freen(); freeo(); freep(); freeq(); freer(); frees(); freet() ) end and updateML(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)) = (updateMLa(x, a); updateMLb(x ++ offsetb, b); updateMLc(x ++ offsetc, c); updateMLd(x ++ offsetd, d); updateMLe(x ++ offsete, e); updateMLf(x ++ offsetf, f); updateMLg(x ++ offsetg, g); updateMLh(x ++ offseth, h); updateMLi(x ++ offseti, i); updateMLj(x ++ offsetj, j); updateMLk(x ++ offsetk, k); updateMLl(x ++ offsetl, l); updateMLm(x ++ offsetm, m); updateMLn(x ++ offsetn, n); updateMLo(x ++ offseto, o); updateMLp(x ++ offsetp, p); updateMLq(x ++ offsetq, q); updateMLr(x ++ offsetr, r); updateMLs(x ++ offsets, s); updateMLt(x ++ offsett, t)) and updateC(x, (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o, p, q, r, s, t)) = (updateCa(x, a); updateCb(x ++ offsetb, b); updateCc(x ++ offsetc, c); updateCd(x ++ offsetd, d); updateCe(x ++ offsete, e); updateCf(x ++ offsetf, f); updateCg(x ++ offsetg, g); updateCh(x ++ offseth, h); updateCi(x ++ offseti, i); updateCj(x ++ offsetj, j); updateCk(x ++ offsetk, k); updateCl(x ++ offsetl, l); updateCm(x ++ offsetm, m); updateCn(x ++ offsetn, n); updateCo(x ++ offseto, o); updateCp(x ++ offsetp, p); updateCq(x ++ offsetq, q); updateCr(x ++ offsetr, r); updateCs(x ++ offsets, s); updateCt(x ++ offsett, t)) val align = Word.max(aligna, Word.max(alignb, Word.max(alignc, Word.max(alignd, Word.max(aligne, Word.max(alignf, Word.max(aligng, Word.max(alignh, Word.max(aligni, Word.max(alignj, Word.max(alignk, Word.max(alignl, Word.max(alignm, Word.max(alignn, Word.max(aligno, Word.max(alignp, Word.max(alignq, Word.max(alignr, Word.max(aligns, alignt))))))))))))))))))) val size = offsett + sizet val typeForm = LowLevel.CTypeStruct[ctypea, ctypeb, ctypec, ctyped, ctypee, ctypef, ctypeg, ctypeh, ctypei, ctypej, ctypek, ctypel, ctypem, ctypen, ctypeo, ctypep, ctypeq, ctyper, ctypes, ctypet] val ctype = {align=align, size=size, typeForm=typeForm} in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = ctype} end (* Conversion for call-by-reference. *) local open Memory LowLevel in fun cStar({load=loada, store=storea, ctype=ctypea, ...}: 'a conversion): 'a ref conversion = let fun store(m, ref s) = let (* When we pass a ref X into a cStar cX function we need to allocate a memory cell big enough for a cX value. Then we copy the current value of the ML into this. We set the argument, a pointer, to the address of the cell. *) val mem = malloc(#size ctypea) val () = setAddress(m, 0w0, mem) val freea = storea(mem, s) in fn () => (free mem; freea()) end (* Called to update the ML value when the C . *) fun updateML(m, s) = s := loada(getAddress(m, 0w0)) (* Used when an ML callback receives a cStar argument. *) fun load s = ref(loada(getAddress(s, 0w0))) (* Used when a callback has returned to update the C value. If storea allocates then there's nothing we can do. *) fun updateC(m, ref s) = ignore(storea(getAddress(m, 0w0), s)) in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = cTypePointer} end (* Similar to cStar but without the need to update the result. *) fun cConstStar({load=loada, store=storea, updateML=updateMLa, updateC=updateCa, ctype=ctypea}: 'a conversion): 'a conversion = let fun load s = loada(getAddress(s, 0w0)) fun store(m, s) = let val mem = malloc(#size ctypea) val () = setAddress(m, 0w0, mem) val freea = storea(mem, s) in fn () => (free mem; freea()) end (* Do we have to do anything here? Could we pass a const pointer to a structure with variable fields? *) fun updateML(m, s) = updateMLa(getAddress(m, 0w0), s) and updateC(m, s) = updateCa(getAddress(m, 0w0), s) in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = cTypePointer} end (* Fixed size vector. It is treated as a struct and passed by value or embedded in a structure. *) fun cVectorFixedSize(n, {load=loadEl, store=storeEl, updateML=updateMLel, updateC=updateCel, ctype=ctypeEl as {size=sizeEl, align=alignEl, ...}, ...}: 'a conversion) : 'a vector conversion = let val arraySize = sizeEl * Word.fromInt n val ffiTypeArray = LowLevel.CTypeStruct(List.tabulate (n, fn _ => ctypeEl)) val arrayType = { size = arraySize, align = alignEl, typeForm = ffiTypeArray } fun load(v: voidStar): 'a vector = Vector.tabulate(n, fn i => loadEl(v ++ Word.fromInt i)) fun store(v: voidStar, s: 'a vector) = let val sLen = Vector.length s val _ = sLen <= n orelse raise Foreign "vector too long" (* Store the values. Make a list of the free fns in case they allocate *) val frees = Vector.foldli(fn(i, el, l) => storeEl(v ++ Word.fromInt i, el) :: l) [] s; in fn () => List.app (fn f => f()) frees end (* If we have a ref in here we need to update *) fun updateML(v, s) = Vector.appi(fn (i, el) => updateMLel(v ++ Word.fromInt i, el)) s and updateC(v, s) = Vector.appi(fn (i, el) => updateCel(v ++ Word.fromInt i, el)) s in { load = load, store = store, updateML=updateML, updateC=updateC, ctype = arrayType } end (* Pass an ML vector as a pointer to a C array. *) fun cVectorPointer ({store=storeEl, updateML=updateMLel, ctype={size=sizeEl, ...}, ...}: 'a conversion) : 'a vector conversion = let (* We can't determine the size so can't construct a suitable ML value. *) fun load _ = raise Foreign "Cannot return a cVectorPointer from C to ML" fun store(m, s) = let val mem = malloc(sizeEl * Word.fromInt(Vector.length s)) val () = setAddress(m, 0w0, mem) (* Store the values. Make a list of the free fns in case they allocate *) val frees = Vector.foldli(fn(i, el, l) => storeEl(mem ++ (sizeEl * Word.fromInt i), el) :: l) [] s; in fn () => (List.app (fn f => f()) frees; free mem) end (* This is only appropriate if the elements are refs. *) fun updateML(v, s) = let val addr = getAddress(v, 0w0) in Vector.appi(fn (i, el) => updateMLel(addr ++ (sizeEl * Word.fromInt i), el)) s end (* updateC can't actually be used because we can't load a suitable value *) and updateC _ = raise Foreign "Cannot return a cVectorPointer from C to ML" in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = cTypePointer} end (* Pass an ML array as a pointer to a C array and, on return, update each element of the ML array from the C array. *) fun cArrayPointer ({load=loadEl, store=storeEl, ctype={size=sizeEl, ...}, ...}: 'a conversion) : 'a array conversion = let (* We can't determine the size so can't construct a suitable ML value. *) fun load _ = raise Foreign "Cannot return a cArrayPointer from C to ML" fun store(m, s) = let val mem = malloc(sizeEl * Word.fromInt(Array.length s)) val () = setAddress(m, 0w0, mem) (* Store the values. Make a list of the free fns in case they allocate *) val frees = Array.foldli(fn(i, el, l) => storeEl(mem ++ (sizeEl * Word.fromInt i), el) :: l) [] s; in fn () => (List.app (fn f => f()) frees; free mem) end (* updateML is used after a C function returns. It needs to update each element. *) fun updateML(v, s) = let val addr = getAddress(v, 0w0) in Array.modifyi(fn (i, _) => loadEl(addr ++ (sizeEl * Word.fromInt i))) s end (* updateC can't actually be used because we can't load a suitable value *) and updateC _ = raise Foreign "Cannot return a cArrayPointer from C to ML" in {load=load, store=store, updateML=updateML, updateC=updateC, ctype = cTypePointer} end end (* Calls with conversion. *) (* Note: it may be possible to have general functions to compute offsets but we don't do that because this way the compiler can compute the offsets as constants during inline expansion. *) local open Memory LowLevel fun buildCall(argConv, resConv, callF) = let val { ctype = resType, load = resLoad, ...} = resConv val { store=storeArgs, ctype={size=argSize, ...}, updateML=updateArgs, ...} = argConv val resultOffset = alignUp(argSize, #align resType) val argResSpace = resultOffset + #size resType in fn mlArgs => alloca(argResSpace, fn rMem => let val freeArgs = storeArgs(rMem, mlArgs) val resultAddr = rMem++resultOffset in let val () = callF(rMem, resultAddr) val result = resLoad resultAddr in updateArgs(rMem, mlArgs); freeArgs(); result end handle exn => (freeArgs(); raise exn) end) end in fun buildCall0withAbi(abi: abi, fnAddr, (), {ctype = resType, load= resLoad, ...} : 'a conversion): unit->'a = let val callF = callwithAbi abi [] resType fnAddr in fn () => alloca(#size resType, fn rMem => (callF(Memory.null, rMem); resLoad rMem)) end fun buildCall0(symbol, argTypes, resType) = buildCall0withAbi (abiDefault, symbol, argTypes, resType) fun buildCall1withAbi (abi: abi, fnAddr, { ctype = argType, store = argStore, updateML = argUpdate, ...}: 'a conversion, { ctype = resType, load= resLoad, ...}: 'b conversion): 'a ->'b = let val callF = callwithAbi abi [argType] resType fnAddr (* Allocate space for argument and result. *) val argOffset = alignUp(#size resType, #align argType) val argSpace = argOffset + #size argType in fn x => alloca(argSpace, fn rMem => let val argAddr = rMem ++ argOffset val freea = argStore (argAddr, x) in let val () = callF(argAddr, rMem) val result = resLoad rMem in argUpdate (argAddr, x); freea (); result end handle exn => (freea(); raise exn) end) end fun buildCall1(symbol, argTypes, resType) = buildCall1withAbi (abiDefault, symbol, argTypes, resType) fun buildCall2withAbi (abi: abi, fnAddr, (arg1Conv: 'a conversion, arg2Conv: 'b conversion), resConv: 'c conversion): 'a * 'b -> 'c = let val callF = callwithAbi abi [#ctype arg1Conv, #ctype arg2Conv] (#ctype resConv) fnAddr val argConv = cStruct2(arg1Conv, arg2Conv) in buildCall(argConv, resConv, callF) end fun buildCall2(symbol, argTypes, resType) = buildCall2withAbi (abiDefault, symbol, argTypes, resType) fun buildCall3withAbi (abi: abi, fnAddr, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion), resConv: 'd conversion): 'a * 'b *'c -> 'd = let val callF = callwithAbi abi [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv] (#ctype resConv) fnAddr val argConv = cStruct3(arg1Conv, arg2Conv, arg3Conv) in buildCall(argConv, resConv, callF) end fun buildCall3(symbol, argTypes, resType) = buildCall3withAbi (abiDefault, symbol, argTypes, resType) fun buildCall4withAbi (abi: abi, fnAddr, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion), resConv: 'e conversion): 'a * 'b *'c * 'd -> 'e = let val callF = callwithAbi abi [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv] (#ctype resConv) fnAddr val argConv = cStruct4(arg1Conv, arg2Conv, arg3Conv, arg4Conv) in buildCall(argConv, resConv, callF) end fun buildCall4(symbol, argTypes, resType) = buildCall4withAbi (abiDefault, symbol, argTypes, resType) fun buildCall5withAbi (abi: abi, fnAddr, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion, arg5Conv: 'e conversion), resConv: 'f conversion): 'a * 'b *'c * 'd * 'e -> 'f = let val callF = callwithAbi abi [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv, #ctype arg5Conv] (#ctype resConv) fnAddr val argConv = cStruct5(arg1Conv, arg2Conv, arg3Conv, arg4Conv, arg5Conv) in buildCall(argConv, resConv, callF) end fun buildCall5(symbol, argTypes, resType) = buildCall5withAbi (abiDefault, symbol, argTypes, resType) fun buildCall6withAbi (abi: abi, fnAddr, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion, arg5Conv: 'e conversion, arg6Conv: 'f conversion), resConv: 'g conversion): 'a * 'b *'c * 'd * 'e * 'f -> 'g = let val callF = callwithAbi abi [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv, #ctype arg5Conv, #ctype arg6Conv] (#ctype resConv) fnAddr val argConv = cStruct6(arg1Conv, arg2Conv, arg3Conv, arg4Conv, arg5Conv, arg6Conv) in buildCall(argConv, resConv, callF) end fun buildCall6(symbol, argTypes, resType) = buildCall6withAbi (abiDefault, symbol, argTypes, resType) fun buildCall7withAbi (abi: abi, fnAddr, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion, arg5Conv: 'e conversion, arg6Conv: 'f conversion, arg7Conv: 'g conversion), resConv: 'h conversion): 'a * 'b *'c * 'd * 'e * 'f * 'g -> 'h = let val callF = callwithAbi abi [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv, #ctype arg5Conv, #ctype arg6Conv, #ctype arg7Conv] (#ctype resConv) fnAddr val argConv = cStruct7(arg1Conv, arg2Conv, arg3Conv, arg4Conv, arg5Conv, arg6Conv, arg7Conv) in buildCall(argConv, resConv, callF) end fun buildCall7(symbol, argTypes, resType) = buildCall7withAbi (abiDefault, symbol, argTypes, resType) fun buildCall8withAbi (abi: abi, fnAddr, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion, arg5Conv: 'e conversion, arg6Conv: 'f conversion, arg7Conv: 'g conversion, arg8Conv: 'h conversion), resConv: 'i conversion): 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h -> 'i = let val callF = callwithAbi abi [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv, #ctype arg5Conv, #ctype arg6Conv, #ctype arg7Conv, #ctype arg8Conv] (#ctype resConv) fnAddr val argConv = cStruct8(arg1Conv, arg2Conv, arg3Conv, arg4Conv, arg5Conv, arg6Conv, arg7Conv, arg8Conv) in buildCall(argConv, resConv, callF) end fun buildCall8(symbol, argTypes, resType) = buildCall8withAbi (abiDefault, symbol, argTypes, resType) fun buildCall9withAbi (abi: abi, fnAddr, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion, arg5Conv: 'e conversion, arg6Conv: 'f conversion, arg7Conv: 'g conversion, arg8Conv: 'h conversion, arg9Conv: 'i conversion), resConv: 'j conversion): 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i -> 'j = let val callF = callwithAbi abi [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv, #ctype arg5Conv, #ctype arg6Conv, #ctype arg7Conv, #ctype arg8Conv, #ctype arg9Conv] (#ctype resConv) fnAddr val argConv = cStruct9(arg1Conv, arg2Conv, arg3Conv, arg4Conv, arg5Conv, arg6Conv, arg7Conv, arg8Conv, arg9Conv) in buildCall(argConv, resConv, callF) end fun buildCall9(symbol, argTypes, resType) = buildCall9withAbi (abiDefault, symbol, argTypes, resType) fun buildCall10withAbi (abi: abi, fnAddr, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion, arg5Conv: 'e conversion, arg6Conv: 'f conversion, arg7Conv: 'g conversion, arg8Conv: 'h conversion, arg9Conv: 'i conversion, arg10Conv: 'j conversion), resConv: 'k conversion): 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j -> 'k = let val callF = callwithAbi abi [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv, #ctype arg5Conv, #ctype arg6Conv, #ctype arg7Conv, #ctype arg8Conv, #ctype arg9Conv, #ctype arg10Conv] (#ctype resConv) fnAddr val argConv = cStruct10(arg1Conv, arg2Conv, arg3Conv, arg4Conv, arg5Conv, arg6Conv, arg7Conv, arg8Conv, arg9Conv, arg10Conv) in buildCall(argConv, resConv, callF) end fun buildCall10(symbol, argTypes, resType) = buildCall10withAbi (abiDefault, symbol, argTypes, resType) fun buildCall11withAbi (abi: abi, fnAddr, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion, arg5Conv: 'e conversion, arg6Conv: 'f conversion, arg7Conv: 'g conversion, arg8Conv: 'h conversion, arg9Conv: 'i conversion, arg10Conv: 'j conversion, arg11Conv: 'k conversion), resConv: 'l conversion): 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k -> 'l = let val callF = callwithAbi abi [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv, #ctype arg5Conv, #ctype arg6Conv, #ctype arg7Conv, #ctype arg8Conv, #ctype arg9Conv, #ctype arg10Conv, #ctype arg11Conv] (#ctype resConv) fnAddr val argConv = cStruct11(arg1Conv, arg2Conv, arg3Conv, arg4Conv, arg5Conv, arg6Conv, arg7Conv, arg8Conv, arg9Conv, arg10Conv, arg11Conv) in buildCall(argConv, resConv, callF) end fun buildCall11(symbol, argTypes, resType) = buildCall11withAbi (abiDefault, symbol, argTypes, resType) fun buildCall12withAbi (abi: abi, fnAddr, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion, arg5Conv: 'e conversion, arg6Conv: 'f conversion, arg7Conv: 'g conversion, arg8Conv: 'h conversion, arg9Conv: 'i conversion, arg10Conv: 'j conversion, arg11Conv: 'k conversion, arg12Conv: 'l conversion), resConv: 'm conversion): 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l -> 'm = let val callF = callwithAbi abi [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv, #ctype arg5Conv, #ctype arg6Conv, #ctype arg7Conv, #ctype arg8Conv, #ctype arg9Conv, #ctype arg10Conv, #ctype arg11Conv, #ctype arg12Conv] (#ctype resConv) fnAddr val argConv = cStruct12(arg1Conv, arg2Conv, arg3Conv, arg4Conv, arg5Conv, arg6Conv, arg7Conv, arg8Conv, arg9Conv, arg10Conv, arg11Conv, arg12Conv) in buildCall(argConv, resConv, callF) end fun buildCall12(symbol, argTypes, resType) = buildCall12withAbi (abiDefault, symbol, argTypes, resType) fun buildCall13withAbi (abi: abi, fnAddr, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion, arg5Conv: 'e conversion, arg6Conv: 'f conversion, arg7Conv: 'g conversion, arg8Conv: 'h conversion, arg9Conv: 'i conversion, arg10Conv: 'j conversion, arg11Conv: 'k conversion, arg12Conv: 'l conversion, arg13Conv: 'm conversion), resConv: 'n conversion): 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm -> 'n = let val callF = callwithAbi abi [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv, #ctype arg5Conv, #ctype arg6Conv, #ctype arg7Conv, #ctype arg8Conv, #ctype arg9Conv, #ctype arg10Conv, #ctype arg11Conv, #ctype arg12Conv, #ctype arg13Conv] (#ctype resConv) fnAddr val argConv = cStruct13(arg1Conv, arg2Conv, arg3Conv, arg4Conv, arg5Conv, arg6Conv, arg7Conv, arg8Conv, arg9Conv, arg10Conv, arg11Conv, arg12Conv, arg13Conv) in buildCall(argConv, resConv, callF) end fun buildCall13(symbol, argTypes, resType) = buildCall13withAbi (abiDefault, symbol, argTypes, resType) fun buildCall14withAbi (abi: abi, fnAddr, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion, arg5Conv: 'e conversion, arg6Conv: 'f conversion, arg7Conv: 'g conversion, arg8Conv: 'h conversion, arg9Conv: 'i conversion, arg10Conv: 'j conversion, arg11Conv: 'k conversion, arg12Conv: 'l conversion, arg13Conv: 'm conversion, arg14Conv: 'n conversion), resConv: 'o conversion): 'a * 'b *'c * 'd * 'e * 'f * 'g * 'h * 'i * 'j * 'k * 'l * 'm * 'n -> 'o = let val callF = callwithAbi abi [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv, #ctype arg5Conv, #ctype arg6Conv, #ctype arg7Conv, #ctype arg8Conv, #ctype arg9Conv, #ctype arg10Conv, #ctype arg11Conv, #ctype arg12Conv, #ctype arg13Conv, #ctype arg14Conv] (#ctype resConv) fnAddr val argConv = cStruct14(arg1Conv, arg2Conv, arg3Conv, arg4Conv, arg5Conv, arg6Conv, arg7Conv, arg8Conv, arg9Conv, arg10Conv, arg11Conv, arg12Conv, arg13Conv, arg14Conv) in buildCall(argConv, resConv, callF) end fun buildCall14(symbol, argTypes, resType) = buildCall14withAbi (abiDefault, symbol, argTypes, resType) end (* A closure is now a "closure cell" (in 32-in-64) or a single word cell containing the address of a code (in native address versions). It can be used exactly like a SysWord.word except that the code can be garbage-collected if the cell is no longer reachable. *) type 'a closure = Memory.voidStar local open Memory LowLevel fun load _ = raise Foreign "Cannot return a closure" (* Store the address of the code. Touch the closure after the function returns to ensure it cannot be GCed earlier. That would only happen if this resulted in a callback to a different function during the execution. *) and store(v, cl: ('a->'b) closure) = (Memory.setAddress(v, 0w0, cl); fn () => RunCall.touch cl) in val cFunction: ('a->'b) closure conversion = makeConversion { load=load, store=store, ctype = LowLevel.cTypePointer } end local open Memory LowLevel in fun buildClosure0withAbi(f: unit-> 'a, abi: abi, (), resConv: 'a conversion): (unit->'a) closure = let fun callback (f: unit -> 'a) (_: voidStar, res: voidStar): unit = ignore(#store resConv (res, f ())) (* Ignore the result of #store resConv. What this means is if the callback returns something, e.g. a string, that requires dynamic allocation there will be a memory leak. *) val makeCallback = cFunctionWithAbi abi [] (#ctype resConv) in makeCallback(callback f) end fun buildClosure0(f, argConv, resConv) = buildClosure0withAbi(f, abiDefault, argConv, resConv) fun buildClosure1withAbi (f: 'a -> 'b, abi: abi, argConv: 'a conversion, resConv: 'b conversion) : ('a -> 'b) closure = let fun callback (f: 'a -> 'b) (args: voidStar, res: voidStar): unit = let val arg1 = #load argConv args val result = f arg1 val () = #updateC argConv (args, arg1) in ignore(#store resConv (res, result)) end val makeCallback = cFunctionWithAbi abi [#ctype argConv] (#ctype resConv) in makeCallback(callback f) end fun buildClosure1(f, argConv, resConv) = buildClosure1withAbi(f, abiDefault, argConv, resConv) fun buildClosure2withAbi (f: 'a * 'b -> 'c, abi: abi, (arg1Conv: 'a conversion, arg2Conv: 'b conversion), resConv: 'c conversion) : ('a * 'b -> 'c) closure = let val { load=loadArgs, updateC=updateArgs, ...} = cStruct2(arg1Conv, arg2Conv) fun callback (f: 'a *'b -> 'c) (args: voidStar, res: voidStar): unit = let val mlArgs = loadArgs args val result = f mlArgs val () = updateArgs(args, mlArgs) in ignore(#store resConv (res, result)) end val argTypes = [#ctype arg1Conv, #ctype arg2Conv] and resType = #ctype resConv val makeCallback = cFunctionWithAbi abi argTypes resType in makeCallback(callback f) end fun buildClosure2(f, argConv, resConv) = buildClosure2withAbi(f, abiDefault, argConv, resConv) fun buildClosure3withAbi (f, abi, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion), resConv: 'd conversion) = let val { load=loadArgs, updateC=updateArgs, ...} = cStruct3(arg1Conv, arg2Conv, arg3Conv) fun callback (f: 'a *'b * 'c -> 'd) (args: voidStar, res: voidStar): unit = let val mlArgs = loadArgs args val result = f mlArgs val () = updateArgs(args, mlArgs) in ignore(#store resConv (res, result)) end val argTypes = [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv] and resType = #ctype resConv val makeCallback = cFunctionWithAbi abi argTypes resType in makeCallback(callback f) end fun buildClosure3(f, argConv, resConv) = buildClosure3withAbi(f, abiDefault, argConv, resConv) fun buildClosure4withAbi (f, abi, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion), resConv: 'e conversion) = let val { load=loadArgs, updateC=updateArgs, ...} = cStruct4(arg1Conv, arg2Conv, arg3Conv, arg4Conv) fun callback (f: 'a *'b * 'c * 'd -> 'e) (args: voidStar, res: voidStar): unit = let val mlArgs = loadArgs args val result = f mlArgs val () = updateArgs(args, mlArgs) in ignore(#store resConv (res, result)) end val argTypes = [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv] and resType = #ctype resConv val makeCallback = cFunctionWithAbi abi argTypes resType in makeCallback(callback f) end fun buildClosure4(f, argConv, resConv) = buildClosure4withAbi(f, abiDefault, argConv, resConv) fun buildClosure5withAbi (f, abi, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion, arg5Conv: 'e conversion), resConv: 'f conversion) = let val { load=loadArgs, updateC=updateArgs, ...} = cStruct5(arg1Conv, arg2Conv, arg3Conv, arg4Conv, arg5Conv) fun callback (f: 'a *'b * 'c * 'd * 'e -> 'f) (args: voidStar, res: voidStar): unit = let val mlArgs = loadArgs args val result = f mlArgs val () = updateArgs(args, mlArgs) in ignore(#store resConv (res, result)) end val argTypes = [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv, #ctype arg5Conv] and resType = #ctype resConv val makeCallback = cFunctionWithAbi abi argTypes resType in makeCallback(callback f) end fun buildClosure5(f, argConv, resConv) = buildClosure5withAbi(f, abiDefault, argConv, resConv) fun buildClosure6withAbi (f, abi, (arg1Conv: 'a conversion, arg2Conv: 'b conversion, arg3Conv: 'c conversion, arg4Conv: 'd conversion, arg5Conv: 'e conversion, arg6Conv: 'f conversion), resConv: 'g conversion) = let val { load=loadArgs, updateC=updateArgs, ...} = cStruct6(arg1Conv, arg2Conv, arg3Conv, arg4Conv, arg5Conv, arg6Conv) fun callback (f: 'a *'b * 'c * 'd * 'e * 'f -> 'g) (args: voidStar, res: voidStar): unit = let val mlArgs = loadArgs args val result = f mlArgs val () = updateArgs(args, mlArgs) in ignore(#store resConv (res, result)) end val argTypes = [#ctype arg1Conv, #ctype arg2Conv, #ctype arg3Conv, #ctype arg4Conv, #ctype arg5Conv, #ctype arg6Conv] and resType = #ctype resConv val makeCallback = cFunctionWithAbi abi argTypes resType in makeCallback(callback f) end fun buildClosure6(f, argConv, resConv) = buildClosure6withAbi(f, abiDefault, argConv, resConv) end end; diff --git a/basis/ForeignConstants.580.sml b/basis/ForeignConstants.580.sml index 9a1f5e25..7cc051cf 100644 --- a/basis/ForeignConstants.580.sml +++ b/basis/ForeignConstants.580.sml @@ -1,68 +1,21 @@ (* Title: Foreign Function Interface: constants Author: David Matthews Copyright David Matthews 2015, 2016-17 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (* This is defined separately so that the values are computed and available as constants for the Foreign structure. *) -structure ForeignConstants = -struct - local - val ffiGeneralCall = RunCall.rtsCallFull2 "PolyFFIGeneral" - fun ffiGeneral(code: int, arg: 'a): 'b = RunCall.unsafeCast(ffiGeneralCall(RunCall.unsafeCast(code, arg))) - in - local - fun getSizeAndAlign (n: int) = - let - val ffiType = ffiGeneral (52, n) - val (size: word, align: word, _, _) = (* Just get the first two fields. *) - ffiGeneral (53, ffiType) - in - {size=size, align=align} - end - in - val saVoid = getSizeAndAlign 0 - and saUint8 = getSizeAndAlign 1 - and saSint8 = getSizeAndAlign 2 - and saUint16 = getSizeAndAlign 3 - and saSint16 = getSizeAndAlign 4 - and saUint32 = getSizeAndAlign 5 - and saSint32 = getSizeAndAlign 6 - and saUint64 = getSizeAndAlign 7 - and saSint64 = getSizeAndAlign 8 - and saFloat = getSizeAndAlign 9 - and saDouble = getSizeAndAlign 10 - and saPointer = getSizeAndAlign 11 - and saUChar = getSizeAndAlign 12 - and saSChar = getSizeAndAlign 13 - and saUShort = getSizeAndAlign 14 - and saSShort = getSizeAndAlign 15 - and saUint = getSizeAndAlign 16 - and saSint = getSizeAndAlign 17 - and saUlong = getSizeAndAlign 18 - and saSlong = getSizeAndAlign 19 - end - - val bigEndian : bool = LibrarySupport.bigEndian - and wordSize : word = RunCall.bytesPerWord - and sysWordSize: word = LibrarySupport.sysWordSize - - (* Minimum argument size. *) - val ffiMinArgSize: Word.word = ffiGeneral (51, 15) - end - -end; diff --git a/basis/ForeignConstants.sml b/basis/ForeignConstants.sml index 4fa45224..b087e40f 100644 --- a/basis/ForeignConstants.sml +++ b/basis/ForeignConstants.sml @@ -1,64 +1,43 @@ (* Title: Foreign Function Interface: constants Author: David Matthews - Copyright David Matthews 2015, 2016-17 + Copyright David Matthews 2015, 2016-17, 2019 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) (* This is defined separately so that the values are computed and - available as constants for the Foreign structure. *) + available as compile-time constants for the Foreign structure. *) structure ForeignConstants = struct + (* Assume that the alignment requirements for these types are the + same as the size. *) local - val ffiGeneralCall = RunCall.rtsCallFull2 "PolyFFIGeneral" - fun ffiGeneral(code: int, arg: 'a): 'b = RunCall.unsafeCast(ffiGeneralCall(RunCall.unsafeCast(code, arg))) + val sizeFloat: word = RunCall.rtsCallFast1 "PolySizeFloat" () + and sizeDouble: word = RunCall.rtsCallFast1 "PolySizeDouble" () + and sizeShort: word = RunCall.rtsCallFast1 "PolySizeShort" () + and sizeInt: word = RunCall.rtsCallFast1 "PolySizeInt" () + and sizeLong: word = RunCall.rtsCallFast1 "PolySizeLong" () in - local - fun getSizeAndAlign (n: int) = - let - val ffiType = ffiGeneral (52, n) - val (size: word, align: word, _, _) = (* Just get the first two fields. *) - ffiGeneral (53, ffiType) - in - {size=size, align=align} - end - in - val saVoid = getSizeAndAlign 0 - and saUint8 = getSizeAndAlign 1 - and saSint8 = getSizeAndAlign 2 - and saUint16 = getSizeAndAlign 3 - and saSint16 = getSizeAndAlign 4 - and saUint32 = getSizeAndAlign 5 - and saSint32 = getSizeAndAlign 6 - and saUint64 = getSizeAndAlign 7 - and saSint64 = getSizeAndAlign 8 - and saFloat = getSizeAndAlign 9 - and saDouble = getSizeAndAlign 10 - and saPointer = getSizeAndAlign 11 - and saUChar = getSizeAndAlign 12 - and saSChar = getSizeAndAlign 13 - and saUShort = getSizeAndAlign 14 - and saSShort = getSizeAndAlign 15 - and saUint = getSizeAndAlign 16 - and saSint = getSizeAndAlign 17 - and saUlong = getSizeAndAlign 18 - and saSlong = getSizeAndAlign 19 + val saFloat = {size=sizeFloat, align=sizeFloat} + and saDouble = {size=sizeDouble, align=sizeDouble} + and saShort = {size=sizeShort, align=sizeShort} + and saInt = {size=sizeInt, align=sizeInt} + and saLong = {size=sizeLong, align=sizeLong} end - + val bigEndian : bool = LibrarySupport.bigEndian and wordSize : word = RunCall.bytesPerWord and sysWordSize: word = LibrarySupport.sysWordSize - end end; diff --git a/basis/ForeignMemory.580.sml b/basis/ForeignMemory.580.sml index f32ab39f..fe56498f 100644 --- a/basis/ForeignMemory.580.sml +++ b/basis/ForeignMemory.580.sml @@ -1,230 +1,18 @@ (* Title: Foreign Function Interface: memory operations Author: David Matthews Copyright David Matthews 2015, 2017, 2019 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) - - -structure ForeignMemory :> - sig - eqtype volatileRef - val volatileRef: SysWord.word -> volatileRef - val setVolatileRef: volatileRef * SysWord.word -> unit - val getVolatileRef: volatileRef -> SysWord.word - - eqtype voidStar - val voidStar2Sysword: voidStar -> SysWord.word - val sysWord2VoidStar: SysWord.word -> voidStar - val null: voidStar - - val ++ : voidStar * word -> voidStar - val -- : voidStar * word -> voidStar - - (* Remember an address except across loads. *) - val memoise: ('a -> voidStar) ->'a -> unit -> voidStar - - exception Memory - - (* malloc - allocate memory. N.B. argument is the number of bytes. - Raises Memory exception if it cannot allocate. *) - val malloc: word -> voidStar - (* free - free allocated memory. *) - val free: voidStar -> unit - - val get8: voidStar * Word.word -> Word8.word - val get16: voidStar * Word.word -> Word.word - val get32: voidStar * Word.word -> Word32.word - val get64: voidStar * Word.word -> SysWord.word - val set8: voidStar * Word.word * Word8.word -> unit - val set16: voidStar * Word.word * Word.word -> unit - val set32: voidStar * Word.word * Word32.word -> unit - val set64: voidStar * Word.word * SysWord.word -> unit - - val getFloat: voidStar * Word.word -> real - val getDouble: voidStar * Word.word -> real - val setFloat: voidStar * Word.word * real -> unit - val setDouble: voidStar * Word.word * real -> unit - - val getAddress: voidStar * Word.word -> voidStar - val setAddress: voidStar * Word.word * voidStar -> unit - end -= -struct - open ForeignConstants - open ForeignMemory - - exception Foreign = RunCall.Foreign - - fun id x = x - (* Internal utility function. *) - fun alignUp(s, align) = Word.andb(s + align-0w1, ~ align) - - (* Both volatileRef and SysWord.word are the ADDRESSes of the actual value. *) - type volatileRef = word ref - - val memMove: SysWord.word * SysWord.word * word * word* word -> unit = RunCall.moveBytes - - fun volatileRef init = - let - (* Allocate a single word marked as mutable, weak, no-overwrite, byte. *) - (* A weak byte cell is cleared to zero when it is read in either from the - executable or from a saved state. Using the no-overwrite bit ensures - that if it is contained in the executable it won't be changed by loading - a saved state but there's a problem if it is contained in a parent state. - Then loading a child state will clear it because we reload all the parents - when we load a child. *) - val v = RunCall.allocateWordMemory(sysWordSize div wordSize, 0wx69, 0w0) - (* Copy the SysWord into it. *) - val () = memMove(init, RunCall.unsafeCast v, 0w0, 0w0, sysWordSize) - in - v - end - - fun setVolatileRef(v, i) = memMove(i, RunCall.unsafeCast v, 0w0, 0w0, sysWordSize) - - fun getVolatileRef var = - let - (* Allocate a single word marked as mutable, byte. *) - val v = RunCall.allocateByteMemory(sysWordSize div wordSize, 0wx41) - val () = memMove(RunCall.unsafeCast var, v, 0w0, 0w0, sysWordSize) - val () = RunCall.clearMutableBit v - in - v - end - - type voidStar = SysWord.word - val voidStar2Sysword = id and sysWord2VoidStar = id (* Exported conversions *) - val null: voidStar = 0w0 - - infix 6 ++ -- - fun s ++ w = s + SysWord.fromLarge(Word.toLarge w) - and s -- w = s - SysWord.fromLarge(Word.toLarge w) - - fun 'a memoise(f: 'a -> voidStar) (a: 'a) : unit -> voidStar = - let - (* Initialise to zero. That means the function won't be - executed until we actually want the result. *) - val v = volatileRef 0w0 - in - (* If we've reloaded the volatile ref it will have been reset to zero. - We need to execute the function and set it. *) - fn () => (case getVolatileRef v of 0w0 => let val r = f a in setVolatileRef(v, r); r end | r => r) - end - - exception Memory - - (* Get and set addresses. This is a bit messy because it has to compile on 64-bits as well as 32-bits. *) - val getAddress: voidStar * Word.word -> voidStar = - if sysWordSize = 0w4 then Word32.toLargeWord o get32 else get64 - val setAddress: voidStar * Word.word * voidStar -> unit = - if sysWordSize = 0w4 then fn (s, i, v) => set32(s, i, Word32.fromLargeWord v) else set64 - - local - local - val ffiGeneralCall = RunCall.rtsCallFull2 "PolyFFIGeneral" - in - fun ffiGeneral(code: int, arg: 'a): 'b = RunCall.unsafeCast(ffiGeneralCall(RunCall.unsafeCast(code, arg))) - end - fun systemMalloc (s: word): voidStar = ffiGeneral (0, s) - (*fun systemFree (s: voidStar): unit = ffiGeneral (1, s)*) - - (* Simple malloc/free implementation to reduce the number of RTS calls needed. *) - val lock = Thread.Mutex.mutex() - (* It would be possible to chain the free list in the C memory - itself. For the moment we don't do that. - The free list is the list of chunks ordered by increasing - address. That allows us to merge adjacent free blocks. *) - val freeList: {address: SysWord.word, size: word} list ref = LibrarySupport.noOverwriteRef nil - (* Clear it once on entry. *) - val () = LibrarySupport.addOnEntry (fn _ => freeList := nil) - - (* Assume that if we align to the maximum of these we're all right. *) - val maxAlign = Word.max(#align saDouble, Word.max(#align saPointer, #align saSint64)) - (* We need a length word in each object we allocate but we need enough - padding to align the result. *) - val overhead = alignUp(sysWordSize, maxAlign) - val chunkSize = 0w4096 (* Configure this. *) - - fun addFree(entry, []) = [entry] - | addFree(entry, this :: rest) = - if #address entry < #address this - then - ( - if #address entry ++ #size entry = #address this - then (* New entry is immediately before old one - merge. *) - {address= #address entry, size = #size entry + #size this } :: rest - else entry :: this :: rest - ) - else if #address this ++ #size this = #address entry - then (* New entry is immediately after this - merge. Continue because it could - also merge with an entry after this as well. *) - addFree({address= #address this, size= #size entry + #size this}, rest) - else this :: addFree(entry, rest) (* Search on. *) - - (* Find free space. *) - fun findFree (_, []) = (NONE, []) - | findFree (space, (this as {size, address}) :: tl) = - if space = size - then (SOME address, tl) - else if space < size - then (SOME address, {size=size-space, address=address ++ space} :: tl) - else - let - val (res, rest) = findFree(space, tl) - in - (res, this :: rest) - end - - fun freeMem s = - let - val addr = s -- overhead - val size = Word.fromLarge(SysWord.toLarge(getAddress(addr, 0w0))) - in - freeList := addFree({address=addr, size=size}, !freeList) - end - - fun allocMem s = - let - val space = alignUp(s + overhead, maxAlign) - val (found, newList) = findFree(space, !freeList) - in - case found of - NONE => - let - (* Need more memory *) - val requestSpace = Word.max(chunkSize, space) - val newSpace = systemMalloc requestSpace - val _ = newSpace <> null orelse raise Memory - in - (* Add the space to the free list in the appropriate place. *) - freeList := addFree({address=newSpace, size=requestSpace}, !freeList); - allocMem s (* Repeat - should succeed now. *) - end - | SOME address => - let - val () = freeList := newList (* Update the free list *) - (* Store the length in the first word. *) - val () = setAddress(address, 0w0, SysWord.fromLarge(Word.toLarge space)) - in - address ++ overhead - end - end - in - val malloc: word -> voidStar = ThreadLib.protect lock allocMem - fun free v = if v = null then () else ThreadLib.protect lock freeMem v - end -end; - diff --git a/basis/ForeignMemory.sml b/basis/ForeignMemory.sml index b92b5cc6..fcf6eb65 100644 --- a/basis/ForeignMemory.sml +++ b/basis/ForeignMemory.sml @@ -1,240 +1,240 @@ (* Title: Foreign Function Interface: memory operations Author: David Matthews Copyright David Matthews 2015, 2017, 2019 This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *) structure ForeignMemory :> sig eqtype volatileRef val volatileRef: SysWord.word -> volatileRef val setVolatileRef: volatileRef * SysWord.word -> unit val getVolatileRef: volatileRef -> SysWord.word eqtype voidStar val voidStar2Sysword: voidStar -> SysWord.word val sysWord2VoidStar: SysWord.word -> voidStar val null: voidStar val ++ : voidStar * word -> voidStar val -- : voidStar * word -> voidStar (* Remember an address except across loads. *) val memoise: ('a -> voidStar) ->'a -> unit -> voidStar exception Memory (* malloc - allocate memory. N.B. argument is the number of bytes. Raises Memory exception if it cannot allocate. *) val malloc: word -> voidStar (* free - free allocated memory. *) val free: voidStar -> unit (* alloca: allocate temporary memory on the C-stack and call the function. The memory is deallocated when the function returns or raises and exception. *) val alloca: word * (voidStar -> 'a) -> 'a val get8: voidStar * Word.word -> Word8.word val get16: voidStar * Word.word -> Word.word val get32: voidStar * Word.word -> Word32.word val get64: voidStar * Word.word -> SysWord.word val set8: voidStar * Word.word * Word8.word -> unit val set16: voidStar * Word.word * Word.word -> unit val set32: voidStar * Word.word * Word32.word -> unit val set64: voidStar * Word.word * SysWord.word -> unit val getFloat: voidStar * Word.word -> real val getDouble: voidStar * Word.word -> real val setFloat: voidStar * Word.word * real -> unit val setDouble: voidStar * Word.word * real -> unit val getAddress: voidStar * Word.word -> voidStar val setAddress: voidStar * Word.word * voidStar -> unit end = struct open ForeignConstants open ForeignMemory exception Foreign = Foreign.Foreign fun id x = x (* Internal utility function. *) fun alignUp(s, align) = Word.andb(s + align-0w1, ~ align) (* Both volatileRef and SysWord.word are the ADDRESSes of the actual value. *) type volatileRef = word ref val memMove: SysWord.word * SysWord.word * word * word* word -> unit = RunCall.moveBytes fun volatileRef init = let (* Allocate a single word marked as mutable, weak, no-overwrite, byte. *) (* A weak byte cell is cleared to zero when it is read in either from the executable or from a saved state. Using the no-overwrite bit ensures that if it is contained in the executable it won't be changed by loading a saved state but there's a problem if it is contained in a parent state. Then loading a child state will clear it because we reload all the parents when we load a child. *) val v = RunCall.allocateWordMemory(sysWordSize div wordSize, 0wx69, 0w0) (* Copy the SysWord into it. *) val () = memMove(init, RunCall.unsafeCast v, 0w0, 0w0, sysWordSize) in v end fun setVolatileRef(v, i) = memMove(i, RunCall.unsafeCast v, 0w0, 0w0, sysWordSize) fun getVolatileRef var = let (* Allocate a single word marked as mutable, byte. *) val v = RunCall.allocateByteMemory(sysWordSize div wordSize, 0wx41) val () = memMove(RunCall.unsafeCast var, v, 0w0, 0w0, sysWordSize) val () = RunCall.clearMutableBit v in v end type voidStar = SysWord.word val voidStar2Sysword = id and sysWord2VoidStar = id (* Exported conversions *) val null: voidStar = 0w0 infix 6 ++ -- fun s ++ w = s + SysWord.fromLarge(Word.toLarge w) and s -- w = s - SysWord.fromLarge(Word.toLarge w) fun 'a memoise(f: 'a -> voidStar) (a: 'a) : unit -> voidStar = let (* Initialise to zero. That means the function won't be executed until we actually want the result. *) val v = volatileRef 0w0 in (* If we've reloaded the volatile ref it will have been reset to zero. We need to execute the function and set it. *) fn () => (case getVolatileRef v of 0w0 => let val r = f a in setVolatileRef(v, r); r end | r => r) end exception Memory (* Get and set addresses. This is a bit messy because it has to compile on 64-bits as well as 32-bits. *) val getAddress: voidStar * Word.word -> voidStar = if sysWordSize = 0w4 then Word32.toLargeWord o get32 else get64 val setAddress: voidStar * Word.word * voidStar -> unit = if sysWordSize = 0w4 then fn (s, i, v) => set32(s, i, Word32.fromLargeWord v) else set64 local val systemMalloc: word -> voidStar = RunCall.rtsCallFull1 "PolyFFIMalloc" (*val systemFree: word -> unit = RunCall.rtsCallFast1 "PolyFFIFree"*) (* Simple malloc/free implementation to reduce the number of RTS calls needed. *) val lock = Thread.Mutex.mutex() (* It would be possible to chain the free list in the C memory itself. For the moment we don't do that. The free list is the list of chunks ordered by increasing address. That allows us to merge adjacent free blocks. *) val freeList: {address: SysWord.word, size: word} list ref = LibrarySupport.noOverwriteRef nil (* Clear it once on entry. *) val () = LibrarySupport.addOnEntry (fn _ => freeList := nil) (* Assume that if we align to the maximum of these we're all right. *) - val maxAlign = Word.max(#align saDouble, Word.max(#align saPointer, #align saSint64)) + val maxAlign = Word.max(#align saDouble, Word.max(LibrarySupport.sysWordSize(*#align saPointer*), 0w8(*#align saSint64*))) (* We need a length word in each object we allocate but we need enough padding to align the result. *) val overhead = alignUp(sysWordSize, maxAlign) val chunkSize = 0w4096 (* Configure this. *) fun addFree(entry, []) = [entry] | addFree(entry, this :: rest) = if #address entry < #address this then ( if #address entry ++ #size entry = #address this then (* New entry is immediately before old one - merge. *) {address= #address entry, size = #size entry + #size this } :: rest else entry :: this :: rest ) else if #address this ++ #size this = #address entry then (* New entry is immediately after this - merge. Continue because it could also merge with an entry after this as well. *) addFree({address= #address this, size= #size entry + #size this}, rest) else this :: addFree(entry, rest) (* Search on. *) (* Find free space. *) fun findFree (_, []) = (NONE, []) | findFree (space, (this as {size, address}) :: tl) = if space = size then (SOME address, tl) else if space < size then (SOME address, {size=size-space, address=address ++ space} :: tl) else let val (res, rest) = findFree(space, tl) in (res, this :: rest) end fun freeMem s = let val addr = s -- overhead val size = Word.fromLarge(SysWord.toLarge(getAddress(addr, 0w0))) in freeList := addFree({address=addr, size=size}, !freeList) end fun allocMem s = let val space = alignUp(s + overhead, maxAlign) val (found, newList) = findFree(space, !freeList) in case found of NONE => let (* Need more memory *) val requestSpace = Word.max(chunkSize, space) val newSpace = systemMalloc requestSpace val _ = newSpace <> null orelse raise Memory in (* Add the space to the free list in the appropriate place. *) freeList := addFree({address=newSpace, size=requestSpace}, !freeList); allocMem s (* Repeat - should succeed now. *) end | SOME address => let val () = freeList := newList (* Update the free list *) (* Store the length in the first word. *) val () = setAddress(address, 0w0, SysWord.fromLarge(Word.toLarge space)) in address ++ overhead end end in val malloc: word -> voidStar = ThreadLib.protect lock allocMem fun free v = if v = null then () else ThreadLib.protect lock freeMem v (* Allocate space on the C stack. This is faster than using malloc/free. *) fun alloca(length, f) = let (* This must be at least 16 byte aligned. *) val aligned = alignUp(length, Word.max(maxAlign, 0w16)) val space = allocCStack aligned in f space before freeCStack(space, aligned) handle exn => (freeCStack(space, aligned); raise exn) end end end; diff --git a/libpolyml/polyffi.cpp b/libpolyml/polyffi.cpp index bdf7ef89..3be2d4b7 100644 --- a/libpolyml/polyffi.cpp +++ b/libpolyml/polyffi.cpp @@ -1,583 +1,433 @@ /* Title: New Foreign Function Interface Copyright (c) 2015, 2018, 2019 David C.J. Matthews This library is free software; you can redistribute it and/or modify it under the terms of the GNU Lesser General Public License version 2.1 as published by the Free Software Foundation. This library is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more details. You should have received a copy of the GNU Lesser General Public License along with this library; if not, write to the Free Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA */ #ifdef HAVE_CONFIG_H #include "config.h" #elif defined(_WIN32) #include "winconfig.h" #else #error "No configuration file" #endif #ifdef HAVE_ERRNO_H #include #endif #ifdef HAVE_DLFCN_H #include #endif #ifdef HAVE_ASSERT_H #include #define ASSERT(x) assert(x) #else #define ASSERT(x) 0 #endif #ifdef HAVE_STDIO_H #include #endif #ifdef HAVE_STDLIB_H #include #endif #ifdef HAVE_MALLOC_H #include #endif #ifdef HAVE_STRING_H #include #endif #include "globals.h" // TODO: Do we need this?? // We need to include globals.h before in mingw64 otherwise // it messes up POLYUFMT/POLYSFMT. -#include #include #include "arb.h" #include "save_vec.h" #include "polyffi.h" #include "run_time.h" #include "sys.h" #include "processes.h" #include "polystring.h" #if (defined(_WIN32)) #include #include "winstartup.h" /* For hApplicationInstance. */ #endif #include "scanaddrs.h" #include "diagnostics.h" #include "reals.h" #include "rts_module.h" #include "rtsentry.h" extern "C" { POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFIGeneral(FirstArgument threadId, PolyWord code, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolySizeFloat(); POLYEXTERNALSYMBOL POLYUNSIGNED PolySizeDouble(); + POLYEXTERNALSYMBOL POLYUNSIGNED PolySizeShort(); + POLYEXTERNALSYMBOL POLYUNSIGNED PolySizeInt(); + POLYEXTERNALSYMBOL POLYUNSIGNED PolySizeLong(); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFIGetError(PolyWord addr); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFISetError(PolyWord err); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFICreateExtFn(FirstArgument threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFICreateExtData(FirstArgument threadId, PolyWord arg); POLYEXTERNALSYMBOL void PolyFFICallbackException(); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFIMalloc(FirstArgument threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFIFree(PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFILoadLibrary(FirstArgument threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFILoadExecutable(FirstArgument threadId); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFIUnloadLibrary(FirstArgument threadId, PolyWord arg); POLYEXTERNALSYMBOL POLYUNSIGNED PolyFFIGetSymbolAddress(FirstArgument threadId, PolyWord moduleAddress, PolyWord symbolName); } - -static struct _abiTable { const char *abiName; ffi_abi abiCode; } abiTable[] = -{ -// Unfortunately the ABI entries are enums rather than #defines so we -// can't test individual entries. -#ifdef X86_WIN32 - {"sysv", FFI_SYSV}, - {"stdcall", FFI_STDCALL}, - {"thiscall", FFI_THISCALL}, - {"fastcall", FFI_FASTCALL}, - {"ms_cdecl", FFI_MS_CDECL}, -#elif defined(X86_WIN64) - {"win64", FFI_WIN64}, -#elif defined(X86_ANY) -#if (defined(__i386__) || defined(__i386)) - {"sysv", FFI_SYSV}, -#else - {"unix64", FFI_UNIX64}, -#endif -#endif - { "default", FFI_DEFAULT_ABI} -}; - -// Table of constants returned by call 51 -static int constantTable[] = -{ - FFI_DEFAULT_ABI, // Default ABI - FFI_TYPE_VOID, // Type codes - FFI_TYPE_INT, - FFI_TYPE_FLOAT, - FFI_TYPE_DOUBLE, - FFI_TYPE_UINT8, - FFI_TYPE_SINT8, - FFI_TYPE_UINT16, - FFI_TYPE_SINT16, - FFI_TYPE_UINT32, - FFI_TYPE_SINT32, - FFI_TYPE_UINT64, - FFI_TYPE_SINT64, - FFI_TYPE_STRUCT, - FFI_TYPE_POINTER, - FFI_SIZEOF_ARG // Minimum size for result space -}; - -// Table of predefined ffi types -static ffi_type *ffiTypeTable[] = -{ - &ffi_type_void, - &ffi_type_uint8, - &ffi_type_sint8, - &ffi_type_uint16, - &ffi_type_sint16, - &ffi_type_uint32, - &ffi_type_sint32, - &ffi_type_uint64, - &ffi_type_sint64, - &ffi_type_float, - &ffi_type_double, - &ffi_type_pointer, - &ffi_type_uchar, // These are all aliases for the above - &ffi_type_schar, - &ffi_type_ushort, - &ffi_type_sshort, - &ffi_type_uint, - &ffi_type_sint, - &ffi_type_ulong, - &ffi_type_slong -}; - -static Handle mkAbitab(TaskData *taskData, void*, char *p); - static Handle toSysWord(TaskData *taskData, void *p) { return Make_sysword(taskData, (uintptr_t)p); } -static Handle poly_ffi(TaskData *taskData, Handle args, Handle code) -{ - unsigned c = get_C_unsigned(taskData, code->Word()); - switch (c) - { - - // Libffi functions - case 50: // Return a list of available ABIs - return makeList(taskData, sizeof(abiTable)/sizeof(abiTable[0]), - (char*)abiTable, sizeof(abiTable[0]), 0, mkAbitab); - - case 51: // A constant from the table - { - unsigned index = get_C_unsigned(taskData, args->Word()); - if (index >= sizeof(constantTable) / sizeof(constantTable[0])) - raise_exception_string(taskData, EXC_foreign, "Index out of range"); - return Make_arbitrary_precision(taskData, constantTable[index]); - } - - case 52: // Return an FFI type - { - unsigned index = get_C_unsigned(taskData, args->Word()); - if (index >= sizeof(ffiTypeTable) / sizeof(ffiTypeTable[0])) - raise_exception_string(taskData, EXC_foreign, "Index out of range"); - return toSysWord(taskData, ffiTypeTable[index]); - } - - case 53: // Extract fields from ffi type. - { - ffi_type *ffit = *(ffi_type**)(args->WordP()); - Handle sizeHandle = Make_arbitrary_precision(taskData, ffit->size); - Handle alignHandle = Make_arbitrary_precision(taskData, ffit->alignment); - Handle typeHandle = Make_arbitrary_precision(taskData, ffit->type); - Handle elemHandle = toSysWord(taskData, ffit->elements); - Handle resHandle = alloc_and_save(taskData, 4); - resHandle->WordP()->Set(0, sizeHandle->Word()); - resHandle->WordP()->Set(1, alignHandle->Word()); - resHandle->WordP()->Set(2, typeHandle->Word()); - resHandle->WordP()->Set(3, elemHandle->Word()); - return resHandle; - } - - case 54: // Construct an ffi type. - { - // This is probably only used to create structs. - size_t size = getPolyUnsigned(taskData, args->WordP()->Get(0)); - unsigned short align = get_C_ushort(taskData, args->WordP()->Get(1)); - unsigned short type = get_C_ushort(taskData, args->WordP()->Get(2)); - unsigned nElems = 0; - for (PolyWord p = args->WordP()->Get(3); !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) - nElems++; - size_t space = sizeof(ffi_type); - // If we need the elements add space for the elements plus - // one extra for the zero terminator. - if (nElems != 0) space += (nElems+1) * sizeof(ffi_type *); - ffi_type *result = (ffi_type*)calloc(1, space); - // Raise an exception rather than returning zero. - if (result == 0) raise_syscall(taskData, "Insufficient memory", ENOMEM); - ffi_type **elem = 0; - if (nElems != 0) elem = (ffi_type **)(result+1); - result->size = size; - result->alignment = align; - result->type = type; - result->elements = elem; - if (elem != 0) - { - for (PolyWord p = args->WordP()->Get(3); !ML_Cons_Cell::IsNull(p); p = ((ML_Cons_Cell*)p.AsObjPtr())->t) - { - PolyWord e = ((ML_Cons_Cell*)p.AsObjPtr())->h; - *elem++ = *(ffi_type**)(e.AsAddress()); - } - *elem = 0; - } - return toSysWord(taskData, result); - } - - default: - { - char msg[100]; - sprintf(msg, "Unknown ffi function: %d", c); - raise_exception_string(taskData, EXC_foreign, msg); - return 0; - } - } -} - -// Construct an entry in the ABI table. -static Handle mkAbitab(TaskData *taskData, void *arg, char *p) -{ - struct _abiTable *ab = (struct _abiTable *)p; - // Construct a pair of the string and the code - Handle name = taskData->saveVec.push(C_string_to_Poly(taskData, ab->abiName)); - Handle code = Make_arbitrary_precision(taskData, ab->abiCode); - Handle result = alloc_and_save(taskData, 2); - result->WordP()->Set(0, name->Word()); - result->WordP()->Set(1, code->Word()); - return result; -} - // General interface to IO. Ideally the various cases will be made into // separate functions. POLYUNSIGNED PolyFFIGeneral(FirstArgument threadId, PolyWord code, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedCode = taskData->saveVec.push(code); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { - result = poly_ffi(taskData, pushedArg, pushedCode); + raise_exception_string(taskData, EXC_foreign, "No longer used"); } catch (...) { } // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Malloc memory - Needs to allocate the SysWord.word value on the heap. POLYUNSIGNED PolyFFIMalloc(FirstArgument threadId, PolyWord arg) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { POLYUNSIGNED size = getPolyUnsigned(taskData, arg); result = toSysWord(taskData, malloc(size)); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Free memory. Not currently used: freed memory is just added back to the free list. POLYUNSIGNED PolyFFIFree(PolyWord arg) { void* mem = *(void**)(arg.AsObjPtr()); free(mem); return TAGGED(0).AsUnsigned(); } POLYUNSIGNED PolyFFILoadLibrary(FirstArgument threadId, PolyWord arg) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { TempString libName(arg); #if (defined(_WIN32)) HINSTANCE lib = LoadLibrary(libName); if (lib == NULL) { char buf[256]; #if (defined(UNICODE)) _snprintf(buf, sizeof(buf), "Loading <%S> failed. Error %lu", (LPCTSTR)libName, GetLastError()); #else _snprintf(buf, sizeof(buf), "Loading <%s> failed. Error %lu", (const char*)libName, GetLastError()); #endif buf[sizeof(buf) - 1] = 0; // Terminate just in case raise_exception_string(taskData, EXC_foreign, buf); } #else void* lib = dlopen(libName, RTLD_LAZY); if (lib == NULL) { char buf[256]; snprintf(buf, sizeof(buf), "Loading <%s> failed: %s", (const char*)libName, dlerror()); buf[sizeof(buf) - 1] = 0; // Terminate just in case raise_exception_string(taskData, EXC_foreign, buf); } #endif result = toSysWord(taskData, lib); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Get the address of the executable as a library. POLYUNSIGNED PolyFFILoadExecutable(FirstArgument threadId) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { #if (defined(_WIN32)) HINSTANCE lib = hApplicationInstance; #else void* lib = dlopen(NULL, RTLD_LAZY); if (lib == NULL) { char buf[256]; snprintf(buf, sizeof(buf), "Loading address of executable failed: %s", dlerror()); buf[sizeof(buf) - 1] = 0; // Terminate just in case raise_exception_string(taskData, EXC_foreign, buf); } #endif result = toSysWord(taskData, lib); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Unload library - Is this actually going to be used? POLYUNSIGNED PolyFFIUnloadLibrary(FirstArgument threadId, PolyWord arg) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); try { #if (defined(_WIN32)) HMODULE hMod = *(HMODULE*)(arg.AsObjPtr()); if (!FreeLibrary(hMod)) raise_syscall(taskData, "FreeLibrary failed", GetLastError()); #else void* lib = *(void**)(arg.AsObjPtr()); if (dlclose(lib) != 0) { char buf[256]; snprintf(buf, sizeof(buf), "dlclose failed: %s", dlerror()); buf[sizeof(buf) - 1] = 0; // Terminate just in case raise_exception_string(taskData, EXC_foreign, buf); } #endif } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); return TAGGED(0).AsUnsigned(); } // Load the address of a symbol from a library. POLYUNSIGNED PolyFFIGetSymbolAddress(FirstArgument threadId, PolyWord moduleAddress, PolyWord symbolName) { TaskData* taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle result = 0; try { TempCString symName(symbolName); #if (defined(_WIN32)) HMODULE hMod = *(HMODULE*)(moduleAddress.AsObjPtr()); void* sym = (void*)GetProcAddress(hMod, symName); if (sym == NULL) { char buf[256]; _snprintf(buf, sizeof(buf), "Loading symbol <%s> failed. Error %lu", (LPCSTR)symName, GetLastError()); buf[sizeof(buf) - 1] = 0; // Terminate just in case raise_exception_string(taskData, EXC_foreign, buf); } #else void* lib = *(void**)(moduleAddress.AsObjPtr()); void* sym = dlsym(lib, symName); if (sym == NULL) { char buf[256]; snprintf(buf, sizeof(buf), "load_sym <%s> : %s", (const char*)symName, dlerror()); buf[sizeof(buf) - 1] = 0; // Terminate just in case raise_exception_string(taskData, EXC_foreign, buf); } #endif result = toSysWord(taskData, sym); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // These functions are needed in the compiler POLYUNSIGNED PolySizeFloat() { return TAGGED((POLYSIGNED)sizeof(float)).AsUnsigned(); } POLYUNSIGNED PolySizeDouble() { return TAGGED((POLYSIGNED)sizeof(double)).AsUnsigned(); } +POLYUNSIGNED PolySizeShort() +{ + return TAGGED((POLYSIGNED)sizeof(short)).AsUnsigned(); +} + +POLYUNSIGNED PolySizeInt() +{ + return TAGGED((POLYSIGNED)sizeof(int)).AsUnsigned(); +} + +POLYUNSIGNED PolySizeLong() +{ + return TAGGED((POLYSIGNED)sizeof(long)).AsUnsigned(); +} + // Get either errno or GetLastError POLYUNSIGNED PolyFFIGetError(PolyWord addr) { #if (defined(_WIN32)) addr.AsObjPtr()->Set(0, PolyWord::FromUnsigned(GetLastError())); #else addr.AsObjPtr()->Set(0, PolyWord::FromUnsigned((POLYUNSIGNED)errno)); #endif return 0; } // The argument is a SysWord.word value i.e. the address of a byte cell. POLYUNSIGNED PolyFFISetError(PolyWord err) { #if (defined(_WIN32)) SetLastError((DWORD)(err.AsObjPtr()->Get(0).AsUnsigned())); #else errno = err.AsObjPtr()->Get(0).AsSigned(); #endif return 0; } // Create an external function reference. The value returned has space for // an address followed by the name of the external symbol. Because the // address comes at the beginning it can be used in the same way as the // SysWord value returned by the get-symbol call from a library. POLYUNSIGNED PolyFFICreateExtFn(FirstArgument threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = creatEntryPointObject(taskData, pushedArg, true); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Create an external reference to data. On a small number of platforms // different forms of relocation are needed for data and for functions. POLYUNSIGNED PolyFFICreateExtData(FirstArgument threadId, PolyWord arg) { TaskData *taskData = TaskData::FindTaskForId(threadId); ASSERT(taskData != 0); taskData->PreRTSCall(); Handle reset = taskData->saveVec.mark(); Handle pushedArg = taskData->saveVec.push(arg); Handle result = 0; try { result = creatEntryPointObject(taskData, pushedArg, false); } catch (...) {} // If an ML exception is raised taskData->saveVec.reset(reset); // Ensure the save vec is reset taskData->PostRTSCall(); if (result == 0) return TAGGED(0).AsUnsigned(); else return result->Word().AsUnsigned(); } // Called if a callback raises an exception. There's nothing we // can do because we don't have anything to pass back to C. void PolyFFICallbackException() { Crash("An ML function called from foreign code raised an exception. Unable to continue."); } struct _entrypts polyFFIEPT[] = { { "PolyFFIGeneral", (polyRTSFunction)&PolyFFIGeneral}, { "PolySizeFloat", (polyRTSFunction)&PolySizeFloat}, { "PolySizeDouble", (polyRTSFunction)&PolySizeDouble}, + { "PolySizeShort", (polyRTSFunction)&PolySizeShort}, + { "PolySizeInt", (polyRTSFunction)&PolySizeInt}, + { "PolySizeLong", (polyRTSFunction)&PolySizeLong}, { "PolyFFIGetError", (polyRTSFunction)&PolyFFIGetError}, { "PolyFFISetError", (polyRTSFunction)&PolyFFISetError}, { "PolyFFICreateExtFn", (polyRTSFunction)&PolyFFICreateExtFn}, { "PolyFFICreateExtData", (polyRTSFunction)&PolyFFICreateExtData }, { "PolyFFICallbackException", (polyRTSFunction)&PolyFFICallbackException }, { "PolyFFIMalloc", (polyRTSFunction)&PolyFFIMalloc }, { "PolyFFIFree", (polyRTSFunction)&PolyFFIFree }, { "PolyFFILoadLibrary", (polyRTSFunction)&PolyFFILoadLibrary }, { "PolyFFILoadExecutable", (polyRTSFunction)&PolyFFILoadExecutable }, { "PolyFFIUnloadLibrary", (polyRTSFunction)&PolyFFIUnloadLibrary }, { "PolyFFIGetSymbolAddress", (polyRTSFunction)&PolyFFIGetSymbolAddress }, { NULL, NULL} // End of list. };