1-- Mcode back-end for ortho - Constants handling. 2-- Copyright (C) 2006 Tristan Gingold 3-- 4-- This program is free software: you can redistribute it and/or modify 5-- it under the terms of the GNU General Public License as published by 6-- the Free Software Foundation, either version 2 of the License, or 7-- (at your option) any later version. 8-- 9-- This program is distributed in the hope that it will be useful, 10-- but WITHOUT ANY WARRANTY; without even the implied warranty of 11-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 12-- GNU General Public License for more details. 13-- 14-- You should have received a copy of the GNU General Public License 15-- along with this program. If not, see <gnu.org/licenses>. 16with Ada.Unchecked_Conversion; 17with Tables; 18with Ada.Text_IO; 19with Ortho_Code.Types; use Ortho_Code.Types; 20with Ortho_Code.Decls; 21with Ortho_Code.Debug; 22 23package body Ortho_Code.Consts is 24 type Cnode_Common is record 25 Kind : OC_Kind; 26 Lit_Type : O_Tnode; 27 end record; 28 for Cnode_Common use record 29 Kind at 0 range 0 .. 31; 30 Lit_Type at 4 range 0 .. 31; 31 end record; 32 for Cnode_Common'Size use 64; 33 34 type Cnode_Signed is record 35 Val : Integer_64; 36 end record; 37 for Cnode_Signed'Size use 64; 38 39 type Cnode_Unsigned is record 40 Val : Unsigned_64; 41 end record; 42 for Cnode_Unsigned'Size use 64; 43 44 type Cnode_Float is record 45 Val : IEEE_Float_64; 46 end record; 47 for Cnode_Float'Size use 64; 48 49 type Cnode_Enum is record 50 Id : O_Ident; 51 Val : Uns32; 52 end record; 53 for Cnode_Enum'Size use 64; 54 55 type Cnode_Addr is record 56 Decl : O_Dnode; 57 Pad : Int32; 58 end record; 59 for Cnode_Addr'Size use 64; 60 61 type Cnode_Global is record 62 Obj : O_Gnode; 63 Pad : Int32; 64 end record; 65 for Cnode_Global'Size use 64; 66 67 type Cnode_Aggr is record 68 Els : Int32; 69 Nbr : Int32; 70 end record; 71 for Cnode_Aggr'Size use 64; 72 73 type Cnode_Sizeof is record 74 Atype : O_Tnode; 75 Pad : Int32; 76 end record; 77 for Cnode_Sizeof'Size use 64; 78 79 type Cnode_Union is record 80 El : O_Cnode; 81 Field : O_Fnode; 82 end record; 83 for Cnode_Union'Size use 64; 84 85 package Cnodes is new Tables 86 (Table_Component_Type => Cnode_Common, 87 Table_Index_Type => O_Cnode, 88 Table_Low_Bound => 2, 89 Table_Initial => 128); 90 91 type Gnode_Common is record 92 Kind : OG_Kind; 93 Ref : Int32; 94 end record; 95 for Gnode_Common use record 96 Kind at 0 range 0 .. 31; 97 Ref at 4 range 0 .. 31; 98 end record; 99 for Gnode_Common'Size use 64; 100 101 type Gnode_Record_Ref is record 102 Field : O_Fnode; 103 Off : Uns32; 104 end record; 105 for Gnode_Record_Ref'Size use 64; 106 107 function To_Gnode_Common is new Ada.Unchecked_Conversion 108 (Gnode_Record_Ref, Gnode_Common); 109 function To_Gnode_Record_Ref is new Ada.Unchecked_Conversion 110 (Gnode_Common, Gnode_Record_Ref); 111 112 package Gnodes is new Tables 113 (Table_Component_Type => Gnode_Common, 114 Table_Index_Type => O_Gnode, 115 Table_Low_Bound => 2, 116 Table_Initial => 64); 117 118 function Get_Const_Kind (Cst : O_Cnode) return OC_Kind is 119 begin 120 return Cnodes.Table (Cst).Kind; 121 end Get_Const_Kind; 122 123 function Get_Global_Kind (Cst : O_Gnode) return OG_Kind is 124 begin 125 return Gnodes.Table (Cst).Kind; 126 end Get_Global_Kind; 127 128 function Get_Const_Type (Cst : O_Cnode) return O_Tnode is 129 begin 130 return Cnodes.Table (Cst).Lit_Type; 131 end Get_Const_Type; 132 133 function Get_Const_U64 (Cst : O_Cnode) return Unsigned_64 134 is 135 function To_Cnode_Unsigned is new Ada.Unchecked_Conversion 136 (Cnode_Common, Cnode_Unsigned); 137 begin 138 return To_Cnode_Unsigned (Cnodes.Table (Cst + 1)).Val; 139 end Get_Const_U64; 140 141 function Get_Const_I64 (Cst : O_Cnode) return Integer_64 142 is 143 function To_Cnode_Signed is new Ada.Unchecked_Conversion 144 (Cnode_Common, Cnode_Signed); 145 begin 146 return To_Cnode_Signed (Cnodes.Table (Cst + 1)).Val; 147 end Get_Const_I64; 148 149 function Get_Const_F64 (Cst : O_Cnode) return IEEE_Float_64 150 is 151 function To_Cnode_Float is new Ada.Unchecked_Conversion 152 (Cnode_Common, Cnode_Float); 153 begin 154 return To_Cnode_Float (Cnodes.Table (Cst + 1)).Val; 155 end Get_Const_F64; 156 157 function To_Cnode_Common is new Ada.Unchecked_Conversion 158 (Source => Cnode_Signed, Target => Cnode_Common); 159 160 function New_Signed_Literal (Ltype : O_Tnode; Value : Integer_64) 161 return O_Cnode 162 is 163 Res : O_Cnode; 164 begin 165 Cnodes.Append (Cnode_Common'(Kind => OC_Signed, 166 Lit_Type => Ltype)); 167 Res := Cnodes.Last; 168 Cnodes.Append (To_Cnode_Common (Cnode_Signed'(Val => Value))); 169 return Res; 170 end New_Signed_Literal; 171 172 function To_Cnode_Common is new Ada.Unchecked_Conversion 173 (Source => Unsigned_64, Target => Cnode_Common); 174 175 function New_Unsigned_Literal (Ltype : O_Tnode; Value : Unsigned_64) 176 return O_Cnode 177 is 178 Res : O_Cnode; 179 begin 180 Cnodes.Append (Cnode_Common'(Kind => OC_Unsigned, 181 Lit_Type => Ltype)); 182 Res := Cnodes.Last; 183 Cnodes.Append (To_Cnode_Common (Value)); 184 return Res; 185 end New_Unsigned_Literal; 186 187-- function Get_Const_Literal (Cst : O_Cnode) return Uns32 is 188-- begin 189-- return Cnodes.Table (Cst).Val; 190-- end Get_Const_Literal; 191 192 function To_Uns64 is new Ada.Unchecked_Conversion 193 (Source => Cnode_Common, Target => Uns64); 194 195 function Get_Const_U32 (Cst : O_Cnode) return Uns32 is 196 begin 197 return Uns32 (To_Uns64 (Cnodes.Table (Cst + 1))); 198 end Get_Const_U32; 199 200 function Get_Const_R64 (Cst : O_Cnode) return Uns64 is 201 begin 202 return To_Uns64 (Cnodes.Table (Cst + 1)); 203 end Get_Const_R64; 204 205 function Get_Const_Low (Cst : O_Cnode) return Uns32 206 is 207 V : Uns64; 208 begin 209 V := Get_Const_R64 (Cst); 210 return Uns32 (V and 16#Ffff_Ffff#); 211 end Get_Const_Low; 212 213 function Get_Const_High (Cst : O_Cnode) return Uns32 214 is 215 V : Uns64; 216 begin 217 V := Get_Const_R64 (Cst); 218 return Uns32 (Shift_Right (V, 32) and 16#Ffff_Ffff#); 219 end Get_Const_High; 220 221 function Get_Const_Low (Cst : O_Cnode) return Int32 222 is 223 V : Uns64; 224 begin 225 V := Get_Const_R64 (Cst); 226 return To_Int32 (Uns32 (V and 16#Ffff_Ffff#)); 227 end Get_Const_Low; 228 229 function Get_Const_High (Cst : O_Cnode) return Int32 230 is 231 V : Uns64; 232 begin 233 V := Get_Const_R64 (Cst); 234 return To_Int32 (Uns32 (Shift_Right (V, 32) and 16#Ffff_Ffff#)); 235 end Get_Const_High; 236 237 function New_Float_Literal (Ltype : O_Tnode; Value : IEEE_Float_64) 238 return O_Cnode 239 is 240 Res : O_Cnode; 241 242 function To_Cnode_Common is new Ada.Unchecked_Conversion 243 (Source => Cnode_Float, Target => Cnode_Common); 244 begin 245 Cnodes.Append (Cnode_Common'(Kind => OC_Float, 246 Lit_Type => Ltype)); 247 Res := Cnodes.Last; 248 Cnodes.Append (To_Cnode_Common (Cnode_Float'(Val => Value))); 249 return Res; 250 end New_Float_Literal; 251 252 function New_Null_Access (Ltype : O_Tnode) return O_Cnode is 253 begin 254 Cnodes.Append (Cnode_Common'(Kind => OC_Null, 255 Lit_Type => Ltype)); 256 return Cnodes.Last; 257 end New_Null_Access; 258 259 function New_Default_Value (Ltype : O_Tnode) return O_Cnode is 260 begin 261 Cnodes.Append (Cnode_Common'(Kind => OC_Zero, 262 Lit_Type => Ltype)); 263 return Cnodes.Last; 264 end New_Default_Value; 265 266 function To_Cnode_Common is new Ada.Unchecked_Conversion 267 (Source => Cnode_Global, Target => Cnode_Common); 268 269 function To_Cnode_Global is new Ada.Unchecked_Conversion 270 (Source => Cnode_Common, Target => Cnode_Global); 271 272 function New_Global_Unchecked_Address (Lvalue : O_Gnode; Atype : O_Tnode) 273 return O_Cnode 274 is 275 Res : O_Cnode; 276 begin 277 Cnodes.Append (Cnode_Common'(Kind => OC_Address, 278 Lit_Type => Atype)); 279 Res := Cnodes.Last; 280 Cnodes.Append (To_Cnode_Common (Cnode_Global'(Obj => Lvalue, 281 Pad => 0))); 282 return Res; 283 end New_Global_Unchecked_Address; 284 285 function New_Global_Address (Lvalue : O_Gnode; Atype : O_Tnode) 286 return O_Cnode 287 is 288 Res : O_Cnode; 289 begin 290 Cnodes.Append (Cnode_Common'(Kind => OC_Address, 291 Lit_Type => Atype)); 292 Res := Cnodes.Last; 293 Cnodes.Append (To_Cnode_Common (Cnode_Global'(Obj => Lvalue, 294 Pad => 0))); 295 return Res; 296 end New_Global_Address; 297 298 function Get_Const_Global (Cst : O_Cnode) return O_Gnode is 299 begin 300 pragma Assert (Get_Const_Kind (Cst) = OC_Address); 301 return To_Cnode_Global (Cnodes.Table (Cst + 1)).Obj; 302 end Get_Const_Global; 303 304 function To_Cnode_Common is new Ada.Unchecked_Conversion 305 (Source => Cnode_Addr, Target => Cnode_Common); 306 307 function To_Cnode_Addr is new Ada.Unchecked_Conversion 308 (Source => Cnode_Common, Target => Cnode_Addr); 309 310 function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode) 311 return O_Cnode 312 is 313 Res : O_Cnode; 314 begin 315 Cnodes.Append (Cnode_Common'(Kind => OC_Subprg_Address, 316 Lit_Type => Atype)); 317 Res := Cnodes.Last; 318 Cnodes.Append (To_Cnode_Common (Cnode_Addr'(Decl => Subprg, 319 Pad => 0))); 320 return Res; 321 end New_Subprogram_Address; 322 323 function Get_Const_Decl (Cst : O_Cnode) return O_Dnode is 324 begin 325 pragma Assert (Get_Const_Kind (Cst) = OC_Subprg_Address); 326 return To_Cnode_Addr (Cnodes.Table (Cst + 1)).Decl; 327 end Get_Const_Decl; 328 329 function To_Cnode_Common is new Ada.Unchecked_Conversion 330 (Source => Cnode_Enum, Target => Cnode_Common); 331 332 function To_Cnode_Enum is new Ada.Unchecked_Conversion 333 (Source => Cnode_Common, Target => Cnode_Enum); 334 335 --function Get_Named_Literal_Id (Lit : O_Cnode) return O_Ident is 336 --begin 337 -- return To_Cnode_Enum (Cnodes.Table (Lit + 1)).Id; 338 --end Get_Named_Literal_Id; 339 340 function New_Named_Literal 341 (Atype : O_Tnode; Id : O_Ident; Val : Uns32; Prev : O_Cnode) 342 return O_Cnode 343 is 344 Res : O_Cnode; 345 begin 346 Cnodes.Append (Cnode_Common'(Kind => OC_Lit, 347 Lit_Type => Atype)); 348 Res := Cnodes.Last; 349 Cnodes.Append (To_Cnode_Common (Cnode_Enum'(Id => Id, 350 Val => Val))); 351 if Prev /= O_Cnode_Null then 352 if Prev + 2 /= Res then 353 raise Syntax_Error; 354 end if; 355 end if; 356 return Res; 357 end New_Named_Literal; 358 359 function Get_Lit_Ident (L : O_Cnode) return O_Ident is 360 begin 361 return To_Cnode_Enum (Cnodes.Table (L + 1)).Id; 362 end Get_Lit_Ident; 363 364 function Get_Lit_Value (L : O_Cnode) return Uns32 is 365 begin 366 return To_Cnode_Enum (Cnodes.Table (L + 1)).Val; 367 end Get_Lit_Value; 368 369 function Get_Lit_Chain (L : O_Cnode) return O_Cnode is 370 begin 371 return L + 2; 372 end Get_Lit_Chain; 373 374 package Els is new Tables 375 (Table_Component_Type => O_Cnode, 376 Table_Index_Type => Int32, 377 Table_Low_Bound => 2, 378 Table_Initial => 128); 379 380 function To_Cnode_Common is new Ada.Unchecked_Conversion 381 (Source => Cnode_Aggr, Target => Cnode_Common); 382 383 function To_Cnode_Aggr is new Ada.Unchecked_Conversion 384 (Source => Cnode_Common, Target => Cnode_Aggr); 385 386 387 procedure Start_Record_Aggr (List : out O_Record_Aggr_List; 388 Atype : O_Tnode) 389 is 390 Val : Int32; 391 Num : Uns32; 392 begin 393 Num := Get_Type_Record_Nbr_Fields (Atype); 394 Val := Els.Allocate (Integer (Num)); 395 396 Cnodes.Append (Cnode_Common'(Kind => OC_Record, 397 Lit_Type => Atype)); 398 List := (Res => Cnodes.Last, 399 Rec_Field => Get_Type_Record_Fields (Atype), 400 El => Val); 401 Cnodes.Append (To_Cnode_Common (Cnode_Aggr'(Els => Val, 402 Nbr => Int32 (Num)))); 403 end Start_Record_Aggr; 404 405 406 procedure New_Record_Aggr_El (List : in out O_Record_Aggr_List; 407 Value : O_Cnode) 408 is 409 begin 410 Els.Table (List.El) := Value; 411 List.El := List.El + 1; 412 end New_Record_Aggr_El; 413 414 procedure Finish_Record_Aggr (List : in out O_Record_Aggr_List; 415 Res : out O_Cnode) is 416 begin 417 Res := List.Res; 418 end Finish_Record_Aggr; 419 420 421 procedure Start_Array_Aggr 422 (List : out O_Array_Aggr_List; Arr_Type : O_Tnode; Len : Unsigned_32) 423 is 424 Val : Int32; 425 begin 426 case Get_Type_Kind (Arr_Type) is 427 when OT_Subarray => 428 pragma Assert (Uns32 (Len) = Get_Type_Subarray_Length (Arr_Type)); 429 when OT_Ucarray => 430 null; 431 when others => 432 -- The type of an array aggregate must be an array type. 433 raise Syntax_Error; 434 end case; 435 Val := Els.Allocate (Integer (Len)); 436 437 Cnodes.Append (Cnode_Common'(Kind => OC_Array, 438 Lit_Type => Arr_Type)); 439 List := (Res => Cnodes.Last, 440 El => Val, 441 Len => Uns32 (Len)); 442 Cnodes.Append (To_Cnode_Common (Cnode_Aggr'(Els => Val, 443 Nbr => Int32 (Len)))); 444 end Start_Array_Aggr; 445 446 procedure New_Array_Aggr_El (List : in out O_Array_Aggr_List; 447 Value : O_Cnode) is 448 begin 449 pragma Assert (List.Len > 0); 450 List.Len := List.Len - 1; 451 Els.Table (List.El) := Value; 452 List.El := List.El + 1; 453 end New_Array_Aggr_El; 454 455 procedure Finish_Array_Aggr (List : in out O_Array_Aggr_List; 456 Res : out O_Cnode) is 457 begin 458 pragma Assert (List.Len = 0); 459 Res := List.Res; 460 end Finish_Array_Aggr; 461 462 function Get_Const_Aggr_Length (Cst : O_Cnode) return Int32 is 463 begin 464 return To_Cnode_Aggr (Cnodes.Table (Cst + 1)).Nbr; 465 end Get_Const_Aggr_Length; 466 467 function Get_Const_Aggr_Element (Cst : O_Cnode; N : Int32) return O_Cnode 468 is 469 El : Int32; 470 begin 471 El := To_Cnode_Aggr (Cnodes.Table (Cst + 1)).Els; 472 return Els.Table (El + N); 473 end Get_Const_Aggr_Element; 474 475 function New_Union_Aggr (Atype : O_Tnode; Field : O_Fnode; Value : O_Cnode) 476 return O_Cnode 477 is 478 function To_Cnode_Common is new Ada.Unchecked_Conversion 479 (Source => Cnode_Union, Target => Cnode_Common); 480 481 Res : O_Cnode; 482 begin 483 if Debug.Flag_Debug_Hli then 484 Cnodes.Append (Cnode_Common'(Kind => OC_Union, 485 Lit_Type => Atype)); 486 Res := Cnodes.Last; 487 Cnodes.Append (To_Cnode_Common (Cnode_Union'(El => Value, 488 Field => Field))); 489 return Res; 490 else 491 return Value; 492 end if; 493 end New_Union_Aggr; 494 495 function To_Cnode_Union is new Ada.Unchecked_Conversion 496 (Source => Cnode_Common, Target => Cnode_Union); 497 498 function Get_Const_Union_Field (Cst : O_Cnode) return O_Fnode is 499 begin 500 return To_Cnode_Union (Cnodes.Table (Cst + 1)).Field; 501 end Get_Const_Union_Field; 502 503 function Get_Const_Union_Value (Cst : O_Cnode) return O_Cnode is 504 begin 505 return To_Cnode_Union (Cnodes.Table (Cst + 1)).El; 506 end Get_Const_Union_Value; 507 508 function To_Cnode_Common is new Ada.Unchecked_Conversion 509 (Source => Cnode_Sizeof, Target => Cnode_Common); 510 511 function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode 512 is 513 Res : O_Cnode; 514 begin 515 if Debug.Flag_Debug_Hli then 516 Cnodes.Append (Cnode_Common'(Kind => OC_Sizeof, 517 Lit_Type => Rtype)); 518 Res := Cnodes.Last; 519 Cnodes.Append (To_Cnode_Common (Cnode_Sizeof'(Atype => Atype, 520 Pad => 0))); 521 return Res; 522 else 523 return New_Unsigned_Literal 524 (Rtype, Unsigned_64 (Get_Type_Size (Atype))); 525 end if; 526 end New_Sizeof; 527 528 function New_Record_Sizeof 529 (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode 530 is 531 Res : O_Cnode; 532 begin 533 if Debug.Flag_Debug_Hli then 534 Cnodes.Append (Cnode_Common'(Kind => OC_Record_Sizeof, 535 Lit_Type => Rtype)); 536 Res := Cnodes.Last; 537 Cnodes.Append (To_Cnode_Common (Cnode_Sizeof'(Atype => Atype, 538 Pad => 0))); 539 return Res; 540 else 541 return New_Unsigned_Literal 542 (Rtype, Unsigned_64 (Get_Type_Record_Size (Atype))); 543 end if; 544 end New_Record_Sizeof; 545 546 function Get_Sizeof_Type (Cst : O_Cnode) return O_Tnode 547 is 548 function To_Cnode_Sizeof is new Ada.Unchecked_Conversion 549 (Cnode_Common, Cnode_Sizeof); 550 begin 551 return To_Cnode_Sizeof (Cnodes.Table (Cst + 1)).Atype; 552 end Get_Sizeof_Type; 553 554 function New_Alignof (Atype : O_Tnode; Rtype : O_Tnode) return O_Cnode 555 is 556 function To_Cnode_Common is new Ada.Unchecked_Conversion 557 (Source => Cnode_Sizeof, Target => Cnode_Common); 558 559 Res : O_Cnode; 560 begin 561 if Debug.Flag_Debug_Hli then 562 Cnodes.Append (Cnode_Common'(Kind => OC_Alignof, 563 Lit_Type => Rtype)); 564 Res := Cnodes.Last; 565 Cnodes.Append (To_Cnode_Common (Cnode_Sizeof'(Atype => Atype, 566 Pad => 0))); 567 return Res; 568 else 569 return New_Unsigned_Literal 570 (Rtype, Unsigned_64 (Get_Type_Align_Bytes (Atype))); 571 end if; 572 end New_Alignof; 573 574 function Get_Alignof_Type (Cst : O_Cnode) return O_Tnode 575 is 576 function To_Cnode_Sizeof is new Ada.Unchecked_Conversion 577 (Cnode_Common, Cnode_Sizeof); 578 begin 579 return To_Cnode_Sizeof (Cnodes.Table (Cst + 1)).Atype; 580 end Get_Alignof_Type; 581 582 function New_Offsetof (Rec_Type : O_Tnode; Field : O_Fnode; Rtype : O_Tnode) 583 return O_Cnode is 584 begin 585 if Get_Field_Parent (Field) /= Rec_Type then 586 raise Syntax_Error; 587 end if; 588 return New_Unsigned_Literal 589 (Rtype, Unsigned_64 (Get_Field_Offset (Field))); 590 end New_Offsetof; 591 592 function Get_Global_Decl (Global : O_Gnode) return O_Dnode is 593 begin 594 pragma Assert (Get_Global_Kind (Global) = OG_Decl); 595 return O_Dnode (Gnodes.Table (Global).Ref); 596 end Get_Global_Decl; 597 598 function Get_Global_Field (Global : O_Gnode) return O_Fnode is 599 begin 600 pragma Assert (Get_Global_Kind (Global) = OG_Record_Ref); 601 return To_Gnode_Record_Ref (Gnodes.Table (Global + 1)).Field; 602 end Get_Global_Field; 603 604 function Get_Global_Ref (Global : O_Gnode) return O_Gnode is 605 begin 606 pragma Assert (Get_Global_Kind (Global) = OG_Record_Ref); 607 return O_Gnode (Gnodes.Table (Global).Ref); 608 end Get_Global_Ref; 609 610 function Get_Global_Type (Global : O_Gnode) return O_Tnode is 611 begin 612 case Get_Global_Kind (Global) is 613 when OG_Decl => 614 return Decls.Get_Decl_Type (Get_Global_Decl (Global)); 615 when OG_Record_Ref => 616 return Get_Field_Type (Get_Global_Field (Global)); 617 end case; 618 end Get_Global_Type; 619 620 function New_Global (Decl : O_Dnode) return O_Gnode is 621 begin 622 Gnodes.Append (Gnode_Common'(Kind => OG_Decl, 623 Ref => Int32 (Decl))); 624 return Gnodes.Last; 625 end New_Global; 626 627 function New_Global_Selected_Element (Rec : O_Gnode; El : O_Fnode) 628 return O_Gnode 629 is 630 Res : O_Gnode; 631 begin 632 -- TODO: Check Ref. 633 634 -- Check type. 635 pragma Assert 636 (Get_Type_Kind (Get_Global_Type (Rec)) in OT_Kinds_Record_Union); 637 638 Gnodes.Append (Gnode_Common'(Kind => OG_Record_Ref, 639 Ref => Int32 (Rec))); 640 Res := Gnodes.Last; 641 Gnodes.Append (To_Gnode_Common 642 (Gnode_Record_Ref'(Field => El, 643 Off => Get_Field_Offset (El)))); 644 return Res; 645 end New_Global_Selected_Element; 646 647 procedure Get_Global_Decl_Offset (Global : O_Gnode; 648 Decl : out O_Dnode; Off : out Uns32) is 649 begin 650 case Get_Global_Kind (Global) is 651 when OG_Decl => 652 Decl := Get_Global_Decl (Global); 653 Off := 0; 654 when OG_Record_Ref => 655 Get_Global_Decl_Offset (Get_Global_Ref (Global), Decl, Off); 656 Off := Off + Get_Field_Offset (Get_Global_Field (Global)); 657 end case; 658 end Get_Global_Decl_Offset; 659 660 procedure Get_Const_Bytes (Cst : O_Cnode; H, L : out Uns32) is 661 begin 662 case Get_Const_Kind (Cst) is 663 when OC_Signed 664 | OC_Unsigned 665 | OC_Float => 666 H := Get_Const_High (Cst); 667 L := Get_Const_Low (Cst); 668 when OC_Null => 669 H := 0; 670 L := 0; 671 when OC_Lit => 672 H := 0; 673 L := To_Cnode_Enum (Cnodes.Table (Cst + 1)).Val; 674 when OC_Array 675 | OC_Record 676 | OC_Union 677 | OC_Sizeof 678 | OC_Record_Sizeof 679 | OC_Alignof 680 | OC_Address 681 | OC_Subprg_Address 682 | OC_Zero => 683 raise Syntax_Error; 684 end case; 685 end Get_Const_Bytes; 686 687 function Get_Const_Size (Cst : O_Cnode) return Uns32 688 is 689 T : constant O_Tnode := Get_Const_Type (Cst); 690 begin 691 case Get_Type_Kind (T) is 692 when OT_Ucarray => 693 declare 694 Len : constant Int32 := Get_Const_Aggr_Length (Cst); 695 El_Sz : Uns32; 696 begin 697 if Len = 0 then 698 return 0; 699 end if; 700 El_Sz := Get_Const_Size (Get_Const_Aggr_Element (Cst, 0)); 701 return Uns32 (Len) * El_Sz; 702 end; 703 when others => 704 return Get_Type_Size (T); 705 end case; 706 end Get_Const_Size; 707 708 procedure Mark (M : out Mark_Type) is 709 begin 710 M.Cnode := Cnodes.Last; 711 M.Els := Els.Last; 712 end Mark; 713 714 procedure Release (M : Mark_Type) is 715 begin 716 Cnodes.Set_Last (M.Cnode); 717 Els.Set_Last (M.Els); 718 end Release; 719 720 procedure Disp_Stats 721 is 722 use Ada.Text_IO; 723 begin 724 Put_Line ("Number of Cnodes: " & O_Cnode'Image (Cnodes.Last)); 725 Put_Line ("Number of Cnodes-Els: " & Int32'Image (Els.Last)); 726 end Disp_Stats; 727 728 procedure Finish is 729 begin 730 Cnodes.Free; 731 Els.Free; 732 end Finish; 733end Ortho_Code.Consts; 734