Mercurial > hg > CbC > CbC_gcc

comparison gcc/ada/sprint.adb @ 145:1830386684a0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc-9.2.0
author anatofuz
date Thu, 13 Feb 2020 11:34:05 +0900
parents 84e7813d76e9
children
comparison
equal deleted inserted replaced
131:84e7813d76e9 145:1830386684a0
4 -- -- 4 -- --
5 -- S P R I N T -- 5 -- S P R I N T --
6 -- -- 6 -- --
7 -- B o d y -- 7 -- B o d y --
8 -- -- 8 -- --
9 -- Copyright (C) 1992-2018, Free Software Foundation, Inc. -- 9 -- Copyright (C) 1992-2019, Free Software Foundation, Inc. --
10 -- -- 10 -- --
11 -- GNAT is free software; you can redistribute it and/or modify it under -- 11 -- GNAT is free software; you can redistribute it and/or modify it under --
12 -- terms of the GNU General Public License as published by the Free Soft- -- 12 -- terms of the GNU General Public License as published by the Free Soft- --
13 -- ware Foundation; either version 3, or (at your option) any later ver- -- 13 -- ware Foundation; either version 3, or (at your option) any later ver- --
14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- -- 14 -- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
658 658
659 Sprint_Node (Cunit (U)); 659 Sprint_Node (Cunit (U));
660 Write_Source_Lines (Last_Source_Line (Current_Source_File)); 660 Write_Source_Lines (Last_Source_Line (Current_Source_File));
661 Write_Eol; 661 Write_Eol;
662 Close_Debug_Source; 662 Close_Debug_Source;
663 Set_Special_Output (null); 663 Cancel_Special_Output;
664 664
665 -- Normal output to standard output file 665 -- Normal output to standard output file
666 666
667 else 667 else
668 Write_Str ("Source recreated from tree for "); 668 Write_Str ("Source recreated from tree for ");
1481 Indent_End; 1481 Indent_End;
1482 Indent_End; 1482 Indent_End;
1483 end; 1483 end;
1484 1484
1485 when N_Decimal_Fixed_Point_Definition => 1485 when N_Decimal_Fixed_Point_Definition =>
1486 Write_Str_With_Col_Check_Sloc (" delta "); 1486 Write_Str_With_Col_Check_Sloc ("delta ");
1487 Sprint_Node (Delta_Expression (Node)); 1487 Sprint_Node (Delta_Expression (Node));
1488 Write_Str_With_Col_Check ("digits "); 1488 Write_Str_With_Col_Check (" digits ");
1489 Sprint_Node (Digits_Expression (Node)); 1489 Sprint_Node (Digits_Expression (Node));
1490 Sprint_Opt_Node (Real_Range_Specification (Node)); 1490 Sprint_Opt_Node (Real_Range_Specification (Node));
1491 1491
1492 when N_Defining_Character_Literal => 1492 when N_Defining_Character_Literal =>
1493 Write_Name_With_Col_Check_Sloc (Chars (Node)); 1493 Write_Name_With_Col_Check_Sloc (Chars (Node));
4185 then 4185 then
4186 -- Itype to be printed 4186 -- Itype to be printed
4187 4187
4188 declare 4188 declare
4189 B : constant Node_Id := Etype (Typ); 4189 B : constant Node_Id := Etype (Typ);
4190 X : Node_Id;
4191 P : constant Node_Id := Parent (Typ); 4190 P : constant Node_Id := Parent (Typ);
4192
4193 S : constant Saved_Output_Buffer := Save_Output_Buffer; 4191 S : constant Saved_Output_Buffer := Save_Output_Buffer;
4194 -- Save current output buffer 4192 -- Save current output buffer
4195 4193
4196 Old_Sloc : Source_Ptr; 4194 Old_Sloc : Source_Ptr;
4197 -- Save sloc of related node, so it is not modified when 4195 -- Save sloc of related node, so it is not modified when
4198 -- printing with -gnatD. 4196 -- printing with -gnatD.
4197
4198 X : Node_Id;
4199 4199
4200 begin 4200 begin
4201 -- Write indentation at start of line 4201 -- Write indentation at start of line
4202 4202
4203 for J in 1 .. Indent loop 4203 for J in 1 .. Indent loop
4322 -- Print bounds if different from base type 4322 -- Print bounds if different from base type
4323 4323
4324 declare 4324 declare
4325 L : constant Node_Id := Type_Low_Bound (Typ); 4325 L : constant Node_Id := Type_Low_Bound (Typ);
4326 H : constant Node_Id := Type_High_Bound (Typ); 4326 H : constant Node_Id := Type_High_Bound (Typ);
4327 LE : Node_Id; 4327 BL : Node_Id;
4328 HE : Node_Id; 4328 BH : Node_Id;
4329 4329
4330 begin 4330 begin
4331 -- B can either be a scalar type, in which case the 4331 -- B can either be a scalar type, in which case the
4332 -- declaration of Typ may constrain it with different 4332 -- declaration of Typ may constrain it with different
4333 -- bounds, or a private type, in which case we know 4333 -- bounds, or a private type, in which case we know
4334 -- that the declaration of Typ cannot have a scalar 4334 -- that the declaration of Typ cannot have a scalar
4335 -- constraint. 4335 -- constraint.
4336 4336
4337 if Is_Scalar_Type (B) then 4337 if Is_Scalar_Type (B) then
4338 LE := Type_Low_Bound (B); 4338 BL := Type_Low_Bound (B);
4339 HE := Type_High_Bound (B); 4339 BH := Type_High_Bound (B);
4340 else 4340 else
4341 LE := Empty; 4341 BL := Empty;
4342 HE := Empty; 4342 BH := Empty;
4343 end if; 4343 end if;
4344 4344
4345 if No (LE) 4345 if No (BL)
4346 or else (True 4346 or else (True
4347 and then Nkind (L) = N_Integer_Literal 4347 and then Nkind (L) = N_Integer_Literal
4348 and then Nkind (H) = N_Integer_Literal 4348 and then Nkind (H) = N_Integer_Literal
4349 and then Nkind (LE) = N_Integer_Literal 4349 and then Nkind (BL) = N_Integer_Literal
4350 and then Nkind (HE) = N_Integer_Literal 4350 and then Nkind (BH) = N_Integer_Literal
4351 and then UI_Eq (Intval (L), Intval (LE)) 4351 and then UI_Eq (Intval (L), Intval (BL))
4352 and then UI_Eq (Intval (H), Intval (HE))) 4352 and then UI_Eq (Intval (H), Intval (BH)))
4353 then 4353 then
4354 null; 4354 null;
4355 4355
4356 else 4356 else
4357 Write_Str (" range "); 4357 Write_Str (" range ");
4358 Sprint_Node (Type_Low_Bound (Typ)); 4358 Sprint_Node (L);
4359 Write_Str (" .. "); 4359 Write_Str (" .. ");
4360 Sprint_Node (Type_High_Bound (Typ)); 4360 Sprint_Node (H);
4361 end if; 4361 end if;
4362 end; 4362 end;
4363 4363
4364 -- Modular integer types 4364 -- Modular integer types
4365 4365
4366 when E_Modular_Integer_Type => 4366 when E_Modular_Integer_Type =>
4367 Write_Header; 4367 Write_Header;
4368 Write_Str ("mod "); 4368 Write_Str ("mod ");
4369 Write_Uint_With_Col_Check (Modulus (Typ), Auto); 4369 Write_Uint_With_Col_Check (Modulus (Typ), Auto);
4370 4370
4371 -- Floating point types and subtypes 4371 -- Floating-point types and subtypes
4372 4372
4373 when E_Floating_Point_Subtype 4373 when E_Floating_Point_Subtype
4374 | E_Floating_Point_Type 4374 | E_Floating_Point_Type
4375 => 4375 =>
4376 Write_Header (Ekind (Typ) = E_Floating_Point_Type); 4376 Write_Header (Ekind (Typ) = E_Floating_Point_Type);
4377 4377
4378 if Ekind (Typ) = E_Floating_Point_Type then 4378 if Ekind (Typ) = E_Floating_Point_Type then
4379 Write_Str ("new "); 4379 Write_Str ("new ");
4380 end if; 4380 end if;
4381 4381
4382 Write_Id (Etype (Typ)); 4382 Write_Id (B);
4383 4383
4384 if Digits_Value (Typ) /= Digits_Value (Etype (Typ)) then 4384 if Digits_Value (Typ) /= Digits_Value (B) then
4385 Write_Str (" digits "); 4385 Write_Str (" digits ");
4386 Write_Uint_With_Col_Check 4386 Write_Uint_With_Col_Check
4387 (Digits_Value (Typ), Decimal); 4387 (Digits_Value (Typ), Decimal);
4388 end if; 4388 end if;
4389 4389
4390 -- Print bounds if not different from base type 4390 -- Print bounds if not different from base type
4391 4391
4392 declare 4392 declare
4393 L : constant Node_Id := Type_Low_Bound (Typ); 4393 L : constant Node_Id := Type_Low_Bound (Typ);
4394 H : constant Node_Id := Type_High_Bound (Typ); 4394 H : constant Node_Id := Type_High_Bound (Typ);
4395 LE : constant Node_Id := Type_Low_Bound (B); 4395 BL : constant Node_Id := Type_Low_Bound (B);
4396 HE : constant Node_Id := Type_High_Bound (B); 4396 BH : constant Node_Id := Type_High_Bound (B);
4397 4397
4398 begin 4398 begin
4399 if Nkind (L) = N_Real_Literal 4399 if True
4400 and then Nkind (L) = N_Real_Literal
4400 and then Nkind (H) = N_Real_Literal 4401 and then Nkind (H) = N_Real_Literal
4401 and then Nkind (LE) = N_Real_Literal 4402 and then Nkind (BL) = N_Real_Literal
4402 and then Nkind (HE) = N_Real_Literal 4403 and then Nkind (BH) = N_Real_Literal
4403 and then UR_Eq (Realval (L), Realval (LE)) 4404 and then UR_Eq (Realval (L), Realval (BL))
4404 and then UR_Eq (Realval (H), Realval (HE)) 4405 and then UR_Eq (Realval (H), Realval (BH))
4405 then 4406 then
4406 null; 4407 null;
4407 4408
4408 else 4409 else
4409 Write_Str (" range "); 4410 Write_Str (" range ");
4410 Sprint_Node (Type_Low_Bound (Typ)); 4411 Sprint_Node (L);
4411 Write_Str (" .. "); 4412 Write_Str (" .. ");
4412 Sprint_Node (Type_High_Bound (Typ)); 4413 Sprint_Node (H);
4413 end if; 4414 end if;
4414 end; 4415 end;
4416
4417 -- Ordinary fixed-point types and subtypes
4418
4419 when E_Ordinary_Fixed_Point_Subtype
4420 | E_Ordinary_Fixed_Point_Type
4421 =>
4422 Write_Header (Ekind (Typ) = E_Ordinary_Fixed_Point_Type);
4423
4424 Write_Str ("delta ");
4425 Write_Ureal_With_Col_Check_Sloc (Delta_Value (Typ));
4426 Write_Str (" range ");
4427 Sprint_Node (Type_Low_Bound (Typ));
4428 Write_Str (" .. ");
4429 Sprint_Node (Type_High_Bound (Typ));
4430
4431 -- Decimal fixed-point types and subtypes
4432
4433 when E_Decimal_Fixed_Point_Subtype
4434 | E_Decimal_Fixed_Point_Type
4435 =>
4436 Write_Header (Ekind (Typ) = E_Decimal_Fixed_Point_Type);
4437
4438 Write_Str ("delta ");
4439 Write_Ureal_With_Col_Check_Sloc (Delta_Value (Typ));
4440 Write_Str (" digits ");
4441 Write_Uint_With_Col_Check (Digits_Value (Typ), Decimal);
4415 4442
4416 -- Record subtypes 4443 -- Record subtypes
4417 4444
4418 when E_Record_Subtype 4445 when E_Record_Subtype
4419 | E_Record_Subtype_With_Private 4446 | E_Record_Subtype_With_Private
4491 Write_Id (Etype (Typ)); 4518 Write_Id (Etype (Typ));
4492 end if; 4519 end if;
4493 4520
4494 when E_String_Literal_Subtype => 4521 when E_String_Literal_Subtype =>
4495 declare 4522 declare
4496 LB : constant Uint := 4523 L : constant Uint :=
4497 Expr_Value (String_Literal_Low_Bound (Typ)); 4524 Expr_Value (String_Literal_Low_Bound (Typ));
4498 Len : constant Uint := 4525 Len : constant Uint :=
4499 String_Literal_Length (Typ); 4526 String_Literal_Length (Typ);
4500 begin 4527 begin
4501 Write_Header (False); 4528 Write_Header (False);
4502 Write_Str ("String ("); 4529 Write_Str ("String (");
4503 Write_Int (UI_To_Int (LB)); 4530 Write_Int (UI_To_Int (L));
4504 Write_Str (" .. "); 4531 Write_Str (" .. ");
4505 Write_Int (UI_To_Int (LB + Len) - 1); 4532 Write_Int (UI_To_Int (L + Len) - 1);
4506 Write_Str (");"); 4533 Write_Str (");");
4507 end; 4534 end;
4508 4535
4509 -- For all other Itypes, print ??? (fill in later) 4536 -- For all other Itypes, print ??? (fill in later)
4510 4537