diff --git a/.github/scripts/otp-compliance.es b/.github/scripts/otp-compliance.es index 500d44a57145..2a75293b2c68 100755 --- a/.github/scripts/otp-compliance.es +++ b/.github/scripts/otp-compliance.es @@ -60,7 +60,7 @@ test_package_ids/1, test_verificationCode/1, test_supplier_Ericsson/1, test_originator_Ericsson/1, test_versionInfo_not_empty/1, test_package_hasFiles/1, test_project_purl/1, test_packages_purl/1, test_download_location/1, - test_package_relations/1, test_has_extracted_licenses/1, test_snippets/1, + test_package_relations/1, test_has_extracted_licenses/1, test_vendor_packages/1, test_erts/1, test_copyright_format/1]). -define(default_classified_result, "scan-result-classified.json"). @@ -372,10 +372,7 @@ sbom_otp(#{sbom_file := SbomFile, write_to_file := Write, input_file := Input}) improve_sbom_with_info(Sbom, ScanResults) -> {Licenses, Copyrights} = fetch_license_copyrights(ScanResults), - Spdx = generate_spdx_fixes(Sbom, Licenses, Copyrights), - generate_snippet_fixes(Spdx, ScanResults). - %% Spdx. - + generate_spdx_fixes(Sbom, Licenses, Copyrights). fetch_license_copyrights(Input) -> {path_to_license(Input), path_to_copyright(Input)}. @@ -386,68 +383,6 @@ generate_spdx_fixes(Input, Licenses, Copyrights) -> Spdx = lists:foldl(fun ({Fun, Data}, Acc) -> Fun(Data, Acc) end, Input, FixFuns), package_by_app(Spdx). -%% this function has a hard dependency to ScanResults. -%% ScanResults has license results on a per line found basis. -%% Spdx result builds using ScanResult and loses this information. -generate_snippet_fixes(Spdx, ScanResults) -> - Licenses = licenses(scan_results(ScanResults)), - %% We identify the known copied snippet - [Snippet] = lists:filter(fun(#{~"location" := #{~"path" := Path}, ~"license" := License}) -> - case {License, Path} of - {~"Apache-2.0 WITH LLVM-exception AND BSL-1.0", ~"erts/emulator/ryu/d2s.c"} -> - true; - _ -> - false - end - end, Licenses), - Snippets = generate_snippet(Spdx, [Snippet]), - Spdx#{ ~"snippets" => Snippets }. - -%% we are doing the assumption that we only have one known snippet. -generate_snippet(#{~"files" := Files}=_Spdx, [#{~"location" := #{~"path" := ~"erts/emulator/ryu/d2s.c"=Path}, ~"license" := License}]) -> - [#{~"SPDXID" := SpdxId}=SpdxFile] = lists:filter(fun (#{~"fileName" := FileName}) -> FileName == Path end, Files), - - %% read file to find snippet byte range and lines - {ok, Content} = file:read_file(Path), - #{~"begin_byte" := StartOffsetBytes, ~"end_byte" := EndOffsetBytes, - ~"start_line" := StartLine, ~"end_line" := EndLine} = get_snippet_range(Content), - - [#{ ~"SPDXID" => ~"SPDXRef-Snippet-STL", - ~"comment" => ~""" - vendor package. - This is inspired from the MS STL Charconv, under Apache with LLVM exception licence see https://github.com/microsoft/STL/blob/main/LICENSE.txt - The inspiration is at https://github.com/microsoft/STL/blob/e745bad3b1d05b5b19ec652d68abb37865ffa454/stl/inc/xcharconv_ryu.h#L1926 - Changes are described in the file. - """, - ~"copyrightText" => maps:get(~"copyrightText", SpdxFile), - ~"licenseConcluded" => ~"Apache-2.0 WITH LLVM-exception AND BSL-1.0", - ~"licenseInfoInSnippets" => split_licenses_in_individual_parts([License]), - ~"name" => ~"stl", - ~"ranges" => [ #{~"endPointer" => #{ ~"lineNumber" => EndLine, ~"reference" => SpdxId}, - ~"startPointer" => #{ ~"lineNumber" => StartLine, ~"reference" => SpdxId}}, - #{~"endPointer" => #{ ~"offset" => EndOffsetBytes, ~"reference" => SpdxId}, - ~"startPointer" => #{ ~"offset" => StartOffsetBytes, ~"reference" => SpdxId}} ], - ~"snippetFromFile" => SpdxId - }]. - -%% assumes that there is only one snippet in the whole file. --spec get_snippet_range(Content :: binary()) -> map(). -get_snippet_range(Content) -> - get_snippet_range(Content, {<<>>, 1}). -get_snippet_range(<<"\n", Rest/binary>>, {Acc, Lines}) -> - get_snippet_range(Rest, {<<"\n", Acc/binary>>, Lines+1}); -get_snippet_range(<<"// SPDX-SnippetBegin", Rest/binary>>, {Content, Line}) -> - {BeginContent, StartLine} = {Content, Line}, - {EndContent, EndLine} = get_snippet_range(Rest, {<<"// SPDX-SnippetBegin", Content/binary>>, Line+1}), - #{~"begin_byte" => byte_size(BeginContent), - ~"end_byte" => byte_size(EndContent), - ~"start_line" => StartLine, - ~"end_line" => EndLine}; -get_snippet_range(<<"// SPDX-SnippetEnd", _Rest/binary>>, {Content, Line}) -> - {Content, Line}; -get_snippet_range(<>, {Content, Line}) -> - get_snippet_range(Rest, {<>, Line}). - sbom_fixing_functions(Licenses, Copyrights) -> [{fun fix_project_name/2, ?spdxref_project_name}, {fun fix_name/2, ?spdx_project_name}, @@ -1162,9 +1097,7 @@ generate_spdx_vendor_packages(VendorInfoPackages, #{~"files" := SpdxFiles}=_SPDX (#{~"ID" := Id, ~"path" := [_ | _]=ExplicitFiles}=Package) when is_list(ExplicitFiles) -> %% Deals with the cases of creating a package out of specific files Paths = lists:map(fun cleanup_path/1, ExplicitFiles), - Package0 = maps:remove(~"purl", Package), - Package1 = maps:remove(~"ID", Package0), - Package2 = maps:remove(~"path", Package1), + Package1 = maps:without([~"purl", ~"ID", ~"path", ~"update"], Package), %% place files in SPDX in the corresponding package Files = lists:filter(fun (#{~"fileName" := Filename}) -> @@ -1178,7 +1111,7 @@ generate_spdx_vendor_packages(VendorInfoPackages, #{~"files" := SpdxFiles}=_SPDX PackageVerificationCodeValue = generate_verification_code_value(Files), ExternalRefs = generate_vendor_purl(Package), - Package2#{ + Package1#{ ~"SPDXID" => generate_spdxid_name(Id), ~"filesAnalyzed" => true, ~"hasFiles" => lists:map(fun (#{~"SPDXID":=Id0}) -> Id0 end, Files), @@ -1192,9 +1125,7 @@ generate_spdx_vendor_packages(VendorInfoPackages, #{~"files" := SpdxFiles}=_SPDX %% Deals with the case of creating a package out of a path Path = cleanup_path(DirtyPath), true = filelib:is_dir(DirtyPath), - Package0 = maps:remove(~"purl", Package), - Package1 = maps:remove(~"ID", Package0), - Package2 = maps:remove(~"path", Package1), + Package1 = maps:without([~"purl", ~"ID", ~"path", ~"update"], Package), %% place files in SPDX in the corresponding package Files = lists:filter(fun (#{~"fileName" := Filename}) -> @@ -1210,7 +1141,7 @@ generate_spdx_vendor_packages(VendorInfoPackages, #{~"files" := SpdxFiles}=_SPDX PackageVerificationCodeValue = generate_verification_code_value(Files), ExternalRefs = generate_vendor_purl(Package), - Package2#{ + Package1#{ ~"SPDXID" => generate_spdxid_name(Id), ~"filesAnalyzed" => true, ~"hasFiles" => lists:map(fun (#{~"SPDXID":=Id0}) -> Id0 end, Files), @@ -1525,7 +1456,6 @@ package_generator(Sbom) -> test_download_location, test_package_relations, test_has_extracted_licenses, - test_snippets, test_vendor_packages], true = ?CALL_TEST_FUNCTIONS(Tests, Sbom), ok. @@ -1589,7 +1519,7 @@ root_vendor_packages() -> minimum_vendor_packages() -> %% self-contained root_vendor_packages() ++ - [~"tcl", ~"json-test-suite", ~"openssl", ~"Autoconf", ~"wx", ~"jquery", ~"jquery-tablesorter"]. + [~"tcl", ~"ryu_to_chars", ~"json-test-suite", ~"openssl", ~"Autoconf", ~"wx", ~"jquery", ~"jquery-tablesorter"]. test_copyright_not_empty(#{~"packages" := Packages}) -> true = lists:all(fun (#{~"copyrightText" := Copyright}) -> Copyright =/= ~"" end, Packages), @@ -1862,25 +1792,6 @@ test_has_extracted_licenses(#{~"hasExtractedLicensingInfos" := LicensesInfo, true = lists:all(fun (#{~"licenseId" := LicenseId}) -> lists:member(LicenseId, LicenseRefsInProject) end, LicensesInfo), ok. -test_snippets(#{~"snippets" := Snippets, ~"files" := Files}=_Spdx) -> - true = lists:all(fun (#{ ~"SPDXID" := _Id, - ~"copyrightText" := _Copyright, - ~"licenseConcluded" := License, - ~"licenseInfoInSnippets" := Licenses, - ~"name" := _Name, - ~"ranges" := [ #{~"endPointer" := #{ ~"lineNumber" := EndLine, ~"reference" := SpdxId}, - ~"startPointer" := #{ ~"lineNumber" := StartLine, ~"reference" := SpdxId}}, - #{~"endPointer" := #{ ~"offset" := EndOffsetBytes, ~"reference" := SpdxId}, - ~"startPointer" := #{ ~"offset" := StartOffsetBytes, ~"reference" := SpdxId}} ], - ~"snippetFromFile" := SpdxId}) -> - EndLine >= StartLine andalso - EndOffsetBytes >= StartOffsetBytes andalso - lists:all(fun (L) -> lists:member(L, Licenses) end, split_licenses_in_individual_parts([License])) andalso - length(lists:filter(fun (#{~"SPDXID" := Id}) -> SpdxId == Id end, Files)) == 1 - end, Snippets), - ok. - - %% Adds LicenseRef licenses where the text is missing. extracted_license_info() -> [begin diff --git a/erts/emulator/ryu/LICENSE-Apache2 b/erts/emulator/ryu/LICENSE-Apache2 new file mode 100644 index 000000000000..261eeb9e9f8b --- /dev/null +++ b/erts/emulator/ryu/LICENSE-Apache2 @@ -0,0 +1,201 @@ + Apache License + Version 2.0, January 2004 + http://www.apache.org/licenses/ + + TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION + + 1. Definitions. + + "License" shall mean the terms and conditions for use, reproduction, + and distribution as defined by Sections 1 through 9 of this document. + + "Licensor" shall mean the copyright owner or entity authorized by + the copyright owner that is granting the License. + + "Legal Entity" shall mean the union of the acting entity and all + other entities that control, are controlled by, or are under common + control with that entity. For the purposes of this definition, + "control" means (i) the power, direct or indirect, to cause the + direction or management of such entity, whether by contract or + otherwise, or (ii) ownership of fifty percent (50%) or more of the + outstanding shares, or (iii) beneficial ownership of such entity. + + "You" (or "Your") shall mean an individual or Legal Entity + exercising permissions granted by this License. + + "Source" form shall mean the preferred form for making modifications, + including but not limited to software source code, documentation + source, and configuration files. + + "Object" form shall mean any form resulting from mechanical + transformation or translation of a Source form, including but + not limited to compiled object code, generated documentation, + and conversions to other media types. + + "Work" shall mean the work of authorship, whether in Source or + Object form, made available under the License, as indicated by a + copyright notice that is included in or attached to the work + (an example is provided in the Appendix below). + + "Derivative Works" shall mean any work, whether in Source or Object + form, that is based on (or derived from) the Work and for which the + editorial revisions, annotations, elaborations, or other modifications + represent, as a whole, an original work of authorship. For the purposes + of this License, Derivative Works shall not include works that remain + separable from, or merely link (or bind by name) to the interfaces of, + the Work and Derivative Works thereof. + + "Contribution" shall mean any work of authorship, including + the original version of the Work and any modifications or additions + to that Work or Derivative Works thereof, that is intentionally + submitted to Licensor for inclusion in the Work by the copyright owner + or by an individual or Legal Entity authorized to submit on behalf of + the copyright owner. For the purposes of this definition, "submitted" + means any form of electronic, verbal, or written communication sent + to the Licensor or its representatives, including but not limited to + communication on electronic mailing lists, source code control systems, + and issue tracking systems that are managed by, or on behalf of, the + Licensor for the purpose of discussing and improving the Work, but + excluding communication that is conspicuously marked or otherwise + designated in writing by the copyright owner as "Not a Contribution." + + "Contributor" shall mean Licensor and any individual or Legal Entity + on behalf of whom a Contribution has been received by Licensor and + subsequently incorporated within the Work. + + 2. Grant of Copyright License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + copyright license to reproduce, prepare Derivative Works of, + publicly display, publicly perform, sublicense, and distribute the + Work and such Derivative Works in Source or Object form. + + 3. Grant of Patent License. Subject to the terms and conditions of + this License, each Contributor hereby grants to You a perpetual, + worldwide, non-exclusive, no-charge, royalty-free, irrevocable + (except as stated in this section) patent license to make, have made, + use, offer to sell, sell, import, and otherwise transfer the Work, + where such license applies only to those patent claims licensable + by such Contributor that are necessarily infringed by their + Contribution(s) alone or by combination of their Contribution(s) + with the Work to which such Contribution(s) was submitted. If You + institute patent litigation against any entity (including a + cross-claim or counterclaim in a lawsuit) alleging that the Work + or a Contribution incorporated within the Work constitutes direct + or contributory patent infringement, then any patent licenses + granted to You under this License for that Work shall terminate + as of the date such litigation is filed. + + 4. Redistribution. You may reproduce and distribute copies of the + Work or Derivative Works thereof in any medium, with or without + modifications, and in Source or Object form, provided that You + meet the following conditions: + + (a) You must give any other recipients of the Work or + Derivative Works a copy of this License; and + + (b) You must cause any modified files to carry prominent notices + stating that You changed the files; and + + (c) You must retain, in the Source form of any Derivative Works + that You distribute, all copyright, patent, trademark, and + attribution notices from the Source form of the Work, + excluding those notices that do not pertain to any part of + the Derivative Works; and + + (d) If the Work includes a "NOTICE" text file as part of its + distribution, then any Derivative Works that You distribute must + include a readable copy of the attribution notices contained + within such NOTICE file, excluding those notices that do not + pertain to any part of the Derivative Works, in at least one + of the following places: within a NOTICE text file distributed + as part of the Derivative Works; within the Source form or + documentation, if provided along with the Derivative Works; or, + within a display generated by the Derivative Works, if and + wherever such third-party notices normally appear. The contents + of the NOTICE file are for informational purposes only and + do not modify the License. You may add Your own attribution + notices within Derivative Works that You distribute, alongside + or as an addendum to the NOTICE text from the Work, provided + that such additional attribution notices cannot be construed + as modifying the License. + + You may add Your own copyright statement to Your modifications and + may provide additional or different license terms and conditions + for use, reproduction, or distribution of Your modifications, or + for any such Derivative Works as a whole, provided Your use, + reproduction, and distribution of the Work otherwise complies with + the conditions stated in this License. + + 5. Submission of Contributions. Unless You explicitly state otherwise, + any Contribution intentionally submitted for inclusion in the Work + by You to the Licensor shall be under the terms and conditions of + this License, without any additional terms or conditions. + Notwithstanding the above, nothing herein shall supersede or modify + the terms of any separate license agreement you may have executed + with Licensor regarding such Contributions. + + 6. Trademarks. This License does not grant permission to use the trade + names, trademarks, service marks, or product names of the Licensor, + except as required for reasonable and customary use in describing the + origin of the Work and reproducing the content of the NOTICE file. + + 7. Disclaimer of Warranty. Unless required by applicable law or + agreed to in writing, Licensor provides the Work (and each + Contributor provides its Contributions) on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or + implied, including, without limitation, any warranties or conditions + of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A + PARTICULAR PURPOSE. You are solely responsible for determining the + appropriateness of using or redistributing the Work and assume any + risks associated with Your exercise of permissions under this License. + + 8. Limitation of Liability. In no event and under no legal theory, + whether in tort (including negligence), contract, or otherwise, + unless required by applicable law (such as deliberate and grossly + negligent acts) or agreed to in writing, shall any Contributor be + liable to You for damages, including any direct, indirect, special, + incidental, or consequential damages of any character arising as a + result of this License or out of the use or inability to use the + Work (including but not limited to damages for loss of goodwill, + work stoppage, computer failure or malfunction, or any and all + other commercial damages or losses), even if such Contributor + has been advised of the possibility of such damages. + + 9. Accepting Warranty or Additional Liability. While redistributing + the Work or Derivative Works thereof, You may choose to offer, + and charge a fee for, acceptance of support, warranty, indemnity, + or other liability obligations and/or rights consistent with this + License. However, in accepting such obligations, You may act only + on Your own behalf and on Your sole responsibility, not on behalf + of any other Contributor, and only if You agree to indemnify, + defend, and hold each Contributor harmless for any liability + incurred by, or claims asserted against, such Contributor by reason + of your accepting any such warranty or additional liability. + + END OF TERMS AND CONDITIONS + + APPENDIX: How to apply the Apache License to your work. + + To apply the Apache License to your work, attach the following + boilerplate notice, with the fields enclosed by brackets "[]" + replaced with your own identifying information. (Don't include + the brackets!) The text should be enclosed in the appropriate + comment syntax for the file format. We also recommend that a + file or class name and description of purpose be included on the + same "printed page" as the copyright notice for easier + identification within third-party archives. + + Copyright [yyyy] [name of copyright owner] + + Licensed under the Apache License, Version 2.0 (the "License"); + you may not use this file except in compliance with the License. + You may obtain a copy of the License at + + http://www.apache.org/licenses/LICENSE-2.0 + + Unless required by applicable law or agreed to in writing, software + distributed under the License is distributed on an "AS IS" BASIS, + WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. + See the License for the specific language governing permissions and + limitations under the License. diff --git a/erts/emulator/ryu/LICENSE-Boost b/erts/emulator/ryu/LICENSE-Boost new file mode 100644 index 000000000000..36b7cd93cdfb --- /dev/null +++ b/erts/emulator/ryu/LICENSE-Boost @@ -0,0 +1,23 @@ +Boost Software License - Version 1.0 - August 17th, 2003 + +Permission is hereby granted, free of charge, to any person or organization +obtaining a copy of the software and accompanying documentation covered by +this license (the "Software") to use, reproduce, display, distribute, +execute, and transmit the Software, and to prepare derivative works of the +Software, and to permit third-parties to whom the Software is furnished to +do so, all subject to the following: + +The copyright notices in the Software and this entire statement, including +the above license grant, this restriction and the following disclaimer, +must be included in all copies of the Software, in whole or in part, and +all derivative works of the Software, unless such copies or derivative +works are solely in the form of machine-executable object code generated by +a source language processor. + +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR +IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, +FITNESS FOR A PARTICULAR PURPOSE, TITLE AND NON-INFRINGEMENT. IN NO EVENT +SHALL THE COPYRIGHT HOLDERS OR ANYONE DISTRIBUTING THE SOFTWARE BE LIABLE +FOR ANY DAMAGES OR OTHER LIABILITY, WHETHER IN CONTRACT, TORT OR OTHERWISE, +ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER +DEALINGS IN THE SOFTWARE. diff --git a/erts/emulator/ryu/README.ryu_update.md b/erts/emulator/ryu/README.md similarity index 75% rename from erts/emulator/ryu/README.ryu_update.md rename to erts/emulator/ryu/README.md index 589761c4d26b..c3b16dfb5c4d 100644 --- a/erts/emulator/ryu/README.ryu_update.md +++ b/erts/emulator/ryu/README.md @@ -19,11 +19,7 @@ %% %CopyrightEnd% --> -# How to update the Ryu version used by Erlang - -Last commit taken : 844864ac213bdbf1fb57e6f51c653b3d90af0937 - -## The basic changes to the Ryu library +# Erlang RYU To work with the Erlang VM, Ryu has been changed in three important ways. These changes have been marked with a `//CHANGE_FOR_ERLANG` comment explaining them in @@ -39,3 +35,15 @@ Some of the more minor difference: - the Zero case in common.h is changed to correspond to erlang fixed point version - the MS STL pointer check are not here. Erlang generate a 256 bytes buffer, we only need 30 maximum. Beware what this mean when refactoring. + +# How to update the Ryu version used by Erlang + +To update run the `update.sh` script in this folder. It uses + as a base and tries to merge + into it. If there are no merge conflicts it then +checks that the STL file we use had changed. If it has changed you need to manually +check if there are any changes in the `__to_chars` function and if so see if they +need to be uplifted. + +The update script will also bump the versions in vendor.info so that the SBOM +contains the latest versions. \ No newline at end of file diff --git a/erts/emulator/ryu/d2s.c b/erts/emulator/ryu/d2s.c index f3ac78306a73..f4a997a1ff02 100644 --- a/erts/emulator/ryu/d2s.c +++ b/erts/emulator/ryu/d2s.c @@ -84,6 +84,10 @@ typedef struct floating_decimal_64 { int32_t exponent; } floating_decimal_64; +// CHANGE_FOR_ERLANG include STL to_chars function +#include "to_chars.h" +// END CHANGE_FOR_ERLANG + static inline floating_decimal_64 d2d(const uint64_t ieeeMantissa, const uint32_t ieeeExponent) { int32_t e2; uint64_t m2; @@ -295,352 +299,6 @@ static inline floating_decimal_64 d2d(const uint64_t ieeeMantissa, const uint32_ return fd; } -//CHANGE_FOR_ERLANG: This format is new, it is here to handle the different format switch used in the STL code -enum chars_format { - FMT_SCIENTIFIC, - FMT_FIXED, - FMT_GENERAL -}; - -// SPDX-SnippetBegin -// SPDX-SnippetCopyrightText: Copyright (c) Microsoft Corporation. -// SPDX-SnippetCopyrightText: Copyright 2018 Ulf Adams -// SPDX-SnippetCopyrightText: Copyright (c) Microsoft Corporation. All rights reserved. -// SPDX-License-Identifier: (Apache-2.0 WITH LLVM-exception) AND BSL-1.0 -// -// The license information in the original file is not -// clear on whether it should be AND or OR between -// "Apache 2.0 with LLVM-exception" and "Boost Software License 1.0". -// Therefore, just to be safe, an AND was chosen in the SPDX license -// identifier expression above. -// Library: STL -// Git repository: https://github.com/microsoft/STL -// Commit: e745bad3b1d05b5b19ec652d68abb37865ffa454 -// Original function: https://github.com/microsoft/STL/blob/e745bad3b1d05b5b19ec652d68abb37865ffa454/stl/inc/xcharconv_ryu.h#L1926 - - -// This is inspired from the MS STL Charconv, under Apache with LLVM exception licence -// see https://github.com/microsoft/STL/blob/main/LICENSE.txt -// The inspiration is at https://github.com/microsoft/STL/blob/e745bad3b1d05b5b19ec652d68abb37865ffa454/stl/inc/xcharconv_ryu.h#L1926 -// CHANGE_FOR_ERLANG all the types and typecast have been adapted to C types from Cpp. -// I have also kept the Ryu original function head as it allows to not impact the rest of the code -// __v and __mantissa and __exponent have lost their double underscore over the whole function -// all the test on the lenght of the buffer have been dropped too. This could need change, but -// we always pass a 256 bytes buffer when we only need 26 bytes maximum. -static inline int to_chars(const floating_decimal_64 v, const bool sign, char* const result) { - // Step 5: Print the decimal representation. - uint64_t __output = v.mantissa; - int32_t _Ryu_exponent = v.exponent; - const uint32_t __olength = decimalLength17(__output); - int32_t _Scientific_exponent = _Ryu_exponent + ((int32_t) __olength) - 1; - - // CHANGE_FOR_ERLANG: we use our chars_format instead of the STL one - enum chars_format _Fmt; - - int32_t _Lower; - int32_t _Upper; - - if (__olength == 1) { - // CHANGE_FOR_ERLANG the format and examples have been adapted to the erlang format - // as the original would have not shown a change in format - // (erlang always add ".0" to scientific format) and omit the + in the exponent - // Value | Fixed | Scientific - // 1e-4 | "0.0001" | "1.0e-4" - // 1e2 | "100.0" | "1.0e2" - // CHANGE_FOR_ERLANG the values for a switch, as seen in the example above, for erlang - // are different than for STL format. - _Lower = -4; - _Upper = 2; - } else if (_Scientific_exponent >= 10) { - // CHANGE_FOR_ERLANG This case does not exist for the STL and is due to the - // negative sign in the exponent. - // Value | Fixed | Scientific - // 123456789e1 | "1234567890.0" | "1.23456789e9" - // 123456789e2 | "12345678900.0" | "1.23456789e10" - - _Lower = - (int32_t) (__olength + 2); - _Upper = 2; - } else { - // CHANGE_FOR_ERLANG the format and examples have been adapted to the erlang format - // as the original would have not shown a change in format - // (erlang always add ".0" to scientific format) and omit the + in the exponent - // Value | Fixed | Scientific - // 1234e-6 | "0.001234" | "1.234e-4" - // 1234e1 | "12340.0" | "1.234e4" - // CHANGE_FOR_ERLANG the values for a switch, as seen in the example above, for erlang - // are different than for STL format. - _Lower = - (int32_t) (__olength + 2); - _Upper = 1; - } - - if (_Lower <= _Ryu_exponent && _Ryu_exponent <= _Upper) { - // CHANGE_FOR_ERLANG this is added to handle the -2**53, 2**53 range special case - // These are edge cases not captured above, all the other are naturally handled - // by _Lower nad _Upper - if ((__output >= (1ull << 53) && _Ryu_exponent == 0) - || (__output > ((1ull << 52) / 5) && _Ryu_exponent == 1) - || (__output > ((1ull << 51) / 25) && _Ryu_exponent == 2)) { - _Fmt = FMT_SCIENTIFIC; - } else { - _Fmt = FMT_FIXED; - } - } else { - // CHANGE_FOR_ERLANG we do not need to handle the %g case here. - _Fmt = FMT_SCIENTIFIC; - } - - // CHANGE_FOR_ERLANG we handle the sign here as it is handled outside of this in the STL case - // and we need it to compute the start of the buffer for the characters after - if (sign) { - result[0] = '-'; - } - - // CHANGE_FOR_ERLANG we compute the start of the usable buffer. It is done here - // in order to be fixed for both branches of formatting. - char* const __result = result + sign; - - if (_Fmt == FMT_FIXED) { - // CHANGE_FOR_ERLANG this whole table has been adapted to erlang examples to help - // debug and evolve the edge cases - // Example: __output == 1729, __olength == 4 - - // _Ryu_exponent | Printed | _Whole_digits | _Total_fixed_length | Notes - // --------------|----------|---------------|----------------------|--------------------------------------- - // 1 | 17290.0 | 5 | _Whole_digits + 2 | Unified length cases. - // 0 | 1729.0 | 4 | | - // --------------|----------|---------------|----------------------|--------------------------------------- - // -1 | 172.9 | 3 | __olength + 1 | This case can't happen for - // -2 | 17.29 | 2 | | __olength == 1, but no additional - // -3 | 1.729 | 1 | | code is needed to avoid it. - // --------------|----------|---------------|----------------------|--------------------------------------- - // -4 | 0.1729 | 0 | 2 - _Ryu_exponent | If the decimal point appears, we need - // -5 | 0.01729 | -1 | | to put the "0" in front - // -6 | 0.001729 | -2 | | - - const int32_t _Whole_digits = (int32_t) (__olength) + _Ryu_exponent; - - uint32_t _Total_fixed_length; - if (_Ryu_exponent >= 0) { - // CHANGE_FOR_ERLANG the examples and values have been adapted to erlang format one - // CHANGE_FOR_ERLANG we also dropped the whole adjustement, as it is only of value - // for %f which we do not handle - // cases "17290.0" and "1729.0" - _Total_fixed_length = (uint32_t) (_Whole_digits) + 2; - } else if (_Whole_digits > 0) { // case "17.29" - _Total_fixed_length = __olength + 1; - } else { // case "0.001729" - _Total_fixed_length = (uint32_t) (2 - _Ryu_exponent); - } - - char* _Mid; - if (_Ryu_exponent >= 0) { // case "172900.0" - // CHANGE_FOR_ERLANG we do not need the can_use_ryu, as we are not doing %f - // but always shortest round_trip. The whole complexity here is dropped - // Print the decimal digits, left-aligned within [result, result + _Total_fixed_length). - _Mid = __result + __olength; - } else { // cases "1729.0", "17.29", and "0.001729" - // Print the decimal digits, right-aligned within [result, result + _Total_fixed_length). - _Mid = __result + _Total_fixed_length; - } - - // We prefer 32-bit operations, even on 64-bit platforms. - // We have at most 17 digits, and uint32_t can store 9 digits. - // If __output doesn't fit into uint32_t, we cut off 8 digits, - // so the rest will fit into uint32_t. - // CHANGE_FOR_ERLANG we consider in this whole thing that memcopy use the same - // char has defined in the DIGIT_TABLE - // CHANGE_FOR_ERLANG __DIGIT_TABLE became DIGIT_TABLE - if ((__output >> 32) != 0) { - // Expensive 64-bit division. - const uint64_t __q = div1e8(__output); - uint32_t __output2 = (uint32_t) (__output - 100000000 * __q); - __output = __q; - - const uint32_t __c = __output2 % 10000; - __output2 /= 10000; - const uint32_t __d = __output2 % 10000; - const uint32_t __c0 = (__c % 100) << 1; - const uint32_t __c1 = (__c / 100) << 1; - const uint32_t __d0 = (__d % 100) << 1; - const uint32_t __d1 = (__d / 100) << 1; - - memcpy(_Mid -= 2, DIGIT_TABLE + __c0, 2); - memcpy(_Mid -= 2, DIGIT_TABLE + __c1, 2); - memcpy(_Mid -= 2, DIGIT_TABLE + __d0, 2); - memcpy(_Mid -= 2, DIGIT_TABLE + __d1, 2); - } - uint32_t __output2 = (uint32_t) __output; - while (__output2 >= 10000) { -#ifdef __clang__ // TRANSITION, LLVM-38217 - const uint32_t __c = __output2 - 10000 * (__output2 / 10000); -#else - const uint32_t __c = __output2 % 10000; -#endif - __output2 /= 10000; - const uint32_t __c0 = (__c % 100) << 1; - const uint32_t __c1 = (__c / 100) << 1; - memcpy(_Mid -= 2, DIGIT_TABLE + __c0, 2); - memcpy(_Mid -= 2, DIGIT_TABLE + __c1, 2); - } - if (__output2 >= 100) { - const uint32_t __c = (__output2 % 100) << 1; - __output2 /= 100; - memcpy(_Mid -= 2, DIGIT_TABLE + __c, 2); - } - if (__output2 >= 10) { - const uint32_t __c = __output2 << 1; - memcpy(_Mid -= 2, DIGIT_TABLE + __c, 2); - } else { - *--_Mid = (char) ('0' + __output2); - } - - if (_Ryu_exponent > 0) { // case "172900.0" - // Performance note: it might be more efficient to do this immediately after setting _Mid. - // CHANGE_FOR_ERLANG we have different case here, so we have to add the ".0" here - // we use memset as we do not have access to fill_n - memset(__result + __olength, '0', (size_t) _Ryu_exponent); - __result[__olength + (size_t) _Ryu_exponent] = '.'; - __result[__olength + (size_t) _Ryu_exponent + 1] = '0'; - } else if (_Ryu_exponent == 0) { // case "1729.0" - // CHANGE_FOR_ERLANG we have different case here, so we have to add the ".0" here - __result[__olength] = '.'; - __result[__olength + 1] = '0'; - } else if (_Whole_digits > 0) { // case "17.29" - // Performance note: moving digits might not be optimal. - memmove(__result, __result + 1, (size_t) _Whole_digits); - __result[_Whole_digits] = '.'; - } else { // case "0.001729" - // CHANGE_FOR_ERLANG we use the memset here as we do not have access to fill_n - // Performance note: a larger memset() followed by overwriting '.' might be more efficient. - __result[0] = '0'; - __result[1] = '.'; - memset(__result + 2, '0', (size_t) (-_Whole_digits)); - } - - // CHANGE_FOR_ERLANG we do not need the errc and we are only interested in - // returning the length, as it is what Ryu and erlang expect. We do add the - // sign as we did it here instead of adding it by default as in the STL - return _Total_fixed_length + sign; - } - - uint32_t _Scientific_exponent_length; - // CHANGE_FOR_ERLANG we have to do a little bit more complex logic here because we do not always - // print the exponent sign, only if it is negative - if (_Scientific_exponent <= -100) { // "e-100" - _Scientific_exponent_length = 5; - } else if (_Scientific_exponent <= -10 || _Scientific_exponent >= 100) { // "e-10" or "e100" - _Scientific_exponent_length = 4; - } else if ((_Scientific_exponent > -10 && _Scientific_exponent < 0) || _Scientific_exponent >= 10) { // "e-9" or "e10" - _Scientific_exponent_length = 3; - } else { // "e1" - _Scientific_exponent_length = 2; - } - - // CHANGE_FOR_ERLANG we do not need the ternary as we did all the logic above - const uint32_t _Total_scientific_length = __olength + 1 +(__olength == 1) // digits + decimal point + possible 0 after decimal point - + _Scientific_exponent_length; // + scientific exponent - - // Print the decimal digits. - uint32_t __i = 0; - // We prefer 32-bit operations, even on 64-bit platforms. - // We have at most 17 digits, and uint32_t can store 9 digits. - // If __output doesn't fit into uint32_t, we cut off 8 digits, - // so the rest will fit into uint32_t. - // CHANGE_FOR_ERLANG we consider in this whole thing that memcopy use the same - // char has defined in the DIGIT_TABLE - // CHANGE_FOR_ERLANG __DIGIT_TABLE became DIGIT_TABLE - if ((__output >> 32) != 0) { - // Expensive 64-bit division. - const uint64_t __q = div1e8(__output); - uint32_t __output2 = (uint32_t) (__output) - 100000000 * (uint32_t) (__q); - __output = __q; - - const uint32_t __c = __output2 % 10000; - __output2 /= 10000; - const uint32_t __d = __output2 % 10000; - const uint32_t __c0 = (__c % 100) << 1; - const uint32_t __c1 = (__c / 100) << 1; - const uint32_t __d0 = (__d % 100) << 1; - const uint32_t __d1 = (__d / 100) << 1; - memcpy(__result + __olength - __i - 1, DIGIT_TABLE + __c0, 2); - memcpy(__result + __olength - __i - 3, DIGIT_TABLE + __c1, 2); - memcpy(__result + __olength - __i - 5, DIGIT_TABLE + __d0, 2); - memcpy(__result + __olength - __i - 7, DIGIT_TABLE + __d1, 2); - __i += 8; - } - uint32_t __output2 = (uint32_t) (__output); - while (__output2 >= 10000) { -#ifdef __clang__ // TRANSITION, LLVM-38217 - const uint32_t __c = __output2 - 10000 * (__output2 / 10000); -#else - const uint32_t __c = __output2 % 10000; -#endif - __output2 /= 10000; - const uint32_t __c0 = (__c % 100) << 1; - const uint32_t __c1 = (__c / 100) << 1; - memcpy(__result + __olength - __i - 1, DIGIT_TABLE + __c0, 2); - memcpy(__result + __olength - __i - 3, DIGIT_TABLE + __c1, 2); - __i += 4; - } - if (__output2 >= 100) { - const uint32_t __c = (__output2 % 100) << 1; - __output2 /= 100; - memcpy(__result + __olength - __i - 1, DIGIT_TABLE + __c, 2); - __i += 2; - } - if (__output2 >= 10) { - const uint32_t __c = __output2 << 1; - // We can't use memcpy here: the decimal dot goes between these two digits. - __result[2] = DIGIT_TABLE[__c + 1]; - __result[0] = DIGIT_TABLE[__c]; - } else { - __result[0] = (char) ('0' + __output2); - } - - // Print decimal point if needed. - uint32_t __index; - if (__olength > 1) { - __result[1] = '.'; - __index = __olength + 1; - } else { - // In erlang we _have_ to print the ".0" in the case this is an integer - __result[1] = '.'; - __result[2] = '0'; - __index = __olength + 2; - } - - // Print the exponent. - __result[__index++] = 'e'; - if (_Scientific_exponent < 0) { - __result[__index++] = '-'; - _Scientific_exponent = -_Scientific_exponent; - } - // CHANGE_FOR_ERLANG no else, as we do not print the positive sign on the exponent - - if (_Scientific_exponent >= 100) { - const int32_t __c = _Scientific_exponent % 10; - memcpy(__result + __index, DIGIT_TABLE + 2 * (_Scientific_exponent / 10), 2); - __result[__index + 2] = (char) ('0' + __c); - __index += 3; - } else if (_Scientific_exponent >= 10) { - // CHANGE_FOR_ERLANG we have to do this only if the exponent is larger than 10 - memcpy(__result + __index, DIGIT_TABLE + 2 * _Scientific_exponent, 2); - __index += 2; - } else { - // CHANGE_FOR_ERLANG we can have an exponent under 10, which is not handled by the table - // so we handle it here - __result[__index++] = (char) ('0' + _Scientific_exponent); - } - - // CHANGE_FOR_ERLANG we do not need the errc and we are only interested in - // returning the length, as it is what Ryu and erlang expect. We do add the - // sign as we did it here instead of adding it by default as in the STL - return _Total_scientific_length + sign; -} -// end of STL code, back to ryu -// SPDX-SnippetEnd - - static inline bool d2d_small_int(const uint64_t ieeeMantissa, const uint32_t ieeeExponent, floating_decimal_64* const v) { const uint64_t m2 = (1ull << DOUBLE_MANTISSA_BITS) | ieeeMantissa; diff --git a/erts/emulator/ryu/d2s_intrinsics.h b/erts/emulator/ryu/d2s_intrinsics.h index 77388b308821..3d53ed3b3b81 100644 --- a/erts/emulator/ryu/d2s_intrinsics.h +++ b/erts/emulator/ryu/d2s_intrinsics.h @@ -189,15 +189,14 @@ static inline uint32_t mod1e9(const uint64_t x) { #endif // defined(RYU_32_BIT_PLATFORM) static inline uint32_t pow5Factor(uint64_t value) { + const uint64_t m_inv_5 = 14757395258967641293u; // 5 * m_inv_5 = 1 (mod 2^64) + const uint64_t n_div_5 = 3689348814741910323u; // #{ n | n = 0 (mod 2^64) } = 2^64 / 5 uint32_t count = 0; for (;;) { assert(value != 0); - const uint64_t q = div5(value); - const uint32_t r = ((uint32_t) value) - 5 * ((uint32_t) q); - if (r != 0) { + value *= m_inv_5; + if (value > n_div_5) break; - } - value = q; ++count; } return count; diff --git a/erts/emulator/ryu/to_chars.h b/erts/emulator/ryu/to_chars.h new file mode 100644 index 000000000000..1d41d3ea9883 --- /dev/null +++ b/erts/emulator/ryu/to_chars.h @@ -0,0 +1,340 @@ +// SPDX-CopyrightText: Copyright (c) Microsoft Corporation. +// SPDX-CopyrightText: Copyright 2018 Ulf Adams +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception AND BSL-1.0 +//h +// The license information in the original file is not super clear. +// Microsoft seems to have changed it from Apache-2.0 to Apache-2.0 WITH LLVM-exception +// which they most likely are not allowed to do as the LLVM exception is less +// restrictive than Apache-2.0 plain. There is not much we can do about that +// though so we use their license. +// +// Library: STL +// Git repository: https://github.com/microsoft/STL +// Commit: e745bad3b1d05b5b19ec652d68abb37865ffa454 +// Original function: https://github.com/microsoft/STL/blob/e745bad3b1d05b5b19ec652d68abb37865ffa454/stl/inc/xcharconv_ryu.h#L1926 + +//CHANGE_FOR_ERLANG: This format is new, it is here to handle the different format switch used in the STL code +enum chars_format { + FMT_SCIENTIFIC, + FMT_FIXED, + FMT_GENERAL +}; + +// This is inspired from the MS STL Charconv, under Apache with LLVM exception licence +// see https://github.com/microsoft/STL/blob/main/LICENSE.txt +// The inspiration is at https://github.com/microsoft/STL/blob/e745bad3b1d05b5b19ec652d68abb37865ffa454/stl/inc/xcharconv_ryu.h#L1926 +// CHANGE_FOR_ERLANG all the types and typecast have been adapted to C types from Cpp. +// I have also kept the Ryu original function head as it allows to not impact the rest of the code +// __v and __mantissa and __exponent have lost their double underscore over the whole function +// all the test on the lenght of the buffer have been dropped too. This could need change, but +// we always pass a 256 bytes buffer when we only need 26 bytes maximum. +static inline int to_chars(const floating_decimal_64 v, const bool sign, char* const result) { + // Step 5: Print the decimal representation. + uint64_t __output = v.mantissa; + int32_t _Ryu_exponent = v.exponent; + const uint32_t __olength = decimalLength17(__output); + int32_t _Scientific_exponent = _Ryu_exponent + ((int32_t) __olength) - 1; + + // CHANGE_FOR_ERLANG: we use our chars_format instead of the STL one + enum chars_format _Fmt; + + int32_t _Lower; + int32_t _Upper; + + if (__olength == 1) { + // CHANGE_FOR_ERLANG the format and examples have been adapted to the erlang format + // as the original would have not shown a change in format + // (erlang always add ".0" to scientific format) and omit the + in the exponent + // Value | Fixed | Scientific + // 1e-4 | "0.0001" | "1.0e-4" + // 1e2 | "100.0" | "1.0e2" + // CHANGE_FOR_ERLANG the values for a switch, as seen in the example above, for erlang + // are different than for STL format. + _Lower = -4; + _Upper = 2; + } else if (_Scientific_exponent >= 10) { + // CHANGE_FOR_ERLANG This case does not exist for the STL and is due to the + // negative sign in the exponent. + // Value | Fixed | Scientific + // 123456789e1 | "1234567890.0" | "1.23456789e9" + // 123456789e2 | "12345678900.0" | "1.23456789e10" + + _Lower = - (int32_t) (__olength + 2); + _Upper = 2; + } else { + // CHANGE_FOR_ERLANG the format and examples have been adapted to the erlang format + // as the original would have not shown a change in format + // (erlang always add ".0" to scientific format) and omit the + in the exponent + // Value | Fixed | Scientific + // 1234e-6 | "0.001234" | "1.234e-4" + // 1234e1 | "12340.0" | "1.234e4" + // CHANGE_FOR_ERLANG the values for a switch, as seen in the example above, for erlang + // are different than for STL format. + _Lower = - (int32_t) (__olength + 2); + _Upper = 1; + } + + if (_Lower <= _Ryu_exponent && _Ryu_exponent <= _Upper) { + // CHANGE_FOR_ERLANG this is added to handle the -2**53, 2**53 range special case + // These are edge cases not captured above, all the other are naturally handled + // by _Lower nad _Upper + if ((__output >= (1ull << 53) && _Ryu_exponent == 0) + || (__output > ((1ull << 52) / 5) && _Ryu_exponent == 1) + || (__output > ((1ull << 51) / 25) && _Ryu_exponent == 2)) { + _Fmt = FMT_SCIENTIFIC; + } else { + _Fmt = FMT_FIXED; + } + } else { + // CHANGE_FOR_ERLANG we do not need to handle the %g case here. + _Fmt = FMT_SCIENTIFIC; + } + + // CHANGE_FOR_ERLANG we handle the sign here as it is handled outside of this in the STL case + // and we need it to compute the start of the buffer for the characters after + if (sign) { + result[0] = '-'; + } + + // CHANGE_FOR_ERLANG we compute the start of the usable buffer. It is done here + // in order to be fixed for both branches of formatting. + char* const __result = result + sign; + + if (_Fmt == FMT_FIXED) { + // CHANGE_FOR_ERLANG this whole table has been adapted to erlang examples to help + // debug and evolve the edge cases + // Example: __output == 1729, __olength == 4 + + // _Ryu_exponent | Printed | _Whole_digits | _Total_fixed_length | Notes + // --------------|----------|---------------|----------------------|--------------------------------------- + // 1 | 17290.0 | 5 | _Whole_digits + 2 | Unified length cases. + // 0 | 1729.0 | 4 | | + // --------------|----------|---------------|----------------------|--------------------------------------- + // -1 | 172.9 | 3 | __olength + 1 | This case can't happen for + // -2 | 17.29 | 2 | | __olength == 1, but no additional + // -3 | 1.729 | 1 | | code is needed to avoid it. + // --------------|----------|---------------|----------------------|--------------------------------------- + // -4 | 0.1729 | 0 | 2 - _Ryu_exponent | If the decimal point appears, we need + // -5 | 0.01729 | -1 | | to put the "0" in front + // -6 | 0.001729 | -2 | | + + const int32_t _Whole_digits = (int32_t) (__olength) + _Ryu_exponent; + + uint32_t _Total_fixed_length; + if (_Ryu_exponent >= 0) { + // CHANGE_FOR_ERLANG the examples and values have been adapted to erlang format one + // CHANGE_FOR_ERLANG we also dropped the whole adjustement, as it is only of value + // for %f which we do not handle + // cases "17290.0" and "1729.0" + _Total_fixed_length = (uint32_t) (_Whole_digits) + 2; + } else if (_Whole_digits > 0) { // case "17.29" + _Total_fixed_length = __olength + 1; + } else { // case "0.001729" + _Total_fixed_length = (uint32_t) (2 - _Ryu_exponent); + } + + char* _Mid; + if (_Ryu_exponent >= 0) { // case "172900.0" + // CHANGE_FOR_ERLANG we do not need the can_use_ryu, as we are not doing %f + // but always shortest round_trip. The whole complexity here is dropped + // Print the decimal digits, left-aligned within [result, result + _Total_fixed_length). + _Mid = __result + __olength; + } else { // cases "1729.0", "17.29", and "0.001729" + // Print the decimal digits, right-aligned within [result, result + _Total_fixed_length). + _Mid = __result + _Total_fixed_length; + } + + // We prefer 32-bit operations, even on 64-bit platforms. + // We have at most 17 digits, and uint32_t can store 9 digits. + // If __output doesn't fit into uint32_t, we cut off 8 digits, + // so the rest will fit into uint32_t. + // CHANGE_FOR_ERLANG we consider in this whole thing that memcopy use the same + // char has defined in the DIGIT_TABLE + // CHANGE_FOR_ERLANG __DIGIT_TABLE became DIGIT_TABLE + if ((__output >> 32) != 0) { + // Expensive 64-bit division. + const uint64_t __q = div1e8(__output); + uint32_t __output2 = (uint32_t) (__output - 100000000 * __q); + __output = __q; + + const uint32_t __c = __output2 % 10000; + __output2 /= 10000; + const uint32_t __d = __output2 % 10000; + const uint32_t __c0 = (__c % 100) << 1; + const uint32_t __c1 = (__c / 100) << 1; + const uint32_t __d0 = (__d % 100) << 1; + const uint32_t __d1 = (__d / 100) << 1; + + memcpy(_Mid -= 2, DIGIT_TABLE + __c0, 2); + memcpy(_Mid -= 2, DIGIT_TABLE + __c1, 2); + memcpy(_Mid -= 2, DIGIT_TABLE + __d0, 2); + memcpy(_Mid -= 2, DIGIT_TABLE + __d1, 2); + } + uint32_t __output2 = (uint32_t) __output; + while (__output2 >= 10000) { +#ifdef __clang__ // TRANSITION, LLVM-38217 + const uint32_t __c = __output2 - 10000 * (__output2 / 10000); +#else + const uint32_t __c = __output2 % 10000; +#endif + __output2 /= 10000; + const uint32_t __c0 = (__c % 100) << 1; + const uint32_t __c1 = (__c / 100) << 1; + memcpy(_Mid -= 2, DIGIT_TABLE + __c0, 2); + memcpy(_Mid -= 2, DIGIT_TABLE + __c1, 2); + } + if (__output2 >= 100) { + const uint32_t __c = (__output2 % 100) << 1; + __output2 /= 100; + memcpy(_Mid -= 2, DIGIT_TABLE + __c, 2); + } + if (__output2 >= 10) { + const uint32_t __c = __output2 << 1; + memcpy(_Mid -= 2, DIGIT_TABLE + __c, 2); + } else { + *--_Mid = (char) ('0' + __output2); + } + + if (_Ryu_exponent > 0) { // case "172900.0" + // Performance note: it might be more efficient to do this immediately after setting _Mid. + // CHANGE_FOR_ERLANG we have different case here, so we have to add the ".0" here + // we use memset as we do not have access to fill_n + memset(__result + __olength, '0', (size_t) _Ryu_exponent); + __result[__olength + (size_t) _Ryu_exponent] = '.'; + __result[__olength + (size_t) _Ryu_exponent + 1] = '0'; + } else if (_Ryu_exponent == 0) { // case "1729.0" + // CHANGE_FOR_ERLANG we have different case here, so we have to add the ".0" here + __result[__olength] = '.'; + __result[__olength + 1] = '0'; + } else if (_Whole_digits > 0) { // case "17.29" + // Performance note: moving digits might not be optimal. + memmove(__result, __result + 1, (size_t) _Whole_digits); + __result[_Whole_digits] = '.'; + } else { // case "0.001729" + // CHANGE_FOR_ERLANG we use the memset here as we do not have access to fill_n + // Performance note: a larger memset() followed by overwriting '.' might be more efficient. + __result[0] = '0'; + __result[1] = '.'; + memset(__result + 2, '0', (size_t) (-_Whole_digits)); + } + + // CHANGE_FOR_ERLANG we do not need the errc and we are only interested in + // returning the length, as it is what Ryu and erlang expect. We do add the + // sign as we did it here instead of adding it by default as in the STL + return _Total_fixed_length + sign; + } + + uint32_t _Scientific_exponent_length; + // CHANGE_FOR_ERLANG we have to do a little bit more complex logic here because we do not always + // print the exponent sign, only if it is negative + if (_Scientific_exponent <= -100) { // "e-100" + _Scientific_exponent_length = 5; + } else if (_Scientific_exponent <= -10 || _Scientific_exponent >= 100) { // "e-10" or "e100" + _Scientific_exponent_length = 4; + } else if ((_Scientific_exponent > -10 && _Scientific_exponent < 0) || _Scientific_exponent >= 10) { // "e-9" or "e10" + _Scientific_exponent_length = 3; + } else { // "e1" + _Scientific_exponent_length = 2; + } + + // CHANGE_FOR_ERLANG we do not need the ternary as we did all the logic above + const uint32_t _Total_scientific_length = __olength + 1 +(__olength == 1) // digits + decimal point + possible 0 after decimal point + + _Scientific_exponent_length; // + scientific exponent + + // Print the decimal digits. + uint32_t __i = 0; + // We prefer 32-bit operations, even on 64-bit platforms. + // We have at most 17 digits, and uint32_t can store 9 digits. + // If __output doesn't fit into uint32_t, we cut off 8 digits, + // so the rest will fit into uint32_t. + // CHANGE_FOR_ERLANG we consider in this whole thing that memcopy use the same + // char has defined in the DIGIT_TABLE + // CHANGE_FOR_ERLANG __DIGIT_TABLE became DIGIT_TABLE + if ((__output >> 32) != 0) { + // Expensive 64-bit division. + const uint64_t __q = div1e8(__output); + uint32_t __output2 = (uint32_t) (__output) - 100000000 * (uint32_t) (__q); + __output = __q; + + const uint32_t __c = __output2 % 10000; + __output2 /= 10000; + const uint32_t __d = __output2 % 10000; + const uint32_t __c0 = (__c % 100) << 1; + const uint32_t __c1 = (__c / 100) << 1; + const uint32_t __d0 = (__d % 100) << 1; + const uint32_t __d1 = (__d / 100) << 1; + memcpy(__result + __olength - __i - 1, DIGIT_TABLE + __c0, 2); + memcpy(__result + __olength - __i - 3, DIGIT_TABLE + __c1, 2); + memcpy(__result + __olength - __i - 5, DIGIT_TABLE + __d0, 2); + memcpy(__result + __olength - __i - 7, DIGIT_TABLE + __d1, 2); + __i += 8; + } + uint32_t __output2 = (uint32_t) (__output); + while (__output2 >= 10000) { +#ifdef __clang__ // TRANSITION, LLVM-38217 + const uint32_t __c = __output2 - 10000 * (__output2 / 10000); +#else + const uint32_t __c = __output2 % 10000; +#endif + __output2 /= 10000; + const uint32_t __c0 = (__c % 100) << 1; + const uint32_t __c1 = (__c / 100) << 1; + memcpy(__result + __olength - __i - 1, DIGIT_TABLE + __c0, 2); + memcpy(__result + __olength - __i - 3, DIGIT_TABLE + __c1, 2); + __i += 4; + } + if (__output2 >= 100) { + const uint32_t __c = (__output2 % 100) << 1; + __output2 /= 100; + memcpy(__result + __olength - __i - 1, DIGIT_TABLE + __c, 2); + __i += 2; + } + if (__output2 >= 10) { + const uint32_t __c = __output2 << 1; + // We can't use memcpy here: the decimal dot goes between these two digits. + __result[2] = DIGIT_TABLE[__c + 1]; + __result[0] = DIGIT_TABLE[__c]; + } else { + __result[0] = (char) ('0' + __output2); + } + + // Print decimal point if needed. + uint32_t __index; + if (__olength > 1) { + __result[1] = '.'; + __index = __olength + 1; + } else { + // In erlang we _have_ to print the ".0" in the case this is an integer + __result[1] = '.'; + __result[2] = '0'; + __index = __olength + 2; + } + + // Print the exponent. + __result[__index++] = 'e'; + if (_Scientific_exponent < 0) { + __result[__index++] = '-'; + _Scientific_exponent = -_Scientific_exponent; + } + // CHANGE_FOR_ERLANG no else, as we do not print the positive sign on the exponent + + if (_Scientific_exponent >= 100) { + const int32_t __c = _Scientific_exponent % 10; + memcpy(__result + __index, DIGIT_TABLE + 2 * (_Scientific_exponent / 10), 2); + __result[__index + 2] = (char) ('0' + __c); + __index += 3; + } else if (_Scientific_exponent >= 10) { + // CHANGE_FOR_ERLANG we have to do this only if the exponent is larger than 10 + memcpy(__result + __index, DIGIT_TABLE + 2 * _Scientific_exponent, 2); + __index += 2; + } else { + // CHANGE_FOR_ERLANG we can have an exponent under 10, which is not handled by the table + // so we handle it here + __result[__index++] = (char) ('0' + _Scientific_exponent); + } + + // CHANGE_FOR_ERLANG we do not need the errc and we are only interested in + // returning the length, as it is what Ryu and erlang expect. We do add the + // sign as we did it here instead of adding it by default as in the STL + return _Total_scientific_length + sign; +} diff --git a/erts/emulator/ryu/update.sh b/erts/emulator/ryu/update.sh new file mode 100755 index 000000000000..d9b9b07398dc --- /dev/null +++ b/erts/emulator/ryu/update.sh @@ -0,0 +1,105 @@ +#!/bin/bash +# +# %CopyrightBegin% +# +# SPDX-License-Identifier: Apache-2.0 +# +# Copyright Ericsson AB 2025. All Rights Reserved. +# +# Licensed under the Apache License, Version 2.0 (the "License"); +# you may not use this file except in compliance with the License. +# You may obtain a copy of the License at +# +# http://www.apache.org/licenses/LICENSE-2.0 +# +# Unless required by applicable law or agreed to in writing, software +# distributed under the License is distributed on an "AS IS" BASIS, +# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +# See the License for the specific language governing permissions and +# limitations under the License. +# +# %CopyrightEnd% + +ORIGIN_REPO="https://github.com/erlang/ryu" +UPSTREAM_REPO="https://github.com/ulfjack/ryu" + +cd $ERL_TOP/erts/emulator/ryu + +set -exo pipefail + +## Clone reference +git clone ${ORIGIN_REPO} ryu-copy + +## into ryu-copy +cd ryu-copy +git remote add upstream ${UPSTREAM_REPO} +git fetch upstream + +SHA=$(git rev-parse --verify upstream/master) +SHORT_SHA=$(git rev-parse --verify --short upstream/master) + +if ! git merge upstream/master; then + git status --short | grep "^D" | awk '{print $2}' | xargs git rm -rf + git status --short | grep "^A" | awk '{print $2}' | xargs git rm -rf + if ! git commit; then + cat < ${ERL_TOP}/erts/emulator/ryu/xcharconv_ryu.h.sha + +EOF + +fi + +## Remove old files +shopt -s extglob +git rm -rf $(ls -d !(update.sh|vendor.info|ryu.mk|obj|README.ryu_update.md|ryu-copy|STL|xcharconv_ryu.h.sha)) +shopt -u extglob + +cp -r ryu-copy/* . +rm -rf ryu-copy STL + +## Update vendor info +COMMENTS=$(cat vendor.info | grep "^//") +NEW_VENDOR_INFO=$(cat vendor.info | grep -v "^//" | jq "map(if .ID == \"erts-ryu\" then .versionInfo = \"${SHA}\" | .sha = \"${SHA}\" else . end)") +NEW_VENDOR_INFO=$(echo "${NEW_VENDOR_INFO}" | jq "map(if .ID == \"erts-ryu-to_chars\" then .versionInfo = \"${STL_VSN}\" | .sha = \"${STL_SHA}\" else . end)") + +cat < vendor.info +${COMMENTS} +${NEW_VENDOR_INFO} +EOF + +git add . + +git commit -m "erts: Update ryu version to ${SHA}" \ No newline at end of file diff --git a/erts/emulator/ryu/vendor.info b/erts/emulator/ryu/vendor.info index 3877f18ad3da..372863235c9f 100644 --- a/erts/emulator/ryu/vendor.info +++ b/erts/emulator/ryu/vendor.info @@ -12,11 +12,41 @@ "copyrightText": "Copyright 2018 Ulf Adams", "downloadLocation": "https://github.com/ulfjack/ryu", "homepage": "https://github.com/ulfjack/ryu", - "licenseDeclared": "Apache-2.0 OR BSL-1.0", + "licenseDeclared": "Apache-2.0", "name": "ryu", - "versionInfo": "844864ac213bdbf1fb57e6f51c653b3d90af0937", - "path": "./erts/emulator/ryu", + "versionInfo": "1264a946ba66eab320e927bfd2362e0c8580c42f", + "path": ["./erts/emulator/ryu/common.h", + "./erts/emulator/ryu/d2s.c", + "./erts/emulator/ryu/d2s_full_table.h", + "./erts/emulator/ryu/d2s_intrinsics.h", + "./erts/emulator/ryu/digit_table.h", + "./erts/emulator/ryu/ryu.h", + "./erts/emulator/ryu/ryu.mk", + "./erts/emulator/ryu/README.md", + "./erts/emulator/ryu/LICENSE-Apache2", + "./erts/emulator/ryu/LICENSE-Boost" + ], "supplier": "Person: Ulf Adams", - "purl": "pkg:github/ulfjack/ryu" + "purl": "pkg:github/ulfjack/ryu#ryu", + "update": "./erts/emulator/ryu/update.sh", + "sha": "1264a946ba66eab320e927bfd2362e0c8580c42f" + }, + { + "ID": "ryu-to_chars", + "description": "to_chars from STL ryu", + "copyrightText": "Copyright 2018 Ulf Adams\nCopyright (c) Microsoft Corporation.", + "downloadLocation": "https://github.com/microsoft/STL", + "homepage": "https://github.com/microsoft/STL", + "licenseDeclared": "Apache-2.0 WITH LLVM-exception AND BSL-1.0", + "name": "ryu_to_chars", + "versionInfo": "vs-2022-17.13", + "path": [ + "./erts/emulator/ryu/to_chars.h", + "./erts/emulator/ryu/xcharconv_ryu.h.sha" + ], + "supplier": "Organization: Microsoft Corporation", + "purl": "pkg:github/microsoft/STL#stl/inc/xcharconv_ryu.h", + "update": "./erts/emulator/ryu/update.sh", + "sha": "442029c6fa37f1b6f9203357de09672d5704077c" } ] diff --git a/erts/emulator/ryu/xcharconv_ryu.h.sha b/erts/emulator/ryu/xcharconv_ryu.h.sha new file mode 100644 index 000000000000..a3c589e489f7 --- /dev/null +++ b/erts/emulator/ryu/xcharconv_ryu.h.sha @@ -0,0 +1 @@ +c12089e489c7b6a3896f5043ed545ac8d1870590 diff --git a/erts/emulator/zstd/update.sh b/erts/emulator/zstd/update.sh index 79d3a5772ab2..faa935cf6947 100755 --- a/erts/emulator/zstd/update.sh +++ b/erts/emulator/zstd/update.sh @@ -22,20 +22,21 @@ cd $ERL_TOP/erts/emulator/zstd +set -eo pipefail + +## Remove old files +shopt -s extglob +git rm -rf $(ls -d !(update.sh|vendor.info|zstd.mk|obj)) +shopt -u extglob + ## Fetch latest version of zstd from github VSN=$(curl -sL -H "Authorization: Bearer $(cat ~/.githubtoken)" -H "Accept: application/vnd.github+json" -H "X-GitHub-Api-Version: 2022-11-28" https://api.github.com/repos/facebook/zstd/releases/latest | jq ".tag_name" | sed 's/"//g') ## Clone it -git clone git@github.com:facebook/zstd -b $VSN zstd-copy +git clone https://github.com/facebook/zstd -b $VSN zstd-copy ## Save sha version for book keeping SHA=$(cd zstd-copy && git rev-parse --verify HEAD) -echo "// SPDX-License-Identifier: Apache-2.0 -// SPDX-FileCopyrightText: 2025 Ericsson and the Erlang/OTP contributors -${SHA}" > zstd.version - -## Remove old files -rm -rf common compress decompress ezstd.h LICENSE ## Copy new files cp -r zstd-copy/lib/{common,compress,decompress} ./ @@ -52,27 +53,16 @@ done rm -rf zstd-copy -git add common compress decompress ./erl_*.h COPYING LICENSE zstd.version - -LICENSE=$(cat LICENSE) -COPYING=$(cat COPYING) -read -r -d '' SYSTEM_COPYRIGHT << EOM -[zstd] - -* Info: - * SPDX-License-Identifier: BSD-3-Clause OR GPL-2.0-only - * Tool: zstd - * Git Repository: https://github.com/facebook/zstd - * Version: ${VSN} - * Commit: ${SHA} - * OTP Location: ./erts/emulator/zstd - -${LICENSE} +## Update vendor info +COMMENTS=$(cat vendor.info | grep "^//") +NEW_VENDOR_INFO=$(cat vendor.info | grep -v "^//" | jq "map(if .ID == \"erts-zstd\" then .versionInfo = \"${VSN}\" | .sha = \"${SHA}\" else . end)") -${COPYING} +cat < vendor.info +${COMMENTS} +${NEW_VENDOR_INFO} +EOF -EOM -SYSTEM_COPYRIGHT=$(echo "${SYSTEM_COPYRIGHT}" | sed 's@/@\\/@g') +## Add and commit everything +git add common compress decompress ./erl_*.h COPYING LICENSE vendor.info -perl -0777 -i -pe 's/\[zstd\](.|\n)*(\n------*)/'"${SYSTEM_COPYRIGHT}"'\n$2/is' \ - "$ERL_TOP/system/COPYRIGHT" +git commit -m "erts: Update zstd version to ${VSN}" \ No newline at end of file diff --git a/erts/emulator/zstd/vendor.info b/erts/emulator/zstd/vendor.info index 7b1d2d08675d..41101c977e4c 100644 --- a/erts/emulator/zstd/vendor.info +++ b/erts/emulator/zstd/vendor.info @@ -18,6 +18,7 @@ "versionInfo": "v1.5.7", "path": "./erts/emulator/zstd", "supplier": "Organization: Meta", - "purl": "pkg:github/facebook/zstd" + "purl": "pkg:github/facebook/zstd", + "update": "./erts/emulator/zstd/update.sh" } ]