/compiler/raatt.pas
Pascal | 1683 lines | 1457 code | 108 blank | 118 comment | 111 complexity | ccd1b59afaaf39f46e137a1524e6f14c MD5 | raw file
Possible License(s): LGPL-2.0, LGPL-2.1, LGPL-3.0
Large files files are truncated, but you can click here to view the full file
1{ 2 Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman 3 4 Does the parsing for the GAS styled inline assembler. 5 6 This program is free software; you can redistribute it and/or modify 7 it under the terms of the GNU General Public License as published by 8 the Free Software Foundation; either version 2 of the License, or 9 (at your option) any later version. 10 11 This program is distributed in the hope that it will be useful, 12 but WITHOUT ANY WARRANTY; without even the implied warranty of 13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 GNU General Public License for more details. 15 16 You should have received a copy of the GNU General Public License 17 along with this program; if not, write to the Free Software 18 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 19 20 **************************************************************************** 21} 22unit raatt; 23 24{$i fpcdefs.inc} 25 26 interface 27 28 uses 29 { common } 30 cutils,cclasses, 31 { global } 32 globtype, 33 { aasm } 34 cpubase,cpuinfo,aasmbase,aasmtai,aasmdata,aasmcpu, 35 { assembler reader } 36 rabase, 37 rasm, 38 rautils, 39 { symtable } 40 symconst, 41 { cg } 42 cgbase; 43 44 type 45 tasmtoken = ( 46 AS_NONE,AS_LABEL,AS_LLABEL,AS_STRING,AS_INTNUM, 47 AS_REALNUM,AS_COMMA,AS_LPAREN, 48 AS_RPAREN,AS_COLON,AS_DOT,AS_PLUS,AS_MINUS,AS_STAR, 49 AS_SEPARATOR,AS_ID,AS_REGISTER,AS_OPCODE,AS_SLASH,AS_DOLLAR, 50 AS_HASH,AS_LSBRACKET,AS_RSBRACKET,AS_LBRACKET,AS_RBRACKET, 51 {------------------ Assembler directives --------------------} 52 AS_DB,AS_DW,AS_DD,AS_DQ,AS_GLOBAL, 53 AS_ALIGN,AS_BALIGN,AS_P2ALIGN,AS_ASCII, 54 AS_ASCIIZ,AS_LCOMM,AS_COMM,AS_SINGLE,AS_DOUBLE,AS_EXTENDED,AS_CEXTENDED, 55 AS_DATA,AS_TEXT,AS_INIT,AS_FINI,AS_RVA, 56 AS_SET,AS_WEAK,AS_SECTION,AS_END, 57 {------------------ Assembler Operators --------------------} 58 AS_TYPE,AS_SIZEOF,AS_VMTOFFSET,AS_MOD,AS_SHL,AS_SHR,AS_NOT,AS_AND,AS_OR,AS_XOR,AS_NOR,AS_AT, 59 AS_LO,AS_HI, 60 {------------------ Target-specific directive ---------------} 61 AS_TARGET_DIRECTIVE 62 ); 63 64 tasmkeyword = string[10]; 65 66 const 67 { These tokens should be modified accordingly to the modifications } 68 { in the different enumerations. } 69 firstdirective = AS_DB; 70 lastdirective = AS_END; 71 72 token2str : array[tasmtoken] of tasmkeyword=( 73 '','Label','LLabel','string','integer', 74 'float',',','(', 75 ')',':','.','+','-','*', 76 ';','identifier','register','opcode','/','$', 77 '#','{','}','[',']', 78 '.byte','.word','.long','.quad','.globl', 79 '.align','.balign','.p2align','.ascii', 80 '.asciz','.lcomm','.comm','.single','.double','.tfloat','.tcfloat', 81 '.data','.text','.init','.fini','.rva', 82 '.set','.weak','.section','END', 83 'TYPE','SIZEOF','VMTOFFSET','%','<<','>>','!','&','|','^','~','@','lo','hi', 84 'directive'); 85 86 type 87 tattreader = class(tasmreader) 88 actasmtoken : tasmtoken; 89 prevasmtoken : tasmtoken; 90 procedure SetupTables; 91 procedure BuildConstant(constsize: byte); 92 procedure BuildConstantOperand(oper : toperand); 93 procedure BuildRealConstant(typ : tfloattype); 94 procedure BuildStringConstant(asciiz: boolean); 95 procedure BuildRva; 96 procedure BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint; var mangledname: string; needvmtofs: boolean); 97 procedure BuildConstSymbolExpression(allowref,betweenbracket,needofs:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype); 98 function BuildConstExpression(allowref,betweenbracket:boolean): aint; 99 function Assemble: tlinkedlist;override; 100 procedure handleopcode;virtual;abstract; 101 function is_asmopcode(const s: string) : boolean;virtual;abstract; 102 Function is_asmdirective(const s: string):boolean; 103 function is_register(const s:string):boolean;virtual; 104 function is_locallabel(const s: string):boolean; 105 function is_targetdirective(const s: string): boolean;virtual; 106 procedure GetToken; 107 function consume(t : tasmtoken):boolean; 108 procedure RecoverConsume(allowcomma:boolean); 109 procedure handlepercent;virtual; 110 procedure handledollar;virtual; 111 procedure HandleTargetDirective;virtual; 112 end; 113 tcattreader = class of tattreader; 114 115 var 116 cattreader : tcattreader; 117 118 implementation 119 120 uses 121 { globals } 122 verbose,systems, 123 { input } 124 scanner, 125 { symtable } 126 symbase,symtype,symsym,symdef,symtable, 127{$ifdef x86} 128 rax86, 129{$endif x86} 130 itcpugas, 131 procinfo; 132 133 134 procedure tattreader.SetupTables; 135 var 136 i : tasmop; 137 Begin 138 iasmops:=TFPHashList.create; 139 for i:=firstop to lastop do 140 iasmops.Add(upper(gas_op2str[i]),Pointer(PtrInt(i))); 141 end; 142 143 144 function tattreader.is_asmdirective(const s: string):boolean; 145 var 146 i : tasmtoken; 147 hs : string; 148 Begin 149 { GNU as is also not casesensitive with this } 150 hs:=lower(s); 151 for i:=firstdirective to lastdirective do 152 if hs=token2str[i] then 153 begin 154 actasmtoken:=i; 155 is_asmdirective:=true; 156 exit; 157 end; 158 is_asmdirective:=false; 159 end; 160 161 162 function tattreader.is_register(const s:string):boolean; 163 begin 164 is_register:=false; 165 actasmregister:=gas_regnum_search(lower(s)); 166 if actasmregister<>NR_NO then 167 begin 168 is_register:=true; 169 actasmtoken:=AS_REGISTER; 170 end; 171 end; 172 173 174 function tattreader.is_locallabel(const s: string):boolean; 175 begin 176 is_locallabel:=(length(s)>=2) and (s[1]='.') and (s[2]='L'); 177 end; 178 179 180 procedure tattreader.handledollar; 181 begin 182 c:=current_scanner.asmgetchar; 183 actasmtoken:=AS_DOLLAR; 184 end; 185 186 procedure tattreader.handlepercent; 187 begin 188 c:=current_scanner.asmgetchar; 189 actasmtoken:=AS_MOD; 190 end; 191 192 function tattreader.is_targetdirective(const s: string): boolean; 193 begin 194 result:=false; 195 end; 196 197 procedure tattreader.handletargetdirective; 198 begin 199 end; 200 201 procedure tattreader.GetToken; 202 var 203 len : longint; 204 srsym : tsym; 205 srsymtable : TSymtable; 206 begin 207 { save old token and reset new token } 208 prevasmtoken:=actasmtoken; 209 actasmtoken:=AS_NONE; 210 { reset } 211 actasmpattern:=''; 212 { while space and tab , continue scan... } 213 while c in [' ',#9] do 214 c:=current_scanner.asmgetchar; 215 { get token pos } 216 if not (c in [#10,#13,'{',';']) then 217 current_scanner.gettokenpos; 218 { Local Label, Label, Directive, Prefix or Opcode } 219 if firsttoken and not(c in [#10,#13,'{',';']) then 220 begin 221 firsttoken:=FALSE; 222 len:=0; 223 { directive or local label } 224 if c = '.' then 225 begin 226 inc(len); 227 actasmpattern[len]:=c; 228 { Let us point to the next character } 229 c:=current_scanner.asmgetchar; 230 while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do 231 begin 232 inc(len); 233 actasmpattern[len]:=c; 234 c:=current_scanner.asmgetchar; 235 end; 236 actasmpattern[0]:=chr(len); 237 { this is a local label... } 238 if (c=':') and is_locallabel(actasmpattern) then 239 Begin 240 { local variables are case sensitive } 241 actasmtoken:=AS_LLABEL; 242 c:=current_scanner.asmgetchar; 243 firsttoken:=true; 244 exit; 245 end 246 { must be a directive } 247 else 248 Begin 249 { directives are case sensitive!! } 250 if is_asmdirective(actasmpattern) then 251 exit; 252 if is_targetdirective(actasmpattern) then 253 begin 254 actasmtoken:=AS_TARGET_DIRECTIVE; 255 exit; 256 end; 257 Message1(asmr_e_not_directive_or_local_symbol,actasmpattern); 258 end; 259 end; 260 { only opcodes and global labels are allowed now. } 261 while c in ['A'..'Z','a'..'z','0'..'9','_'] do 262 begin 263 inc(len); 264 actasmpattern[len]:=c; 265 c:=current_scanner.asmgetchar; 266 end; 267 actasmpattern[0]:=chr(len); 268 { Label ? } 269 if c = ':' then 270 begin 271 actasmtoken:=AS_LABEL; 272 { let us point to the next character } 273 c:=current_scanner.asmgetchar; 274 firsttoken:=true; 275 exit; 276 end; 277{$if defined(POWERPC) or defined(POWERPC64)} 278 { some PowerPC instructions can have the postfix -, + or . 279 this code could be moved to is_asmopcode but I think 280 it's better to ifdef it here (FK) 281 } 282 case c of 283 '.', '-', '+': 284 begin 285 actasmpattern:=actasmpattern+c; 286 c:=current_scanner.asmgetchar; 287 end 288 end; 289{$endif POWERPC} 290{$if defined(ARM)} 291 { Thumb-2 instructions can have a .W postfix to indicate 32bit instructions 292 } 293 case c of 294 '.': 295 begin 296 actasmpattern:=actasmpattern+c; 297 c:=current_scanner.asmgetchar; 298 299 if upcase(c) = 'W' then 300 begin 301 actasmpattern:=actasmpattern+c; 302 c:=current_scanner.asmgetchar; 303 end 304 else 305 internalerror(2010122301); 306 end 307 end; 308{$endif ARM} 309 { Opcode ? } 310 If is_asmopcode(upper(actasmpattern)) then 311 Begin 312 uppervar(actasmpattern); 313 exit; 314 end; 315 { End of assemblerblock ? } 316 if upper(actasmpattern) = 'END' then 317 begin 318 actasmtoken:=AS_END; 319 exit; 320 end; 321 message1(asmr_e_unknown_opcode,actasmpattern); 322 actasmtoken:=AS_NONE; 323 end 324 else { else firsttoken } 325 { Here we must handle all possible cases } 326 begin 327 case c of 328 '.' : { possiblities : - local label reference , such as in jmp @local1 } 329 { - field of object/record } 330 { - directive. } 331 begin 332 if (prevasmtoken in [AS_ID,AS_RPAREN]) then 333 begin 334 c:=current_scanner.asmgetchar; 335 actasmtoken:=AS_DOT; 336 exit; 337 end; 338 actasmpattern:=c; 339 c:=current_scanner.asmgetchar; 340 while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do 341 begin 342 actasmpattern:=actasmpattern + c; 343 c:=current_scanner.asmgetchar; 344 end; 345 if is_asmdirective(actasmpattern) then 346 exit; 347 if is_targetdirective(actasmpattern) then 348 begin 349 actasmtoken:=AS_TARGET_DIRECTIVE; 350 exit; 351 end; 352 { local label references and directives } 353 { are case sensitive } 354 actasmtoken:=AS_ID; 355 exit; 356 end; 357 358 { identifier, register, prefix or directive } 359 '_','A'..'Z','a'..'z': 360 begin 361 len:=0; 362 while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do 363 begin 364 inc(len); 365 actasmpattern[len]:=c; 366 c:=current_scanner.asmgetchar; 367 end; 368 actasmpattern[0]:=chr(len); 369 uppervar(actasmpattern); 370{$ifdef x86} 371 { only x86 architectures have instruction prefixes } 372 373 { Opcode, can only be when the previous was a prefix } 374 If is_prefix(actopcode) and is_asmopcode(actasmpattern) then 375 Begin 376 uppervar(actasmpattern); 377 exit; 378 end; 379{$endif x86} 380 { check for end which is a reserved word unlike the opcodes } 381 if actasmpattern = 'END' then 382 Begin 383 actasmtoken:=AS_END; 384 exit; 385 end; 386 if actasmpattern = 'TYPE' then 387 Begin 388 actasmtoken:=AS_TYPE; 389 exit; 390 end; 391 if actasmpattern = 'SIZEOF' then 392 Begin 393 actasmtoken:=AS_SIZEOF; 394 exit; 395 end; 396 if actasmpattern = 'VMTOFFSET' then 397 Begin 398 actasmtoken:=AS_VMTOFFSET; 399 exit; 400 end; 401 if is_register(actasmpattern) then 402 begin 403 actasmtoken:=AS_REGISTER; 404 exit; 405 end; 406 { if next is a '.' and this is a unitsym then we also need to 407 parse the identifier } 408 if (c='.') then 409 begin 410 searchsym(actasmpattern,srsym,srsymtable); 411 if assigned(srsym) and 412 (srsym.typ=unitsym) and 413 (srsym.owner.symtabletype in [staticsymtable,globalsymtable]) and 414 srsym.owner.iscurrentunit then 415 begin 416 actasmpattern:=actasmpattern+c; 417 c:=current_scanner.asmgetchar; 418 while c in ['A'..'Z','a'..'z','0'..'9','_','$'] do 419 begin 420 actasmpattern:=actasmpattern + upcase(c); 421 c:=current_scanner.asmgetchar; 422 end; 423 end; 424 end; 425 actasmtoken:=AS_ID; 426 exit; 427 end; 428 429 '%' : { register or modulo } 430 handlepercent; 431 432 '1'..'9': { integer number } 433 begin 434 len:=0; 435 while c in ['0'..'9'] do 436 Begin 437 inc(len); 438 actasmpattern[len]:=c; 439 c:=current_scanner.asmgetchar; 440 end; 441 actasmpattern[0]:=chr(len); 442 actasmpattern:=tostr(ParseVal(actasmpattern,10)); 443 actasmtoken:=AS_INTNUM; 444 exit; 445 end; 446 '0' : { octal,hexa,real or binary number. } 447 begin 448 actasmpattern:=c; 449 c:=current_scanner.asmgetchar; 450 case upcase(c) of 451 'B': { binary } 452 Begin 453 c:=current_scanner.asmgetchar; 454 while c in ['0','1'] do 455 Begin 456 actasmpattern:=actasmpattern + c; 457 c:=current_scanner.asmgetchar; 458 end; 459 actasmpattern:=tostr(ParseVal(actasmpattern,2)); 460 actasmtoken:=AS_INTNUM; 461 exit; 462 end; 463 'D': { real } 464 Begin 465 c:=current_scanner.asmgetchar; 466 { get ridd of the 0d } 467 if (c in ['+','-']) then 468 begin 469 actasmpattern:=c; 470 c:=current_scanner.asmgetchar; 471 end 472 else 473 actasmpattern:=''; 474 while c in ['0'..'9'] do 475 Begin 476 actasmpattern:=actasmpattern + c; 477 c:=current_scanner.asmgetchar; 478 end; 479 if c='.' then 480 begin 481 actasmpattern:=actasmpattern + c; 482 c:=current_scanner.asmgetchar; 483 while c in ['0'..'9'] do 484 Begin 485 actasmpattern:=actasmpattern + c; 486 c:=current_scanner.asmgetchar; 487 end; 488 if upcase(c) = 'E' then 489 begin 490 actasmpattern:=actasmpattern + c; 491 c:=current_scanner.asmgetchar; 492 if (c in ['+','-']) then 493 begin 494 actasmpattern:=actasmpattern + c; 495 c:=current_scanner.asmgetchar; 496 end; 497 while c in ['0'..'9'] do 498 Begin 499 actasmpattern:=actasmpattern + c; 500 c:=current_scanner.asmgetchar; 501 end; 502 end; 503 actasmtoken:=AS_REALNUM; 504 exit; 505 end 506 else 507 begin 508 Message1(asmr_e_invalid_float_const,actasmpattern+c); 509 actasmtoken:=AS_NONE; 510 end; 511 end; 512 'X': { hexadecimal } 513 Begin 514 c:=current_scanner.asmgetchar; 515 while c in ['0'..'9','a'..'f','A'..'F'] do 516 Begin 517 actasmpattern:=actasmpattern + c; 518 c:=current_scanner.asmgetchar; 519 end; 520 actasmpattern:=tostr(ParseVal(actasmpattern,16)); 521 actasmtoken:=AS_INTNUM; 522 exit; 523 end; 524 '1'..'7': { octal } 525 begin 526 actasmpattern:=actasmpattern + c; 527 while c in ['0'..'7'] do 528 Begin 529 actasmpattern:=actasmpattern + c; 530 c:=current_scanner.asmgetchar; 531 end; 532 actasmpattern:=tostr(ParseVal(actasmpattern,8)); 533 actasmtoken:=AS_INTNUM; 534 exit; 535 end; 536 else { octal number zero value...} 537 Begin 538 actasmpattern:=tostr(ParseVal(actasmpattern,8)); 539 actasmtoken:=AS_INTNUM; 540 exit; 541 end; 542 end; { end case } 543 end; 544 545 '&' : 546 begin 547 c:=current_scanner.asmgetchar; 548 actasmtoken:=AS_AND; 549 end; 550 551 '''' : { char } 552 begin 553 current_scanner.in_asm_string:=true; 554 actasmpattern:=''; 555 repeat 556 c:=current_scanner.asmgetchar; 557 case c of 558 '\' : 559 begin 560 { copy also the next char so \" is parsed correctly } 561 actasmpattern:=actasmpattern+c; 562 c:=current_scanner.asmgetchar; 563 actasmpattern:=actasmpattern+c; 564 end; 565 '''' : 566 begin 567 c:=current_scanner.asmgetchar; 568 break; 569 end; 570 #10,#13: 571 Message(scan_f_string_exceeds_line); 572 else 573 actasmpattern:=actasmpattern+c; 574 end; 575 until false; 576 actasmpattern:=EscapeToPascal(actasmpattern); 577 actasmtoken:=AS_STRING; 578 current_scanner.in_asm_string:=false; 579 exit; 580 end; 581 582 '"' : { string } 583 begin 584 current_scanner.in_asm_string:=true; 585 actasmpattern:=''; 586 repeat 587 c:=current_scanner.asmgetchar; 588 case c of 589 '\' : 590 begin 591 { copy also the next char so \" is parsed correctly } 592 actasmpattern:=actasmpattern+c; 593 c:=current_scanner.asmgetchar; 594 actasmpattern:=actasmpattern+c; 595 end; 596 '"' : 597 begin 598 c:=current_scanner.asmgetchar; 599 break; 600 end; 601 #10,#13: 602 Message(scan_f_string_exceeds_line); 603 else 604 actasmpattern:=actasmpattern+c; 605 end; 606 until false; 607 actasmpattern:=EscapeToPascal(actasmpattern); 608 actasmtoken:=AS_STRING; 609 current_scanner.in_asm_string:=false; 610 exit; 611 end; 612 613 '$' : 614 begin 615 handledollar; 616 exit; 617 end; 618 619 '#' : 620 begin 621 actasmtoken:=AS_HASH; 622 c:=current_scanner.asmgetchar; 623 exit; 624 end; 625 626 '[' : 627 begin 628 actasmtoken:=AS_LBRACKET; 629 c:=current_scanner.asmgetchar; 630 exit; 631 end; 632 633 ']' : 634 begin 635 actasmtoken:=AS_RBRACKET; 636 c:=current_scanner.asmgetchar; 637 exit; 638 end; 639{$ifdef arm} 640 // the arm assembler uses { ... } for register sets 641 '{' : 642 begin 643 actasmtoken:=AS_LSBRACKET; 644 c:=current_scanner.asmgetchar; 645 exit; 646 end; 647 648 '}' : 649 begin 650 actasmtoken:=AS_RSBRACKET; 651 c:=current_scanner.asmgetchar; 652 exit; 653 end; 654{$endif arm} 655 656 ',' : 657 begin 658 actasmtoken:=AS_COMMA; 659 c:=current_scanner.asmgetchar; 660 exit; 661 end; 662 663 '<' : 664 begin 665 actasmtoken:=AS_SHL; 666 c:=current_scanner.asmgetchar; 667 if c = '<' then 668 c:=current_scanner.asmgetchar; 669 exit; 670 end; 671 672 '>' : 673 begin 674 actasmtoken:=AS_SHL; 675 c:=current_scanner.asmgetchar; 676 if c = '>' then 677 c:=current_scanner.asmgetchar; 678 exit; 679 end; 680 681 '|' : 682 begin 683 actasmtoken:=AS_OR; 684 c:=current_scanner.asmgetchar; 685 exit; 686 end; 687 688 '^' : 689 begin 690 actasmtoken:=AS_XOR; 691 c:=current_scanner.asmgetchar; 692 exit; 693 end; 694 695 696 '(' : 697 begin 698 actasmtoken:=AS_LPAREN; 699 c:=current_scanner.asmgetchar; 700 exit; 701 end; 702 703 ')' : 704 begin 705 actasmtoken:=AS_RPAREN; 706 c:=current_scanner.asmgetchar; 707 exit; 708 end; 709 710 ':' : 711 begin 712 actasmtoken:=AS_COLON; 713 c:=current_scanner.asmgetchar; 714 exit; 715 end; 716 717 '+' : 718 begin 719 actasmtoken:=AS_PLUS; 720 c:=current_scanner.asmgetchar; 721 exit; 722 end; 723 724 '-' : 725 begin 726 actasmtoken:=AS_MINUS; 727 c:=current_scanner.asmgetchar; 728 exit; 729 end; 730 731 '*' : 732 begin 733 actasmtoken:=AS_STAR; 734 c:=current_scanner.asmgetchar; 735 exit; 736 end; 737 738 '/' : 739 begin 740 actasmtoken:=AS_SLASH; 741 c:=current_scanner.asmgetchar; 742 exit; 743 end; 744 745 '!' : 746 begin 747 actasmtoken:=AS_NOT; 748 c:=current_scanner.asmgetchar; 749 exit; 750 end; 751 752 '@' : 753 begin 754 actasmtoken:=AS_AT; 755 c:=current_scanner.asmgetchar; 756 exit; 757 end; 758 759{$ifndef arm} 760 '{', 761{$endif arm} 762 #13,#10,';' : 763 begin 764 { the comment is read by asmgetchar } 765 c:=current_scanner.asmgetchar; 766 firsttoken:=TRUE; 767 actasmtoken:=AS_SEPARATOR; 768 exit; 769 end; 770 771 else 772 current_scanner.illegal_char(c); 773 end; 774 end; 775 end; 776 777 778 function tattreader.consume(t : tasmtoken):boolean; 779 begin 780 Consume:=true; 781 if t<>actasmtoken then 782 begin 783 Message2(scan_f_syn_expected,token2str[t],token2str[actasmtoken]); 784 Consume:=false; 785 end; 786 repeat 787 gettoken; 788 until actasmtoken<>AS_NONE; 789 end; 790 791 792 procedure tattreader.RecoverConsume(allowcomma:boolean); 793 begin 794 While not (actasmtoken in [AS_SEPARATOR,AS_END]) do 795 begin 796 if allowcomma and (actasmtoken=AS_COMMA) then 797 break; 798 Consume(actasmtoken); 799 end; 800 end; 801 802 803 Procedure tattreader.BuildConstant(constsize: byte); 804 var 805 asmsymtyp : TAsmSymType; 806 asmsym, 807 expr: string; 808 value : aint; 809 Begin 810 Repeat 811 Case actasmtoken of 812 AS_STRING: 813 Begin 814 expr:=actasmpattern; 815 if length(expr) > 1 then 816 Message(asmr_e_string_not_allowed_as_const); 817 Consume(AS_STRING); 818 Case actasmtoken of 819 AS_COMMA: Consume(AS_COMMA); 820 AS_END, 821 AS_SEPARATOR: ; 822 else 823 Message(asmr_e_invalid_string_expression); 824 end; { end case } 825 ConcatString(curlist,expr); 826 end; 827 AS_INTNUM, 828 AS_PLUS, 829 AS_MINUS, 830 AS_LPAREN, 831 AS_TYPE, 832 AS_SIZEOF, 833 AS_NOT, 834 AS_VMTOFFSET, 835 AS_ID : 836 Begin 837 BuildConstSymbolExpression(false,false,false,value,asmsym,asmsymtyp); 838 if asmsym<>'' then 839 begin 840 if constsize<>sizeof(pint) then 841 Message(asmr_w_32bit_const_for_address); 842 ConcatConstSymbol(curlist,asmsym,asmsymtyp,value) 843 end 844 else 845 ConcatConstant(curlist,value,constsize); 846 end; 847 AS_COMMA: 848 Consume(AS_COMMA); 849 AS_END, 850 AS_SEPARATOR: 851 break; 852 else 853 begin 854 Message(asmr_e_syn_constant); 855 RecoverConsume(false); 856 end 857 end; { end case } 858 Until false; 859 end; 860 861 862 Procedure tattreader.BuildRealConstant(typ : tfloattype); 863 var 864 expr : string; 865 r : bestreal; 866 code : integer; 867 negativ : boolean; 868 errorflag: boolean; 869 Begin 870 errorflag:=FALSE; 871 Repeat 872 negativ:=false; 873 expr:=''; 874 if actasmtoken=AS_PLUS then 875 Consume(AS_PLUS) 876 else 877 if actasmtoken=AS_MINUS then 878 begin 879 negativ:=true; 880 consume(AS_MINUS); 881 end; 882 Case actasmtoken of 883 AS_INTNUM: 884 Begin 885 expr:=actasmpattern; 886 Consume(AS_INTNUM); 887 if negativ then 888 expr:='-'+expr; 889 val(expr,r,code); 890 if code<>0 then 891 Begin 892 r:=0; 893 Message(asmr_e_invalid_float_expr); 894 End; 895 ConcatRealConstant(curlist,r,typ); 896 end; 897 AS_REALNUM: 898 Begin 899 expr:=actasmpattern; 900 Consume(AS_REALNUM); 901 { in ATT syntax you have 0d in front of the real } 902 { should this be forced ? yes i think so, as to } 903 { conform to gas as much as possible. } 904 if (expr[1]='0') and (upper(expr[2])='D') then 905 Delete(expr,1,2); 906 if negativ then 907 expr:='-'+expr; 908 val(expr,r,code); 909 if code<>0 then 910 Begin 911 r:=0; 912 Message(asmr_e_invalid_float_expr); 913 End; 914 ConcatRealConstant(curlist,r,typ); 915 end; 916 AS_COMMA: 917 begin 918 Consume(AS_COMMA); 919 end; 920 AS_END, 921 AS_SEPARATOR: 922 begin 923 break; 924 end; 925 else 926 Begin 927 Consume(actasmtoken); 928 if not errorflag then 929 Message(asmr_e_invalid_float_expr); 930 errorflag:=TRUE; 931 end; 932 end; 933 Until false; 934 end; 935 936 937 Procedure tattreader.BuildStringConstant(asciiz: boolean); 938 var 939 expr: string; 940 errorflag : boolean; 941 Begin 942 errorflag:=FALSE; 943 Repeat 944 Case actasmtoken of 945 AS_STRING: 946 Begin 947 expr:=actasmpattern; 948 if asciiz then 949 expr:=expr+#0; 950 ConcatPasString(curlist,expr); 951 Consume(AS_STRING); 952 end; 953 AS_COMMA: 954 begin 955 Consume(AS_COMMA); 956 end; 957 AS_END, 958 AS_SEPARATOR: 959 begin 960 break; 961 end; 962 else 963 Begin 964 Consume(actasmtoken); 965 if not errorflag then 966 Message(asmr_e_invalid_string_expression); 967 errorflag:=TRUE; 968 end; 969 end; 970 Until false; 971 end; 972 973 974 Function tattreader.Assemble: tlinkedlist; 975 Var 976 hl : tasmlabel; 977 commname, 978 symname, 979 symval : string; 980 lasTSec : TAsmSectiontype; 981 l1, 982 l2, 983 symofs : aint; 984 symtyp : TAsmsymtype; 985 Begin 986 Message1(asmr_d_start_reading,'GNU AS'); 987 firsttoken:=TRUE; 988 { sets up all opcode and register tables in uppercase } 989 if not _asmsorted then 990 Begin 991 SetupTables; 992 _asmsorted:=TRUE; 993 end; 994 curlist:=TAsmList.Create; 995 lasTSec:=sec_code; 996 { setup label linked list } 997 LocalLabelList:=TLocalLabelList.Create; 998 { start tokenizer } 999 c:=current_scanner.asmgetcharstart; 1000 gettoken; 1001 { main loop } 1002 repeat 1003 case actasmtoken of 1004 AS_LLABEL: 1005 Begin 1006 if CreateLocalLabel(actasmpattern,hl,true) then 1007 ConcatLabel(curlist,hl); 1008 Consume(AS_LLABEL); 1009 end; 1010 1011 AS_LABEL: 1012 Begin 1013 if SearchLabel(upper(actasmpattern),hl,true) then 1014 ConcatLabel(curlist,hl) 1015 else 1016 Message1(asmr_e_unknown_label_identifier,actasmpattern); 1017 Consume(AS_LABEL); 1018 end; 1019 1020 AS_DW: 1021 Begin 1022 Consume(AS_DW); 1023 BuildConstant(2); 1024 end; 1025 1026 AS_DATA: 1027 Begin 1028 new_section(curList,sec_data,lower(current_procinfo.procdef.mangledname),0); 1029 lasTSec:=sec_data; 1030 Consume(AS_DATA); 1031 end; 1032 1033 AS_TEXT: 1034 Begin 1035 new_section(curList,sec_code,lower(current_procinfo.procdef.mangledname),0); 1036 lasTSec:=sec_code; 1037 Consume(AS_TEXT); 1038 end; 1039 1040 AS_INIT: 1041 Begin 1042 new_section(curList,sec_init,lower(current_procinfo.procdef.mangledname),0); 1043 lasTSec:=sec_init; 1044 Consume(AS_INIT); 1045 end; 1046 1047 AS_FINI: 1048 Begin 1049 new_section(curList,sec_fini,lower(current_procinfo.procdef.mangledname),0); 1050 lasTSec:=sec_fini; 1051 Consume(AS_FINI); 1052 end; 1053 1054 AS_DB: 1055 Begin 1056 Consume(AS_DB); 1057 BuildConstant(1); 1058 end; 1059 1060 AS_DD: 1061 Begin 1062 Consume(AS_DD); 1063 BuildConstant(4); 1064 end; 1065 1066 AS_DQ: 1067 Begin 1068 Consume(AS_DQ); 1069{$ifdef cpu64bitaddr} 1070 BuildConstant(8); 1071{$else cpu64bitaddr} 1072 BuildRealConstant(s64comp); 1073{$endif cpu64bitaddr} 1074 end; 1075 1076 AS_SINGLE: 1077 Begin 1078 Consume(AS_SINGLE); 1079 BuildRealConstant(s32real); 1080 end; 1081 1082 AS_DOUBLE: 1083 Begin 1084 Consume(AS_DOUBLE); 1085 BuildRealConstant(s64real); 1086 end; 1087 1088 AS_EXTENDED: 1089 Begin 1090 Consume(AS_EXTENDED); 1091 BuildRealConstant(s80real); 1092 end; 1093 1094 AS_CEXTENDED: 1095 Begin 1096 Consume(AS_CEXTENDED); 1097 BuildRealConstant(sc80real); 1098 end; 1099 1100 AS_GLOBAL: 1101 Begin 1102 Consume(AS_GLOBAL); 1103 if actasmtoken=AS_ID then 1104 ConcatPublic(curlist,actasmpattern); 1105 Consume(AS_ID); 1106 if actasmtoken<>AS_SEPARATOR then 1107 Consume(AS_SEPARATOR); 1108 end; 1109 1110 AS_ALIGN: 1111 Begin 1112 Consume(AS_ALIGN); 1113 l1:=BuildConstExpression(false,false); 1114 if (target_info.system in [system_i386_GO32V2]) then 1115 begin 1116 l2:=1; 1117 if (l1>=0) and (l1<=16) then 1118 while (l1>0) do 1119 begin 1120 l2:=2*l2; 1121 dec(l1); 1122 end; 1123 l1:=l2; 1124 end; 1125 ConcatAlign(curlist,l1); 1126 Message(asmr_n_align_is_target_specific); 1127 if actasmtoken<>AS_SEPARATOR then 1128 Consume(AS_SEPARATOR); 1129 end; 1130 1131 AS_BALIGN: 1132 Begin 1133 Consume(AS_BALIGN); 1134 ConcatAlign(curlist,BuildConstExpression(false,false)); 1135 if actasmtoken<>AS_SEPARATOR then 1136 Consume(AS_SEPARATOR); 1137 end; 1138 1139 AS_P2ALIGN: 1140 Begin 1141 Consume(AS_P2ALIGN); 1142 l1:=BuildConstExpression(false,false); 1143 l2:=1; 1144 if (l1>=0) and (l1<=16) then 1145 while (l1>0) do 1146 begin 1147 l2:=2*l2; 1148 dec(l1); 1149 end; 1150 l1:=l2; 1151 ConcatAlign(curlist,l1); 1152 if actasmtoken<>AS_SEPARATOR then 1153 Consume(AS_SEPARATOR); 1154 end; 1155 1156 AS_ASCIIZ: 1157 Begin 1158 Consume(AS_ASCIIZ); 1159 BuildStringConstant(TRUE); 1160 end; 1161 1162 AS_ASCII: 1163 Begin 1164 Consume(AS_ASCII); 1165 BuildStringConstant(FALSE); 1166 end; 1167 1168 AS_LCOMM: 1169 Begin 1170 Consume(AS_LCOMM); 1171 commname:=actasmpattern; 1172 Consume(AS_ID); 1173 Consume(AS_COMMA); 1174 curList.concat(Tai_datablock.Create(commname,BuildConstExpression(false,false))); 1175 if actasmtoken<>AS_SEPARATOR then 1176 Consume(AS_SEPARATOR); 1177 end; 1178 1179 AS_COMM: 1180 Begin 1181 Consume(AS_COMM); 1182 commname:=actasmpattern; 1183 Consume(AS_ID); 1184 Consume(AS_COMMA); 1185 curList.concat(Tai_datablock.Create_global(commname,BuildConstExpression(false,false))); 1186 if actasmtoken<>AS_SEPARATOR then 1187 Consume(AS_SEPARATOR); 1188 end; 1189 1190 AS_OPCODE: 1191 Begin 1192 HandleOpCode; 1193 end; 1194 1195 AS_SEPARATOR: 1196 Begin 1197 Consume(AS_SEPARATOR); 1198 end; 1199 1200 AS_RVA: 1201 begin 1202 { .rva generally applies to systems with COFF output format, 1203 not just Windows. } 1204 if not (target_info.system in systems_all_windows) then 1205 Message1(asmr_e_unsupported_directive,token2str[AS_RVA]); 1206 Consume(AS_RVA); 1207 BuildRva; 1208 end; 1209 1210 AS_SET: 1211 begin 1212 Consume(AS_SET); 1213 BuildConstSymbolExpression(true,false,false, symofs,symname,symtyp); 1214 Consume(AS_COMMA); 1215 BuildConstSymbolExpression(true,false,false, symofs,symval,symtyp); 1216 1217 curList.concat(tai_set.create(symname,symval)); 1218 end; 1219 1220 AS_WEAK: 1221 begin 1222 Consume(AS_WEAK); 1223 BuildConstSymbolExpression(true,false,false, l1,symname,symtyp); 1224 curList.concat(tai_weak.create(symname)); 1225 end; 1226 1227 AS_SECTION: 1228 begin 1229 Consume(AS_SECTION); 1230 new_section(curlist, sec_user, actasmpattern, 0); 1231 //curList.concat(tai_section.create(sec_user, actasmpattern, 0)); 1232 consume(AS_STRING); 1233 end; 1234 1235 AS_TARGET_DIRECTIVE: 1236 HandleTargetDirective; 1237 1238 AS_END: 1239 begin 1240 break; { end assembly block } 1241 end; 1242 1243 else 1244 Begin 1245 Message(asmr_e_syntax_error); 1246 RecoverConsume(false); 1247 end; 1248 end; 1249 until false; 1250 { Check LocalLabelList } 1251 LocalLabelList.CheckEmitted; 1252 LocalLabelList.Free; 1253 { are we back in the code section? } 1254 if lasTSec<>sec_code then 1255 begin 1256 Message(asmr_w_assembler_code_not_returned_to_text); 1257 new_section(curList,sec_code,lower(current_procinfo.procdef.mangledname),0); 1258 end; 1259 { Return the list in an asmnode } 1260 assemble:=curlist; 1261 Message1(asmr_d_finish_reading,'GNU AS'); 1262 end; 1263 1264 1265{***************************************************************************** 1266 Parsing Helpers 1267*****************************************************************************} 1268 1269 Procedure tattreader.BuildRecordOffsetSize(const expr: string;var offset:aint;var size:aint; var mangledname: string; needvmtofs: boolean); 1270 { Description: This routine builds up a record offset after a AS_DOT } 1271 { token is encountered. } 1272 { On entry actasmtoken should be equal to AS_DOT } 1273 var 1274 s : string; 1275 Begin 1276 offset:=0; 1277 size:=0; 1278 s:=expr; 1279 while (actasmtoken=AS_DOT) do 1280 begin 1281 Consume(AS_DOT); 1282 if actasmtoken=AS_ID then 1283 s:=s+'.'+actasmpattern; 1284 if not Consume(AS_ID) then 1285 begin 1286 RecoverConsume(true); 1287 break; 1288 end; 1289 end; 1290 if not GetRecordOffsetSize(s,offset,size,mangledname,needvmtofs) then 1291 Message(asmr_e_building_record_offset); 1292 end; 1293 1294 1295 procedure tattreader.BuildConstSymbolExpression(allowref,betweenbracket,needofs:boolean;var value:aint;var asmsym:string;var asmsymtyp:TAsmsymtype); 1296 var 1297 hssymtyp : TAsmSymType; 1298 hs,tempstr,expr,mangledname : string; 1299 parenlevel : longint; 1300 l,k : aint; 1301 errorflag : boolean; 1302 prevtok : tasmtoken; 1303 sym : tsym; 1304 srsymtable : TSymtable; 1305 hl : tasmlabel; 1306 Begin 1307 asmsym:=''; 1308 asmsymtyp:=AT_DATA; 1309 value:=0; 1310 errorflag:=FALSE; 1311 tempstr:=''; 1312 expr:=''; 1313 parenlevel:=0; 1314 Repeat 1315 Case actasmtoken of 1316 AS_LPAREN: 1317 Begin 1318 { Exit if ref? } 1319 if allowref and (prevasmtoken in [AS_INTNUM,AS_ID]) then 1320 break; 1321 Consume(AS_LPAREN); 1322 expr:=expr + '('; 1323 inc(parenlevel); 1324 end; 1325 AS_RBRACKET: 1326 begin 1327 if betweenbracket then 1328 break; 1329 { write error only once. } 1330 if not errorflag then 1331 Message(asmr_e_invalid_constant_expression); 1332 { consume tokens until we find COMMA or SEPARATOR } 1333 Consume(actasmtoken); 1334 errorflag:=TRUE; 1335 end; 1336 AS_RPAREN: 1337 Begin 1338 { end of ref ? } 1339 if (parenlevel=0) and betweenbracket then 1340 break; 1341 Consume(AS_RPAREN); 1342 expr:=expr + ')'; 1343 dec(parenlevel); 1344 end; 1345 AS_SHL: 1346 Begin 1347 Consume(AS_SHL); 1348 expr:=expr + '<'; 1349 end; 1350 AS_SHR: 1351 Begin 1352 Consume(AS_SHR); 1353 expr:=expr + '>'; 1354 end; 1355 AS_SLASH: 1356 Begin 1357 Consume(AS_SLASH); 1358 expr:=expr + '/'; 1359 end; 1360 AS_MOD: 1361 Begin 1362 Consume(AS_MOD); 1363 expr:=expr + '%'; 1364 end; 1365 AS_STAR: 1366 Begin 1367 Consume(AS_STAR); 1368 expr:=expr + '*'; 1369 end; 1370 AS_PLUS: 1371 Begin 1372 Consume(AS_PLUS); 1373 expr:=expr + '+'; 1374 end; 1375 AS_MINUS: 1376 Begin 1377 Consume(AS_MINUS); 1378 expr:=expr + '-'; 1379 end; 1380 AS_AND: 1381 Begin 1382 Consume(AS_AND); 1383 expr:=expr + '&'; 1384 end; 1385 AS_NOT: 1386 Begin 1387 Consume(AS_NOT); 1388 expr:=expr + '~'; 1389 end; 1390 AS_XOR: 1391 Begin 1392 Consume(AS_XOR); 1393 expr:=expr + '^'; 1394 end; 1395 AS_OR: 1396 Begin 1397 Consume(AS_OR); 1398 expr:=expr + '|'; 1399 end; 1400 AS_INTNUM: 1401 Begin 1402 expr:=expr + actasmpattern; 1403 Consume(AS_INTNUM); 1404 end; 1405 AS_DOLLAR: 1406 begin 1407 Consume(AS_DOLLAR); 1408 if actasmtoken<>AS_ID then 1409 Message(asmr_e_dollar_without_identifier); 1410 end; 1411 AS_STRING: 1412 Begin 1413 l:=0; 1414 case Length(actasmpattern) of 1415 1 : 1416 l:=ord(actasmpattern[1]); 1417 2 : 1418 l:=ord(actasmpattern[2]) + ord(actasmpattern[1]) shl 8; 1419 3 : 1420 l:=ord(actasmpattern[3]) + 1421 Ord(actasmpattern[2]) shl 8 + ord(actasmpattern[1]) shl 16; 1422 4 : 1423 l:=ord(actasmpattern[4]) + ord(actasmpattern[3]) shl 8 + 1424 Ord(actasmpattern[2]) shl 16 + ord(actasmpattern[1]) shl 24; 1425 else 1426 Message1(asmr_e_invalid_string_as_opcode_operand,actasmpattern); 1427 end; 1428 str(l, tempstr); 1429 expr:=expr + tempstr; 1430 Consume(AS_STRING); 1431 end; 1432 AS_SIZEOF, 1433 AS_TYPE: 1434 begin 1435 l:=0; 1436 Consume(actasmtoken); 1437 if actasmtoken<>AS_ID then 1438 Message(asmr_e_type_without_identifier) 1439 else 1440 begin 1441 tempstr:=actasmpattern; 1442 Consume(AS_ID); 1443 if actasmtoken=AS_DOT then 1444 begin 1445 BuildRecordOffsetSize(tempstr,k,l,mangledname,false); 1446 if mangledname<>'' then 1447 Message(asmr_e_wrong_sym_type); 1448 end 1449 else 1450 begin 1451 searchsym(tempstr,sym,srsymtable); 1452 if assigned(sym) then 1453 begin 1454 case sym.typ of 1455 staticvarsym, 1456 localvarsym, 1457 paravarsym : 1458 l:=tabstractvarsym(sym).getsize; 1459 typesym : 1460 l:=ttypesym(sym).typedef.size; 1461 else 1462 Message(asmr_e_wrong_sym_type); 1463 end; 1464 end 1465 else 1466 Message1(sym_e_unknown_id,tempstr); 1467 end; 1468 end; 1469 str(l, tempstr); 1470 expr:=expr + tempstr; 1471 end; 1472 AS_VMTOFFSET: 1473 begin 1474 Consume(actasmtoken); 1475 if actasmtoken<>AS_ID then 1476 Message(asmr_e_type_without_identifier) 1477 else 1478 begin 1479 tempstr:=actasmpattern; 1480 consume(AS_ID); 1481 BuildRecordOffsetSize(tempstr,k,l,mangledname,true); 1482 if (mangledname <> '') then 1483 Message(asmr_e_wrong_sym_type); 1484 str(k,tempstr); 1485 expr := expr + tempstr; 1486 end 1487 end; 1488 AS_ID: 1489 Begin 1490 hs:=''; 1491 hssymtyp:=AT_DATA; 1492 tempstr:=actasmpattern; 1493 prevtok:=prevasmtoken; 1494 consume(AS_ID); 1495 if SearchIConstant(tempstr,l) then 1496 begin 1497 str(l, tempstr); 1498 expr:=expr + tempstr; 1499 end 1500 else 1501 begin 1502 if is_locallabel(tempstr) then 1503 begin 1504 CreateLocalLabel(tempstr,hl,false); 1505 hs:=hl.name; 1506 hssymtyp:=AT_LABEL; 1507 end 1508 else 1509 if SearchLabel(tempstr,hl,false) then 1510 begin 1511 hs:=hl.name; 1512 hssymtyp:=AT_FUNCTION; 1513 end 1514 else 1515 begin 1516 searchsym(tempstr,sym,srsymtable); 1517 if assigned(sym) then 1518 begin 1519 case sym.typ of 1520 staticvarsym : 1521 hs:=tstaticvarsym(sym).mangledname; 1522 localvarsym, 1523 paravarsym : 1524 Message(asmr_e_no_local_or_para_allowed); 1525 procsym : 1526 begin 1527 if Tprocsym(sym).ProcdefList.Count>1 then 1528 Message(asmr_w_calling_overload_func); 1529 hs:=tprocdef(tprocsym(sym).ProcdefList[0]).mangledname; 1530 hssymtyp:=AT_FUNCTION; 1531 end; 1532 typesym : 1533 begin 1534 if not(ttypesym(sym).typedef.typ in [recorddef,objectdef]) then 1535 Message(asmr_e_wrong_sym_type); 1536 end; 1537 else 1538 Message(asmr_e_wrong_sym_type); 1539 end; 1540 end 1541 else 1542 Message1(sym_e_unknown_id,tempstr); 1543 end; 1544 { symbol found? } 1545 if hs<>'' then 1546 begin 1547 if needofs and (prevtok<>AS_DOLLAR) then 1548 Message(asmr_e_need_dollar); 1549 if asmsym='' then 1550 begin 1551 …
Large files files are truncated, but you can click here to view the full file