1-- Mcode back-end for ortho - Expressions and control 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 Ortho_Code.Abi; 17 18package Ortho_Code.Exprs is 19 type OE_Kind is 20 ( 21 OE_Nil, 22 23 -- Dyadic operations. 24 -- ARG1 is left, ARG2 is right. 25 OE_Add_Ov, 26 OE_Sub_Ov, 27 OE_Mul_Ov, 28 OE_Div_Ov, 29 OE_Rem, 30 OE_Mod, 31 32 OE_And, 33 OE_Or, 34 OE_Xor, 35 36 -- Monadic operations. 37 -- ARG1 is expression. 38 OE_Not, 39 OE_Neg_Ov, 40 OE_Abs_Ov, 41 42 -- Comparaison. 43 -- ARG1 is left, ARG2 is right. 44 OE_Eq, 45 OE_Neq, 46 OE_Le, 47 OE_Lt, 48 OE_Ge, 49 OE_Gt, 50 51 -- Without checks, for addresses. 52 OE_Add, 53 OE_Mul, 54 OE_Shl, -- Left shift 55 56 -- A literal. 57 -- ARG1 is low part, ARG2 is high part. 58 OE_Const, 59 60 -- Address of a local variable/parameter. 61 -- ARG1 is object. 62 -- ARG2 is the frame pointer or O_Enode_Null for current frame pointer. 63 OE_Addrl, 64 -- Address of a declaration. 65 -- ARG1 is the declaration. 66 OE_Addrd, 67 68 -- Pointer dereference. 69 -- ARG1 is operand. 70 OE_Indir, 71 72 -- Conversion. 73 -- ARG1 is expression. 74 -- ARG2: type 75 OE_Conv_Ptr, 76 OE_Conv_Ov, 77 OE_Conv, 78 79 -- Typed expression. 80 OE_Typed, 81 82 -- Local memory allocation. 83 -- ARG1 is size (in bytes). 84 OE_Alloca, 85 86 -- Statements. 87 88 -- Subrogram entry. 89 -- ARG1 is the corresponding Leave (used to skip inner subprograms). 90 -- ARG2 is unused. 91 OE_Entry, 92 -- Subprogram exit. 93 -- ARG1 and ARG2 are unused. 94 OE_Leave, 95 96 -- Declaration blocks. 97 -- ARG1: parent 98 -- ARG2: corresponding declarations. 99 OE_Beg, 100 -- ARG1: corresponding beg 101 -- ARG2: unsused. 102 OE_End, 103 104 -- Assignment. 105 -- ARG1 is value, ARG2 is target (address). 106 OE_Asgn, 107 108 -- Subprogram calls. 109 -- ARG1 is value 110 -- ARG2 is link to the next argument. 111 OE_Arg, 112 -- ARG1 is subprogram 113 -- ARG2 is arguments. 114 OE_Call, 115 -- ARG1 is intrinsic operation. 116 OE_Intrinsic, 117 118 -- Modify the stack pointer value, to align the stack before pushing 119 -- arguments, or to free the stack. 120 -- ARG1 is the signed offset. 121 OE_Stack_Adjust, 122 123 -- Return ARG1 (if not mode_nil) from current subprogram. 124 -- ARG1: expression. 125 OE_Ret, 126 127 -- Line number (for debugging). 128 -- ARG1: line number 129 OE_Line, 130 131 -- High level instructions. 132 133 -- Basic block. 134 -- ARG1: next BB 135 -- ARG2: number 136 OE_BB, 137 138 -- ARG1 is the literal. 139 OE_Lit, 140 -- ARG1: value 141 -- ARG2: first branch (HLI only). 142 OE_Case, 143 -- ARG1: the corresponding OE_Case 144 OE_Case_Expr, 145 -- ARG1: left bound 146 -- ARG2: right bound 147 -- LINK: choice link 148 OE_Case_Choice, 149 -- ARG1: choice link 150 -- ARG2: next branch 151 OE_Case_Branch, 152 -- End of case. 153 OE_Case_End, 154 155 -- ARG1: the condition 156 -- ARG2: the else/endif 157 OE_If, 158 OE_Else, 159 OE_Endif, 160 161 -- ARG1: loop level. 162 OE_Loop, 163 -- ARG1: loop. 164 OE_Eloop, 165 -- ARG2: loop. 166 OE_Next, 167 OE_Exit, 168 169 -- ARG1: the record 170 -- ARG2: the field 171 OE_Record_Ref, 172 173 -- ARG1: the expression. 174 OE_Access_Ref, 175 176 -- ARG1: the array 177 -- ARG2: the index 178 OE_Index_Ref, 179 OE_Slice_Ref, 180 181 -- Low level instructions. 182 183 -- Label. 184 -- ARG1: current block (used for alloca), only during tree building. 185 -- ARG2: user info (generally used to store symbol). 186 OE_Label, 187 188 -- Jump to ARG2. 189 OE_Jump, 190 191 -- Jump to ARG2 if ARG1 is true/false. 192 OE_Jump_T, 193 OE_Jump_F, 194 195 -- Used internally only. 196 -- ARG2 is info/target, ARG1 is expression (if any). 197 OE_Spill, 198 OE_Reload, 199 OE_Move, 200 201 -- Alloca/allocb handling. 202 OE_Get_Stack, 203 OE_Set_Stack, 204 205 -- Get current frame pointer. 206 OE_Get_Frame, 207 208 -- Additionnal reg 209 OE_Reg 210 ); 211 for OE_Kind'Size use 8; 212 213 subtype OE_Kind_Dyadic is OE_Kind range OE_Add_Ov .. OE_Xor; 214 subtype OE_Kind_Cmp is OE_Kind range OE_Eq .. OE_Gt; 215 216 -- BE representation of an instruction. 217 type O_Insn is mod 256; 218 219 type Subprogram_Data; 220 type Subprogram_Data_Acc is access Subprogram_Data; 221 222 type Subprogram_Data is record 223 -- Parent or null if top-level subprogram. 224 Parent : Subprogram_Data_Acc; 225 226 -- Block in which this subprogram is declared, or o_dnode_null if 227 -- top-level subprogram. 228 --Parent_Block : O_Dnode; 229 230 -- First and last child, or null if no children. 231 First_Child : Subprogram_Data_Acc; 232 Last_Child : Subprogram_Data_Acc; 233 234 -- Next subprogram at the same depth level. 235 Brother : Subprogram_Data_Acc; 236 237 -- Depth of the subprogram. 238 Depth : O_Depth; 239 240 -- Dnode for the declaration. 241 D_Decl : O_Dnode; 242 243 -- Enode for the Entry. 244 E_Entry : O_Enode; 245 246 -- Dnode for the Body. 247 D_Body : O_Dnode; 248 249 -- Label just before leave. 250 Exit_Label : O_Enode; 251 252 -- Last statement of this subprogram. 253 Last_Stmt : O_Enode; 254 255 -- Static maximum stack use. 256 Stack_Max : Uns32; 257 258 -- Target specific data. 259 Target : Abi.Target_Subprg; 260 end record; 261 262 -- Data for the current subprogram. 263 Cur_Subprg : Subprogram_Data_Acc := null; 264 265 -- First and last (top-level) subprogram. 266 First_Subprg : Subprogram_Data_Acc := null; 267 Last_Subprg : Subprogram_Data_Acc := null; 268 269 -- Type of the stack pointer - for OE_Get_Stack and OE_Set_Stack. 270 -- Can be set by back-ends. 271 Stack_Ptr_Type : O_Tnode := O_Tnode_Null; 272 273 -- Create a new node. 274 -- Should be used only by back-end to add internal nodes. 275 function New_Enode (Kind : OE_Kind; 276 Mode : Mode_Type; 277 Rtype : O_Tnode; 278 Arg1 : O_Enode; 279 Arg2 : O_Enode) return O_Enode; 280 281 -- Get the kind of ENODE. 282 function Get_Expr_Kind (Enode : O_Enode) return OE_Kind; 283 pragma Inline (Get_Expr_Kind); 284 285 -- Get the mode of ENODE. 286 function Get_Expr_Mode (Enode : O_Enode) return Mode_Type; 287 pragma Inline (Get_Expr_Mode); 288 289 -- Get/Set the register of ENODE. 290 function Get_Expr_Reg (Enode : O_Enode) return O_Reg; 291 procedure Set_Expr_Reg (Enode : O_Enode; Reg : O_Reg); 292 pragma Inline (Get_Expr_Reg); 293 pragma Inline (Set_Expr_Reg); 294 295 -- Get the operand of an unary expression. 296 function Get_Expr_Operand (Enode : O_Enode) return O_Enode; 297 procedure Set_Expr_Operand (Enode : O_Enode; Val : O_Enode); 298 299 -- Get left/right operand of a binary expression. 300 function Get_Expr_Left (Enode : O_Enode) return O_Enode; 301 function Get_Expr_Right (Enode : O_Enode) return O_Enode; 302 procedure Set_Expr_Left (Enode : O_Enode; Val : O_Enode); 303 procedure Set_Expr_Right (Enode : O_Enode; Val : O_Enode); 304 305 -- Get the low and high part of an OE_CONST node. 306 function Get_Expr_Low (Cst : O_Enode) return Uns32; 307 function Get_Expr_High (Cst : O_Enode) return Uns32; 308 309 -- Help for OE_CONST: return True iff the value is a signed 32 bit value. 310 function Is_Expr_S32 (Cst : O_Enode) return Boolean; 311 312 -- Get target of the assignment. 313 function Get_Assign_Target (Enode : O_Enode) return O_Enode; 314 procedure Set_Assign_Target (Enode : O_Enode; Targ : O_Enode); 315 316 -- For OE_Lit: get the literal. 317 function Get_Expr_Lit (Lit : O_Enode) return O_Cnode; 318 319 -- Type of a OE_Conv/OE_Nop/OE_Typed/OE_Alloca 320 -- Used only for display/debugging purposes. 321 function Get_Conv_Type (Enode : O_Enode) return O_Tnode; 322 323 -- Leave node corresponding to the entry. 324 function Get_Entry_Leave (Enode : O_Enode) return O_Enode; 325 326 -- Get the label of a jump/ret 327 function Get_Jump_Label (Enode : O_Enode) return O_Enode; 328 procedure Set_Jump_Label (Enode : O_Enode; Label : O_Enode); 329 330 -- Get the declaration of addrl,addrp,addrs 331 function Get_Addr_Decl (Enode : O_Enode) return O_Dnode; 332 333 -- Get the object of addrg 334 function Get_Addr_Object (Enode : O_Enode) return O_Lnode; 335 336 -- Get the computed frame for the object. 337 -- If O_Enode_Null, then use current frame. 338 function Get_Addrl_Frame (Enode : O_Enode) return O_Enode; 339 procedure Set_Addrl_Frame (Enode : O_Enode; Frame : O_Enode); 340 341 -- Return the stack adjustment. For positive values, this is the amount of 342 -- bytes to allocate on the stack before pushing arguments, so that the 343 -- stack pointer stays aligned. For negtive values, this is the amount of 344 -- bytes to release on the stack. 345 function Get_Stack_Adjust (Enode : O_Enode) return Int32; 346 procedure Set_Stack_Adjust (Enode : O_Enode; Off : Int32); 347 348 -- Get the subprogram called by ENODE. 349 function Get_Call_Subprg (Enode : O_Enode) return O_Dnode; 350 351 -- Get the first argument of a call, or the next argument of an arg. 352 function Get_Arg_Link (Enode : O_Enode) return O_Enode; 353 354 -- Get the declaration chain of a Beg statement. 355 function Get_Block_Decls (Blk : O_Enode) return O_Dnode; 356 357 -- Get the parent of the block. 358 function Get_Block_Parent (Blk : O_Enode) return O_Enode; 359 360 -- Get the corresponding beg. 361 function Get_End_Beg (Blk : O_Enode) return O_Enode; 362 363 -- True if the block contains an alloca insn. 364 function Get_Block_Has_Alloca (Blk : O_Enode) return Boolean; 365 366 -- Set the next branch of a case/case_branch. 367 procedure Set_Case_Branch (C : O_Enode; Branch : O_Enode); 368 369 -- Set the first choice of a case branch. 370 procedure Set_Case_Branch_Choice (Branch : O_Enode; Choice : O_Enode); 371 function Get_Case_Branch_Choice (Branch : O_Enode) return O_Enode; 372 373 -- Set the choice link of a case choice. 374 procedure Set_Case_Choice_Link (Choice : O_Enode; N_Choice : O_Enode); 375 function Get_Case_Choice_Link (Choice : O_Enode) return O_Enode; 376 377 -- Get/Set the max stack size for the end block BLKE. 378 --function Get_Block_Max_Stack (Blke : O_Enode) return Int32; 379 --procedure Set_Block_Max_Stack (Blke : O_Enode; Max : Int32); 380 381 -- Get the field of an o_record_ref node. 382 function Get_Ref_Field (Ref : O_Enode) return O_Fnode; 383 384 -- Get the index of an OE_Index_Ref or OE_Slice_Ref node. 385 function Get_Ref_Index (Ref : O_Enode) return O_Enode; 386 387 -- Get/Set the info field of a label. 388 function Get_Label_Info (Label : O_Enode) return Int32; 389 procedure Set_Label_Info (Label : O_Enode; Info : Int32); 390 391 -- Get the info of a spill. 392 function Get_Spill_Info (Spill : O_Enode) return Int32; 393 procedure Set_Spill_Info (Spill : O_Enode; Info : Int32); 394 395 -- Get the statement link. 396 function Get_Stmt_Link (Stmt : O_Enode) return O_Enode; 397 procedure Set_Stmt_Link (Stmt : O_Enode; Next : O_Enode); 398 399 -- Get the line number of an OE_Line statement. 400 function Get_Expr_Line_Number (Stmt : O_Enode) return Int32; 401 402 -- Get the operation of an intrinsic. 403 function Get_Intrinsic_Operation (Stmt : O_Enode) return Int32; 404 405 -- Get the basic block label (uniq number). 406 function Get_BB_Number (Stmt : O_Enode) return Int32; 407 408 -- For OE_Loop, set loop level (an integer). 409 -- Reserved for back-end in HLI mode only. 410 function Get_Loop_Level (Stmt : O_Enode) return Int32; 411 procedure Set_Loop_Level (Stmt : O_Enode; Level : Int32); 412 413 -- Start a subprogram body. 414 -- Note: the declaration may have an external storage, in this case it 415 -- becomes public. 416 procedure Start_Subprogram_Body (Func : O_Dnode); 417 418 -- Finish a subprogram body. 419 procedure Finish_Subprogram_Body; 420 421 -- Translate a scalar literal into an expression. 422 function New_Lit (Lit : O_Cnode) return O_Enode; 423 424 -- Translate an object (var, const or interface) into an lvalue. 425 function New_Obj (Obj : O_Dnode) return O_Lnode; 426 427 -- Create a dyadic operation. 428 -- Left and right nodes must have the same type. 429 -- Binary operation is allowed only on boolean types. 430 -- The result is of the type of the operands. 431 function New_Dyadic_Op (Kind : ON_Dyadic_Op_Kind; Left, Right : O_Enode) 432 return O_Enode; 433 434 -- Create a monadic operation. 435 -- Result is of the type of operand. 436 function New_Monadic_Op (Kind : ON_Monadic_Op_Kind; Operand : O_Enode) 437 return O_Enode; 438 439 -- Create a comparaison operator. 440 -- NTYPE is the type of the result and must be a boolean type. 441 function New_Compare_Op 442 (Kind : ON_Compare_Op_Kind; Left, Right : O_Enode; Ntype : O_Tnode) 443 return O_Enode; 444 445 -- Returns the size in bytes of ATYPE. The result is a literal of 446 -- unsigned type RTYPE 447 -- ATYPE cannot be an unconstrained array type. 448 function New_Sizeof (Atype : O_Tnode; Rtype : O_Tnode) return O_Enode; 449 450 -- Returns the offset of FIELD in its record. The result is a literal 451 -- of unsigned type RTYPE. 452 function New_Offsetof (Field : O_Fnode; Rtype : O_Tnode) return O_Enode; 453 454 -- Get an element of an array. 455 -- INDEX must be of the type of the array index. 456 function New_Indexed_Element (Arr : O_Lnode; Index : O_Enode) 457 return O_Lnode; 458 459 -- Get a slice of an array; this is equivalent to a conversion between 460 -- an array or an array subtype and an array subtype. 461 -- RES_TYPE must be an array_sub_type whose base type is the same as the 462 -- base type of ARR. 463 -- INDEX must be of the type of the array index. 464 function New_Slice (Arr : O_Lnode; Res_Type : O_Tnode; Index : O_Enode) 465 return O_Lnode; 466 467 -- Get an element of a record. 468 -- Type of REC must be a record type. 469 function New_Selected_Element (Rec : O_Lnode; El : O_Fnode) 470 return O_Lnode; 471 472 -- Reference an access. 473 -- Type of ACC must be an access type. 474 function New_Access_Element (Acc : O_Enode) return O_Lnode; 475 476 -- Do a conversion. 477 -- Allowed conversions are: 478 -- FIXME: to write. 479 function New_Convert_Ov (Val : O_Enode; Rtype : O_Tnode) return O_Enode; 480 function New_Convert (Val : O_Enode; Rtype : O_Tnode) return O_Enode; 481 482 -- Get the address of LVALUE. 483 -- ATYPE must be a type access whose designated type is the type of LVALUE. 484 -- FIXME: what about arrays. 485 function New_Address (Lvalue : O_Lnode; Atype : O_Tnode) return O_Enode; 486 487 -- Same as New_Address but without any restriction. 488 function New_Unchecked_Address (Lvalue : O_Lnode; Atype : O_Tnode) 489 return O_Enode; 490 491 -- Get the address of a subprogram. 492 function New_Subprogram_Address (Subprg : O_Dnode; Atype : O_Tnode) 493 return O_Enode; 494 495 -- Get the value of an Lvalue. 496 function New_Value (Lvalue : O_Lnode) return O_Enode; 497 498 -- Return a pointer of type RTPE to SIZE bytes allocated on the stack. 499 function New_Alloca (Rtype : O_Tnode; Size : O_Enode) return O_Enode; 500 501 type O_Assoc_List is limited private; 502 503 -- Create a function call or a procedure call. 504 procedure Start_Association (Assocs : out O_Assoc_List; Subprg : O_Dnode); 505 procedure New_Association (Assocs : in out O_Assoc_List; Val : O_Enode); 506 function New_Function_Call (Assocs : O_Assoc_List) return O_Enode; 507 procedure New_Procedure_Call (Assocs : in out O_Assoc_List); 508 509 -- Assign VALUE to TARGET, type must be the same or compatible. 510 -- FIXME: what about slice assignment? 511 procedure New_Assign_Stmt (Target : O_Lnode; Value : O_Enode); 512 513 -- Exit from the subprogram and return VALUE. 514 procedure New_Return_Stmt (Value : O_Enode); 515 -- Exit from the subprogram, which doesn't return value. 516 procedure New_Return_Stmt; 517 518 type O_If_Block is limited private; 519 520 -- Build an IF statement. 521 procedure Start_If_Stmt (Block : out O_If_Block; Cond : O_Enode); 522 procedure New_Else_Stmt (Block : in out O_If_Block); 523 procedure Finish_If_Stmt (Block : in out O_If_Block); 524 525 type O_Snode is private; 526 O_Snode_Null : constant O_Snode; 527 528 -- Create a infinite loop statement. 529 procedure Start_Loop_Stmt (Label : out O_Snode); 530 procedure Finish_Loop_Stmt (Label : in out O_Snode); 531 532 -- Exit from a loop stmt or from a for stmt. 533 procedure New_Exit_Stmt (L : O_Snode); 534 -- Go to the start of a loop stmt or of a for stmt. 535 -- Loops/Fors between L and the current points are exited. 536 procedure New_Next_Stmt (L : O_Snode); 537 538 -- Case statement. 539 -- VALUE is the selector and must be a discrete type. 540 type O_Case_Block is limited private; 541 procedure Start_Case_Stmt (Block : out O_Case_Block; Value : O_Enode); 542 procedure Start_Choice (Block : in out O_Case_Block); 543 procedure New_Expr_Choice (Block : in out O_Case_Block; Expr : O_Cnode); 544 procedure New_Range_Choice (Block : in out O_Case_Block; 545 Low, High : O_Cnode); 546 procedure New_Default_Choice (Block : in out O_Case_Block); 547 procedure Finish_Choice (Block : in out O_Case_Block); 548 procedure Finish_Case_Stmt (Block : in out O_Case_Block); 549 550 procedure Start_Declare_Stmt; 551 procedure Finish_Declare_Stmt; 552 553 procedure New_Debug_Line_Stmt (Line : Natural); 554 555 procedure Disp_Subprg_Body (Indent : Natural; Subprg : O_Enode); 556 procedure Disp_All_Enode; 557 procedure Disp_Stats; 558 559 type Mark_Type is limited private; 560 procedure Mark (M : out Mark_Type); 561 procedure Release (M : Mark_Type); 562 563 procedure Finish; 564private 565 type O_Assoc_List is record 566 -- Subprogram being called. 567 Subprg : O_Dnode; 568 -- First and last argument statement. 569 First_Arg : O_Enode; 570 Last_Arg : O_Enode; 571 -- Interface for the next association. 572 Next_Inter : O_Dnode; 573 end record; 574 575 type O_Case_Block is record 576 -- Expression for the selection. 577 Expr : O_Enode; 578 579 -- Type of expression. 580 -- Used to perform checks. 581 Expr_Type : O_Tnode; 582 583 -- Choice code and branch code is not mixed (anymore). 584 -- Therefore, code to perform choices is inserted. 585 -- Last node of the choice code. 586 Last_Node : O_Enode; 587 588 -- Label at the end of the case statement. 589 -- used to jump from the end of a branch to the end of the statement. 590 Label_End : O_Enode; 591 592 -- Label of the branch code. 593 Label_Branch : O_Enode; 594 end record; 595 596 type O_If_Block is record 597 Label_End : O_Enode; 598 Label_Next : O_Enode; 599 end record; 600 601 type O_Snode is record 602 Label_Start : O_Enode; 603 Label_End : O_Enode; 604 end record; 605 O_Snode_Null : constant O_Snode := (Label_Start => O_Enode_Null, 606 Label_End => O_Enode_Null); 607 608 type Mark_Type is record 609 Enode : O_Enode; 610 end record; 611end Ortho_Code.Exprs; 612