]> git.ipfire.org Git - thirdparty/gcc.git/blame - gcc/ada/repinfo.adb
projects / thirdparty / gcc.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
expr.c (expand_expr): Use unsave lang hook.
[thirdparty/gcc.git] / gcc / ada / repinfo.adb
CommitLineData
19235870
RK		 1------------------------------------------------------------------------------
2-- --
3-- GNAT COMPILER COMPONENTS --
4-- --
5-- R E P I N F O --
6-- --
7-- B o d y --
8-- --
44d6a706 9-- $Revision: 1.1 $
19235870
RK		 10-- --
11-- Copyright (C) 1999-2001 Free Software Foundation, Inc. --
12-- --
13-- GNAT is free software; you can redistribute it and/or modify it under --
14-- terms of the GNU General Public License as published by the Free Soft- --
15-- ware Foundation; either version 2, or (at your option) any later ver- --
16-- sion. GNAT is distributed in the hope that it will be useful, but WITH- --
17-- OUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY --
18-- or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License --
19-- for more details. You should have received a copy of the GNU General --
20-- Public License distributed with GNAT; see file COPYING. If not, write --
21-- to the Free Software Foundation, 59 Temple Place - Suite 330, Boston, --
22-- MA 02111-1307, USA. --
23-- --
24-- As a special exception, if other files instantiate generics from this --
25-- unit, or you link this unit with other files to produce an executable, --
26-- this unit does not by itself cause the resulting executable to be --
27-- covered by the GNU General Public License. This exception does not --
28-- however invalidate any other reasons why the executable file might be --
29-- covered by the GNU Public License. --
30-- --
31-- GNAT was originally developed by the GNAT team at New York University. --
32-- It is now maintained by Ada Core Technologies Inc (http://www.gnat.com). --
33-- --
34------------------------------------------------------------------------------
35
36with Alloc; use Alloc;
37with Atree; use Atree;
38with Casing; use Casing;
39with Debug; use Debug;
40with Einfo; use Einfo;
41with Lib; use Lib;
42with Namet; use Namet;
43with Opt; use Opt;
44with Output; use Output;
45with Sinfo; use Sinfo;
46with Sinput; use Sinput;
47with Table; use Table;
48with Uname; use Uname;
49with Urealp; use Urealp;
50
51package body Repinfo is
52
53 SSU : constant := 8;
54 -- Value for Storage_Unit, we do not want to get this from TTypes, since
55 -- this introduces problematic dependencies in ASIS, and in any case this
56 -- value is assumed to be 8 for the implementation of the DDA.
57 -- This is wrong for AAMP???
58
59 ---------------------------------------
60 -- Representation of gcc Expressions --
61 ---------------------------------------
62
63 -- This table is used only if Frontend_Layout_On_Target is False,
64 -- so that gigi lays out dynamic size/offset fields using encoded
65 -- gcc expressions.
66
67 -- A table internal to this unit is used to hold the values of
68 -- back annotated expressions. This table is written out by -gnatt
69 -- and read back in for ASIS processing.
70
71 -- Node values are stored as Uint values which are the negative of
72 -- the node index in this table. Constants appear as non-negative
73 -- Uint values.
74
75 type Exp_Node is record
76 Expr : TCode;
77 Op1 : Node_Ref_Or_Val;
78 Op2 : Node_Ref_Or_Val;
79 Op3 : Node_Ref_Or_Val;
80 end record;
81
82 package Rep_Table is new Table.Table (
83 Table_Component_Type => Exp_Node,
84 Table_Index_Type => Nat,
85 Table_Low_Bound => 1,
86 Table_Initial => Alloc.Rep_Table_Initial,
87 Table_Increment => Alloc.Rep_Table_Increment,
88 Table_Name => "BE_Rep_Table");
89
90 --------------------------------------------------------------
91 -- Representation of Front-End Dynamic Size/Offset Entities --
92 --------------------------------------------------------------
93
94 package Dynamic_SO_Entity_Table is new Table.Table (
95 Table_Component_Type => Entity_Id,
96 Table_Index_Type => Nat,
97 Table_Low_Bound => 1,
98 Table_Initial => Alloc.Rep_Table_Initial,
99 Table_Increment => Alloc.Rep_Table_Increment,
100 Table_Name => "FE_Rep_Table");
101
102 -----------------------
103 -- Local Subprograms --
104 -----------------------
105
106 Unit_Casing : Casing_Type;
44d6a706 107 -- Identifier casing for current unit
19235870
RK		 108
109 procedure Spaces (N : Natural);
110 -- Output given number of spaces
111
112 function Back_End_Layout return Boolean;
113 -- Test for layout mode, True = back end, False = front end. This
114 -- function is used rather than checking the configuration parameter
115 -- because we do not want Repinfo to depend on Targparm (for ASIS)
116
117 procedure List_Entities (Ent : Entity_Id);
118 -- This procedure lists the entities associated with the entity E,
119 -- starting with the First_Entity and using the Next_Entity link.
120 -- If a nested package is found, entities within the package are
121 -- recursively processed.
122
123 procedure List_Name (Ent : Entity_Id);
124 -- List name of entity Ent in appropriate case. The name is listed with
125 -- full qualification up to but not including the compilation unit name.
126
127 procedure List_Array_Info (Ent : Entity_Id);
128 -- List representation info for array type Ent
129
130 procedure List_Object_Info (Ent : Entity_Id);
131 -- List representation info for object Ent
132
133 procedure List_Record_Info (Ent : Entity_Id);
134 -- List representation info for record type Ent
135
136 procedure List_Type_Info (Ent : Entity_Id);
137 -- List type info for type Ent
138
139 function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean;
140 -- Returns True if Val represents a variable value, and False if it
141 -- represents a value that is fixed at compile time.
142
143 procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False);
144 -- Given a representation value, write it out. No_Uint values or values
145 -- dependent on discriminants are written as two question marks. If the
146 -- flag Paren is set, then the output is surrounded in parentheses if
147 -- it is other than a simple value.
148
149 ---------------------
150 -- Back_End_Layout --
151 ---------------------
152
153 function Back_End_Layout return Boolean is
154 begin
155 -- We have back end layout if the back end has made any entries in
156 -- the table of GCC expressions, otherwise we have front end layout.
157
158 return Rep_Table.Last > 0;
159 end Back_End_Layout;
160
161 ------------------------
162 -- Create_Discrim_Ref --
163 ------------------------
164
165 function Create_Discrim_Ref
166 (Discr : Entity_Id)
167 return Node_Ref
168 is
169 N : constant Uint := Discriminant_Number (Discr);
170 T : Nat;
171
172 begin
173 Rep_Table.Increment_Last;
174 T := Rep_Table.Last;
175 Rep_Table.Table (T).Expr := Discrim_Val;
176 Rep_Table.Table (T).Op1 := N;
177 Rep_Table.Table (T).Op2 := No_Uint;
178 Rep_Table.Table (T).Op3 := No_Uint;
179 return UI_From_Int (-T);
180 end Create_Discrim_Ref;
181
182 ---------------------------
183 -- Create_Dynamic_SO_Ref --
184 ---------------------------
185
186 function Create_Dynamic_SO_Ref
187 (E : Entity_Id)
188 return Dynamic_SO_Ref
189 is
190 T : Nat;
191
192 begin
193 Dynamic_SO_Entity_Table.Increment_Last;
194 T := Dynamic_SO_Entity_Table.Last;
195 Dynamic_SO_Entity_Table.Table (T) := E;
196 return UI_From_Int (-T);
197 end Create_Dynamic_SO_Ref;
198
199 -----------------
200 -- Create_Node --
201 -----------------
202
203 function Create_Node
204 (Expr : TCode;
205 Op1 : Node_Ref_Or_Val;
206 Op2 : Node_Ref_Or_Val := No_Uint;
207 Op3 : Node_Ref_Or_Val := No_Uint)
208 return Node_Ref
209 is
210 T : Nat;
211
212 begin
213 Rep_Table.Increment_Last;
214 T := Rep_Table.Last;
215 Rep_Table.Table (T).Expr := Expr;
216 Rep_Table.Table (T).Op1 := Op1;
217 Rep_Table.Table (T).Op2 := Op2;
218 Rep_Table.Table (T).Op3 := Op3;
219
220 return UI_From_Int (-T);
221 end Create_Node;
222
223 ---------------------------
224 -- Get_Dynamic_SO_Entity --
225 ---------------------------
226
227 function Get_Dynamic_SO_Entity
228 (U : Dynamic_SO_Ref)
229 return Entity_Id
230 is
231 begin
232 return Dynamic_SO_Entity_Table.Table (-UI_To_Int (U));
233 end Get_Dynamic_SO_Entity;
234
235 -----------------------
236 -- Is_Dynamic_SO_Ref --
237 -----------------------
238
239 function Is_Dynamic_SO_Ref (U : SO_Ref) return Boolean is
240 begin
241 return U < Uint_0;
242 end Is_Dynamic_SO_Ref;
243
244 ----------------------
245 -- Is_Static_SO_Ref --
246 ----------------------
247
248 function Is_Static_SO_Ref (U : SO_Ref) return Boolean is
249 begin
250 return U >= Uint_0;
251 end Is_Static_SO_Ref;
252
253 ---------
254 -- lgx --
255 ---------
256
257 procedure lgx (U : Node_Ref_Or_Val) is
258 begin
259 List_GCC_Expression (U);
260 Write_Eol;
261 end lgx;
262
263 ----------------------
264 -- List_Array_Info --
265 ----------------------
266
267 procedure List_Array_Info (Ent : Entity_Id) is
268 begin
269 List_Type_Info (Ent);
270
271 Write_Str ("for ");
272 List_Name (Ent);
273 Write_Str ("'Component_Size use ");
274 Write_Val (Component_Size (Ent));
275 Write_Line (";");
276 end List_Array_Info;
277
278 -------------------
279 -- List_Entities --
280 -------------------
281
282 procedure List_Entities (Ent : Entity_Id) is
283 E : Entity_Id;
284
285 begin
286 if Present (Ent) then
287 E := First_Entity (Ent);
288 while Present (E) loop
289 if Comes_From_Source (E) or else Debug_Flag_AA then
290
291 if Is_Record_Type (E) then
292 List_Record_Info (E);
293
294 elsif Is_Array_Type (E) then
295 List_Array_Info (E);
296
297 elsif List_Representation_Info >= 2 then
298
299 if Is_Type (E) then
300 List_Type_Info (E);
301
302 elsif Ekind (E) = E_Variable
303 or else
304 Ekind (E) = E_Constant
305 or else
306 Ekind (E) = E_Loop_Parameter
307 or else
308 Is_Formal (E)
309 then
310 List_Object_Info (E);
311 end if;
312 end if;
313
314 -- Recurse over nested package, but not if they are
315 -- package renamings (in particular renamings of the
316 -- enclosing package, as for some Java bindings and
317 -- for generic instances).
318
319 if (Ekind (E) = E_Package
320 and then No (Renamed_Object (E)))
321 or else
322 Ekind (E) = E_Protected_Type
323 or else
324 Ekind (E) = E_Task_Type
325 or else
326 Ekind (E) = E_Subprogram_Body
327 or else
328 Ekind (E) = E_Package_Body
329 or else
330 Ekind (E) = E_Task_Body
331 or else
332 Ekind (E) = E_Protected_Body
333 then
334 List_Entities (E);
335 end if;
336 end if;
337
338 E := Next_Entity (E);
339 end loop;
340 end if;
341 end List_Entities;
342
343 -------------------------
344 -- List_GCC_Expression --
345 -------------------------
346
347 procedure List_GCC_Expression (U : Node_Ref_Or_Val) is
348
349 procedure P (Val : Node_Ref_Or_Val);
350 -- Internal recursive procedure to print expression
351
352 procedure P (Val : Node_Ref_Or_Val) is
353 begin
354 if Val >= 0 then
355 UI_Write (Val, Decimal);
356
357 else
358 declare
359 Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
360
361 procedure Binop (S : String);
362 -- Output text for binary operator with S being operator name
363
364 procedure Binop (S : String) is
365 begin
366 Write_Char ('(');
367 P (Node.Op1);
368 Write_Str (S);
369 P (Node.Op2);
370 Write_Char (')');
371 end Binop;
372
373 -- Start of processing for P
374
375 begin
376 case Node.Expr is
377 when Cond_Expr =>
378 Write_Str ("(if ");
379 P (Node.Op1);
380 Write_Str (" then ");
381 P (Node.Op2);
382 Write_Str (" else ");
383 P (Node.Op3);
384 Write_Str (" end)");
385
386 when Plus_Expr =>
387 Binop (" + ");
388
389 when Minus_Expr =>
390 Binop (" - ");
391
392 when Mult_Expr =>
393 Binop (" * ");
394
395 when Trunc_Div_Expr =>
396 Binop (" /t ");
397
398 when Ceil_Div_Expr =>
399 Binop (" /c ");
400
401 when Floor_Div_Expr =>
402 Binop (" /f ");
403
404 when Trunc_Mod_Expr =>
405 Binop (" modt ");
406
407 when Floor_Mod_Expr =>
408 Binop (" modf ");
409
410 when Ceil_Mod_Expr =>
411 Binop (" modc ");
412
413 when Exact_Div_Expr =>
414 Binop (" /e ");
415
416 when Negate_Expr =>
417 Write_Char ('-');
418 P (Node.Op1);
419
420 when Min_Expr =>
421 Binop (" min ");
422
423 when Max_Expr =>
424 Binop (" max ");
425
426 when Abs_Expr =>
427 Write_Str ("abs ");
428 P (Node.Op1);
429
430 when Truth_Andif_Expr =>
431 Binop (" and if ");
432
433 when Truth_Orif_Expr =>
434 Binop (" or if ");
435
436 when Truth_And_Expr =>
437 Binop (" and ");
438
439 when Truth_Or_Expr =>
440 Binop (" or ");
441
442 when Truth_Xor_Expr =>
443 Binop (" xor ");
444
445 when Truth_Not_Expr =>
446 Write_Str ("not ");
447 P (Node.Op1);
448
449 when Lt_Expr =>
450 Binop (" < ");
451
452 when Le_Expr =>
453 Binop (" <= ");
454
455 when Gt_Expr =>
456 Binop (" > ");
457
458 when Ge_Expr =>
459 Binop (" >= ");
460
461 when Eq_Expr =>
462 Binop (" == ");
463
464 when Ne_Expr =>
465 Binop (" != ");
466
467 when Discrim_Val =>
468 Write_Char ('#');
469 UI_Write (Node.Op1);
470
471 end case;
472 end;
473 end if;
474 end P;
475
476 -- Start of processing for List_GCC_Expression
477
478 begin
479 if U = No_Uint then
480 Write_Line ("??");
481 else
482 P (U);
483 end if;
484 end List_GCC_Expression;
485
486 ---------------
487 -- List_Name --
488 ---------------
489
490 procedure List_Name (Ent : Entity_Id) is
491 begin
492 if not Is_Compilation_Unit (Scope (Ent)) then
493 List_Name (Scope (Ent));
494 Write_Char ('.');
495 end if;
496
497 Get_Unqualified_Decoded_Name_String (Chars (Ent));
498 Set_Casing (Unit_Casing);
499 Write_Str (Name_Buffer (1 .. Name_Len));
500 end List_Name;
501
502 ---------------------
503 -- List_Object_Info --
504 ---------------------
505
506 procedure List_Object_Info (Ent : Entity_Id) is
507 begin
508 Write_Eol;
509
510 if Known_Esize (Ent) then
511 Write_Str ("for ");
512 List_Name (Ent);
513 Write_Str ("'Size use ");
514 Write_Val (Esize (Ent));
515 Write_Line (";");
516 end if;
517
518 if Known_Alignment (Ent) then
519 Write_Str ("for ");
520 List_Name (Ent);
521 Write_Str ("'Alignment use ");
522 Write_Val (Alignment (Ent));
523 Write_Line (";");
524 end if;
525 end List_Object_Info;
526
527 ----------------------
528 -- List_Record_Info --
529 ----------------------
530
531 procedure List_Record_Info (Ent : Entity_Id) is
532 Comp : Entity_Id;
533 Esiz : Uint;
534 Cfbit : Uint;
535 Sunit : Uint;
536
537 Max_Name_Length : Natural;
538 Max_Suni_Length : Natural;
539
540 begin
541 List_Type_Info (Ent);
542
543 Write_Str ("for ");
544 List_Name (Ent);
545 Write_Line (" use record");
546
547 -- First loop finds out max line length and max starting position
548 -- length, for the purpose of lining things up nicely.
549
550 Max_Name_Length := 0;
551 Max_Suni_Length := 0;
552
553 Comp := First_Entity (Ent);
554 while Present (Comp) loop
555 if Ekind (Comp) = E_Component
556 or else Ekind (Comp) = E_Discriminant
557 then
558 Get_Decoded_Name_String (Chars (Comp));
559 Max_Name_Length := Natural'Max (Max_Name_Length, Name_Len);
560
561 Cfbit := Component_Bit_Offset (Comp);
562
563 if Rep_Not_Constant (Cfbit) then
564 UI_Image_Length := 2;
565
566 else
567 -- Complete annotation in case not done
568
569 Set_Normalized_Position (Comp, Cfbit / SSU);
570 Set_Normalized_First_Bit (Comp, Cfbit mod SSU);
571
572 Esiz := Esize (Comp);
573 Sunit := Cfbit / SSU;
574 UI_Image (Sunit);
575 end if;
576
577 if Unknown_Normalized_First_Bit (Comp) then
578 Set_Normalized_First_Bit (Comp, Uint_0);
579 end if;
580
581 Max_Suni_Length :=
582 Natural'Max (Max_Suni_Length, UI_Image_Length);
583 end if;
584
585 Comp := Next_Entity (Comp);
586 end loop;
587
588 -- Second loop does actual output based on those values
589
590 Comp := First_Entity (Ent);
591 while Present (Comp) loop
592 if Ekind (Comp) = E_Component
593 or else Ekind (Comp) = E_Discriminant
594 then
595 declare
596 Esiz : constant Uint := Esize (Comp);
597 Bofs : constant Uint := Component_Bit_Offset (Comp);
598 Npos : constant Uint := Normalized_Position (Comp);
599 Fbit : constant Uint := Normalized_First_Bit (Comp);
600 Lbit : Uint;
601
602 begin
603 Write_Str (" ");
604 Get_Decoded_Name_String (Chars (Comp));
605 Set_Casing (Unit_Casing);
606 Write_Str (Name_Buffer (1 .. Name_Len));
607
608 for J in 1 .. Max_Name_Length - Name_Len loop
609 Write_Char (' ');
610 end loop;
611
612 Write_Str (" at ");
613
614 if Known_Static_Normalized_Position (Comp) then
615 UI_Image (Npos);
616 Spaces (Max_Suni_Length - UI_Image_Length);
617 Write_Str (UI_Image_Buffer (1 .. UI_Image_Length));
618
619 elsif Known_Component_Bit_Offset (Comp)
620 and then List_Representation_Info = 3
621 then
622 Spaces (Max_Suni_Length - 2);
623 Write_Val (Bofs, Paren => True);
624 Write_Str (" / 8");
625
626 elsif Known_Normalized_Position (Comp)
627 and then List_Representation_Info = 3
628 then
629 Spaces (Max_Suni_Length - 2);
630 Write_Val (Npos);
631
632 else
633 Write_Str ("??");
634 end if;
635
636 Write_Str (" range ");
637 UI_Write (Fbit);
638 Write_Str (" .. ");
639
640 if not Is_Dynamic_SO_Ref (Esize (Comp)) then
641 Lbit := Fbit + Esiz - 1;
642
643 if Lbit < 10 then
644 Write_Char (' ');
645 end if;
646
647 UI_Write (Lbit);
648
649 elsif List_Representation_Info < 3 then
650 Write_Str ("??");
651
652 else -- List_Representation >= 3
653
654 Write_Val (Esiz, Paren => True);
655
656 -- If in front end layout mode, then dynamic size is
657 -- stored in storage units, so renormalize for output
658
659 if not Back_End_Layout then
660 Write_Str (" * ");
661 Write_Int (SSU);
662 end if;
663
664 -- Add appropriate first bit offset
665
666 if Fbit = 0 then
667 Write_Str (" - 1");
668
669 elsif Fbit = 1 then
670 null;
671
672 else
673 Write_Str (" + ");
674 Write_Int (UI_To_Int (Fbit) - 1);
675 end if;
676 end if;
677
678 Write_Line (";");
679 end;
680 end if;
681
682 Comp := Next_Entity (Comp);
683 end loop;
684
685 Write_Line ("end record;");
686 end List_Record_Info;
687
688 -------------------
689 -- List_Rep_Info --
690 -------------------
691
692 procedure List_Rep_Info is
693 Col : Nat;
694
695 begin
696 for U in Main_Unit .. Last_Unit loop
697 if In_Extended_Main_Source_Unit (Cunit_Entity (U)) then
698 Unit_Casing := Identifier_Casing (Source_Index (U));
699 Write_Eol;
700 Write_Str ("Representation information for unit ");
701 Write_Unit_Name (Unit_Name (U));
702 Col := Column;
703 Write_Eol;
704
705 for J in 1 .. Col - 1 loop
706 Write_Char ('-');
707 end loop;
708
709 Write_Eol;
710 List_Entities (Cunit_Entity (U));
711 end if;
712 end loop;
713 end List_Rep_Info;
714
715 --------------------
716 -- List_Type_Info --
717 --------------------
718
719 procedure List_Type_Info (Ent : Entity_Id) is
720 begin
721 Write_Eol;
722
723 -- If Esize and RM_Size are the same and known, list as Size. This
724 -- is a common case, which we may as well list in simple form.
725
726 if Esize (Ent) = RM_Size (Ent) then
727 if Known_Esize (Ent) then
728 Write_Str ("for ");
729 List_Name (Ent);
730 Write_Str ("'Size use ");
731 Write_Val (Esize (Ent));
732 Write_Line (";");
733 end if;
734
735 -- For now, temporary case, to be removed when gigi properly back
736 -- annotates RM_Size, if RM_Size is not set, then list Esize as
737 -- Size. This avoids odd Object_Size output till we fix things???
738
739 elsif Unknown_RM_Size (Ent) then
740 if Known_Esize (Ent) then
741 Write_Str ("for ");
742 List_Name (Ent);
743 Write_Str ("'Size use ");
744 Write_Val (Esize (Ent));
745 Write_Line (";");
746 end if;
747
748 -- Otherwise list size values separately if they are set
749
750 else
751 if Known_Esize (Ent) then
752 Write_Str ("for ");
753 List_Name (Ent);
754 Write_Str ("'Object_Size use ");
755 Write_Val (Esize (Ent));
756 Write_Line (";");
757 end if;
758
759 -- Note on following check: The RM_Size of a discrete type can
760 -- legitimately be set to zero, so a special check is needed.
761
762 if Known_RM_Size (Ent) or else Is_Discrete_Type (Ent) then
763 Write_Str ("for ");
764 List_Name (Ent);
765 Write_Str ("'Value_Size use ");
766 Write_Val (RM_Size (Ent));
767 Write_Line (";");
768 end if;
769 end if;
770
771 if Known_Alignment (Ent) then
772 Write_Str ("for ");
773 List_Name (Ent);
774 Write_Str ("'Alignment use ");
775 Write_Val (Alignment (Ent));
776 Write_Line (";");
777 end if;
778 end List_Type_Info;
779
780 ----------------------
781 -- Rep_Not_Constant --
782 ----------------------
783
784 function Rep_Not_Constant (Val : Node_Ref_Or_Val) return Boolean is
785 begin
786 if Val = No_Uint or else Val < 0 then
787 return True;
788 else
789 return False;
790 end if;
791 end Rep_Not_Constant;
792
793 ---------------
794 -- Rep_Value --
795 ---------------
796
797 function Rep_Value
798 (Val : Node_Ref_Or_Val;
799 D : Discrim_List)
800 return Uint
801 is
802 function B (Val : Boolean) return Uint;
803 -- Returns Uint_0 for False, Uint_1 for True
804
805 function T (Val : Node_Ref_Or_Val) return Boolean;
806 -- Returns True for 0, False for any non-zero (i.e. True)
807
808 function V (Val : Node_Ref_Or_Val) return Uint;
809 -- Internal recursive routine to evaluate tree
810
811 -------
812 -- B --
813 -------
814
815 function B (Val : Boolean) return Uint is
816 begin
817 if Val then
818 return Uint_1;
819 else
820 return Uint_0;
821 end if;
822 end B;
823
824 -------
825 -- T --
826 -------
827
828 function T (Val : Node_Ref_Or_Val) return Boolean is
829 begin
830 if V (Val) = 0 then
831 return False;
832 else
833 return True;
834 end if;
835 end T;
836
837 -------
838 -- V --
839 -------
840
841 function V (Val : Node_Ref_Or_Val) return Uint is
842 L, R, Q : Uint;
843
844 begin
845 if Val >= 0 then
846 return Val;
847
848 else
849 declare
850 Node : Exp_Node renames Rep_Table.Table (-UI_To_Int (Val));
851
852 begin
853 case Node.Expr is
854 when Cond_Expr =>
855 if T (Node.Op1) then
856 return V (Node.Op2);
857 else
858 return V (Node.Op3);
859 end if;
860
861 when Plus_Expr =>
862 return V (Node.Op1) + V (Node.Op2);
863
864 when Minus_Expr =>
865 return V (Node.Op1) - V (Node.Op2);
866
867 when Mult_Expr =>
868 return V (Node.Op1) * V (Node.Op2);
869
870 when Trunc_Div_Expr =>
871 return V (Node.Op1) / V (Node.Op2);
872
873 when Ceil_Div_Expr =>
874 return
875 UR_Ceiling
876 (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
877
878 when Floor_Div_Expr =>
879 return
880 UR_Floor
881 (V (Node.Op1) / UR_From_Uint (V (Node.Op2)));
882
883 when Trunc_Mod_Expr =>
884 return V (Node.Op1) rem V (Node.Op2);
885
886 when Floor_Mod_Expr =>
887 return V (Node.Op1) mod V (Node.Op2);
888
889 when Ceil_Mod_Expr =>
890 L := V (Node.Op1);
891 R := V (Node.Op2);
892 Q := UR_Ceiling (L / UR_From_Uint (R));
893 return L - R * Q;
894
895 when Exact_Div_Expr =>
896 return V (Node.Op1) / V (Node.Op2);
897
898 when Negate_Expr =>
899 return -V (Node.Op1);
900
901 when Min_Expr =>
902 return UI_Min (V (Node.Op1), V (Node.Op2));
903
904 when Max_Expr =>
905 return UI_Max (V (Node.Op1), V (Node.Op2));
906
907 when Abs_Expr =>
908 return UI_Abs (V (Node.Op1));
909
910 when Truth_Andif_Expr =>
911 return B (T (Node.Op1) and then T (Node.Op2));
912
913 when Truth_Orif_Expr =>
914 return B (T (Node.Op1) or else T (Node.Op2));
915
916 when Truth_And_Expr =>
917 return B (T (Node.Op1) and T (Node.Op2));
918
919 when Truth_Or_Expr =>
920 return B (T (Node.Op1) or T (Node.Op2));
921
922 when Truth_Xor_Expr =>
923 return B (T (Node.Op1) xor T (Node.Op2));
924
925 when Truth_Not_Expr =>
926 return B (not T (Node.Op1));
927
928 when Lt_Expr =>
929 return B (V (Node.Op1) < V (Node.Op2));
930
931 when Le_Expr =>
932 return B (V (Node.Op1) <= V (Node.Op2));
933
934 when Gt_Expr =>
935 return B (V (Node.Op1) > V (Node.Op2));
936
937 when Ge_Expr =>
938 return B (V (Node.Op1) >= V (Node.Op2));
939
940 when Eq_Expr =>
941 return B (V (Node.Op1) = V (Node.Op2));
942
943 when Ne_Expr =>
944 return B (V (Node.Op1) /= V (Node.Op2));
945
946 when Discrim_Val =>
947 declare
948 Sub : constant Int := UI_To_Int (Node.Op1);
949
950 begin
951 pragma Assert (Sub in D'Range);
952 return D (Sub);
953 end;
954
955 end case;
956 end;
957 end if;
958 end V;
959
960 -- Start of processing for Rep_Value
961
962 begin
963 if Val = No_Uint then
964 return No_Uint;
965
966 else
967 return V (Val);
968 end if;
969 end Rep_Value;
970
971 ------------
972 -- Spaces --
973 ------------
974
975 procedure Spaces (N : Natural) is
976 begin
977 for J in 1 .. N loop
978 Write_Char (' ');
979 end loop;
980 end Spaces;
981
982 ---------------
983 -- Tree_Read --
984 ---------------
985
986 procedure Tree_Read is
987 begin
988 Rep_Table.Tree_Read;
989 end Tree_Read;
990
991 ----------------
992 -- Tree_Write --
993 ----------------
994
995 procedure Tree_Write is
996 begin
997 Rep_Table.Tree_Write;
998 end Tree_Write;
999
1000 ---------------
1001 -- Write_Val --
1002 ---------------
1003
1004 procedure Write_Val (Val : Node_Ref_Or_Val; Paren : Boolean := False) is
1005 begin
1006 if Rep_Not_Constant (Val) then
1007 if List_Representation_Info < 3 then
1008 Write_Str ("??");
1009 else
1010 if Back_End_Layout then
1011 Write_Char (' ');
1012 List_GCC_Expression (Val);
1013 Write_Char (' ');
1014 else
1015 Write_Name_Decoded (Chars (Get_Dynamic_SO_Entity (Val)));
1016 end if;
1017 end if;
1018
1019 else
1020 UI_Write (Val);
1021 end if;
1022 end Write_Val;
1023
1024end Repinfo;
Mirror of https://gcc.gnu.org/git/gcc.git