coreboot-gerrit December 2022

coreboot-gerrit@coreboot.org

1 participants
6828 discussions

[S] Change in coreboot[master]: soc/cavium/cn81xx: Use read64p()
by Elyes Haouas (Code Review) 03 Dec '22

03 Dec '22

Elyes Haouas has uploaded this change for review. ( https://review.coreboot.org/c/coreboot/+/70284 ) Change subject: soc/cavium/cn81xx: Use read64p() ...................................................................... soc/cavium/cn81xx: Use read64p() Change-Id: Ia79816ccc230d17dd1ce2bde7a185b4d502ad107 Signed-off-by: Elyes Haouas <ehaouas(a)noos.fr> --- M src/soc/cavium/cn81xx/clock.c M src/soc/cavium/cn81xx/cpu.c 2 files changed, 15 insertions(+), 5 deletions(-) git pull ssh://review.coreboot.org:29418/coreboot refs/changes/84/70284/1 diff --git a/src/soc/cavium/cn81xx/clock.c b/src/soc/cavium/cn81xx/clock.c index e415a85..0aafefc 100644 --- a/src/soc/cavium/cn81xx/clock.c +++ b/src/soc/cavium/cn81xx/clock.c @@ -46,7 +46,7 @@ { union cavm_rst_boot rst_boot; - rst_boot.u = read64((void *)RST_PF_BAR0); + rst_boot.u = read64p(RST_PF_BAR0); return ((u64)rst_boot.s.pnr_mul) * PLL_REF_CLK; } @@ -58,7 +58,7 @@ { union cavm_rst_boot rst_boot; - rst_boot.u = read64((void *)RST_PF_BAR0); + rst_boot.u = read64p(RST_PF_BAR0); return ((u64)rst_boot.s.c_mul) * PLL_REF_CLK; } diff --git a/src/soc/cavium/cn81xx/cpu.c b/src/soc/cavium/cn81xx/cpu.c index bb85029..14aff58 100644 --- a/src/soc/cavium/cn81xx/cpu.c +++ b/src/soc/cavium/cn81xx/cpu.c @@ -11,7 +11,7 @@ uint64_t cpu_get_available_core_mask(void) { - return read64((void *)RST_PP_AVAILABLE); + return read64p(RST_PP_AVAILABLE); } size_t cpu_get_num_available_cores(void) @@ -75,7 +75,7 @@ write64((void *)MIO_BOOT_AP_JUMP, (uintptr_t)secondary_init); /* Get coremask of cores in reset */ - const uint64_t reset = read64((void *)RST_PP_RESET); + const uint64_t reset = read64p(RST_PP_RESET); printk(BIOS_INFO, "CPU: Cores currently in reset: 0x%llx\n", reset); /* Setup entry for secondary core */ @@ -93,7 +93,7 @@ stopwatch_init_usecs_expire(&sw, 1000000); do { - pending = read64((void *)RST_PP_PENDING); + pending = read64p(RST_PP_PENDING); } while (!stopwatch_expired(&sw) && (pending & coremask)); if (stopwatch_expired(&sw)) { -- To view, visit https://review.coreboot.org/c/coreboot/+/70284 To unsubscribe, or for help writing mail filters, visit https://review.coreboot.org/settings Gerrit-Project: coreboot Gerrit-Branch: master Gerrit-Change-Id: Ia79816ccc230d17dd1ce2bde7a185b4d502ad107 Gerrit-Change-Number: 70284 Gerrit-PatchSet: 1 Gerrit-Owner: Elyes Haouas <ehaouas(a)noos.fr> Gerrit-MessageType: newchange

1 0

[M] Change in coreboot[master]: coreboot_tables: Make existing alignment conventions more explicit
by Peter Stuge (Code Review) 03 Dec '22

03 Dec '22

Attention is currently required from: Julius Werner, Martin Roth, ron minnich. Peter Stuge has posted comments on this change. ( https://review.coreboot.org/c/coreboot/+/70158 ) Change subject: coreboot_tables: Make existing alignment conventions more explicit ...................................................................... Patch Set 2: Code-Review-1 (3 comments) File src/commonlib/include/commonlib/coreboot_tables.h: https://review.coreboot.org/c/coreboot/+/70158/comment/15765d41_bbf101f0 PS2, Line 110: #define LB_ENTRY_ALIGN 4 Should this come before lb_uint64_t on line 107 and be used there too? File src/lib/coreboot_table.c: https://review.coreboot.org/c/coreboot/+/70158/comment/b7e05c4e_5121cef3 PS2, Line 80: assert(IS_ALIGNED(rec->size, LB_ENTRY_ALIGN)); What happens if assert() fails? Does any existing code in the same code path use assert() already? I don't like that there can be a runtime failure, since that is likely a catastrophical error. Can it be avoided by doing something else? Explicit serialization code would avoid it, but I do recognize that that is a larger and/or different change. https://review.coreboot.org/c/coreboot/+/70158/comment/3bff3fa3_18d57c90 PS2, Line 306: strlen(mainboard_part_number) + 1, LB_ENTRY_ALIGN); Isn't this (8->4) a functional change in all 7 instances? -- To view, visit https://review.coreboot.org/c/coreboot/+/70158 To unsubscribe, or for help writing mail filters, visit https://review.coreboot.org/settings Gerrit-Project: coreboot Gerrit-Branch: master Gerrit-Change-Id: Iaeef29ef255047a855066469e03b5481812e5975 Gerrit-Change-Number: 70158 Gerrit-PatchSet: 2 Gerrit-Owner: Julius Werner <jwerner(a)chromium.org> Gerrit-Reviewer: Arthur Heymans <arthur(a)aheymans.xyz> Gerrit-Reviewer: Jakub Czapiga <jacz(a)semihalf.com> Gerrit-Reviewer: Martin Roth <martin.roth(a)amd.corp-partner.google.com> Gerrit-Reviewer: Peter Stuge <peter(a)stuge.se> Gerrit-Reviewer: build bot (Jenkins) <no-reply(a)coreboot.org> Gerrit-Reviewer: ron minnich <rminnich(a)gmail.com> Gerrit-Attention: Julius Werner <jwerner(a)chromium.org> Gerrit-Attention: Martin Roth <martin.roth(a)amd.corp-partner.google.com> Gerrit-Attention: ron minnich <rminnich(a)gmail.com> Gerrit-Comment-Date: Sat, 03 Dec 2022 10:19:18 +0000 Gerrit-HasComments: Yes Gerrit-Has-Labels: Yes Gerrit-MessageType: comment

1 0

[XL] Change in coreboot[master]: [test] Update libgnat
by build bot (Jenkins) (Code Review) 03 Dec '22

03 Dec '22

Attention is currently required from: Nico Huber. build bot (Jenkins) has posted comments on this change. ( https://review.coreboot.org/c/coreboot/+/70283 ) Change subject: [test] Update libgnat ...................................................................... Patch Set 3: (2 comments) Commit Message: Robot Comment from checkpatch (run ID jenkins-coreboot-checkpatch-165158): https://review.coreboot.org/c/coreboot/+/70283/comment/8666cbca_7424f25b PS3, Line 9: update to gcc/ada/libgnat/ Possible unwrapped commit description (prefer a maximum 72 chars per line) File src/lib/gnat/s-stalib.ads: Robot Comment from checkpatch (run ID jenkins-coreboot-checkpatch-165158): https://review.coreboot.org/c/coreboot/+/70283/comment/efe5772f_1761b20f PS3, Line 60: -- we never want to attempt initialiazation of virtual variables of this 'initialiazation' may be misspelled - perhaps 'initialization'? -- To view, visit https://review.coreboot.org/c/coreboot/+/70283 To unsubscribe, or for help writing mail filters, visit https://review.coreboot.org/settings Gerrit-Project: coreboot Gerrit-Branch: master Gerrit-Change-Id: I7545be873ecd28dfb78c03ab39ba699f4af21979 Gerrit-Change-Number: 70283 Gerrit-PatchSet: 3 Gerrit-Owner: Elyes Haouas <ehaouas(a)noos.fr> Gerrit-Reviewer: Nico Huber <nico.h(a)gmx.de> Gerrit-CC: build bot (Jenkins) <no-reply(a)coreboot.org> Gerrit-Attention: Nico Huber <nico.h(a)gmx.de> Gerrit-Comment-Date: Sat, 03 Dec 2022 07:49:32 +0000 Gerrit-HasComments: Yes Gerrit-Has-Labels: No Gerrit-MessageType: comment

1 0

[XL] Change in coreboot[master]: [test] Update libgnat
by Elyes Haouas (Code Review) 03 Dec '22

03 Dec '22

Attention is currently required from: Nico Huber. Hello Nico Huber, I'd like you to reexamine a change. Please visit https://review.coreboot.org/c/coreboot/+/70283 to look at the new patch set (#2). Change subject: [test] Update libgnat ...................................................................... [test] Update libgnat update to gcc/ada/libgnat/ ( https://gcc.gnu.org/git/?p=gcc.git;a=tree;f=gcc/ada/libgnat;h=e865587273168… ) Change-Id: I7545be873ecd28dfb78c03ab39ba699f4af21979 Signed-off-by: Elyes Haouas <ehaouas(a)noos.fr> --- M gnat.adc M src/lib/gnat/Makefile.inc A src/lib/gnat/a-except.ads M src/lib/gnat/a-unccon.ads M src/lib/gnat/ada.ads M src/lib/gnat/g-souinf.ads M src/lib/gnat/gnat.ads M src/lib/gnat/i-c.adb M src/lib/gnat/i-c.ads M src/lib/gnat/interfac.ads M src/lib/gnat/s-atacco.ads A src/lib/gnat/s-exctab.ads A src/lib/gnat/s-imagen.adb A src/lib/gnat/s-imen16.ads A src/lib/gnat/s-imen32.ads D src/lib/gnat/s-imenne.adb D src/lib/gnat/s-imenne.ads A src/lib/gnat/s-imenu8.ads M src/lib/gnat/s-maccod.ads M src/lib/gnat/s-parame.ads A src/lib/gnat/s-stalib.ads M src/lib/gnat/s-stoele.adb M src/lib/gnat/s-stoele.ads A src/lib/gnat/s-traent.adb A src/lib/gnat/s-traent.ads M src/lib/gnat/s-unstyp.ads M src/lib/gnat/system.ads 27 files changed, 2,973 insertions(+), 273 deletions(-) git pull ssh://review.coreboot.org:29418/coreboot refs/changes/83/70283/2 -- To view, visit https://review.coreboot.org/c/coreboot/+/70283 To unsubscribe, or for help writing mail filters, visit https://review.coreboot.org/settings Gerrit-Project: coreboot Gerrit-Branch: master Gerrit-Change-Id: I7545be873ecd28dfb78c03ab39ba699f4af21979 Gerrit-Change-Number: 70283 Gerrit-PatchSet: 2 Gerrit-Owner: Elyes Haouas <ehaouas(a)noos.fr> Gerrit-Reviewer: Nico Huber <nico.h(a)gmx.de> Gerrit-CC: build bot (Jenkins) <no-reply(a)coreboot.org> Gerrit-Attention: Nico Huber <nico.h(a)gmx.de> Gerrit-MessageType: newpatchset

1 0

[XL] Change in coreboot[master]: [test] Update libgnat
by build bot (Jenkins) (Code Review) 03 Dec '22

03 Dec '22

build bot (Jenkins) has posted comments on this change. ( https://review.coreboot.org/c/coreboot/+/70283 ) Change subject: [test] Update libgnat ...................................................................... Patch Set 1: (1 comment) File src/lib/gnat/s-stalib.ads: Robot Comment from checkpatch (run ID jenkins-coreboot-checkpatch-165157): https://review.coreboot.org/c/coreboot/+/70283/comment/57241b48_f23f0fc9 PS1, Line 60: -- we never want to attempt initialiazation of virtual variables of this 'initialiazation' may be misspelled - perhaps 'initialization'? -- To view, visit https://review.coreboot.org/c/coreboot/+/70283 To unsubscribe, or for help writing mail filters, visit https://review.coreboot.org/settings Gerrit-Project: coreboot Gerrit-Branch: master Gerrit-Change-Id: I7545be873ecd28dfb78c03ab39ba699f4af21979 Gerrit-Change-Number: 70283 Gerrit-PatchSet: 1 Gerrit-Owner: Elyes Haouas <ehaouas(a)noos.fr> Gerrit-CC: build bot (Jenkins) <no-reply(a)coreboot.org> Gerrit-Comment-Date: Sat, 03 Dec 2022 07:40:22 +0000 Gerrit-HasComments: Yes Gerrit-Has-Labels: No Gerrit-MessageType: comment

1 0

[XL] Change in coreboot[master]: [test] Update libgnat
by Elyes Haouas (Code Review) 03 Dec '22

03 Dec '22

Elyes Haouas has uploaded this change for review. ( https://review.coreboot.org/c/coreboot/+/70283 ) Change subject: [test] Update libgnat ...................................................................... [test] Update libgnat Change-Id: I7545be873ecd28dfb78c03ab39ba699f4af21979 Signed-off-by: Elyes Haouas <ehaouas(a)noos.fr> --- M gnat.adc M src/lib/gnat/Makefile.inc A src/lib/gnat/a-except.ads M src/lib/gnat/a-unccon.ads M src/lib/gnat/ada.ads M src/lib/gnat/g-souinf.ads M src/lib/gnat/gnat.ads M src/lib/gnat/i-c.adb M src/lib/gnat/i-c.ads M src/lib/gnat/interfac.ads M src/lib/gnat/s-atacco.ads A src/lib/gnat/s-exctab.ads A src/lib/gnat/s-imagen.adb A src/lib/gnat/s-imen16.ads A src/lib/gnat/s-imen32.ads D src/lib/gnat/s-imenne.adb D src/lib/gnat/s-imenne.ads A src/lib/gnat/s-imenu8.ads M src/lib/gnat/s-maccod.ads M src/lib/gnat/s-parame.ads A src/lib/gnat/s-stalib.ads M src/lib/gnat/s-stoele.adb M src/lib/gnat/s-stoele.ads A src/lib/gnat/s-traent.adb A src/lib/gnat/s-traent.ads M src/lib/gnat/s-unstyp.ads M src/lib/gnat/system.ads 27 files changed, 2,970 insertions(+), 273 deletions(-) git pull ssh://review.coreboot.org:29418/coreboot refs/changes/83/70283/1 diff --git a/gnat.adc b/gnat.adc index 5a03406..b50510f 100644 --- a/gnat.adc +++ b/gnat.adc @@ -19,7 +19,6 @@ pragma Restrictions (No_Tasking); pragma Restrictions (No_Unchecked_Access); pragma Restrictions (No_Unchecked_Deallocation); -pragma Restrictions (No_Wide_Characters); pragma Restrictions (Static_Storage_Size); pragma Assertion_Policy (Statement_Assertions => Disable, diff --git a/src/lib/gnat/Makefile.inc b/src/lib/gnat/Makefile.inc index 065ba71..4c17105 100644 --- a/src/lib/gnat/Makefile.inc +++ b/src/lib/gnat/Makefile.inc @@ -15,6 +15,7 @@ -Werror \ -fno-pie \ +libgnat-$(1)-y += a-except.ads libgnat-$(1)-y += a-unccon.ads libgnat-$(1)-y += ada.ads libgnat-$(1)-y += g-souinf.ads @@ -23,12 +24,18 @@ libgnat-$(1)-y += i-c.ads libgnat-$(1)-y += interfac.ads libgnat-$(1)-y += s-atacco.ads +libgnat-$(1)-y += s-exctab.ads +libgnat-$(1)-y += s-imen16.ads +libgnat-$(1)-y += s-imen32.ads libgnat-$(1)-y += s-imenne.adb -libgnat-$(1)-y += s-imenne.ads +libgnat-$(1)-y += s-imenu8.ads libgnat-$(1)-y += s-maccod.ads libgnat-$(1)-y += s-parame.ads +libgnat-$(1)-y += s-stalib.ads libgnat-$(1)-y += s-stoele.adb libgnat-$(1)-y += s-stoele.ads +libgnat-$(1)-y += s-traent.adb +libgnat-$(1)-y += s-traent.ads libgnat-$(1)-y += s-unstyp.ads libgnat-$(1)-y += system.ads diff --git a/src/lib/gnat/a-except.ads b/src/lib/gnat/a-except.ads new file mode 100644 index 0000000..af87d66 --- /dev/null +++ b/src/lib/gnat/a-except.ads @@ -0,0 +1,295 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- A D A . E X C E P T I O N S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This is the default version of this package. We also have cert and zfp +-- versions. + +with System; +with System.Parameters; +with System.Standard_Library; +with System.Traceback_Entries; + +package Ada.Exceptions is + pragma Preelaborate; + -- In accordance with Ada 2005 AI-362. + + type Exception_Id is private; + pragma Preelaborable_Initialization (Exception_Id); + + Null_Id : constant Exception_Id; + + type Exception_Occurrence is limited private; + pragma Preelaborable_Initialization (Exception_Occurrence); + + type Exception_Occurrence_Access is access all Exception_Occurrence; + + Null_Occurrence : constant Exception_Occurrence; + + function Exception_Name (Id : Exception_Id) return String; + + function Exception_Name (X : Exception_Occurrence) return String; + + function Wide_Exception_Name + (Id : Exception_Id) return Wide_String; + pragma Ada_05 (Wide_Exception_Name); + + function Wide_Exception_Name + (X : Exception_Occurrence) return Wide_String; + pragma Ada_05 (Wide_Exception_Name); + + function Wide_Wide_Exception_Name + (Id : Exception_Id) return Wide_Wide_String; + pragma Ada_05 (Wide_Wide_Exception_Name); + + function Wide_Wide_Exception_Name + (X : Exception_Occurrence) return Wide_Wide_String; + pragma Ada_05 (Wide_Wide_Exception_Name); + + procedure Raise_Exception (E : Exception_Id; Message : String := ""); + pragma No_Return (Raise_Exception); + -- Note: In accordance with AI-466, CE is raised if E = Null_Id + + function Exception_Message (X : Exception_Occurrence) return String; + + procedure Reraise_Occurrence (X : Exception_Occurrence); + -- Note: it would be really nice to give a pragma No_Return for this + -- procedure, but it would be wrong, since Reraise_Occurrence does return + -- if the argument is the null exception occurrence. See also procedure + -- Reraise_Occurrence_Always in the private part of this package. + + function Exception_Identity (X : Exception_Occurrence) return Exception_Id; + + function Exception_Information (X : Exception_Occurrence) return String; + -- The format of the exception information is as follows: + -- + -- exception name (as in Exception_Name) + -- message (or a null line if no message) + -- PID=nnnn + -- 0xyyyyyyyy 0xyyyyyyyy ... + -- + -- The lines are separated by a ASCII.LF character + -- + -- The nnnn is the partition Id given as decimal digits + -- + -- The 0x... line represents traceback program counter locations, + -- in order with the first one being the exception location. + + -- Note on ordering: the compiler uses the Save_Occurrence procedure, but + -- not the function from Rtsfind, so it is important that the procedure + -- come first, since Rtsfind finds the first matching entity. + + procedure Save_Occurrence + (Target : out Exception_Occurrence; + Source : Exception_Occurrence); + + function Save_Occurrence + (Source : Exception_Occurrence) + return Exception_Occurrence_Access; + + -- Ada 2005 (AI-438): The language revision introduces the following + -- subprograms and attribute definitions. We do not provide them + -- explicitly. instead, the corresponding stream attributes are made + -- available through a pragma Stream_Convert in the private part. + + -- procedure Read_Exception_Occurrence + -- (Stream : not null access Ada.Streams.Root_Stream_Type'Class; + -- Item : out Exception_Occurrence); + + -- procedure Write_Exception_Occurrence + -- (Stream : not null access Ada.Streams.Root_Stream_Type'Class; + -- Item : Exception_Occurrence); + + -- for Exception_Occurrence'Read use Read_Exception_Occurrence; + -- for Exception_Occurrence'Write use Write_Exception_Occurrence; + +private + package SSL renames System.Standard_Library; + package SP renames System.Parameters; + + subtype EOA is Exception_Occurrence_Access; + + Exception_Msg_Max_Length : constant := SP.Default_Exception_Msg_Max_Length; + + ------------------ + -- Exception_Id -- + ------------------ + + subtype Code_Loc is System.Address; + -- Code location used in building exception tables and for call addresses + -- when propagating an exception. Values of this type are created by using + -- Label'Address or extracted from machine states using Get_Code_Loc. + + Null_Loc : constant Code_Loc := System.Null_Address; + -- Null code location, used to flag outer level frame + + type Exception_Id is new SSL.Exception_Data_Ptr; + + function EId_To_String (X : Exception_Id) return String; + function String_To_EId (S : String) return Exception_Id; + pragma Stream_Convert (Exception_Id, String_To_EId, EId_To_String); + -- Functions for implementing Exception_Id stream attributes + + Null_Id : constant Exception_Id := null; + + ------------------------- + -- Private Subprograms -- + ------------------------- + + function Exception_Name_Simple (X : Exception_Occurrence) return String; + -- Like Exception_Name, but returns the simple non-qualified name of the + -- exception. This is used to implement the Exception_Name function in + -- Current_Exceptions (the DEC compatible unit). It is called from the + -- compiler generated code (using Rtsfind, which does not respect the + -- private barrier, so we can place this function in the private part + -- where the compiler can find it, but the spec is unchanged.) + + procedure Raise_Exception_Always (E : Exception_Id; Message : String := ""); + pragma No_Return (Raise_Exception_Always); + pragma Export (Ada, Raise_Exception_Always, "__gnat_raise_exception"); + -- This differs from Raise_Exception only in that the caller has determined + -- that for sure the parameter E is not null, and that therefore no check + -- for Null_Id is required. The expander converts Raise_Exception calls to + -- Raise_Exception_Always if it can determine this is the case. The Export + -- allows this routine to be accessed from Pure units. + + pragma Machine_Attribute (Raise_Exception_Always, + "strub", "callable"); + -- Make it callable from strub contexts + + procedure Raise_From_Controlled_Operation (X : Exception_Occurrence); + pragma No_Return (Raise_From_Controlled_Operation); + pragma Export + (Ada, Raise_From_Controlled_Operation, + "__gnat_raise_from_controlled_operation"); + -- Raise Program_Error, providing information about X (an exception raised + -- during a controlled operation) in the exception message. + + procedure Reraise_Library_Exception_If_Any; + pragma Export + (Ada, Reraise_Library_Exception_If_Any, + "__gnat_reraise_library_exception_if_any"); + -- If there was an exception raised during library-level finalization, + -- reraise the exception. + + procedure Reraise_Occurrence_Always (X : Exception_Occurrence); + pragma No_Return (Reraise_Occurrence_Always); + -- This differs from Raise_Occurrence only in that the caller guarantees + -- that for sure the parameter X is not the null occurrence, and that + -- therefore this procedure cannot return. The expander uses this routine + -- in the translation of a raise statement with no parameter (reraise). + + procedure Reraise_Occurrence_No_Defer (X : Exception_Occurrence); + pragma No_Return (Reraise_Occurrence_No_Defer); + -- Exactly like Reraise_Occurrence, except that abort is not deferred + -- before the call and the parameter X is known not to be the null + -- occurrence. This is used in generated code when it is known that abort + -- is already deferred. + + function Triggered_By_Abort return Boolean; + -- Determine whether the current exception (if it exists) is an instance of + -- Standard'Abort_Signal. + + -------------------------- + -- Exception_Occurrence -- + -------------------------- + + package TBE renames System.Traceback_Entries; + + Max_Tracebacks : constant := 50; + -- Maximum number of trace backs stored in exception occurrence + + subtype Tracebacks_Array is TBE.Tracebacks_Array (1 .. Max_Tracebacks); + -- Traceback array stored in exception occurrence + + type Exception_Occurrence is record + Id : Exception_Id := Null_Id; + -- Exception_Identity for this exception occurrence + + Machine_Occurrence : System.Address; + -- The underlying machine occurrence. For GCC, this corresponds to the + -- _Unwind_Exception structure address. + + Msg_Length : Natural := 0; + -- Length of message (zero = no message) + + Msg : String (1 .. Exception_Msg_Max_Length); + -- Characters of message + + Exception_Raised : Boolean := False; + -- Set to true to indicate that this exception occurrence has actually + -- been raised. When an exception occurrence is first created, this is + -- set to False, then when it is processed by Raise_Current_Exception, + -- it is set to True. If Raise_Current_Exception is used to raise an + -- exception for which this flag is already True, then it knows that + -- it is dealing with the reraise case (which is useful to distinguish + -- for exception tracing purposes). + + Pid : Natural := 0; + -- Partition_Id for partition raising exception + + Num_Tracebacks : Natural range 0 .. Max_Tracebacks := 0; + -- Number of traceback entries stored + + Tracebacks : Tracebacks_Array; + -- Stored tracebacks (in Tracebacks (1 .. Num_Tracebacks)) + end record; + + function "=" (Left, Right : Exception_Occurrence) return Boolean + is abstract; + -- Don't allow comparison on exception occurrences, we should not need + -- this, and it would not work right, because of the Msg and Tracebacks + -- fields which have unused entries not copied by Save_Occurrence. + + function Get_Exception_Machine_Occurrence + (X : Exception_Occurrence) return System.Address; + pragma Export (Ada, Get_Exception_Machine_Occurrence, + "__gnat_get_exception_machine_occurrence"); + -- Get the machine occurrence corresponding to an exception occurrence. + -- It is Null_Address if there is no machine occurrence (in runtimes that + -- doesn't use GCC mechanism) or if it has been lost (Save_Occurrence + -- doesn't save the machine occurrence). + + function EO_To_String (X : Exception_Occurrence) return String; + function String_To_EO (S : String) return Exception_Occurrence; + pragma Stream_Convert (Exception_Occurrence, String_To_EO, EO_To_String); + -- Functions for implementing Exception_Occurrence stream attributes + + Null_Occurrence : constant Exception_Occurrence := + (Machine_Occurrence => System.Null_Address, + Msg => (others => '*'), + Tracebacks => (others => System.Traceback_Entries.Null_TB_Entry), + others => <>); + +end Ada.Exceptions; diff --git a/src/lib/gnat/a-unccon.ads b/src/lib/gnat/a-unccon.ads index ffa84d9..a8429c1 100644 --- a/src/lib/gnat/a-unccon.ads +++ b/src/lib/gnat/a-unccon.ads @@ -19,5 +19,6 @@ function Ada.Unchecked_Conversion (S : Source) return Target; -pragma Pure (Unchecked_Conversion); -pragma Import (Intrinsic, Unchecked_Conversion); +pragma No_Elaboration_Code_All (Ada.Unchecked_Conversion); +pragma Pure (Ada.Unchecked_Conversion); +pragma Import (Intrinsic, Ada.Unchecked_Conversion); diff --git a/src/lib/gnat/ada.ads b/src/lib/gnat/ada.ads index 8c86011..4c2a3d0 100644 --- a/src/lib/gnat/ada.ads +++ b/src/lib/gnat/ada.ads @@ -14,6 +14,7 @@ ------------------------------------------------------------------------------ package Ada is + pragma No_Elaboration_Code_All; pragma Pure; end Ada; diff --git a/src/lib/gnat/g-souinf.ads b/src/lib/gnat/g-souinf.ads index 610db23..6b72a64 100644 --- a/src/lib/gnat/g-souinf.ads +++ b/src/lib/gnat/g-souinf.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2000-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2000-2022, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -36,7 +36,13 @@ -- and logging purposes. For example, an exception handler can print out -- the name of the source file in which the exception is handled. -package GNAT.Source_Info is +package GNAT.Source_Info with + SPARK_Mode, + Abstract_State => + (Source_Code_Information with + External => (Async_Writers, Async_Readers)), + Annotate => (GNATprove, Always_Return) +is pragma Preelaborate; -- Note that this unit is Preelaborate, but not Pure, that's because the -- functions here such as Line are clearly not pure functions, and normally @@ -47,6 +53,8 @@ -- intrinsics as not Pure, even in Pure units, so no problems arose. function File return String with + Volatile_Function, + Global => Source_Code_Information, Import, Convention => Intrinsic; -- Return the name of the current file, not including the path information. -- The result is considered to be a static string constant. @@ -57,6 +65,8 @@ -- static expression. function Source_Location return String with + Volatile_Function, + Global => Source_Code_Information, Import, Convention => Intrinsic; -- Return a string literal of the form "name:line", where name is the -- current source file name without path information, and line is the @@ -66,6 +76,8 @@ -- string constant. function Enclosing_Entity return String with + Volatile_Function, + Global => Source_Code_Information, Import, Convention => Intrinsic; -- Return the name of the current subprogram, package, task, entry or -- protected subprogram. The string is in exactly the form used for the @@ -79,12 +91,22 @@ -- package itself. This is useful in identifying and logging information -- from within generic templates. + function Compilation_ISO_Date return String with + Volatile_Function, + Global => Source_Code_Information, + Import, Convention => Intrinsic; + -- Returns date of compilation as a static string "yyyy-mm-dd". + function Compilation_Date return String with + Volatile_Function, + Global => Source_Code_Information, Import, Convention => Intrinsic; -- Returns date of compilation as a static string "mmm dd yyyy". This is -- in local time form, and is exactly compatible with C macro __DATE__. function Compilation_Time return String with + Volatile_Function, + Global => Source_Code_Information, Import, Convention => Intrinsic; -- Returns GMT time of compilation as a static string "hh:mm:ss". This is -- in local time form, and is exactly compatible with C macro __TIME__. diff --git a/src/lib/gnat/gnat.ads b/src/lib/gnat/gnat.ads index a0807b6..1471c50 100644 --- a/src/lib/gnat/gnat.ads +++ b/src/lib/gnat/gnat.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, AdaCore -- +-- Copyright (C) 1992-2022, AdaCore -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -31,7 +31,30 @@ -- This is the parent package for a library of useful units provided with GNAT +-- Note: this unit is used during bootstrap, see ADA_GENERATED_FILES in +-- gcc-interface/Make-lang.in for details on the constraints. + package GNAT is pragma Pure; + -- The following type denotes the range of buckets for various hashed + -- data structures in the GNAT unit hierarchy. + + type Bucket_Range_Type is mod 2 ** 32; + + -- The following exception is raised whenever an attempt is made to mutate + -- the state of a data structure that is being iterated on. + + Iterated : exception; + + -- The following exception is raised when an iterator is exhausted and + -- further attempts are made to advance it. + + Iterator_Exhausted : exception; + + -- The following exception is raised whenever an attempt is made to mutate + -- the state of a data structure that has not been created yet. + + Not_Created : exception; + end GNAT; diff --git a/src/lib/gnat/i-c.adb b/src/lib/gnat/i-c.adb index 6926a9e..4b50d18 100644 --- a/src/lib/gnat/i-c.adb +++ b/src/lib/gnat/i-c.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2009, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -29,7 +29,77 @@ -- -- ------------------------------------------------------------------------------ -package body Interfaces.C is +-- Ghost code, loop invariants and assertions in this unit are meant for +-- analysis only, not for run-time checking, as it would be too costly +-- otherwise. This is enforced by setting the assertion policy to Ignore. + +pragma Assertion_Policy (Ghost => Ignore, + Loop_Invariant => Ignore, + Assert => Ignore); + +package body Interfaces.C + with SPARK_Mode +is + + -------------------- + -- C_Length_Ghost -- + -------------------- + + function C_Length_Ghost (Item : char_array) return size_t is + begin + for J in Item'Range loop + if Item (J) = nul then + return J - Item'First; + end if; + + pragma Loop_Invariant + (for all K in Item'First .. J => Item (K) /= nul); + end loop; + + raise Program_Error; + end C_Length_Ghost; + + function C_Length_Ghost (Item : wchar_array) return size_t is + begin + for J in Item'Range loop + if Item (J) = wide_nul then + return J - Item'First; + end if; + + pragma Loop_Invariant + (for all K in Item'First .. J => Item (K) /= wide_nul); + end loop; + + raise Program_Error; + end C_Length_Ghost; + + function C_Length_Ghost (Item : char16_array) return size_t is + begin + for J in Item'Range loop + if Item (J) = char16_nul then + return J - Item'First; + end if; + + pragma Loop_Invariant + (for all K in Item'First .. J => Item (K) /= char16_nul); + end loop; + + raise Program_Error; + end C_Length_Ghost; + + function C_Length_Ghost (Item : char32_array) return size_t is + begin + for J in Item'Range loop + if Item (J) = char32_nul then + return J - Item'First; + end if; + + pragma Loop_Invariant + (for all K in Item'First .. J => Item (K) /= char32_nul); + end loop; + + raise Program_Error; + end C_Length_Ghost; ----------------------- -- Is_Nul_Terminated -- @@ -43,6 +113,57 @@ if Item (J) = nul then return True; end if; + + pragma Loop_Invariant + (for all K in Item'First .. J => Item (K) /= nul); + end loop; + + return False; + end Is_Nul_Terminated; + + -- Case of wchar_array + + function Is_Nul_Terminated (Item : wchar_array) return Boolean is + begin + for J in Item'Range loop + if Item (J) = wide_nul then + return True; + end if; + + pragma Loop_Invariant + (for all K in Item'First .. J => Item (K) /= wide_nul); + end loop; + + return False; + end Is_Nul_Terminated; + + -- Case of char16_array + + function Is_Nul_Terminated (Item : char16_array) return Boolean is + begin + for J in Item'Range loop + if Item (J) = char16_nul then + return True; + end if; + + pragma Loop_Invariant + (for all K in Item'First .. J => Item (K) /= char16_nul); + end loop; + + return False; + end Is_Nul_Terminated; + + -- Case of char32_array + + function Is_Nul_Terminated (Item : char32_array) return Boolean is + begin + for J in Item'Range loop + if Item (J) = char32_nul then + return True; + end if; + + pragma Loop_Invariant + (for all K in Item'First .. J => Item (K) /= char32_nul); end loop; return False; @@ -59,6 +180,531 @@ return Character'Val (char'Pos (Item)); end To_Ada; + -- Convert char_array to String (function form) + + function To_Ada + (Item : char_array; + Trim_Nul : Boolean := True) return String + is + Count : Natural; + From : size_t; + + begin + if Trim_Nul then + From := Item'First; + + loop + pragma Loop_Invariant (From in Item'Range); + pragma Loop_Invariant + (for some J in From .. Item'Last => Item (J) = nul); + pragma Loop_Invariant + (for all J in Item'First .. From when J /= From => + Item (J) /= nul); + + if From > Item'Last then + raise Terminator_Error; + elsif Item (From) = nul then + exit; + else + From := From + 1; + end if; + end loop; + + pragma Assert (From = Item'First + C_Length_Ghost (Item)); + + Count := Natural (From - Item'First); + + else + Count := Item'Length; + end if; + + declare + Count_Cst : constant Natural := Count; + R : String (1 .. Count_Cst) with Relaxed_Initialization; + + begin + for J in R'Range loop + R (J) := To_Ada (Item (size_t (J) - 1 + Item'First)); + + pragma Loop_Invariant (for all K in 1 .. J => R (K)'Initialized); + pragma Loop_Invariant + (for all K in 1 .. J => + R (K) = To_Ada (Item (size_t (K) - 1 + Item'First))); + end loop; + + return R; + end; + end To_Ada; + + -- Convert char_array to String (procedure form) + + procedure To_Ada + (Item : char_array; + Target : out String; + Count : out Natural; + Trim_Nul : Boolean := True) + is + From : size_t; + To : Integer; + + begin + if Trim_Nul then + From := Item'First; + loop + pragma Loop_Invariant (From in Item'Range); + pragma Loop_Invariant + (for some J in From .. Item'Last => Item (J) = nul); + pragma Loop_Invariant + (for all J in Item'First .. From when J /= From => + Item (J) /= nul); + + if From > Item'Last then + raise Terminator_Error; + elsif Item (From) = nul then + exit; + else + From := From + 1; + end if; + end loop; + + Count := Natural (From - Item'First); + + else + Count := Item'Length; + end if; + + if Count > Target'Length then + raise Constraint_Error; + + else + From := Item'First; + To := Target'First; + + for J in 1 .. Count loop + Target (To) := Character (Item (From)); + + pragma Loop_Invariant (From in Item'Range); + pragma Loop_Invariant (To in Target'Range); + pragma Loop_Invariant (To = Target'First + (J - 1)); + pragma Loop_Invariant (From = Item'First + size_t (J - 1)); + pragma Loop_Invariant + (for all J in Target'First .. To => Target (J)'Initialized); + pragma Loop_Invariant + (Target (Target'First .. To)'Initialized); + pragma Loop_Invariant + (for all K in Target'First .. To => + Target (K) = + To_Ada (Item (size_t (K - Target'First) + Item'First))); + + -- Avoid possible overflow when incrementing To in the last + -- iteration of the loop. + exit when J = Count; + + From := From + 1; + To := To + 1; + end loop; + end if; + end To_Ada; + + -- Convert wchar_t to Wide_Character + + function To_Ada (Item : wchar_t) return Wide_Character is + begin + return Wide_Character (Item); + end To_Ada; + + -- Convert wchar_array to Wide_String (function form) + + function To_Ada + (Item : wchar_array; + Trim_Nul : Boolean := True) return Wide_String + is + Count : Natural; + From : size_t; + + begin + if Trim_Nul then + From := Item'First; + + loop + pragma Loop_Invariant (From in Item'Range); + pragma Loop_Invariant + (for some J in From .. Item'Last => Item (J) = wide_nul); + pragma Loop_Invariant + (for all J in Item'First .. From when J /= From => + Item (J) /= wide_nul); + + if From > Item'Last then + raise Terminator_Error; + elsif Item (From) = wide_nul then + exit; + else + From := From + 1; + end if; + end loop; + + pragma Assert (From = Item'First + C_Length_Ghost (Item)); + + Count := Natural (From - Item'First); + + else + Count := Item'Length; + end if; + + declare + Count_Cst : constant Natural := Count; + R : Wide_String (1 .. Count_Cst) with Relaxed_Initialization; + + begin + for J in R'Range loop + R (J) := To_Ada (Item (size_t (J) - 1 + Item'First)); + + pragma Loop_Invariant (for all K in 1 .. J => R (K)'Initialized); + pragma Loop_Invariant + (for all K in 1 .. J => + R (K) = To_Ada (Item (size_t (K) - 1 + Item'First))); + end loop; + + return R; + end; + end To_Ada; + + -- Convert wchar_array to Wide_String (procedure form) + + procedure To_Ada + (Item : wchar_array; + Target : out Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True) + is + From : size_t; + To : Integer; + + begin + if Trim_Nul then + From := Item'First; + loop + pragma Loop_Invariant (From in Item'Range); + pragma Loop_Invariant + (for some J in From .. Item'Last => Item (J) = wide_nul); + pragma Loop_Invariant + (for all J in Item'First .. From when J /= From => + Item (J) /= wide_nul); + + if From > Item'Last then + raise Terminator_Error; + elsif Item (From) = wide_nul then + exit; + else + From := From + 1; + end if; + end loop; + + Count := Natural (From - Item'First); + + else + Count := Item'Length; + end if; + + if Count > Target'Length then + raise Constraint_Error; + + else + From := Item'First; + To := Target'First; + + for J in 1 .. Count loop + Target (To) := To_Ada (Item (From)); + + pragma Loop_Invariant (From in Item'Range); + pragma Loop_Invariant (To in Target'Range); + pragma Loop_Invariant (To = Target'First + (J - 1)); + pragma Loop_Invariant (From = Item'First + size_t (J - 1)); + pragma Loop_Invariant + (for all J in Target'First .. To => Target (J)'Initialized); + pragma Loop_Invariant + (Target (Target'First .. To)'Initialized); + pragma Loop_Invariant + (for all K in Target'First .. To => + Target (K) = + To_Ada (Item (size_t (K - Target'First) + Item'First))); + + -- Avoid possible overflow when incrementing To in the last + -- iteration of the loop. + exit when J = Count; + + From := From + 1; + To := To + 1; + end loop; + end if; + end To_Ada; + + -- Convert char16_t to Wide_Character + + function To_Ada (Item : char16_t) return Wide_Character is + begin + return Wide_Character'Val (char16_t'Pos (Item)); + end To_Ada; + + -- Convert char16_array to Wide_String (function form) + + function To_Ada + (Item : char16_array; + Trim_Nul : Boolean := True) return Wide_String + is + Count : Natural; + From : size_t; + + begin + if Trim_Nul then + From := Item'First; + + loop + pragma Loop_Invariant (From in Item'Range); + pragma Loop_Invariant + (for some J in From .. Item'Last => Item (J) = char16_nul); + pragma Loop_Invariant + (for all J in Item'First .. From when J /= From => + Item (J) /= char16_nul); + + if From > Item'Last then + raise Terminator_Error; + elsif Item (From) = char16_nul then + exit; + else + From := From + 1; + end if; + end loop; + + pragma Assert (From = Item'First + C_Length_Ghost (Item)); + + Count := Natural (From - Item'First); + + else + Count := Item'Length; + end if; + + declare + Count_Cst : constant Natural := Count; + R : Wide_String (1 .. Count_Cst) with Relaxed_Initialization; + + begin + for J in R'Range loop + R (J) := To_Ada (Item (size_t (J) - 1 + Item'First)); + + pragma Loop_Invariant (for all K in 1 .. J => R (K)'Initialized); + pragma Loop_Invariant + (for all K in 1 .. J => + R (K) = To_Ada (Item (size_t (K) - 1 + Item'First))); + end loop; + + return R; + end; + end To_Ada; + + -- Convert char16_array to Wide_String (procedure form) + + procedure To_Ada + (Item : char16_array; + Target : out Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True) + is + From : size_t; + To : Integer; + + begin + if Trim_Nul then + From := Item'First; + loop + pragma Loop_Invariant (From in Item'Range); + pragma Loop_Invariant + (for some J in From .. Item'Last => Item (J) = char16_nul); + pragma Loop_Invariant + (for all J in Item'First .. From when J /= From => + Item (J) /= char16_nul); + + if From > Item'Last then + raise Terminator_Error; + elsif Item (From) = char16_nul then + exit; + else + From := From + 1; + end if; + end loop; + + Count := Natural (From - Item'First); + + else + Count := Item'Length; + end if; + + if Count > Target'Length then + raise Constraint_Error; + + else + From := Item'First; + To := Target'First; + + for J in 1 .. Count loop + Target (To) := To_Ada (Item (From)); + + pragma Loop_Invariant (From in Item'Range); + pragma Loop_Invariant (To in Target'Range); + pragma Loop_Invariant (To = Target'First + (J - 1)); + pragma Loop_Invariant (From = Item'First + size_t (J - 1)); + pragma Loop_Invariant + (for all J in Target'First .. To => Target (J)'Initialized); + pragma Loop_Invariant + (Target (Target'First .. To)'Initialized); + pragma Loop_Invariant + (for all K in Target'First .. To => + Target (K) = + To_Ada (Item (size_t (K - Target'First) + Item'First))); + + -- Avoid possible overflow when incrementing To in the last + -- iteration of the loop. + exit when J = Count; + + From := From + 1; + To := To + 1; + end loop; + end if; + end To_Ada; + + -- Convert char32_t to Wide_Wide_Character + + function To_Ada (Item : char32_t) return Wide_Wide_Character is + begin + return Wide_Wide_Character'Val (char32_t'Pos (Item)); + end To_Ada; + + -- Convert char32_array to Wide_Wide_String (function form) + + function To_Ada + (Item : char32_array; + Trim_Nul : Boolean := True) return Wide_Wide_String + is + Count : Natural; + From : size_t; + + begin + if Trim_Nul then + From := Item'First; + + loop + pragma Loop_Invariant (From in Item'Range); + pragma Loop_Invariant + (for some J in From .. Item'Last => Item (J) = char32_nul); + pragma Loop_Invariant + (for all J in Item'First .. From when J /= From => + Item (J) /= char32_nul); + + if From > Item'Last then + raise Terminator_Error; + elsif Item (From) = char32_nul then + exit; + else + From := From + 1; + end if; + end loop; + + pragma Assert (From = Item'First + C_Length_Ghost (Item)); + + Count := Natural (From - Item'First); + + else + Count := Item'Length; + end if; + + declare + Count_Cst : constant Natural := Count; + R : Wide_Wide_String (1 .. Count_Cst) with Relaxed_Initialization; + + begin + for J in R'Range loop + R (J) := To_Ada (Item (size_t (J) - 1 + Item'First)); + + pragma Loop_Invariant (for all K in 1 .. J => R (K)'Initialized); + pragma Loop_Invariant + (for all K in 1 .. J => + R (K) = To_Ada (Item (size_t (K) - 1 + Item'First))); + end loop; + + return R; + end; + end To_Ada; + + -- Convert char32_array to Wide_Wide_String (procedure form) + + procedure To_Ada + (Item : char32_array; + Target : out Wide_Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True) + is + From : size_t; + To : Integer; + + begin + if Trim_Nul then + From := Item'First; + loop + pragma Loop_Invariant (From in Item'Range); + pragma Loop_Invariant + (for some J in From .. Item'Last => Item (J) = char32_nul); + pragma Loop_Invariant + (for all J in Item'First .. From when J /= From => + Item (J) /= char32_nul); + + if From > Item'Last then + raise Terminator_Error; + elsif Item (From) = char32_nul then + exit; + else + From := From + 1; + end if; + end loop; + + Count := Natural (From - Item'First); + + else + Count := Item'Length; + end if; + + if Count > Target'Length then + raise Constraint_Error; + + else + From := Item'First; + To := Target'First; + + for J in 1 .. Count loop + Target (To) := To_Ada (Item (From)); + + pragma Loop_Invariant (From in Item'Range); + pragma Loop_Invariant (To in Target'Range); + pragma Loop_Invariant (To = Target'First + (J - 1)); + pragma Loop_Invariant (From = Item'First + size_t (J - 1)); + pragma Loop_Invariant + (for all J in Target'First .. To => Target (J)'Initialized); + pragma Loop_Invariant + (Target (Target'First .. To)'Initialized); + pragma Loop_Invariant + (for all K in Target'First .. To => + Target (K) = + To_Ada (Item (size_t (K - Target'First) + Item'First))); + + -- Avoid possible overflow when incrementing To in the last + -- iteration of the loop. + exit when J = Count; + + From := From + 1; + To := To + 1; + end loop; + end if; + end To_Ada; + ---------- -- To_C -- ---------- @@ -70,4 +716,511 @@ return char'Val (Character'Pos (Item)); end To_C; + -- Convert String to char_array (function form) + + function To_C + (Item : String; + Append_Nul : Boolean := True) return char_array + is + begin + if Append_Nul then + declare + R : char_array (0 .. Item'Length) with Relaxed_Initialization; + + begin + for J in Item'Range loop + R (size_t (J - Item'First)) := To_C (Item (J)); + + pragma Loop_Invariant + (for all K in 0 .. size_t (J - Item'First) => + R (K)'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + R (size_t (K - Item'First)) = To_C (Item (K))); + end loop; + + R (R'Last) := nul; + + pragma Assert + (for all J in Item'Range => + R (size_t (J - Item'First)) = To_C (Item (J))); + + return R; + end; + + -- Append_Nul False + + else + -- A nasty case, if the string is null, we must return a null + -- char_array. The lower bound of this array is required to be zero + -- (RM B.3(50)) but that is of course impossible given that size_t + -- is unsigned. According to Ada 2005 AI-258, the result is to raise + -- Constraint_Error. This is also the appropriate behavior in Ada 95, + -- since nothing else makes sense. + + if Item'Length = 0 then + raise Constraint_Error; + + -- Normal case + + else + declare + R : char_array (0 .. Item'Length - 1) + with Relaxed_Initialization; + + begin + for J in Item'Range loop + R (size_t (J - Item'First)) := To_C (Item (J)); + + pragma Loop_Invariant + (for all K in 0 .. size_t (J - Item'First) => + R (K)'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + R (size_t (K - Item'First)) = To_C (Item (K))); + end loop; + + return R; + end; + end if; + end if; + end To_C; + + -- Convert String to char_array (procedure form) + + procedure To_C + (Item : String; + Target : out char_array; + Count : out size_t; + Append_Nul : Boolean := True) + is + To : size_t; + + begin + if Target'Length < Item'Length then + raise Constraint_Error; + + else + To := Target'First; + for From in Item'Range loop + Target (To) := char (Item (From)); + + pragma Loop_Invariant (To in Target'Range); + pragma Loop_Invariant + (To - Target'First = size_t (From - Item'First)); + pragma Loop_Invariant + (for all J in Target'First .. To => Target (J)'Initialized); + pragma Loop_Invariant + (Target (Target'First .. To)'Initialized); + pragma Loop_Invariant + (for all J in Item'First .. From => + Target (Target'First + size_t (J - Item'First)) = + To_C (Item (J))); + + To := To + 1; + end loop; + + if Append_Nul then + if To > Target'Last then + raise Constraint_Error; + else + Target (To) := nul; + Count := Item'Length + 1; + end if; + + else + Count := Item'Length; + end if; + end if; + end To_C; + + -- Convert Wide_Character to wchar_t + + function To_C (Item : Wide_Character) return wchar_t is + begin + return wchar_t (Item); + end To_C; + + -- Convert Wide_String to wchar_array (function form) + + function To_C + (Item : Wide_String; + Append_Nul : Boolean := True) return wchar_array + is + begin + if Append_Nul then + declare + R : wchar_array (0 .. Item'Length) with Relaxed_Initialization; + + begin + for J in Item'Range loop + R (size_t (J - Item'First)) := To_C (Item (J)); + + pragma Loop_Invariant + (for all K in 0 .. size_t (J - Item'First) => + R (K)'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + R (size_t (K - Item'First)) = To_C (Item (K))); + end loop; + + R (R'Last) := wide_nul; + + pragma Assert + (for all J in Item'Range => + R (size_t (J - Item'First)) = To_C (Item (J))); + + return R; + end; + + else + -- A nasty case, if the string is null, we must return a null + -- wchar_array. The lower bound of this array is required to be zero + -- (RM B.3(50)) but that is of course impossible given that size_t + -- is unsigned. According to Ada 2005 AI-258, the result is to raise + -- Constraint_Error. This is also the appropriate behavior in Ada 95, + -- since nothing else makes sense. + + if Item'Length = 0 then + raise Constraint_Error; + + else + declare + R : wchar_array (0 .. Item'Length - 1) + with Relaxed_Initialization; + + begin + for J in Item'Range loop + R (size_t (J - Item'First)) := To_C (Item (J)); + + pragma Loop_Invariant + (for all K in 0 .. size_t (J - Item'First) => + R (K)'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + R (size_t (K - Item'First)) = To_C (Item (K))); + end loop; + + return R; + end; + end if; + end if; + end To_C; + + -- Convert Wide_String to wchar_array (procedure form) + + procedure To_C + (Item : Wide_String; + Target : out wchar_array; + Count : out size_t; + Append_Nul : Boolean := True) + is + To : size_t; + + begin + if Target'Length < Item'Length then + raise Constraint_Error; + + else + To := Target'First; + for From in Item'Range loop + Target (To) := To_C (Item (From)); + + pragma Loop_Invariant (To in Target'Range); + pragma Loop_Invariant + (To - Target'First = size_t (From - Item'First)); + pragma Loop_Invariant + (for all J in Target'First .. To => Target (J)'Initialized); + pragma Loop_Invariant + (Target (Target'First .. To)'Initialized); + pragma Loop_Invariant + (for all J in Item'First .. From => + Target (Target'First + size_t (J - Item'First)) = + To_C (Item (J))); + + To := To + 1; + end loop; + + pragma Assert + (for all J in Item'Range => + Target (Target'First + size_t (J - Item'First)) = + To_C (Item (J))); + pragma Assert + (if Item'Length /= 0 then + Target (Target'First .. + Target'First + (Item'Length - 1))'Initialized); + + if Append_Nul then + if To > Target'Last then + raise Constraint_Error; + else + Target (To) := wide_nul; + Count := Item'Length + 1; + end if; + + else + Count := Item'Length; + end if; + end if; + end To_C; + + -- Convert Wide_Character to char16_t + + function To_C (Item : Wide_Character) return char16_t is + begin + return char16_t'Val (Wide_Character'Pos (Item)); + end To_C; + + -- Convert Wide_String to char16_array (function form) + + function To_C + (Item : Wide_String; + Append_Nul : Boolean := True) return char16_array + is + begin + if Append_Nul then + declare + R : char16_array (0 .. Item'Length) with Relaxed_Initialization; + + begin + for J in Item'Range loop + R (size_t (J - Item'First)) := To_C (Item (J)); + + pragma Loop_Invariant + (for all K in 0 .. size_t (J - Item'First) => + R (K)'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + R (size_t (K - Item'First)) = To_C (Item (K))); + end loop; + + R (R'Last) := char16_nul; + + pragma Assert + (for all J in Item'Range => + R (size_t (J - Item'First)) = To_C (Item (J))); + + return R; + end; + + else + -- A nasty case, if the string is null, we must return a null + -- char16_array. The lower bound of this array is required to be zero + -- (RM B.3(50)) but that is of course impossible given that size_t + -- is unsigned. According to Ada 2005 AI-258, the result is to raise + -- Constraint_Error. This is also the appropriate behavior in Ada 95, + -- since nothing else makes sense. + + if Item'Length = 0 then + raise Constraint_Error; + + else + declare + R : char16_array (0 .. Item'Length - 1) + with Relaxed_Initialization; + + begin + for J in Item'Range loop + R (size_t (J - Item'First)) := To_C (Item (J)); + + pragma Loop_Invariant + (for all K in 0 .. size_t (J - Item'First) => + R (K)'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + R (size_t (K - Item'First)) = To_C (Item (K))); + end loop; + + return R; + end; + end if; + end if; + end To_C; + + -- Convert Wide_String to char16_array (procedure form) + + procedure To_C + (Item : Wide_String; + Target : out char16_array; + Count : out size_t; + Append_Nul : Boolean := True) + is + To : size_t; + + begin + if Target'Length < Item'Length then + raise Constraint_Error; + + else + To := Target'First; + for From in Item'Range loop + Target (To) := To_C (Item (From)); + + pragma Loop_Invariant (To in Target'Range); + pragma Loop_Invariant + (To - Target'First = size_t (From - Item'First)); + pragma Loop_Invariant + (for all J in Target'First .. To => Target (J)'Initialized); + pragma Loop_Invariant + (Target (Target'First .. To)'Initialized); + pragma Loop_Invariant + (for all J in Item'First .. From => + Target (Target'First + size_t (J - Item'First)) = + To_C (Item (J))); + + To := To + 1; + end loop; + + pragma Assert + (for all J in Item'Range => + Target (Target'First + size_t (J - Item'First)) = + To_C (Item (J))); + pragma Assert + (if Item'Length /= 0 then + Target (Target'First .. + Target'First + (Item'Length - 1))'Initialized); + + if Append_Nul then + if To > Target'Last then + raise Constraint_Error; + else + Target (To) := char16_nul; + Count := Item'Length + 1; + end if; + + else + Count := Item'Length; + end if; + end if; + end To_C; + + -- Convert Wide_Character to char32_t + + function To_C (Item : Wide_Wide_Character) return char32_t is + begin + return char32_t'Val (Wide_Wide_Character'Pos (Item)); + end To_C; + + -- Convert Wide_Wide_String to char32_array (function form) + + function To_C + (Item : Wide_Wide_String; + Append_Nul : Boolean := True) return char32_array + is + begin + if Append_Nul then + declare + R : char32_array (0 .. Item'Length) with Relaxed_Initialization; + + begin + for J in Item'Range loop + R (size_t (J - Item'First)) := To_C (Item (J)); + + pragma Loop_Invariant + (for all K in 0 .. size_t (J - Item'First) => + R (K)'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + R (size_t (K - Item'First)) = To_C (Item (K))); + end loop; + + R (R'Last) := char32_nul; + + pragma Assert + (for all J in Item'Range => + R (size_t (J - Item'First)) = To_C (Item (J))); + + return R; + end; + + else + -- A nasty case, if the string is null, we must return a null + -- char32_array. The lower bound of this array is required to be zero + -- (RM B.3(50)) but that is of course impossible given that size_t + -- is unsigned. According to Ada 2005 AI-258, the result is to raise + -- Constraint_Error. + + if Item'Length = 0 then + raise Constraint_Error; + + else + declare + R : char32_array (0 .. Item'Length - 1) + with Relaxed_Initialization; + + begin + for J in Item'Range loop + R (size_t (J - Item'First)) := To_C (Item (J)); + + pragma Loop_Invariant + (for all K in 0 .. size_t (J - Item'First) => + R (K)'Initialized); + pragma Loop_Invariant + (for all K in Item'First .. J => + R (size_t (K - Item'First)) = To_C (Item (K))); + end loop; + + return R; + end; + end if; + end if; + end To_C; + + -- Convert Wide_Wide_String to char32_array (procedure form) + + procedure To_C + (Item : Wide_Wide_String; + Target : out char32_array; + Count : out size_t; + Append_Nul : Boolean := True) + is + To : size_t; + + begin + if Target'Length < Item'Length then + raise Constraint_Error; + + else + To := Target'First; + for From in Item'Range loop + Target (To) := To_C (Item (From)); + + pragma Loop_Invariant (To in Target'Range); + pragma Loop_Invariant + (To - Target'First = size_t (From - Item'First)); + pragma Loop_Invariant + (for all J in Target'First .. To => Target (J)'Initialized); + pragma Loop_Invariant + (Target (Target'First .. To)'Initialized); + pragma Loop_Invariant + (for all J in Item'First .. From => + Target (Target'First + size_t (J - Item'First)) = + To_C (Item (J))); + + To := To + 1; + end loop; + + pragma Assert + (for all J in Item'Range => + Target (Target'First + size_t (J - Item'First)) = + To_C (Item (J))); + pragma Assert + (if Item'Length /= 0 then + Target (Target'First .. + Target'First + (Item'Length - 1))'Initialized); + + if Append_Nul then + if To > Target'Last then + raise Constraint_Error; + else + Target (To) := char32_nul; + Count := Item'Length + 1; + end if; + + else + Count := Item'Length; + end if; + end if; + end To_C; + end Interfaces.C; diff --git a/src/lib/gnat/i-c.ads b/src/lib/gnat/i-c.ads index 7e90a60..7013902 100644 --- a/src/lib/gnat/i-c.ads +++ b/src/lib/gnat/i-c.ads @@ -13,10 +13,32 @@ -- -- ------------------------------------------------------------------------------ +-- Preconditions in this unit are meant for analysis only, not for run-time +-- checking, so that the expected exceptions are raised. This is enforced by +-- setting the corresponding assertion policy to Ignore. Postconditions and +-- contract cases should not be executed at runtime as well, in order not to +-- slow down the execution of these functions. + +pragma Assertion_Policy (Pre => Ignore, + Post => Ignore, + Contract_Cases => Ignore, + Ghost => Ignore); + with System.Parameters; -package Interfaces.C is - pragma Pure; +package Interfaces.C + with SPARK_Mode, Pure +is + pragma Annotate (GNATprove, Always_Return, C); + + -- Each of the types declared in Interfaces.C is C-compatible. + + -- The types int, short, long, unsigned, ptrdiff_t, size_t, double, + -- char, wchar_t, char16_t, and char32_t correspond respectively to the + -- C types having the same names. The types signed_char, unsigned_short, + -- unsigned_long, unsigned_char, C_bool, C_float, and long_double + -- correspond respectively to the C types signed char, unsigned + -- short, unsigned long, unsigned char, bool, float, and long double. -- Declaration's based on C's <limits.h> @@ -36,18 +58,24 @@ type short is new Short_Integer; type long is range -(2 ** (System.Parameters.long_bits - Integer'(1))) .. +(2 ** (System.Parameters.long_bits - Integer'(1))) - 1; + type long_long is new Long_Long_Integer; type signed_char is range SCHAR_MIN .. SCHAR_MAX; for signed_char'Size use CHAR_BIT; - type unsigned is mod 2 ** int'Size; - type unsigned_short is mod 2 ** short'Size; - type unsigned_long is mod 2 ** long'Size; + type unsigned is mod 2 ** int'Size; + type unsigned_short is mod 2 ** short'Size; + type unsigned_long is mod 2 ** long'Size; + type unsigned_long_long is mod 2 ** long_long'Size; type unsigned_char is mod (UCHAR_MAX + 1); for unsigned_char'Size use CHAR_BIT; - subtype plain_char is unsigned_char; -- ??? should be parameterized + -- Note: Ada RM states that the type of the subtype plain_char is either + -- signed_char or unsigned_char, depending on the C implementation. GNAT + -- instead choses unsigned_char always. + + subtype plain_char is unsigned_char; -- Note: the Integer qualifications used in the declaration of ptrdiff_t -- avoid ambiguities when compiling in the presence of s-auxdec.ads and @@ -59,8 +87,16 @@ type size_t is mod 2 ** System.Parameters.ptr_bits; - -- For convenience, also provide an uintptr_t type - type uintptr_t is mod 2 ** System.Parameters.ptr_bits; + -- Boolean type + + type C_bool is new Boolean; + pragma Convention (C, C_bool); + + -- Floating-Point + + type C_float is new Float; + type double is new Standard.Long_Float; + type long_double is new Standard.Long_Long_Float; ---------------------------- -- Characters and Strings -- @@ -70,12 +106,492 @@ nul : constant char := char'First; - function To_C (Item : Character) return char; - function To_Ada (Item : char) return Character; + -- The functions To_C and To_Ada map between the Ada type Character and the + -- C type char. + + function To_C (Item : Character) return char + with + Post => To_C'Result = char'Val (Character'Pos (Item)); + + function To_Ada (Item : char) return Character + with + Post => To_Ada'Result = Character'Val (char'Pos (Item)); type char_array is array (size_t range <>) of aliased char; for char_array'Component_Size use CHAR_BIT; - function Is_Nul_Terminated (Item : char_array) return Boolean; + function Is_Nul_Terminated (Item : char_array) return Boolean + with + Post => Is_Nul_Terminated'Result = (for some C of Item => C = nul); + -- The result of Is_Nul_Terminated is True if Item contains nul, and is + -- False otherwise. + + function C_Length_Ghost (Item : char_array) return size_t + with + Ghost, + Pre => Is_Nul_Terminated (Item), + Post => C_Length_Ghost'Result <= Item'Last - Item'First + and then Item (Item'First + C_Length_Ghost'Result) = nul + and then (for all J in Item'First .. Item'First + C_Length_Ghost'Result + when J /= Item'First + C_Length_Ghost'Result => + Item (J) /= nul); + -- Ghost function to compute the length of a char_array up to the first nul + -- character. + + function To_C + (Item : String; + Append_Nul : Boolean := True) return char_array + with + Pre => not (Append_Nul = False and then Item'Length = 0), + Post => To_C'Result'First = 0 + and then To_C'Result'Length = + (if Append_Nul then Item'Length + 1 else Item'Length) + and then (for all J in Item'Range => + To_C'Result (size_t (J - Item'First)) = To_C (Item (J))) + and then (if Append_Nul then To_C'Result (To_C'Result'Last) = nul); + -- The result of To_C is a char_array value of length Item'Length (if + -- Append_Nul is False) or Item'Length+1 (if Append_Nul is True). The lower + -- bound is 0. For each component Item(I), the corresponding component + -- in the result is To_C applied to Item(I). The value nul is appended if + -- Append_Nul is True. If Append_Nul is False and Item'Length is 0, then + -- To_C propagates Constraint_Error. + + function To_Ada + (Item : char_array; + Trim_Nul : Boolean := True) return String + with + Pre => (if Trim_Nul then + Is_Nul_Terminated (Item) + and then C_Length_Ghost (Item) <= size_t (Natural'Last) + else + Item'Last - Item'First < size_t (Natural'Last)), + Post => To_Ada'Result'First = 1 + and then To_Ada'Result'Length = + (if Trim_Nul then C_Length_Ghost (Item) else Item'Length) + and then (for all J in To_Ada'Result'Range => + To_Ada'Result (J) = + To_Ada (Item (size_t (J) - 1 + Item'First))); + -- The result of To_Ada is a String whose length is Item'Length (if + -- Trim_Nul is False) or the length of the slice of Item preceding the + -- first nul (if Trim_Nul is True). The lower bound of the result is 1. + -- If Trim_Nul is False, then for each component Item(I) the corresponding + -- component in the result is To_Ada applied to Item(I). If Trim_Nul + -- is True, then for each component Item(I) before the first nul the + -- corresponding component in the result is To_Ada applied to Item(I). The + -- function propagates Terminator_Error if Trim_Nul is True and Item does + -- not contain nul. + + procedure To_C + (Item : String; + Target : out char_array; + Count : out size_t; + Append_Nul : Boolean := True) + with + Relaxed_Initialization => Target, + Pre => Target'Length >= + (if Append_Nul then Item'Length + 1 else Item'Length), + Post => Count = (if Append_Nul then Item'Length + 1 else Item'Length) + and then + (if Count /= 0 then + Target (Target'First .. Target'First + (Count - 1))'Initialized) + and then + (for all J in Item'Range => + Target (Target'First + size_t (J - Item'First)) = To_C (Item (J))) + and then + (if Append_Nul then Target (Target'First + (Count - 1)) = nul); + -- For procedure To_C, each element of Item is converted (via the To_C + -- function) to a char, which is assigned to the corresponding element of + -- Target. If Append_Nul is True, nul is then assigned to the next element + -- of Target. In either case, Count is set to the number of Target elements + -- assigned. If Target is not long enough, Constraint_Error is propagated. + + procedure To_Ada + (Item : char_array; + Target : out String; + Count : out Natural; + Trim_Nul : Boolean := True) + with + Relaxed_Initialization => Target, + Pre => (if Trim_Nul then + Is_Nul_Terminated (Item) + and then C_Length_Ghost (Item) <= size_t (Target'Length) + else + Item'Last - Item'First < size_t (Target'Length)), + Post => Count = + (if Trim_Nul then Natural (C_Length_Ghost (Item)) else Item'Length) + and then + (if Count /= 0 then + Target (Target'First .. Target'First + (Count - 1))'Initialized) + and then + (for all J in Target'First .. Target'First + (Count - 1) => + Target (J) = + To_Ada (Item (size_t (J - Target'First) + Item'First))); + -- For procedure To_Ada, each element of Item (if Trim_Nul is False) or + -- each element of Item preceding the first nul (if Trim_Nul is True) is + -- converted (via the To_Ada function) to a Character, which is assigned + -- to the corresponding element of Target. Count is set to the number of + -- Target elements assigned. If Target is not long enough, Constraint_Error + -- is propagated. If Trim_Nul is True and Item does not contain nul, then + -- Terminator_Error is propagated. + + ------------------------------------ + -- Wide Character and Wide String -- + ------------------------------------ + + type wchar_t is new Wide_Character; + for wchar_t'Size use Standard'Wchar_T_Size; + + wide_nul : constant wchar_t := wchar_t'First; + + -- To_C and To_Ada provide the mappings between the Ada and C wide + -- character types. + + function To_C (Item : Wide_Character) return wchar_t + with + Post => To_C'Result = wchar_t (Item); + + function To_Ada (Item : wchar_t) return Wide_Character + with + Post => To_Ada'Result = Wide_Character (Item); + + type wchar_array is array (size_t range <>) of aliased wchar_t; + + function Is_Nul_Terminated (Item : wchar_array) return Boolean + with + Post => Is_Nul_Terminated'Result = (for some C of Item => C = wide_nul); + -- The result of Is_Nul_Terminated is True if Item contains wide_nul, and + -- is False otherwise. + + -- The To_C and To_Ada subprograms that convert between Wide_String and + -- wchar_array have analogous effects to the To_C and To_Ada subprograms + -- that convert between String and char_array, except that wide_nul is + -- used instead of nul. + + function C_Length_Ghost (Item : wchar_array) return size_t + with + Ghost, + Pre => Is_Nul_Terminated (Item), + Post => C_Length_Ghost'Result <= Item'Last - Item'First + and then Item (Item'First + C_Length_Ghost'Result) = wide_nul + and then (for all J in Item'First .. Item'First + C_Length_Ghost'Result + when J /= Item'First + C_Length_Ghost'Result => + Item (J) /= wide_nul); + -- Ghost function to compute the length of a wchar_array up to the first + -- wide_nul character. + + function To_C + (Item : Wide_String; + Append_Nul : Boolean := True) return wchar_array + with + Pre => not (Append_Nul = False and then Item'Length = 0), + Post => To_C'Result'First = 0 + and then To_C'Result'Length = + (if Append_Nul then Item'Length + 1 else Item'Length) + and then (for all J in Item'Range => + To_C'Result (size_t (J - Item'First)) = To_C (Item (J))) + and then (if Append_Nul then To_C'Result (To_C'Result'Last) = wide_nul); + + function To_Ada + (Item : wchar_array; + Trim_Nul : Boolean := True) return Wide_String + with + Pre => (if Trim_Nul then + Is_Nul_Terminated (Item) + and then C_Length_Ghost (Item) <= size_t (Natural'Last) + else + Item'Last - Item'First < size_t (Natural'Last)), + Post => To_Ada'Result'First = 1 + and then To_Ada'Result'Length = + (if Trim_Nul then C_Length_Ghost (Item) else Item'Length) + and then (for all J in To_Ada'Result'Range => + To_Ada'Result (J) = + To_Ada (Item (size_t (J) - 1 + Item'First))); + + procedure To_C + (Item : Wide_String; + Target : out wchar_array; + Count : out size_t; + Append_Nul : Boolean := True) + with + Relaxed_Initialization => Target, + Pre => Target'Length >= + (if Append_Nul then Item'Length + 1 else Item'Length), + Post => Count = (if Append_Nul then Item'Length + 1 else Item'Length) + and then + (if Count /= 0 then + Target (Target'First .. Target'First + (Count - 1))'Initialized) + and then + (for all J in Item'Range => + Target (Target'First + size_t (J - Item'First)) = To_C (Item (J))) + and then + (if Append_Nul then Target (Target'First + (Count - 1)) = wide_nul); + + procedure To_Ada + (Item : wchar_array; + Target : out Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True) + with + Relaxed_Initialization => Target, + Pre => (if Trim_Nul then + Is_Nul_Terminated (Item) + and then C_Length_Ghost (Item) <= size_t (Target'Length) + else + Item'Last - Item'First < size_t (Target'Length)), + Post => Count = + (if Trim_Nul then Natural (C_Length_Ghost (Item)) else Item'Length) + and then + (if Count /= 0 then + Target (Target'First .. Target'First + (Count - 1))'Initialized) + and then + (for all J in Target'First .. Target'First + (Count - 1) => + Target (J) = + To_Ada (Item (size_t (J - Target'First) + Item'First))); + + Terminator_Error : exception; + + -- The remaining declarations are for Ada 2005 (AI-285) + + -- ISO/IEC 10646:2003 compatible types defined by SC22/WG14 document N1010 + + type char16_t is new Wide_Character; + pragma Ada_05 (char16_t); + + char16_nul : constant char16_t := char16_t'Val (0); + pragma Ada_05 (char16_nul); + + -- To_C and To_Ada provide mappings between the Ada and C 16-bit character + -- types. + + function To_C (Item : Wide_Character) return char16_t + with + Post => To_C'Result = char16_t (Item); + pragma Ada_05 (To_C); + + function To_Ada (Item : char16_t) return Wide_Character + with + Post => To_Ada'Result = Wide_Character (Item); + pragma Ada_05 (To_Ada); + + type char16_array is array (size_t range <>) of aliased char16_t; + pragma Ada_05 (char16_array); + + function Is_Nul_Terminated (Item : char16_array) return Boolean + with + Post => Is_Nul_Terminated'Result = (for some C of Item => C = char16_nul); + pragma Ada_05 (Is_Nul_Terminated); + -- The result of Is_Nul_Terminated is True if Item contains char16_nul, and + -- is False otherwise. + + -- The To_C and To_Ada subprograms that convert between Wide_String and + -- char16_array have analogous effects to the To_C and To_Ada subprograms + -- that convert between String and char_array, except that char16_nul is + -- used instead of nul. + + function C_Length_Ghost (Item : char16_array) return size_t + with + Ghost, + Pre => Is_Nul_Terminated (Item), + Post => C_Length_Ghost'Result <= Item'Last - Item'First + and then Item (Item'First + C_Length_Ghost'Result) = char16_nul + and then (for all J in Item'First .. Item'First + C_Length_Ghost'Result + when J /= Item'First + C_Length_Ghost'Result => + Item (J) /= char16_nul); + -- Ghost function to compute the length of a char16_array up to the first + -- char16_nul character. + + function To_C + (Item : Wide_String; + Append_Nul : Boolean := True) return char16_array + with + Pre => not (Append_Nul = False and then Item'Length = 0), + Post => To_C'Result'First = 0 + and then To_C'Result'Length = + (if Append_Nul then Item'Length + 1 else Item'Length) + and then (for all J in Item'Range => + To_C'Result (size_t (J - Item'First)) = To_C (Item (J))) + and then + (if Append_Nul then To_C'Result (To_C'Result'Last) = char16_nul); + pragma Ada_05 (To_C); + + function To_Ada + (Item : char16_array; + Trim_Nul : Boolean := True) return Wide_String + with + Pre => (if Trim_Nul then + Is_Nul_Terminated (Item) + and then C_Length_Ghost (Item) <= size_t (Natural'Last) + else + Item'Last - Item'First < size_t (Natural'Last)), + Post => To_Ada'Result'First = 1 + and then To_Ada'Result'Length = + (if Trim_Nul then C_Length_Ghost (Item) else Item'Length) + and then (for all J in To_Ada'Result'Range => + To_Ada'Result (J) = + To_Ada (Item (size_t (J) - 1 + Item'First))); + pragma Ada_05 (To_Ada); + + procedure To_C + (Item : Wide_String; + Target : out char16_array; + Count : out size_t; + Append_Nul : Boolean := True) + with + Relaxed_Initialization => Target, + Pre => Target'Length >= + (if Append_Nul then Item'Length + 1 else Item'Length), + Post => Count = (if Append_Nul then Item'Length + 1 else Item'Length) + and then + (if Count /= 0 then + Target (Target'First .. Target'First + (Count - 1))'Initialized) + and then + (for all J in Item'Range => + Target (Target'First + size_t (J - Item'First)) = To_C (Item (J))) + and then + (if Append_Nul then Target (Target'First + (Count - 1)) = char16_nul); + pragma Ada_05 (To_C); + + procedure To_Ada + (Item : char16_array; + Target : out Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True) + with + Relaxed_Initialization => Target, + Pre => (if Trim_Nul then + Is_Nul_Terminated (Item) + and then C_Length_Ghost (Item) <= size_t (Target'Length) + else + Item'Last - Item'First < size_t (Target'Length)), + Post => Count = + (if Trim_Nul then Natural (C_Length_Ghost (Item)) else Item'Length) + and then + (if Count /= 0 then + Target (Target'First .. Target'First + (Count - 1))'Initialized) + and then + (for all J in Target'First .. Target'First + (Count - 1) => + Target (J) = + To_Ada (Item (size_t (J - Target'First) + Item'First))); + pragma Ada_05 (To_Ada); + + type char32_t is new Wide_Wide_Character; + pragma Ada_05 (char32_t); + + char32_nul : constant char32_t := char32_t'Val (0); + pragma Ada_05 (char32_nul); + + -- To_C and To_Ada provide mappings between the Ada and C 32-bit character + -- types. + + function To_C (Item : Wide_Wide_Character) return char32_t + with + Post => To_C'Result = char32_t (Item); + pragma Ada_05 (To_C); + + function To_Ada (Item : char32_t) return Wide_Wide_Character + with + Post => To_Ada'Result = Wide_Wide_Character (Item); + pragma Ada_05 (To_Ada); + + type char32_array is array (size_t range <>) of aliased char32_t; + pragma Ada_05 (char32_array); + + function Is_Nul_Terminated (Item : char32_array) return Boolean + with + Post => Is_Nul_Terminated'Result = (for some C of Item => C = char32_nul); + pragma Ada_05 (Is_Nul_Terminated); + -- The result of Is_Nul_Terminated is True if Item contains char32_nul, and + -- is False otherwise. + + function C_Length_Ghost (Item : char32_array) return size_t + with + Ghost, + Pre => Is_Nul_Terminated (Item), + Post => C_Length_Ghost'Result <= Item'Last - Item'First + and then Item (Item'First + C_Length_Ghost'Result) = char32_nul + and then (for all J in Item'First .. Item'First + C_Length_Ghost'Result + when J /= Item'First + C_Length_Ghost'Result => + Item (J) /= char32_nul); + -- Ghost function to compute the length of a char32_array up to the first + -- char32_nul character. + + -- The To_C and To_Ada subprograms that convert between Wide_Wide_String + -- and char32_array have analogous effects to the To_C and To_Ada + -- subprograms that convert between String and char_array, except + -- that char32_nul is used instead of nul. + + function To_C + (Item : Wide_Wide_String; + Append_Nul : Boolean := True) return char32_array + with + Pre => not (Append_Nul = False and then Item'Length = 0), + Post => To_C'Result'First = 0 + and then To_C'Result'Length = + (if Append_Nul then Item'Length + 1 else Item'Length) + and then (for all J in Item'Range => + To_C'Result (size_t (J - Item'First)) = To_C (Item (J))) + and then + (if Append_Nul then To_C'Result (To_C'Result'Last) = char32_nul); + pragma Ada_05 (To_C); + + function To_Ada + (Item : char32_array; + Trim_Nul : Boolean := True) return Wide_Wide_String + with + Pre => (if Trim_Nul then + Is_Nul_Terminated (Item) + and then C_Length_Ghost (Item) <= size_t (Natural'Last) + else + Item'Last - Item'First < size_t (Natural'Last)), + Post => To_Ada'Result'First = 1 + and then To_Ada'Result'Length = + (if Trim_Nul then C_Length_Ghost (Item) else Item'Length) + and then (for all J in To_Ada'Result'Range => + To_Ada'Result (J) = + To_Ada (Item (size_t (J) - 1 + Item'First))); + pragma Ada_05 (To_Ada); + + procedure To_C + (Item : Wide_Wide_String; + Target : out char32_array; + Count : out size_t; + Append_Nul : Boolean := True) + with + Relaxed_Initialization => Target, + Pre => Target'Length >= + (if Append_Nul then Item'Length + 1 else Item'Length), + Post => Count = (if Append_Nul then Item'Length + 1 else Item'Length) + and then + (if Count /= 0 then + Target (Target'First .. Target'First + (Count - 1))'Initialized) + and then + (for all J in Item'Range => + Target (Target'First + size_t (J - Item'First)) = To_C (Item (J))) + and then + (if Append_Nul then Target (Target'First + (Count - 1)) = char32_nul); + pragma Ada_05 (To_C); + + procedure To_Ada + (Item : char32_array; + Target : out Wide_Wide_String; + Count : out Natural; + Trim_Nul : Boolean := True) + with + Relaxed_Initialization => Target, + Pre => (if Trim_Nul then + Is_Nul_Terminated (Item) + and then C_Length_Ghost (Item) <= size_t (Target'Length) + else + Item'Last - Item'First < size_t (Target'Length)), + Post => Count = + (if Trim_Nul then Natural (C_Length_Ghost (Item)) else Item'Length) + and then + (if Count /= 0 then + Target (Target'First .. Target'First + (Count - 1))'Initialized) + and then + (for all J in Target'First .. Target'First + (Count - 1) => + Target (J) = + To_Ada (Item (size_t (J - Target'First) + Item'First))); + pragma Ada_05 (To_Ada); end Interfaces.C; diff --git a/src/lib/gnat/interfac.ads b/src/lib/gnat/interfac.ads index 96f4b47..b269869 100644 --- a/src/lib/gnat/interfac.ads +++ b/src/lib/gnat/interfac.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2022, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -33,8 +33,12 @@ -- -- ------------------------------------------------------------------------------ +-- This is the compiler version of this unit + package Interfaces is + pragma No_Elaboration_Code_All; pragma Pure; + pragma Annotate (GNATprove, Always_Return, Interfaces); -- All identifiers in this unit are implementation defined @@ -63,6 +67,11 @@ type Unsigned_16 is mod 2 ** 16; for Unsigned_16'Size use 16; + type Unsigned_24 is mod 2 ** 24; + for Unsigned_24'Size use 24; + -- Declare this type for compatibility with legacy Ada compilers. + -- This is particularly useful in the context of CodePeer analysis. + type Unsigned_32 is mod 2 ** 32; for Unsigned_32'Size use 32; @@ -156,4 +165,21 @@ pragma Import (Intrinsic, Rotate_Left); pragma Import (Intrinsic, Rotate_Right); + -- IEEE Floating point types + + type IEEE_Float_32 is digits 6; + for IEEE_Float_32'Size use 32; + + type IEEE_Float_64 is digits 15; + for IEEE_Float_64'Size use 64; + + -- If there is an IEEE extended float available on the machine, we assume + -- that it is available as Long_Long_Float. + + -- Note: it is harmless, and explicitly permitted, to include additional + -- types in interfaces, so it is not wrong to have IEEE_Extended_Float + -- defined even if the extended format is not available. + + type IEEE_Extended_Float is new Long_Long_Float; + end Interfaces; diff --git a/src/lib/gnat/s-atacco.ads b/src/lib/gnat/s-atacco.ads index fb6232d..a928d47 100644 --- a/src/lib/gnat/s-atacco.ads +++ b/src/lib/gnat/s-atacco.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2012, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -54,8 +54,12 @@ -- optimizations that may cause unexpected results based on the assumption -- of no strict aliasing. - function To_Pointer (Value : Address) return Object_Pointer; - function To_Address (Value : Object_Pointer) return Address; + function To_Pointer (Value : Address) return Object_Pointer with + Global => null, + Annotate => (GNATprove, Always_Return); + function To_Address (Value : Object_Pointer) return Address with + SPARK_Mode => Off, + Annotate => (GNATprove, Always_Return); pragma Import (Intrinsic, To_Pointer); pragma Import (Intrinsic, To_Address); diff --git a/src/lib/gnat/s-exctab.ads b/src/lib/gnat/s-exctab.ads new file mode 100644 index 0000000..07a12c1 --- /dev/null +++ b/src/lib/gnat/s-exctab.ads @@ -0,0 +1,73 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . E X C E P T I O N _ T A B L E -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1996-2022, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package implements the interface used to maintain a table of +-- registered exception names, for the implementation of the mapping +-- of names to exceptions (used for exception streams and attributes) + +with System.Standard_Library; + +package System.Exception_Table is + pragma Elaborate_Body; + + package SSL renames System.Standard_Library; + + procedure Register_Exception (X : SSL.Exception_Data_Ptr); + pragma Inline (Register_Exception); + -- Register an exception in the hash table mapping. This function is + -- called during elaboration of library packages. For exceptions that + -- are declared within subprograms, the registration occurs the first + -- time that an exception is elaborated during a call of the subprogram. + -- + -- Note: all calls to Register_Exception other than those to register the + -- predefined exceptions are suppressed if the application is compiled + -- with pragma Restrictions (No_Exception_Registration). + + function Internal_Exception + (X : String; + Create_If_Not_Exist : Boolean := True) return SSL.Exception_Data_Ptr; + -- Given an exception_name X, returns a pointer to the actual internal + -- exception data. A new entry is created in the table if X does not + -- exist yet and Create_If_Not_Exist is True. If it is false and X + -- does not exist yet, null is returned. + + function Registered_Exceptions_Count return Natural; + -- Return the number of currently registered exceptions + + type Exception_Data_Array is array (Natural range <>) + of SSL.Exception_Data_Ptr; + + procedure Get_Registered_Exceptions + (List : out Exception_Data_Array; + Last : out Integer); + -- Return the list of registered exceptions + +end System.Exception_Table; diff --git a/src/lib/gnat/s-imagen.adb b/src/lib/gnat/s-imagen.adb new file mode 100644 index 0000000..cd8e170 --- /dev/null +++ b/src/lib/gnat/s-imagen.adb @@ -0,0 +1,79 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . I M A G E _ N -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2021-2022, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +with Ada.Unchecked_Conversion; + +package body System.Image_N is + + ----------------------- + -- Image_Enumeration -- + ----------------------- + + procedure Image_Enumeration + (Pos : Natural; + S : in out String; + P : out Natural; + Names : String; + Indexes : System.Address) + is + pragma Assert (S'First = 1); + + subtype Names_Index is + Index_Type range Index_Type (Names'First) + .. Index_Type (Names'Last) + 1; + subtype Index is Natural range Natural'First .. Names'Length; + type Index_Table is array (Index) of Names_Index; + type Index_Table_Ptr is access Index_Table; + + function To_Index_Table_Ptr is + new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr); + + IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes); + + pragma Assert (Pos in IndexesT'Range); + pragma Assert (Pos + 1 in IndexesT'Range); + + Start : constant Natural := Natural (IndexesT (Pos)); + Next : constant Natural := Natural (IndexesT (Pos + 1)); + + pragma Assert (Next - 1 >= Start); + pragma Assert (Start >= Names'First); + pragma Assert (Next - 1 <= Names'Last); + + pragma Assert (Next - Start <= S'Last); + -- The caller should guarantee that S is large enough to contain the + -- enumeration image. + begin + S (1 .. Next - Start) := Names (Start .. Next - 1); + P := Next - Start; + end Image_Enumeration; + +end System.Image_N; diff --git a/src/lib/gnat/s-imen16.ads b/src/lib/gnat/s-imen16.ads new file mode 100644 index 0000000..b7192c2 --- /dev/null +++ b/src/lib/gnat/s-imen16.ads @@ -0,0 +1,51 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . I M G _ E N U M _ 1 6 -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2021-2022, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- Instantiation of System.Image_N for enumeration types whose names table +-- has a length that fits in a 16-bit but not a 8-bit integer. + +with Interfaces; +with System.Image_N; + +package System.Img_Enum_16 is + pragma Pure; + + package Impl is new Image_N (Interfaces.Integer_16); + + procedure Image_Enumeration_16 + (Pos : Natural; + S : in out String; + P : out Natural; + Names : String; + Indexes : System.Address) + renames Impl.Image_Enumeration; + +end System.Img_Enum_16; diff --git a/src/lib/gnat/s-imen32.ads b/src/lib/gnat/s-imen32.ads new file mode 100644 index 0000000..96a1b34 --- /dev/null +++ b/src/lib/gnat/s-imen32.ads @@ -0,0 +1,51 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . I M G _ E N U M _ 3 2 -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2021-2022, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- Instantiation of System.Image_N for enumeration types whose names table +-- has a length that fits in a 32-bit but not a 16-bit integer. + +with Interfaces; +with System.Image_N; + +package System.Img_Enum_32 is + pragma Pure; + + package Impl is new Image_N (Interfaces.Integer_32); + + procedure Image_Enumeration_32 + (Pos : Natural; + S : in out String; + P : out Natural; + Names : String; + Indexes : System.Address) + renames Impl.Image_Enumeration; + +end System.Img_Enum_32; diff --git a/src/lib/gnat/s-imenne.adb b/src/lib/gnat/s-imenne.adb deleted file mode 100644 index de57766..0000000 --- a/src/lib/gnat/s-imenne.adb +++ /dev/null @@ -1,128 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- S Y S T E M . I M G _ E N U M _ N E W -- --- -- --- B o d y -- --- -- --- Copyright (C) 2000-2013, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - -pragma Assertion_Policy (Statement_Assertions => Ignore); - -with Ada.Unchecked_Conversion; - -package body System.Img_Enum_New is - - ------------------------- - -- Image_Enumeration_8 -- - ------------------------- - - procedure Image_Enumeration_8 - (Pos : Natural; - S : in out String; - P : out Natural; - Names : String; - Indexes : System.Address) - is - pragma Assert (S'First = 1); - - type Natural_8 is range 0 .. 2 ** 7 - 1; - type Index_Table is array (Natural) of Natural_8; - type Index_Table_Ptr is access Index_Table; - - function To_Index_Table_Ptr is - new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr); - - IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes); - - Start : constant Natural := Natural (IndexesT (Pos)); - Next : constant Natural := Natural (IndexesT (Pos + 1)); - - begin - S (1 .. Next - Start) := Names (Start .. Next - 1); - P := Next - Start; - end Image_Enumeration_8; - - -------------------------- - -- Image_Enumeration_16 -- - -------------------------- - - procedure Image_Enumeration_16 - (Pos : Natural; - S : in out String; - P : out Natural; - Names : String; - Indexes : System.Address) - is - pragma Assert (S'First = 1); - - type Natural_16 is range 0 .. 2 ** 15 - 1; - type Index_Table is array (Natural) of Natural_16; - type Index_Table_Ptr is access Index_Table; - - function To_Index_Table_Ptr is - new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr); - - IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes); - - Start : constant Natural := Natural (IndexesT (Pos)); - Next : constant Natural := Natural (IndexesT (Pos + 1)); - - begin - S (1 .. Next - Start) := Names (Start .. Next - 1); - P := Next - Start; - end Image_Enumeration_16; - - -------------------------- - -- Image_Enumeration_32 -- - -------------------------- - - procedure Image_Enumeration_32 - (Pos : Natural; - S : in out String; - P : out Natural; - Names : String; - Indexes : System.Address) - is - pragma Assert (S'First = 1); - - type Natural_32 is range 0 .. 2 ** 31 - 1; - type Index_Table is array (Natural) of Natural_32; - type Index_Table_Ptr is access Index_Table; - - function To_Index_Table_Ptr is - new Ada.Unchecked_Conversion (System.Address, Index_Table_Ptr); - - IndexesT : constant Index_Table_Ptr := To_Index_Table_Ptr (Indexes); - - Start : constant Natural := Natural (IndexesT (Pos)); - Next : constant Natural := Natural (IndexesT (Pos + 1)); - - begin - S (1 .. Next - Start) := Names (Start .. Next - 1); - P := Next - Start; - end Image_Enumeration_32; - -end System.Img_Enum_New; diff --git a/src/lib/gnat/s-imenne.ads b/src/lib/gnat/s-imenne.ads deleted file mode 100644 index ce470fd..0000000 --- a/src/lib/gnat/s-imenne.ads +++ /dev/null @@ -1,83 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT RUN-TIME COMPONENTS -- --- -- --- S Y S T E M . I M G _ E N U M _ N E W -- --- -- --- S p e c -- --- -- --- Copyright (C) 2000-2013, Free Software Foundation, Inc. -- --- -- --- GNAT is free software; you can redistribute it and/or modify it under -- --- terms of the GNU General Public License as published by the Free Soft- -- --- ware Foundation; either version 3, or (at your option) any later ver- -- --- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- --- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- --- or FITNESS FOR A PARTICULAR PURPOSE. -- --- -- --- As a special exception under Section 7 of GPL version 3, you are granted -- --- additional permissions described in the GCC Runtime Library Exception, -- --- version 3.1, as published by the Free Software Foundation. -- --- -- --- You should have received a copy of the GNU General Public License and -- --- a copy of the GCC Runtime Library Exception along with this program; -- --- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- --- <http://www.gnu.org/licenses/>. -- --- -- --- GNAT was originally developed by the GNAT team at New York University. -- --- Extensive contributions were provided by Ada Core Technologies Inc. -- --- -- ------------------------------------------------------------------------------- - --- Enumeration_Type'Image for all enumeration types except those in package --- Standard (where we have no opportunity to build image tables), and in --- package System (where it is too early to start building image tables). --- Special routines exist for the enumeration types in these packages. - --- This is the new version of the package, for use by compilers built after --- Nov 21st, 2007, which provides procedures that avoid using the secondary --- stack. The original package System.Img_Enum is maintained in the sources --- for bootstrapping with older versions of the compiler which expect to find --- functions in this package. - -package System.Img_Enum_New is - pragma Pure; - - procedure Image_Enumeration_8 - (Pos : Natural; - S : in out String; - P : out Natural; - Names : String; - Indexes : System.Address); - -- Used to compute Enum'Image (Str) where Enum is some enumeration type - -- other than those defined in package Standard. Names is a string with - -- a lower bound of 1 containing the characters of all the enumeration - -- literals concatenated together in sequence. Indexes is the address of - -- an array of type array (0 .. N) of Natural_8, where N is the number of - -- enumeration literals in the type. The Indexes values are the starting - -- subscript of each enumeration literal, indexed by Pos values, with an - -- extra entry at the end containing Names'Length + 1. The reason that - -- Indexes is passed by address is that the actual type is created on the - -- fly by the expander. The desired 'Image value is stored in S (1 .. P) - -- and P is set on return. The caller guarantees that S is long enough to - -- hold the result and that the lower bound is 1. - - procedure Image_Enumeration_16 - (Pos : Natural; - S : in out String; - P : out Natural; - Names : String; - Indexes : System.Address); - -- Identical to Set_Image_Enumeration_8 except that it handles types using - -- array (0 .. Num) of Natural_16 for the Indexes table. - - procedure Image_Enumeration_32 - (Pos : Natural; - S : in out String; - P : out Natural; - Names : String; - Indexes : System.Address); - -- Identical to Set_Image_Enumeration_8 except that it handles types using - -- array (0 .. Num) of Natural_32 for the Indexes table. - -end System.Img_Enum_New; diff --git a/src/lib/gnat/s-imenu8.ads b/src/lib/gnat/s-imenu8.ads new file mode 100644 index 0000000..cdd5a5f --- /dev/null +++ b/src/lib/gnat/s-imenu8.ads @@ -0,0 +1,51 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . I M G _ E N U M _ 8 -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2021-2022, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- Instantiation of System.Image_N for enumeration types whose names table +-- has a length that fits in a 8-bit integer. + +with Interfaces; +with System.Image_N; + +package System.Img_Enum_8 is + pragma Pure; + + package Impl is new Image_N (Interfaces.Integer_8); + + procedure Image_Enumeration_8 + (Pos : Natural; + S : in out String; + P : out Natural; + Names : String; + Indexes : System.Address) + renames Impl.Image_Enumeration; + +end System.Img_Enum_8; diff --git a/src/lib/gnat/s-maccod.ads b/src/lib/gnat/s-maccod.ads index a95e319..df7c7df 100644 --- a/src/lib/gnat/s-maccod.ads +++ b/src/lib/gnat/s-maccod.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2011, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -33,7 +33,10 @@ -- operations, and also for machine code statements. See GNAT documentation -- for full details. -package System.Machine_Code is +package System.Machine_Code + with SPARK_Mode => Off +is + pragma No_Elaboration_Code_All; pragma Pure; -- All identifiers in this unit are implementation defined diff --git a/src/lib/gnat/s-parame.ads b/src/lib/gnat/s-parame.ads index b3682ba..4b81114 100644 --- a/src/lib/gnat/s-parame.ads +++ b/src/lib/gnat/s-parame.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -49,6 +49,62 @@ package System.Parameters is pragma Pure; + --------------------------------------- + -- Task And Stack Allocation Control -- + --------------------------------------- + + type Size_Type is range + -(2 ** (Integer'(Standard'Address_Size) - 1)) .. + +(2 ** (Integer'(Standard'Address_Size) - 1)) - 1; + -- Type used to provide task stack sizes to the runtime. Sized to permit + -- stack sizes of up to half the total addressable memory space. This may + -- seem excessively large (even for 32-bit systems), however there are many + -- instances of users requiring large stack sizes (for example string + -- processing). + + Unspecified_Size : constant Size_Type := Size_Type'First; + -- Value used to indicate that no size type is set + + function Default_Stack_Size return Size_Type; + -- Default task stack size used if none is specified + + function Minimum_Stack_Size return Size_Type; + -- Minimum task stack size permitted + + function Adjust_Storage_Size (Size : Size_Type) return Size_Type; + -- Given the storage size stored in the TCB, return the Storage_Size + -- value required by the RM for the Storage_Size attribute. The + -- required adjustment is as follows: + -- + -- when Size = Unspecified_Size, return Default_Stack_Size + -- when Size < Minimum_Stack_Size, return Minimum_Stack_Size + -- otherwise return given Size + + Default_Env_Stack_Size : constant Size_Type := 8_192_000; + -- Assumed size of the environment task, if no other information is + -- available. This value is used when stack checking is enabled and + -- no GNAT_STACK_LIMIT environment variable is set. + + Stack_Grows_Down : constant Boolean := True; + -- This constant indicates whether the stack grows up (False) or + -- down (True) in memory as functions are called. It is used for + -- proper implementation of the stack overflow check. + + Runtime_Default_Sec_Stack_Size : constant Size_Type := 10 * 1024; + -- The run-time chosen default size for secondary stacks that may be + -- overridden by the user with the use of binder -D switch. + + Sec_Stack_Dynamic : constant Boolean := True; + -- Indicates if secondary stacks can grow and shrink at run-time. If False, + -- the size of a secondary stack is fixed at the point of its creation. + + ------------------------------------ + -- Characteristics of time_t type -- + ------------------------------------ + + time_t_bits : constant := Long_Integer'Size; + -- Number of bits in type time_t + ---------------------------------------------- -- Characteristics of types in Interfaces.C -- ---------------------------------------------- @@ -59,6 +115,76 @@ -- of all targets. ptr_bits : constant := Standard'Address_Size; + subtype C_Address is System.Address; -- Number of bits in Interfaces.C pointers, normally a standard address + C_Malloc_Linkname : constant String := "__gnat_malloc"; + -- Name of runtime function used to allocate such a pointer + + ---------------------------------------------- + -- Behavior of Pragma Finalize_Storage_Only -- + ---------------------------------------------- + + -- Garbage_Collected is a Boolean constant whose value indicates the + -- effect of the pragma Finalize_Storage_Entry on a controlled type. + + -- Garbage_Collected = False + + -- The system releases all storage on program termination only, + -- but not other garbage collection occurs, so finalization calls + -- are omitted only for outer level objects can be omitted if + -- pragma Finalize_Storage_Only is used. + + -- Garbage_Collected = True + + -- The system provides full garbage collection, so it is never + -- necessary to release storage for controlled objects for which + -- a pragma Finalize_Storage_Only is used. + + Garbage_Collected : constant Boolean := False; + -- The storage mode for this system (release on program exit) + + --------------------- + -- Tasking Profile -- + --------------------- + + -- In the following sections, constant parameters are defined to + -- allow some optimizations and fine tuning within the tasking run time + -- based on restrictions on the tasking features. + + ------------------- + -- Task Abortion -- + ------------------- + + No_Abort : constant Boolean := False; + -- This constant indicates whether abort statements and asynchronous + -- transfer of control (ATC) are disallowed. If set to True, it is + -- assumed that neither construct is used, and the run time does not + -- need to defer/undefer abort and check for pending actions at + -- completion points. A value of True for No_Abort corresponds to: + -- pragma Restrictions (No_Abort_Statements); + -- pragma Restrictions (Max_Asynchronous_Select_Nesting => 0); + + --------------------- + -- Task Attributes -- + --------------------- + + Max_Attribute_Count : constant := 32; + -- Number of task attributes stored in the task control block + + ----------------------- + -- Task Image Length -- + ----------------------- + + Max_Task_Image_Length : constant := 256; + -- This constant specifies the maximum length of a task's image + + ------------------------------ + -- Exception Message Length -- + ------------------------------ + + Default_Exception_Msg_Max_Length : constant := 200; + -- This constant specifies the default number of characters to allow + -- in an exception message (200 is minimum required by RM 11.4.1(18)). + end System.Parameters; diff --git a/src/lib/gnat/s-stalib.ads b/src/lib/gnat/s-stalib.ads new file mode 100644 index 0000000..9182c67 --- /dev/null +++ b/src/lib/gnat/s-stalib.ads @@ -0,0 +1,260 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT COMPILER COMPONENTS -- +-- -- +-- S Y S T E M . S T A N D A R D _ L I B R A R Y -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package is included in all programs. It contains declarations that +-- are required to be part of every Ada program. A special mechanism is +-- required to ensure that these are loaded, since it may be the case in +-- some programs that the only references to these required packages are +-- from C code or from code generated directly by Gigi, and in both cases +-- the binder is not aware of such references. + +-- System.Standard_Library also includes data that must be present in every +-- program, in particular data for all the standard exceptions, and also some +-- subprograms that must be present in every program. + +-- The binder unconditionally includes s-stalib.ali, which ensures that this +-- package and the packages it references are included in all Ada programs, +-- together with the included data. + +with Ada.Unchecked_Conversion; + +package System.Standard_Library is + + -- Historical note: pragma Preelaborate was surrounded by a pair of pragma + -- Warnings (Off/On) to circumvent a bootstrap issue. + + pragma Preelaborate; + + subtype Big_String is String (1 .. Positive'Last); + pragma Suppress_Initialization (Big_String); + -- Type used to obtain string access to given address. Initialization is + -- suppressed, since we never want to have variables of this type, and + -- we never want to attempt initialiazation of virtual variables of this + -- type (e.g. when pragma Normalize_Scalars is used). + + type Big_String_Ptr is access all Big_String; + for Big_String_Ptr'Storage_Size use 0; + -- We use this access type to pass a pointer to an area of storage to be + -- accessed as a string. Of course when this pointer is used, it is the + -- responsibility of the accessor to ensure proper bounds. The storage + -- size clause ensures we do not allocate variables of this type. + + function To_Ptr is + new Ada.Unchecked_Conversion (System.Address, Big_String_Ptr); + + ------------------------------------- + -- Exception Declarations and Data -- + ------------------------------------- + + type Raise_Action is access procedure; + pragma Favor_Top_Level (Raise_Action); + -- A pointer to a procedure used in the Raise_Hook field + + type Exception_Data; + type Exception_Data_Ptr is access all Exception_Data; + -- An equivalent of Exception_Id that is public + + -- The following record defines the underlying representation of exceptions + + -- WARNING: Any change to the record needs to be reflected in the following + -- locations in the compiler and runtime code: + + -- 1. The construction of the exception type in Cstand + -- 2. Expand_N_Exception_Declaration in Exp_Ch11 + -- 3. Expand_Pragma_Import_Or_Interface in Exp_Prag + -- 4. The processing in gigi that tests Not_Handled_By_Others + -- 5. The Internal_Exception routine in s-exctab.adb + -- 6. The declaration of the corresponding C type in raise.h + + type Exception_Data is record + Not_Handled_By_Others : aliased Boolean; + -- Normally set False, indicating that the exception is handled in the + -- usual way by others (i.e. an others handler handles the exception). + -- Set True to indicate that this exception is not caught by others + -- handlers, but must be explicitly named in a handler. This latter + -- setting is currently used by the Abort_Signal. + + Lang : aliased Character; + -- A character indicating the language raising the exception. + -- Set to "A" for exceptions defined by an Ada program. + -- Set to "C" for imported C++ exceptions. + + Name_Length : aliased Natural; + -- Length of fully expanded name of exception + + Full_Name : aliased System.Address; + -- Fully expanded name of exception, null terminated + -- You can use To_Ptr to convert this to a string. + + HTable_Ptr : aliased Exception_Data_Ptr; + -- Hash table pointer used to link entries together in the hash table + -- built (by Register_Exception in s-exctab.adb) for converting between + -- identities and names. + + Foreign_Data : aliased System.Address; + -- Data for imported exceptions. Not used in the Ada case. This + -- represents the address of the RTTI for the C++ case. + + Raise_Hook : aliased Raise_Action; + -- This field can be used to place a "hook" on an exception. If the + -- value is non-null, then it points to a procedure which is called + -- whenever the exception is raised. This call occurs immediately, + -- before any other actions taken by the raise (and in particular + -- before any unwinding of the stack occurs). + end record; + + -- Definitions for standard predefined exceptions defined in Standard, + + -- Why are the NULs necessary here, seems like they should not be + -- required, since Gigi is supposed to add a Nul to each name ??? + + Constraint_Error_Name : constant String := "CONSTRAINT_ERROR" & ASCII.NUL; + Program_Error_Name : constant String := "PROGRAM_ERROR" & ASCII.NUL; + Storage_Error_Name : constant String := "STORAGE_ERROR" & ASCII.NUL; + Tasking_Error_Name : constant String := "TASKING_ERROR" & ASCII.NUL; + Abort_Signal_Name : constant String := "_ABORT_SIGNAL" & ASCII.NUL; + + Numeric_Error_Name : constant String := "NUMERIC_ERROR" & ASCII.NUL; + -- This is used only in the Ada 83 case, but it is not worth having a + -- separate version of s-stalib.ads for use in Ada 83 mode. + + Constraint_Error_Def : aliased Exception_Data := + (Not_Handled_By_Others => False, + Lang => 'A', + Name_Length => Constraint_Error_Name'Length, + Full_Name => Constraint_Error_Name'Address, + HTable_Ptr => null, + Foreign_Data => Null_Address, + Raise_Hook => null); + + Numeric_Error_Def : aliased Exception_Data := + (Not_Handled_By_Others => False, + Lang => 'A', + Name_Length => Numeric_Error_Name'Length, + Full_Name => Numeric_Error_Name'Address, + HTable_Ptr => null, + Foreign_Data => Null_Address, + Raise_Hook => null); + + Program_Error_Def : aliased Exception_Data := + (Not_Handled_By_Others => False, + Lang => 'A', + Name_Length => Program_Error_Name'Length, + Full_Name => Program_Error_Name'Address, + HTable_Ptr => null, + Foreign_Data => Null_Address, + Raise_Hook => null); + + Storage_Error_Def : aliased Exception_Data := + (Not_Handled_By_Others => False, + Lang => 'A', + Name_Length => Storage_Error_Name'Length, + Full_Name => Storage_Error_Name'Address, + HTable_Ptr => null, + Foreign_Data => Null_Address, + Raise_Hook => null); + + Tasking_Error_Def : aliased Exception_Data := + (Not_Handled_By_Others => False, + Lang => 'A', + Name_Length => Tasking_Error_Name'Length, + Full_Name => Tasking_Error_Name'Address, + HTable_Ptr => null, + Foreign_Data => Null_Address, + Raise_Hook => null); + + Abort_Signal_Def : aliased Exception_Data := + (Not_Handled_By_Others => True, + Lang => 'A', + Name_Length => Abort_Signal_Name'Length, + Full_Name => Abort_Signal_Name'Address, + HTable_Ptr => null, + Foreign_Data => Null_Address, + Raise_Hook => null); + + pragma Export (C, Constraint_Error_Def, "constraint_error"); + pragma Export (C, Numeric_Error_Def, "numeric_error"); + pragma Export (C, Program_Error_Def, "program_error"); + pragma Export (C, Storage_Error_Def, "storage_error"); + pragma Export (C, Tasking_Error_Def, "tasking_error"); + pragma Export (C, Abort_Signal_Def, "_abort_signal"); + + Local_Partition_ID : Natural := 0; + -- This variable contains the local Partition_ID that will be used when + -- building exception occurrences. In distributed mode, it will be + -- set by each partition to the correct value during the elaboration. + + type Exception_Trace_Kind is + (RM_Convention, + -- No particular trace is requested, only unhandled exceptions + -- in the environment task (following the RM) will be printed. + -- This is the default behavior. + + Every_Raise, + -- Denotes the initial raise event for any exception occurrence, either + -- explicit or due to a specific language rule, within the context of a + -- task or not. + + Unhandled_Raise, + -- Denotes the raise events corresponding to exceptions for which there + -- is no user defined handler. This includes unhandled exceptions in + -- task bodies. + + Unhandled_Raise_In_Main + -- Same as Unhandled_Raise, except exceptions in task bodies are not + -- included. Same as RM_Convention, except (1) the message is printed as + -- soon as the environment task completes due to an unhandled exception + -- (before awaiting the termination of dependent tasks, and before + -- library-level finalization), and (2) a symbolic traceback is given + -- if possible. This is the default behavior if the binder switch -E is + -- used. + ); + -- Provide a way to denote different kinds of automatic traces related + -- to exceptions that can be requested. + + Exception_Trace : Exception_Trace_Kind := RM_Convention; + pragma Atomic (Exception_Trace); + -- By default, follow the RM convention + + ----------------- + -- Subprograms -- + ----------------- + + procedure Abort_Undefer_Direct; + pragma Inline (Abort_Undefer_Direct); + -- A little procedure that just calls Abort_Undefer.all, for use in + -- clean up procedures, which only permit a simple subprogram name. + + procedure Adafinal; + -- Performs the Ada Runtime finalization the first time it is invoked. + -- All subsequent calls are ignored. + +end System.Standard_Library; diff --git a/src/lib/gnat/s-stoele.adb b/src/lib/gnat/s-stoele.adb index 77faa53..f804e6d 100644 --- a/src/lib/gnat/s-stoele.adb +++ b/src/lib/gnat/s-stoele.adb @@ -6,7 +6,7 @@ -- -- -- B o d y -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- diff --git a/src/lib/gnat/s-stoele.ads b/src/lib/gnat/s-stoele.ads index 78faa1d..d047368 100644 --- a/src/lib/gnat/s-stoele.ads +++ b/src/lib/gnat/s-stoele.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 2002-2013, Free Software Foundation, Inc. -- +-- Copyright (C) 2002-2022, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -43,6 +43,8 @@ -- this unit Pure instead of Preelaborable; see RM 13.7.1(15). In Ada 2005, -- this is Pure in any case (AI-362). + pragma Annotate (GNATprove, Always_Return, Storage_Elements); + -- We also add the pragma Pure_Function to the operations in this package, -- because otherwise functions with parameters derived from Address are -- treated as non-pure by the back-end (see exp_ch6.adb). This is because @@ -54,8 +56,7 @@ +(2 ** (Integer'(Standard'Address_Size) - 1)) - Long_Long_Integer'(1); -- Note: the reason for the Long_Long_Integer qualification here is to -- avoid a bogus ambiguity when this unit is analyzed in an rtsfind - -- context. It may be possible to remove this in the future, but it is - -- certainly harmless in any case ??? + -- context. subtype Storage_Count is Storage_Offset range 0 .. Storage_Offset'Last; diff --git a/src/lib/gnat/s-traent.adb b/src/lib/gnat/s-traent.adb new file mode 100644 index 0000000..6f615b0 --- /dev/null +++ b/src/lib/gnat/s-traent.adb @@ -0,0 +1,52 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . T R A C E B A C K _ E N T R I E S -- +-- -- +-- B o d y -- +-- -- +-- Copyright (C) 2003-2022, Free Software Foundation, Inc. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +package body System.Traceback_Entries is + + ------------ + -- PC_For -- + ------------ + + function PC_For (TB_Entry : Traceback_Entry) return System.Address is + begin + return TB_Entry; + end PC_For; + + ------------------ + -- TB_Entry_For -- + ------------------ + + function TB_Entry_For (PC : System.Address) return Traceback_Entry is + begin + return PC; + end TB_Entry_For; + +end System.Traceback_Entries; diff --git a/src/lib/gnat/s-traent.ads b/src/lib/gnat/s-traent.ads new file mode 100644 index 0000000..23e327c --- /dev/null +++ b/src/lib/gnat/s-traent.ads @@ -0,0 +1,61 @@ +------------------------------------------------------------------------------ +-- -- +-- GNAT RUN-TIME COMPONENTS -- +-- -- +-- S Y S T E M . T R A C E B A C K _ E N T R I E S -- +-- -- +-- S p e c -- +-- -- +-- Copyright (C) 2003-2022, Free Software Foundation, Inc. -- +-- -- +-- This specification is derived from the Ada Reference Manual for use with -- +-- GNAT. The copyright notice above, and the license provisions that follow -- +-- apply solely to the contents of the part following the private keyword. -- +-- -- +-- GNAT is free software; you can redistribute it and/or modify it under -- +-- terms of the GNU General Public License as published by the Free Soft- -- +-- ware Foundation; either version 3, or (at your option) any later ver- -- +-- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- +-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY -- +-- or FITNESS FOR A PARTICULAR PURPOSE. -- +-- -- +-- As a special exception under Section 7 of GPL version 3, you are granted -- +-- additional permissions described in the GCC Runtime Library Exception, -- +-- version 3.1, as published by the Free Software Foundation. -- +-- -- +-- You should have received a copy of the GNU General Public License and -- +-- a copy of the GCC Runtime Library Exception along with this program; -- +-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- +-- <http://www.gnu.org/licenses/>. -- +-- -- +-- GNAT was originally developed by the GNAT team at New York University. -- +-- Extensive contributions were provided by Ada Core Technologies Inc. -- +-- -- +------------------------------------------------------------------------------ + +-- This package offers an abstraction of what is stored in traceback arrays +-- for call-chain computation purposes. By default, as defined in this +-- version of the package, an entry is a mere code location representing the +-- address of a call instruction part of the call-chain. + +package System.Traceback_Entries is + pragma Preelaborate; + + subtype Traceback_Entry is System.Address; + -- This subtype defines what each traceback array entry contains + + Null_TB_Entry : constant Traceback_Entry := System.Null_Address; + -- This is the value to be used when initializing an entry + + type Tracebacks_Array is array (Positive range <>) of Traceback_Entry; + + function PC_For (TB_Entry : Traceback_Entry) return System.Address; + pragma Inline (PC_For); + -- Returns the address of the call instruction associated with the + -- provided entry. + + function TB_Entry_For (PC : System.Address) return Traceback_Entry; + pragma Inline (TB_Entry_For); + -- Returns an entry representing a frame for a call instruction at PC + +end System.Traceback_Entries; diff --git a/src/lib/gnat/s-unstyp.ads b/src/lib/gnat/s-unstyp.ads index de4affc..2a700a0 100644 --- a/src/lib/gnat/s-unstyp.ads +++ b/src/lib/gnat/s-unstyp.ads @@ -6,7 +6,7 @@ -- -- -- S p e c -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2022, Free Software Foundation, Inc. -- -- -- -- GNAT is free software; you can redistribute it and/or modify it under -- -- terms of the GNU General Public License as published by the Free Soft- -- @@ -37,19 +37,18 @@ package System.Unsigned_Types is pragma Pure; + pragma No_Elaboration_Code_All; - type Short_Short_Unsigned is mod 2 ** Short_Short_Integer'Size; - type Short_Unsigned is mod 2 ** Short_Integer'Size; - type Unsigned is mod 2 ** Integer'Size; - type Long_Unsigned is mod 2 ** Long_Integer'Size; - type Long_Long_Unsigned is mod 2 ** Long_Long_Integer'Size; - - type Float_Unsigned is mod 2 ** Float'Size; - -- Used in the implementation of Is_Negative intrinsic (see Exp_Intr) + type Short_Short_Unsigned is mod 2 ** Short_Short_Integer'Size; + type Short_Unsigned is mod 2 ** Short_Integer'Size; + type Unsigned is mod 2 ** Integer'Size; + type Long_Unsigned is mod 2 ** Long_Integer'Size; + type Long_Long_Unsigned is mod 2 ** Long_Long_Integer'Size; + type Long_Long_Long_Unsigned is mod Max_Binary_Modulus; type Packed_Byte is mod 2 ** 8; - pragma Universal_Aliasing (Packed_Byte); for Packed_Byte'Size use 8; + pragma Universal_Aliasing (Packed_Byte); -- Component type for Packed_Bytes1, Packed_Bytes2 and Packed_Byte4 arrays. -- As this type is used by the compiler to implement operations on user -- packed array, it needs to be able to alias any type. @@ -57,6 +56,7 @@ type Packed_Bytes1 is array (Natural range <>) of aliased Packed_Byte; for Packed_Bytes1'Alignment use 1; for Packed_Bytes1'Component_Size use Packed_Byte'Size; + pragma Suppress_Initialization (Packed_Bytes1); -- This is the type used to implement packed arrays where no alignment -- is required. This includes the cases of 1,2,4 (where we use direct -- masking operations), and all odd component sizes (where the clusters @@ -65,6 +65,7 @@ type Packed_Bytes2 is new Packed_Bytes1; for Packed_Bytes2'Alignment use Integer'Min (2, Standard'Maximum_Alignment); + pragma Suppress_Initialization (Packed_Bytes2); -- This is the type used to implement packed arrays where an alignment -- of 2 (is possible) is helpful for maximum efficiency of the get and -- set routines in the corresponding library unit. This is true of all @@ -75,6 +76,7 @@ type Packed_Bytes4 is new Packed_Bytes1; for Packed_Bytes4'Alignment use Integer'Min (4, Standard'Maximum_Alignment); + pragma Suppress_Initialization (Packed_Bytes4); -- This is the type used to implement packed arrays where an alignment -- of 4 (if possible) is helpful for maximum efficiency of the get and -- set routines in the corresponding library unit. This is true of all @@ -83,6 +85,24 @@ -- cases the clusters can be assumed to be 4-byte aligned if the array -- is aligned (see System.Pack_12 in file s-pack12 as an example). + type Rev_Packed_Bytes1 is new Packed_Bytes1; + pragma Suppress_Initialization (Rev_Packed_Bytes1); + -- This is equivalent to Packed_Bytes1, but for packed arrays with reverse + -- scalar storage order. But the Scalar_Storage_Order attribute cannot be + -- set directly here, see Exp_Pakd for more details. + + type Rev_Packed_Bytes2 is new Packed_Bytes2; + pragma Suppress_Initialization (Rev_Packed_Bytes2); + -- This is equivalent to Packed_Bytes2, but for packed arrays with reverse + -- scalar storage order. But the Scalar_Storage_Order attribute cannot be + -- set directly here, see Exp_Pakd for more details. + + type Rev_Packed_Bytes4 is new Packed_Bytes4; + pragma Suppress_Initialization (Rev_Packed_Bytes4); + -- This is equivalent to Packed_Bytes4, but for packed arrays with reverse + -- scalar storage order. But the Scalar_Storage_Order attribute cannot be + -- set directly here, see Exp_Pakd for more details. + type Bits_1 is mod 2**1; type Bits_2 is mod 2**2; type Bits_4 is mod 2**4; @@ -191,6 +211,26 @@ (Value : Long_Long_Unsigned; Amount : Natural) return Long_Long_Unsigned; + function Shift_Left + (Value : Long_Long_Long_Unsigned; + Amount : Natural) return Long_Long_Long_Unsigned; + + function Shift_Right + (Value : Long_Long_Long_Unsigned; + Amount : Natural) return Long_Long_Long_Unsigned; + + function Shift_Right_Arithmetic + (Value : Long_Long_Long_Unsigned; + Amount : Natural) return Long_Long_Long_Unsigned; + + function Rotate_Left + (Value : Long_Long_Long_Unsigned; + Amount : Natural) return Long_Long_Long_Unsigned; + + function Rotate_Right + (Value : Long_Long_Long_Unsigned; + Amount : Natural) return Long_Long_Long_Unsigned; + pragma Import (Intrinsic, Shift_Left); pragma Import (Intrinsic, Shift_Right); pragma Import (Intrinsic, Shift_Right_Arithmetic); diff --git a/src/lib/gnat/system.ads b/src/lib/gnat/system.ads index 74ced54..879c89f 100644 --- a/src/lib/gnat/system.ads +++ b/src/lib/gnat/system.ads @@ -5,9 +5,9 @@ -- S Y S T E M -- -- -- -- S p e c -- --- (LSH Version) -- +-- (Compiler Version) -- -- -- --- Copyright (C) 1992-2014, Free Software Foundation, Inc. -- +-- Copyright (C) 1992-2021, Free Software Foundation, Inc. -- -- -- -- This specification is derived from the Ada Reference Manual for use with -- -- GNAT. The copyright notice above, and the license provisions that follow -- @@ -34,11 +34,25 @@ -- -- ------------------------------------------------------------------------------ -pragma Restrictions (No_Exception_Registration); +-- This version of System is a generic version that is used in building the +-- compiler. Right now, we have a host/target problem if we try to use the +-- "proper" System, and since the compiler itself does not care about most +-- System parameters, this generic version works fine. pragma Restrictions (No_Implicit_Dynamic_Code); +-- We want to avoid trampolines in the compiler, so it can be used in systems +-- which prevent execution of code on the stack, e.g. in windows environments +-- with DEP (Data Execution Protection) enabled. + pragma Restrictions (No_Finalization); +-- Use restriction No_Finalization to avoid pulling finalization (not allowed +-- in GNAT) inside sem_spark.adb, when defining type Perm_Tree_Access as an +-- access type on incomplete type Perm_Tree_Wrapper (which is required for +-- defining a recursive type). + pragma Restrictions (No_Tasking); +-- Make it explicit that tasking is not used in the compiler, which also +-- allows generating simpler and more efficient code. package System is pragma Pure; @@ -137,16 +151,13 @@ -- parameters is not too critical for the compiler version (e.g. we -- do not use floating-point anyway in the compiler). - AAMP : constant Boolean := False; Backend_Divide_Checks : constant Boolean := False; - Backend_Overflow_Checks : constant Boolean := True; - Command_Line_Args : constant Boolean := False; - Configurable_Run_Time : constant Boolean := True; + Backend_Overflow_Checks : constant Boolean := False; + Command_Line_Args : constant Boolean := True; + Configurable_Run_Time : constant Boolean := False; Denorm : constant Boolean := True; Duration_32_Bits : constant Boolean := False; - Exit_Status_Supported : constant Boolean := False; - Fractional_Fixed_Ops : constant Boolean := False; - Frontend_Layout : constant Boolean := False; + Exit_Status_Supported : constant Boolean := True; Machine_Overflows : constant Boolean := False; Machine_Rounds : constant Boolean := True; Preallocated_Stacks : constant Boolean := False; @@ -159,17 +170,9 @@ Support_Composite_Compare : constant Boolean := True; Support_Long_Shifts : constant Boolean := True; Always_Compatible_Rep : constant Boolean := True; - Suppress_Standard_Library : constant Boolean := True; + Suppress_Standard_Library : constant Boolean := False; Use_Ada_Main_Program_Name : constant Boolean := False; - ZCX_By_Default : constant Boolean := False; - - -- Obsolete entries, to be removed eventually (bootstrap issues) - - Front_End_ZCX_Support : constant Boolean := False; - High_Integrity_Mode : constant Boolean := False; - Long_Shifts_Inlined : constant Boolean := True; - Functions_Return_By_DSP : constant Boolean := False; - Support_64_Bit_Divides : constant Boolean := True; - GCC_ZCX_Support : constant Boolean := False; + Frontend_Exceptions : constant Boolean := False; + ZCX_By_Default : constant Boolean := True; end System; -- To view, visit https://review.coreboot.org/c/coreboot/+/70283 To unsubscribe, or for help writing mail filters, visit https://review.coreboot.org/settings Gerrit-Project: coreboot Gerrit-Branch: master Gerrit-Change-Id: I7545be873ecd28dfb78c03ab39ba699f4af21979 Gerrit-Change-Number: 70283 Gerrit-PatchSet: 1 Gerrit-Owner: Elyes Haouas <ehaouas(a)noos.fr> Gerrit-MessageType: newchange

1 0

[M] Change in coreboot[master]: mb/google/rex: Add PCIe based SD controller
by Subrata Banik (Code Review) 03 Dec '22

03 Dec '22

Subrata Banik has submitted this change. ( https://review.coreboot.org/c/coreboot/+/70064 ) Change subject: mb/google/rex: Add PCIe based SD controller ...................................................................... mb/google/rex: Add PCIe based SD controller This patch adds PCIe based SD controller at RP 7 (from RP 11) with Proto 1 schematics dated 11/30. Additionally, added the RTD3 entries for the SD controller. Finally, ensured that EN_PP3300_SD (GPP_D03) is configured in bootblock and SD_PERST_L (GPP_D02) is configured in romstage to meet the power cycle requirement. BUG=b:242917011 TEST=Able to build and boot Google/Rex. SD card detection is due for the Proto 1 hardware. Signed-off-by: Subrata Banik <subratabanik(a)google.com> Change-Id: I23d53e4d61ec36d2145f9e5816d97d13eb5b219e Reviewed-on: https://review.coreboot.org/c/coreboot/+/70064 Reviewed-by: Eric Lai <eric_lai(a)quanta.corp-partner.google.com> Reviewed-by: Kapil Porwal <kapilporwal(a)google.com> Tested-by: build bot (Jenkins) <no-reply(a)coreboot.org> Reviewed-by: Ivy Jian <ivy.jian(a)quanta.corp-partner.google.com> --- M src/mainboard/google/rex/variants/rex0/gpio.c M src/mainboard/google/rex/variants/rex0/overridetree.cb 2 files changed, 45 insertions(+), 9 deletions(-) Approvals: build bot (Jenkins): Verified Eric Lai: Looks good to me, approved Ivy Jian: Looks good to me, approved Kapil Porwal: Looks good to me, approved diff --git a/src/mainboard/google/rex/variants/rex0/gpio.c b/src/mainboard/google/rex/variants/rex0/gpio.c index 1a5e3f6..53cd05d 100644 --- a/src/mainboard/google/rex/variants/rex0/gpio.c +++ b/src/mainboard/google/rex/variants/rex0/gpio.c @@ -425,6 +425,8 @@ PAD_CFG_GPO(GPP_C23, 0, DEEP), /* GPP_E07 : [] ==> WWAN_FCPO_L */ PAD_CFG_GPO(GPP_E07, 1, DEEP), + /* GPP_D02 : [] ==> SD_PERST_L */ + PAD_CFG_GPO(GPP_D02, 1, DEEP), }; const struct pad_config *variant_gpio_table(size_t *num) diff --git a/src/mainboard/google/rex/variants/rex0/overridetree.cb b/src/mainboard/google/rex/variants/rex0/overridetree.cb index 8d1d528..6ec0bf2 100644 --- a/src/mainboard/google/rex/variants/rex0/overridetree.cb +++ b/src/mainboard/google/rex/variants/rex0/overridetree.cb @@ -126,15 +126,6 @@ .flags = PCIE_RP_LTR | PCIE_RP_AER, }" end #PCIE9 SSD card - device ref pcie_rp11 on - probe DB_SD SD_GL9755S - # Enable SD Card PCIE 11 using clk 2 - register "pcie_rp[PCH_RP(11)]" = "{ - .clk_src = 2, - .clk_req = 2, - .flags = PCIE_RP_HOTPLUG | PCIE_RP_LTR | PCIE_RP_AER, - }" - end #PCIE11 SD card device ref tbt_pcie_rp0 on end device ref tbt_pcie_rp2 on end device ref tcss_xhci on @@ -471,6 +462,21 @@ device generic 0 on end end end #PCIE6 WWAN card + device ref pcie_rp7 on + # Enable SD Card PCIE 7 using clk 2 + register "pcie_rp[PCH_RP(7)]" = "{ + .clk_src = 2, + .clk_req = 2, + .flags = PCIE_RP_HOTPLUG | PCIE_RP_LTR | PCIE_RP_AER, + }" + chip soc/intel/common/block/pcie/rtd3 + register "enable_gpio" = "ACPI_GPIO_OUTPUT_ACTIVE_HIGH(GPP_D03)" + register "reset_gpio" = "ACPI_GPIO_OUTPUT_ACTIVE_LOW(GPP_D02)" + register "srcclk_pin" = "2" + device generic 0 on end + end + probe DB_SD SD_GL9755S + end device ref gspi1 on chip drivers/spi/acpi register "name" = ""CRFP"" -- To view, visit https://review.coreboot.org/c/coreboot/+/70064 To unsubscribe, or for help writing mail filters, visit https://review.coreboot.org/settings Gerrit-Project: coreboot Gerrit-Branch: master Gerrit-Change-Id: I23d53e4d61ec36d2145f9e5816d97d13eb5b219e Gerrit-Change-Number: 70064 Gerrit-PatchSet: 4 Gerrit-Owner: Subrata Banik <subratabanik(a)google.com> Gerrit-Reviewer: Eric Lai <eric_lai(a)quanta.corp-partner.google.com> Gerrit-Reviewer: Ivy Jian <ivy.jian(a)quanta.corp-partner.google.com> Gerrit-Reviewer: Kapil Porwal <kapilporwal(a)google.com> Gerrit-Reviewer: Subrata Banik <subratabanik(a)google.com> Gerrit-Reviewer: Tarun Tuli <taruntuli(a)google.com> Gerrit-Reviewer: build bot (Jenkins) <no-reply(a)coreboot.org> Gerrit-MessageType: merged

1 0

[M] Change in coreboot[master]: mb/google/rex: Drop `board_id` check while configuring GPIO
by Subrata Banik (Code Review) 03 Dec '22

03 Dec '22

Subrata Banik has submitted this change. ( https://review.coreboot.org/c/coreboot/+/70224 ) Change subject: mb/google/rex: Drop `board_id` check while configuring GPIO ...................................................................... mb/google/rex: Drop `board_id` check while configuring GPIO This patch drops the usage of reading `board_id()` while performing the GPIO configuration. The reason to drop the board_id check is to ensure that GPIO configuration for MLB (mainboard) would remain the same and the only GPIO PIN configuration that differs would be due to usage of having different DBs (daughter board) which will be taken care using CBI (and fw_config.c file) in coreboot. Additionally, drop unused early GPIO default configuration table. BUG=b:260804656 TEST=Able to perform the GPIO configuration and able to boot Google/Rex. Signed-off-by: Subrata Banik <subratabanik(a)google.com> Change-Id: I96cafd1c904001cbf4199977e9e721afe5eab470 Reviewed-on: https://review.coreboot.org/c/coreboot/+/70224 Tested-by: build bot (Jenkins) <no-reply(a)coreboot.org> Reviewed-by: Ivy Jian <ivy.jian(a)quanta.corp-partner.google.com> Reviewed-by: Kapil Porwal <kapilporwal(a)google.com> Reviewed-by: Tarun Tuli <taruntuli(a)google.com> --- M src/mainboard/google/rex/variants/rex0/gpio.c 1 file changed, 39 insertions(+), 55 deletions(-) Approvals: build bot (Jenkins): Verified Ivy Jian: Looks good to me, approved Tarun Tuli: Looks good to me, approved Kapil Porwal: Looks good to me, approved diff --git a/src/mainboard/google/rex/variants/rex0/gpio.c b/src/mainboard/google/rex/variants/rex0/gpio.c index ecda8bf..1a5e3f6 100644 --- a/src/mainboard/google/rex/variants/rex0/gpio.c +++ b/src/mainboard/google/rex/variants/rex0/gpio.c @@ -14,7 +14,7 @@ #include <boardid.h> /* Pad configuration in ramstage */ -static const struct pad_config gpio_table_id0[] = { +static const struct pad_config gpio_table[] = { /* GPP_A00 : GPP_A00 ==> ESPI_SOC_IO0_R configured on reset, do not touch */ /* GPP_A01 : GPP_A01 ==> ESPI_SOC_IO1_R configured on reset, do not touch */ /* GPP_A02 : GPP_A02 ==> ESPI_SOC_IO2_R configured on reset, do not touch */ @@ -382,7 +382,7 @@ }; /* Early pad configuration in bootblock */ -static const struct pad_config early_gpio_table_id0[] = { +static const struct pad_config early_gpio_table[] = { /* GPP_B17 : [] ==> EN_WWAN_PWR */ PAD_CFG_GPO(GPP_B17, 1, DEEP), /* GPP_B18 : [] ==> SOC_I2C_TPM_SDA */ @@ -416,22 +416,7 @@ PAD_CFG_GPI_GPIO_DRIVER_LOCK(GPP_H10, NONE, LOCK_CONFIG), }; -/* Default/Minimal early pad configuration if we can't find board_id */ -static const struct pad_config default_early_gpio_table[] = { - /* GPP_B18 : [] ==> SOC_I2C_TPM_SDA */ - PAD_CFG_NF(GPP_B18, NONE, DEEP, NF2), - /* GPP_B19 : [] ==> SOC_I2C_TPM_SCL */ - PAD_CFG_NF(GPP_B19, NONE, DEEP, NF2), - /* GPP_E03 : [] ==> GSC_SOC_INT_ODL */ - PAD_CFG_GPI_APIC(GPP_E03, NONE, PLTRST, LEVEL, INVERT), - - /* GPP_H08 : [] ==> UART_DBG_TX_SOC_RX_R */ - PAD_CFG_NF(GPP_H08, NONE, DEEP, NF1), - /* GPP_H09 : [] ==> UART_SOC_TX_DBG_RX_R */ - PAD_CFG_NF(GPP_H09, NONE, DEEP, NF1), -}; - -static const struct pad_config romstage_gpio_table_id0[] = { +static const struct pad_config romstage_gpio_table[] = { /* GPP_B11 : [] ==> EN_FP_PWR */ PAD_CFG_GPO(GPP_B11, 0, DEEP), /* A20 : [] ==> SSD_PERST_L */ @@ -444,52 +429,21 @@ const struct pad_config *variant_gpio_table(size_t *num) { - const uint32_t id = board_id(); - switch (id) { - case 0: - *num = ARRAY_SIZE(gpio_table_id0); - return gpio_table_id0; - - case BOARD_ID_UNKNOWN: - default: - printk(BIOS_ERR, "board_id() not found. Unable to load gpio table.\n"); - *num = 0; - return NULL; - } + *num = ARRAY_SIZE(gpio_table); + return gpio_table; } const struct pad_config *variant_early_gpio_table(size_t *num) { - const uint32_t id = board_id(); - switch (id) { - case 0: - *num = ARRAY_SIZE(early_gpio_table_id0); - return early_gpio_table_id0; - - case BOARD_ID_UNKNOWN: - default: - printk(BIOS_ERR, "board_id() not found. Loading default early gpio table.\n"); - *num = ARRAY_SIZE(default_early_gpio_table); - return default_early_gpio_table; - } + *num = ARRAY_SIZE(early_gpio_table); + return early_gpio_table; } /* Create the stub for romstage gpio, typically use for power sequence */ const struct pad_config *variant_romstage_gpio_table(size_t *num) { - const uint32_t id = board_id(); - switch (id) { - case 0: - *num = ARRAY_SIZE(romstage_gpio_table_id0); - return romstage_gpio_table_id0; - - case BOARD_ID_UNKNOWN: - default: - printk(BIOS_ERR, - "board_id() not found. Unable to load romstage gpio table.\n"); - *num = 0; - return NULL; - } + *num = ARRAY_SIZE(romstage_gpio_table); + return romstage_gpio_table; } static const struct cros_gpio cros_gpios[] = { -- To view, visit https://review.coreboot.org/c/coreboot/+/70224 To unsubscribe, or for help writing mail filters, visit https://review.coreboot.org/settings Gerrit-Project: coreboot Gerrit-Branch: master Gerrit-Change-Id: I96cafd1c904001cbf4199977e9e721afe5eab470 Gerrit-Change-Number: 70224 Gerrit-PatchSet: 2 Gerrit-Owner: Subrata Banik <subratabanik(a)google.com> Gerrit-Reviewer: Eric Lai <eric_lai(a)quanta.corp-partner.google.com> Gerrit-Reviewer: Ivy Jian <ivy.jian(a)quanta.corp-partner.google.com> Gerrit-Reviewer: Kapil Porwal <kapilporwal(a)google.com> Gerrit-Reviewer: Subrata Banik <subratabanik(a)google.com> Gerrit-Reviewer: Tarun Tuli <taruntuli(a)google.com> Gerrit-Reviewer: build bot (Jenkins) <no-reply(a)coreboot.org> Gerrit-MessageType: merged

1 0

[S] Change in coreboot[master]: mb/google/rex: Add probed fw_configs to SMBIOS OEM strings
by Subrata Banik (Code Review) 03 Dec '22

03 Dec '22

Subrata Banik has submitted this change. ( https://review.coreboot.org/c/coreboot/+/70228 ) ( 2 is the latest approved patch-set. No files were changed between the latest approved patch-set and the submitted one. )Change subject: mb/google/rex: Add probed fw_configs to SMBIOS OEM strings ...................................................................... mb/google/rex: Add probed fw_configs to SMBIOS OEM strings Enable this feature, and it can use the probe statement in devicetree to cache of fw_config field as oem string. TEST=With CBI FW_CONFIG field set to 0x1561 localhost ~ # dmidecode -t 11 Getting SMBIOS data from sysfs. SMBIOS 3.0 present. Handle 0x0009, DMI type 11, 5 bytes OEM Strings String 1: AUDIO-MAX98357_ALC5682I_I2S String 2: CELLULAR-CELLULAR_PCIE String 3: UFC-UFC_MIPI String 4: WFC-WFC_MIPI String 5: DB_SD-SD_GL9755S Change-Id: I6cb35eb9c0fbe32764ca76bb7a929cc92fc38404 Signed-off-by: Subrata Banik <subratabanik(a)google.com> Reviewed-on: https://review.coreboot.org/c/coreboot/+/70228 Reviewed-by: Eric Lai <eric_lai(a)quanta.corp-partner.google.com> Tested-by: build bot (Jenkins) <no-reply(a)coreboot.org> --- M src/mainboard/google/rex/mainboard.c 1 file changed, 43 insertions(+), 1 deletion(-) Approvals: build bot (Jenkins): Verified Eric Lai: Looks good to me, approved diff --git a/src/mainboard/google/rex/mainboard.c b/src/mainboard/google/rex/mainboard.c index 552c0d3..2414edd 100644 --- a/src/mainboard/google/rex/mainboard.c +++ b/src/mainboard/google/rex/mainboard.c @@ -4,6 +4,7 @@ #include <baseboard/variants.h> #include <device/device.h> #include <ec/ec.h> +#include <fw_config.h> #include <vendorcode/google/chromeos/chromeos.h> static void mainboard_init(void *chip_info) @@ -19,9 +20,20 @@ /* TODO: Add mainboard-specific SSDT entries */ } +static void add_fw_config_oem_string(const struct fw_config *config, void *arg) +{ + struct smbios_type11 *t; + char buffer[64]; + + t = (struct smbios_type11 *)arg; + + snprintf(buffer, sizeof(buffer), "%s-%s", config->field_name, config->option_name); + t->count = smbios_add_string(t->eos, buffer); +} + static void mainboard_smbios_strings(struct device *dev, struct smbios_type11 *t) { - /* TODO: Add mainboard-smbios entries */ + fw_config_for_each_found(add_fw_config_oem_string, t); } static void mainboard_dev_init(struct device *dev) -- To view, visit https://review.coreboot.org/c/coreboot/+/70228 To unsubscribe, or for help writing mail filters, visit https://review.coreboot.org/settings Gerrit-Project: coreboot Gerrit-Branch: master Gerrit-Change-Id: I6cb35eb9c0fbe32764ca76bb7a929cc92fc38404 Gerrit-Change-Number: 70228 Gerrit-PatchSet: 4 Gerrit-Owner: Subrata Banik <subratabanik(a)google.com> Gerrit-Reviewer: Eric Lai <eric_lai(a)quanta.corp-partner.google.com> Gerrit-Reviewer: Kapil Porwal <kapilporwal(a)google.com> Gerrit-Reviewer: Subrata Banik <subratabanik(a)google.com> Gerrit-Reviewer: Tarun Tuli <taruntuli(a)google.com> Gerrit-Reviewer: build bot (Jenkins) <no-reply(a)coreboot.org> Gerrit-MessageType: merged

1 0

[M] Change in coreboot[master]: amdfwtool: Add the new entry type for new family morgana
by ritul guru (Code Review) 03 Dec '22

03 Dec '22

Attention is currently required from: Bao Zheng, Jason Glenesk, Marshall Dawson, Zheng Bao, Martin Roth. ritul guru has posted comments on this change. ( https://review.coreboot.org/c/coreboot/+/69045 ) Change subject: amdfwtool: Add the new entry type for new family morgana ...................................................................... Patch Set 9: (3 comments) File util/amdfwtool/amdfwtool.c: https://review.coreboot.org/c/coreboot/+/69045/comment/16c84b21_a1a2de2c PS9, Line 303: PSP_BOTH this is required for only PSP_LVL2, not needed for L1 dir https://review.coreboot.org/c/coreboot/+/69045/comment/94363d2d_31de7de7 PS9, Line 306: { .type = AMD_RIB, .level = PSP_LVL2 | PSP_BOTH_AB }, can add subprogram 0 and 1 for two different FWs https://review.coreboot.org/c/coreboot/+/69045/comment/2aae52b1_a8eaf068 PS9, Line 402: { .type = AMD_BIOS_PMUD, .inst = 7, .subpr = 1, .level = BDT_BOTH }, need to add 11,12,13 instance as well. -- To view, visit https://review.coreboot.org/c/coreboot/+/69045 To unsubscribe, or for help writing mail filters, visit https://review.coreboot.org/settings Gerrit-Project: coreboot Gerrit-Branch: master Gerrit-Change-Id: I7565c5eda75b332a48613440d7e4cfb388d5012f Gerrit-Change-Number: 69045 Gerrit-PatchSet: 9 Gerrit-Owner: Bao Zheng <fishbaozi(a)gmail.com> Gerrit-Reviewer: Felix Held <felix-coreboot(a)felixheld.de> Gerrit-Reviewer: Jason Glenesk <jason.glenesk(a)gmail.com> Gerrit-Reviewer: Marshall Dawson <marshalldawson3rd(a)gmail.com> Gerrit-Reviewer: Martin L Roth <gaumless(a)gmail.com> Gerrit-Reviewer: Martin Roth <martin.roth(a)amd.corp-partner.google.com> Gerrit-Reviewer: Matt DeVillier <matt.devillier(a)amd.corp-partner.google.com> Gerrit-Reviewer: Zheng Bao Gerrit-Reviewer: build bot (Jenkins) <no-reply(a)coreboot.org> Gerrit-CC: ritul guru <ritul.bits(a)gmail.com> Gerrit-Attention: Bao Zheng <fishbaozi(a)gmail.com> Gerrit-Attention: Jason Glenesk <jason.glenesk(a)gmail.com> Gerrit-Attention: Marshall Dawson <marshalldawson3rd(a)gmail.com> Gerrit-Attention: Zheng Bao Gerrit-Attention: Martin Roth <martin.roth(a)amd.corp-partner.google.com> Gerrit-Comment-Date: Sat, 03 Dec 2022 07:27:44 +0000 Gerrit-HasComments: Yes Gerrit-Has-Labels: No Gerrit-MessageType: comment

1 0

Jump to page:

2025

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

coreboot-gerrit December 2022