1 { 2 Copyright (c) 1998-2002 by Carl Eric Codere and Peter Vreman 3 4 Does the parsing for the ARM GNU AS 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 } 22 Unit raarmgas; 23 24 {$i fpcdefs.inc} 25 26 Interface 27 28 uses 29 raatt,raarm, 30 cpubase; 31 32 type 33 34 tarmattreader = class(tattreader) 35 actoppostfix : TOpPostfix; 36 actwideformat : boolean; is_asmopcodenull37 function is_asmopcode(const s: string):boolean;override; is_registernull38 function is_register(const s:string):boolean;override; is_targetdirectivenull39 function is_targetdirective(const s: string): boolean; override; 40 procedure handleopcode;override; 41 procedure BuildReference(oper : tarmoperand); 42 procedure BuildOperand(oper : tarmoperand); 43 procedure BuildSpecialreg(oper : tarmoperand); TryBuildShifterOpnull44 function TryBuildShifterOp(oper : tarmoperand) : boolean; 45 procedure BuildOpCode(instr : tarminstruction); 46 procedure ReadSym(oper : tarmoperand); 47 procedure ConvertCalljmp(instr : tarminstruction); 48 procedure HandleTargetDirective; override; 49 protected is_unifiednull50 function is_unified: boolean; virtual; 51 end; 52 53 tarmunifiedattreader = class(tarmattreader) 54 protected is_unifiednull55 function is_unified: boolean; override; 56 end; 57 58 59 Implementation 60 61 uses 62 { helpers } 63 cutils, 64 { global } 65 globtype,globals,verbose, 66 systems,aasmbase,aasmtai,aasmdata,aasmcpu, 67 { symtable } 68 symconst,symsym,symdef, 69 procinfo, 70 rabase,rautils, 71 cgbase,cgutils,paramgr; 72 73 tarmunifiedattreader.is_unifiednull74 function tarmunifiedattreader.is_unified: boolean; 75 begin 76 result:=true; 77 end; 78 79 tarmattreader.is_registernull80 function tarmattreader.is_register(const s:string):boolean; 81 type 82 treg2str = record 83 name : string[3]; 84 reg : tregister; 85 end; 86 87 const 88 extraregs : array[0..19+16] of treg2str = ( 89 (name: 'A1'; reg : NR_R0), 90 (name: 'A2'; reg : NR_R1), 91 (name: 'A3'; reg : NR_R2), 92 (name: 'A4'; reg : NR_R3), 93 (name: 'V1'; reg : NR_R4), 94 (name: 'V2'; reg : NR_R5), 95 (name: 'V3'; reg : NR_R6), 96 (name: 'V4'; reg : NR_R7), 97 (name: 'V5'; reg : NR_R8), 98 (name: 'V6'; reg : NR_R9), 99 (name: 'V7'; reg : NR_R10), 100 (name: 'V8'; reg : NR_R11), 101 (name: 'WR'; reg : NR_R7), 102 (name: 'SB'; reg : NR_R9), 103 (name: 'SL'; reg : NR_R10), 104 (name: 'FP'; reg : NR_R11), 105 (name: 'IP'; reg : NR_R12), 106 (name: 'SP'; reg : NR_R13), 107 (name: 'LR'; reg : NR_R14), 108 (name: 'PC'; reg : NR_R15), 109 110 (name: 'C0'; reg : NR_CR0), 111 (name: 'C1'; reg : NR_CR1), 112 (name: 'C2'; reg : NR_CR2), 113 (name: 'C3'; reg : NR_CR3), 114 (name: 'C4'; reg : NR_CR4), 115 (name: 'C5'; reg : NR_CR5), 116 (name: 'C6'; reg : NR_CR6), 117 (name: 'C7'; reg : NR_CR7), 118 (name: 'C8'; reg : NR_CR8), 119 (name: 'C9'; reg : NR_CR9), 120 (name: 'C10'; reg : NR_CR10), 121 (name: 'C11'; reg : NR_CR11), 122 (name: 'C12'; reg : NR_CR12), 123 (name: 'C13'; reg : NR_CR13), 124 (name: 'C14'; reg : NR_CR14), 125 (name: 'C15'; reg : NR_CR15) 126 ); 127 128 var 129 i : longint; 130 131 begin 132 result:=inherited is_register(s); 133 { reg found? 134 possible aliases are always 2 char 135 } 136 if result or (not (length(s) in [2,3])) then 137 exit; 138 for i:=low(extraregs) to high(extraregs) do 139 begin 140 if s=extraregs[i].name then 141 begin 142 actasmregister:=extraregs[i].reg; 143 result:=true; 144 actasmtoken:=AS_REGISTER; 145 exit; 146 end; 147 end; 148 end; 149 tarmattreader.is_targetdirectivenull150 function tarmattreader.is_targetdirective(const s: string): boolean; 151 begin 152 case s of 153 '.thumb_func', 154 '.code', 155 '.thumb_set': 156 result:=true 157 else 158 Result:=inherited is_targetdirective(s); 159 end; 160 end; 161 162 163 procedure tarmattreader.ReadSym(oper : tarmoperand); 164 var 165 tempstr, mangledname : string; 166 typesize,l,k : tcgint; 167 begin 168 tempstr:=actasmpattern; 169 Consume(AS_ID); 170 { typecasting? } 171 if (actasmtoken=AS_LPAREN) and 172 SearchType(tempstr,typesize) then 173 begin 174 oper.hastype:=true; 175 Consume(AS_LPAREN); 176 BuildOperand(oper); 177 Consume(AS_RPAREN); 178 if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then 179 oper.SetSize(typesize,true); 180 end 181 else 182 if not oper.SetupVar(tempstr,false) then 183 Message1(sym_e_unknown_id,tempstr); 184 { record.field ? } 185 if actasmtoken=AS_DOT then 186 begin 187 BuildRecordOffsetSize(tempstr,l,k,mangledname,false); 188 if (mangledname<>'') then 189 Message(asmr_e_invalid_reference_syntax); 190 inc(oper.opr.ref.offset,l); 191 end; 192 end; 193 194 195 Procedure tarmattreader.BuildReference(oper : tarmoperand); 196 197 procedure do_error; 198 begin 199 Message(asmr_e_invalid_reference_syntax); 200 RecoverConsume(false); 201 end; 202 203 204 procedure test_end(require_rbracket : boolean); 205 begin 206 if require_rbracket then begin 207 if not(actasmtoken=AS_RBRACKET) then 208 begin 209 do_error; 210 exit; 211 end 212 else 213 Consume(AS_RBRACKET); 214 if (actasmtoken=AS_NOT) then 215 begin 216 oper.opr.ref.addressmode:=AM_PREINDEXED; 217 Consume(AS_NOT); 218 end; 219 end; 220 if not(actasmtoken in [AS_SEPARATOR,AS_end]) then 221 do_error 222 else 223 begin 224 {$IFDEF debugasmreader} 225 writeln('TEST_end_FINAL_OK. Created the following ref:'); 226 writeln('oper.opr.ref.shiftimm=',oper.opr.ref.shiftimm); 227 writeln('oper.opr.ref.shiftmode=',ord(oper.opr.ref.shiftmode)); 228 writeln('oper.opr.ref.index=',ord(oper.opr.ref.index)); 229 writeln('oper.opr.ref.base=',ord(oper.opr.ref.base)); 230 writeln('oper.opr.ref.signindex=',ord(oper.opr.ref.signindex)); 231 writeln('oper.opr.ref.addressmode=',ord(oper.opr.ref.addressmode)); 232 writeln; 233 {$endIF debugasmreader} 234 end; 235 end; 236 237 is_shifter_ref_operationnull238 function is_shifter_ref_operation(var a : tshiftmode) : boolean; 239 begin 240 a := SM_NONE; 241 if (actasmpattern='LSL') then 242 a := SM_LSL 243 else if (actasmpattern='LSR') then 244 a := SM_LSR 245 else if (actasmpattern='ASR') then 246 a := SM_ASR 247 else if (actasmpattern='ROR') then 248 a := SM_ROR 249 else if (actasmpattern='RRX') then 250 a := SM_RRX; 251 is_shifter_ref_operation := not(a=SM_NONE); 252 end; 253 254 255 procedure read_index_shift(require_rbracket : boolean); 256 var 257 shift : aint; 258 begin 259 case actasmtoken of 260 AS_COMMA : 261 begin 262 Consume(AS_COMMA); 263 if not(actasmtoken=AS_ID) then 264 do_error; 265 if is_shifter_ref_operation(oper.opr.ref.shiftmode) then 266 begin 267 Consume(AS_ID); 268 if not(oper.opr.ref.shiftmode=SM_RRX) then 269 begin 270 if not(actasmtoken=AS_HASH) then 271 do_error; 272 Consume(AS_HASH); 273 shift := BuildConstExpression(false,true); 274 if (shift<0) or (shift>32) then 275 do_error; 276 oper.opr.ref.shiftimm := shift; 277 test_end(require_rbracket); 278 end 279 else 280 test_end(require_rbracket); 281 end 282 else 283 begin 284 do_error; 285 exit; 286 end; 287 end; 288 AS_RBRACKET : 289 if require_rbracket then 290 test_end(require_rbracket) 291 else 292 begin 293 do_error; 294 exit; 295 end; 296 AS_SEPARATOR,AS_END : 297 if not require_rbracket then 298 test_end(false) 299 else 300 do_error; 301 else 302 begin 303 do_error; 304 exit; 305 end; 306 end; 307 end; 308 309 310 procedure read_index(require_rbracket : boolean); 311 var 312 recname : string; 313 o_int,s_int : tcgint; 314 begin 315 case actasmtoken of 316 AS_REGISTER : 317 begin 318 oper.opr.ref.index:=actasmregister; 319 Consume(AS_REGISTER); 320 read_index_shift(require_rbracket); 321 exit; 322 end; 323 AS_PLUS,AS_MINUS : 324 begin 325 if actasmtoken=AS_PLUS then 326 begin 327 Consume(AS_PLUS); 328 end 329 else 330 begin 331 oper.opr.ref.signindex := -1; 332 Consume(AS_MINUS); 333 end; 334 if actasmtoken=AS_REGISTER then 335 begin 336 oper.opr.ref.index:=actasmregister; 337 Consume(AS_REGISTER); 338 read_index_shift(require_rbracket); 339 exit; 340 end 341 else 342 begin 343 do_error; 344 exit; 345 end; 346 test_end(require_rbracket); 347 exit; 348 end; 349 AS_HASH : // constant 350 begin 351 Consume(AS_HASH); 352 o_int := BuildConstExpression(false,true); 353 if (o_int>4095) or (o_int<-4095) then 354 begin 355 Message(asmr_e_constant_out_of_bounds); 356 RecoverConsume(false); 357 exit; 358 end 359 else 360 begin 361 inc(oper.opr.ref.offset,o_int); 362 test_end(require_rbracket); 363 exit; 364 end; 365 end; 366 AS_ID : 367 begin 368 recname := actasmpattern; 369 Consume(AS_ID); 370 BuildRecordOffsetSize(recname,o_int,s_int,recname,false); 371 if (o_int>4095)or(o_int<-4095) then 372 begin 373 Message(asmr_e_constant_out_of_bounds); 374 RecoverConsume(false); 375 exit; 376 end 377 else 378 begin 379 inc(oper.opr.ref.offset,o_int); 380 test_end(require_rbracket); 381 exit; 382 end; 383 end; 384 AS_AT: 385 begin 386 do_error; 387 exit; 388 end; 389 AS_DOT : // local label 390 begin 391 oper.opr.ref.signindex := BuildConstExpression(true,false); 392 test_end(require_rbracket); 393 exit; 394 end; 395 AS_RBRACKET : 396 begin 397 if require_rbracket then 398 begin 399 test_end(require_rbracket); 400 exit; 401 end 402 else 403 begin 404 do_error; // unexpected rbracket 405 exit; 406 end; 407 end; 408 AS_SEPARATOR,AS_end : 409 begin 410 if not require_rbracket then 411 begin 412 test_end(false); 413 exit; 414 end 415 else 416 begin 417 do_error; 418 exit; 419 end; 420 end; 421 else 422 begin 423 // unexpected token 424 do_error; 425 exit; 426 end; 427 end; // case 428 end; 429 430 431 procedure try_prepostindexed; 432 begin 433 Consume(AS_RBRACKET); 434 case actasmtoken of 435 AS_COMMA : 436 begin // post-indexed 437 Consume(AS_COMMA); 438 oper.opr.ref.addressmode:=AM_POSTINDEXED; 439 read_index(false); 440 exit; 441 end; 442 AS_NOT : 443 begin // pre-indexed 444 Consume(AS_NOT); 445 oper.opr.ref.addressmode:=AM_PREINDEXED; 446 test_end(false); 447 exit; 448 end; 449 else 450 begin 451 test_end(false); 452 exit; 453 end; 454 end; // case 455 end; 456 457 var 458 lab : TASMLABEL; 459 begin 460 Consume(AS_LBRACKET); 461 oper.opr.ref.addressmode:=AM_OFFSET; // assume "neither PRE nor POST inc" 462 if actasmtoken=AS_REGISTER then 463 begin 464 oper.opr.ref.base:=actasmregister; 465 Consume(AS_REGISTER); 466 case actasmtoken of 467 AS_RBRACKET : 468 begin 469 try_prepostindexed; 470 exit; 471 end; 472 AS_COMMA : 473 begin 474 Consume(AS_COMMA); 475 read_index(true); 476 exit; 477 end; 478 else 479 begin 480 Message(asmr_e_invalid_reference_syntax); 481 RecoverConsume(false); 482 end; 483 end; 484 end 485 else 486 { 487 if base isn't a register, r15=PC is implied base, so it must be a local label. 488 pascal constants don't make sense, because implied r15 489 record offsets probably don't make sense, too (a record offset of code?) 490 491 TODO: However, we could make the Stackpointer implied. 492 493 } 494 495 Begin 496 case actasmtoken of 497 AS_ID : 498 begin 499 if is_locallabel(actasmpattern) then 500 begin 501 CreateLocalLabel(actasmpattern,lab,false); 502 oper.opr.ref.symbol := lab; 503 oper.opr.ref.base := NR_PC; 504 Consume(AS_ID); 505 test_end(true); 506 exit; 507 end 508 else 509 begin 510 // TODO: Stackpointer implied, 511 Message(asmr_e_invalid_reference_syntax); 512 RecoverConsume(false); 513 exit; 514 end; 515 end; 516 else 517 begin // elsecase 518 Message(asmr_e_invalid_reference_syntax); 519 RecoverConsume(false); 520 exit; 521 end; 522 end; 523 end; 524 end; 525 526 tarmattreader.TryBuildShifterOpnull527 function tarmattreader.TryBuildShifterOp(oper : tarmoperand) : boolean; 528 529 procedure handlepara(sm : tshiftmode); 530 begin 531 consume(AS_ID); 532 fillchar(oper.opr,sizeof(oper.opr),0); 533 oper.opr.typ:=OPR_SHIFTEROP; 534 oper.opr.shifterop.shiftmode:=sm; 535 if sm<>SM_RRX then 536 begin 537 case actasmtoken of 538 AS_REGISTER: 539 begin 540 oper.opr.shifterop.rs:=actasmregister; 541 consume(AS_REGISTER); 542 end; 543 AS_HASH: 544 begin 545 consume(AS_HASH); 546 oper.opr.shifterop.shiftimm:=BuildConstExpression(false,false); 547 end; 548 else 549 Message(asmr_e_illegal_shifterop_syntax); 550 end; 551 end; 552 end; 553 554 begin 555 result:=true; 556 if (actasmtoken=AS_ID) then 557 begin 558 if (actasmpattern='LSL') then 559 handlepara(SM_LSL) 560 else if (actasmpattern='LSR') then 561 handlepara(SM_LSR) 562 else if (actasmpattern='ASR') then 563 handlepara(SM_ASR) 564 else if (actasmpattern='ROR') then 565 handlepara(SM_ROR) 566 else if (actasmpattern='RRX') then 567 handlepara(SM_RRX) 568 else 569 result:=false; 570 end 571 else 572 result:=false; 573 end; 574 575 576 Procedure tarmattreader.BuildOperand(oper : tarmoperand); 577 var 578 expr : string; 579 typesize,l : tcgint; 580 581 582 procedure AddLabelOperand(hl:tasmlabel); 583 begin 584 if not(actasmtoken in [AS_PLUS,AS_MINUS,AS_LPAREN]) and 585 is_calljmp(actopcode) then 586 begin 587 oper.opr.typ:=OPR_SYMBOL; 588 oper.opr.symbol:=hl; 589 end 590 else 591 begin 592 oper.InitRef; 593 oper.opr.ref.symbol:=hl; 594 oper.opr.ref.base:=NR_PC; 595 if (actasmtoken in [AS_PLUS, AS_MINUS]) then 596 begin 597 l:=BuildConstExpression(true,false); 598 oper.opr.ref.offset:=l; 599 end; 600 end; 601 end; 602 603 604 procedure MaybeRecordOffset; 605 var 606 mangledname: string; 607 hasdot : boolean; 608 l, 609 toffset, 610 tsize : tcgint; 611 begin 612 if not(actasmtoken in [AS_DOT,AS_PLUS,AS_MINUS]) then 613 exit; 614 l:=0; 615 mangledname:=''; 616 hasdot:=(actasmtoken=AS_DOT); 617 if hasdot then 618 begin 619 if expr<>'' then 620 begin 621 BuildRecordOffsetSize(expr,toffset,tsize,mangledname,false); 622 if (oper.opr.typ<>OPR_CONSTANT) and 623 (mangledname<>'') then 624 Message(asmr_e_wrong_sym_type); 625 inc(l,toffset); 626 oper.SetSize(tsize,true); 627 end; 628 end; 629 if actasmtoken in [AS_PLUS,AS_MINUS] then 630 inc(l,BuildConstExpression(true,false)); 631 case oper.opr.typ of 632 OPR_LOCAL : 633 begin 634 { don't allow direct access to fields of parameters, because that 635 will generate buggy code. Allow it only for explicit typecasting } 636 if hasdot and 637 (not oper.hastype) then 638 checklocalsubscript(oper.opr.localsym); 639 inc(oper.opr.localsymofs,l) 640 end; 641 OPR_CONSTANT : 642 inc(oper.opr.val,l); 643 OPR_REFERENCE : 644 if (mangledname<>'') then 645 begin 646 if (oper.opr.val<>0) then 647 Message(asmr_e_wrong_sym_type); 648 oper.opr.typ:=OPR_SYMBOL; 649 oper.opr.symbol:=current_asmdata.RefAsmSymbol(mangledname,AT_FUNCTION); endnull650 end 651 else 652 inc(oper.opr.val,l); 653 OPR_SYMBOL: 654 Message(asmr_e_invalid_symbol_ref); 655 else 656 internalerror(200309221); 657 end; 658 end; 659 660 MaybeBuildReferencenull661 function MaybeBuildReference:boolean; 662 { Try to create a reference, if not a reference is found then false 663 is returned } 664 begin 665 MaybeBuildReference:=true; 666 case actasmtoken of 667 AS_INTNUM, 668 AS_MINUS, 669 AS_PLUS: 670 Begin 671 oper.opr.ref.offset:=BuildConstExpression(True,False); 672 if actasmtoken<>AS_LPAREN then 673 Message(asmr_e_invalid_reference_syntax) 674 else 675 BuildReference(oper); 676 end; 677 AS_LPAREN: 678 BuildReference(oper); 679 AS_ID: { only a variable is allowed ... } 680 Begin 681 ReadSym(oper); 682 case actasmtoken of 683 AS_end, 684 AS_SEPARATOR, 685 AS_COMMA: ; 686 AS_LPAREN: 687 BuildReference(oper); 688 else 689 Begin 690 Message(asmr_e_invalid_reference_syntax); 691 Consume(actasmtoken); 692 end; 693 end; {end case } 694 end; 695 else 696 MaybeBuildReference:=false; 697 end; { end case } 698 end; 699 700 is_ConditionCodenull701 function is_ConditionCode(hs: string): boolean; 702 var icond: tasmcond; 703 begin 704 is_ConditionCode := false; 705 706 case actopcode of 707 A_IT,A_ITE,A_ITT, 708 A_ITEE,A_ITTE,A_ITET,A_ITTT, 709 A_ITEEE,A_ITTEE,A_ITETE,A_ITTTE,A_ITEET,A_ITTET,A_ITETT,A_ITTTT: 710 begin 711 { search for condition, conditions are always 2 chars } 712 if length(hs)>1 then 713 begin 714 for icond:=low(tasmcond) to high(tasmcond) do 715 begin 716 if copy(hs,1,2)=uppercond2str[icond] then 717 begin 718 //actcondition:=icond; 719 oper.opr.typ := OPR_COND; 720 oper.opr.cc := icond; 721 exit(true); 722 end; 723 end; 724 end; 725 end; 726 end; 727 end; 728 729 is_modeflagnull730 function is_modeflag(hs : string): boolean; 731 var 732 i: longint; 733 flags: tcpumodeflags; 734 begin 735 is_modeflag := false; 736 737 flags:=[]; 738 hs:=lower(hs); 739 740 if (actopcode in [A_CPSID,A_CPSIE]) and (length(hs) >= 1) then 741 begin 742 for i:=1 to length(hs) do 743 begin 744 case hs[i] of 745 'a': 746 Include(flags,mfA); 747 'f': 748 Include(flags,mfF); 749 'i': 750 Include(flags,mfI); 751 else 752 exit; 753 end; 754 end; 755 oper.opr.typ := OPR_MODEFLAGS; 756 oper.opr.flags := flags; 757 exit(true); 758 end; 759 end; 760 761 762 procedure BuildDirectRef; 763 GetConstLabelnull764 function GetConstLabel(const symname: string; ofs: aint): TAsmLabel; 765 var 766 hp: tai; 767 newconst: tai_const; 768 lab: TAsmLabel; 769 begin 770 if symname<>'' then 771 newconst:=tai_const.Createname(symname,ofs) 772 else 773 newconst:=tai_const.Create_32bit(ofs); 774 775 hp:=tai(current_procinfo.aktlocaldata.First); 776 while assigned(hp) do 777 begin 778 if hp.typ=ait_const then 779 begin 780 if (tai_const(hp).sym=newconst.sym) and 781 (tai_const(hp).value=newconst.value) and 782 assigned(hp.Previous) and 783 (tai(hp.previous).typ=ait_label) then 784 begin 785 newconst.Free; 786 result:=tai_label(hp.Previous).labsym; 787 exit; 788 end; 789 end; 790 791 hp:=tai(hp.Next); 792 end; 793 794 current_asmdata.getjumplabel(lab); 795 current_procinfo.aktlocaldata.concat(tai_align.create(4)); 796 current_procinfo.aktlocaldata.concat(tai_label.create(lab)); 797 current_procinfo.aktlocaldata.concat(newconst); 798 result:=lab; 799 end; 800 801 var 802 symtype: TAsmsymtype; 803 sym: string; 804 val: tcgint; 805 begin 806 case actasmtoken of 807 AS_INTNUM, 808 AS_ID: 809 begin 810 BuildConstSymbolExpression(true,false,false,val,sym,symtype); 811 812 if symtype=AT_NONE then 813 sym:=''; 814 815 reference_reset(oper.opr.ref,4,[]); 816 oper.opr.ref.base:=NR_PC; 817 oper.opr.ref.symbol:=GetConstLabel(sym,val); 818 end; 819 end; 820 end; 821 822 getregsetindexnull823 function getregsetindex(reg: tregister): integer; 824 begin 825 if getsubreg(reg)=R_SUBFS then 826 begin 827 result:=getsupreg(reg)*2; 828 if result>32 then 829 result:=result-63; 830 end 831 else 832 result:=getsupreg(reg); 833 end; 834 835 var 836 tempreg : tregister; 837 ireg : tsuperregister; 838 regtype: tregistertype; 839 subreg: tsubregister; 840 hl : tasmlabel; 841 {ofs : longint;} 842 registerset : tcpuregisterset; 843 Begin 844 expr:=''; 845 case actasmtoken of 846 AS_LBRACKET: { Memory reference or constant expression } 847 Begin 848 oper.InitRef; 849 BuildReference(oper); 850 end; 851 852 AS_HASH: { Constant expression } 853 Begin 854 Consume(AS_HASH); 855 BuildConstantOperand(oper); 856 end; 857 858 AS_EQUAL: 859 begin 860 case actopcode of 861 A_LDRBT,A_LDRB,A_LDR,A_LDRH,A_LDRSB,A_LDRSH,A_LDRT, 862 A_LDREX,A_LDREXB,A_LDREXD,A_LDREXH: 863 begin 864 consume(AS_EQUAL); 865 oper.InitRef; 866 BuildDirectRef; 867 end; 868 else 869 Message(asmr_e_invalid_opcode_and_operand); 870 end; 871 end; 872 873 (* 874 AS_INTNUM, 875 AS_MINUS, 876 AS_PLUS: 877 Begin 878 { Constant memory offset } 879 { This must absolutely be followed by ( } 880 oper.InitRef; 881 oper.opr.ref.offset:=BuildConstExpression(True,False); 882 if actasmtoken<>AS_LPAREN then 883 begin 884 ofs:=oper.opr.ref.offset; 885 BuildConstantOperand(oper); 886 inc(oper.opr.val,ofs); 887 end 888 else 889 BuildReference(oper); 890 end; 891 *) 892 AS_ID: { A constant expression, or a Variable ref. } 893 Begin 894 if is_modeflag(actasmpattern) then 895 begin 896 consume(AS_ID); 897 end 898 else 899 { Condition code? } 900 if is_conditioncode(actasmpattern) then 901 begin 902 consume(AS_ID); 903 end 904 else 905 { Local Label ? } 906 if is_locallabel(actasmpattern) then 907 begin 908 CreateLocalLabel(actasmpattern,hl,false); 909 Consume(AS_ID); 910 AddLabelOperand(hl); 911 end 912 else 913 { Check for label } 914 if SearchLabel(actasmpattern,hl,false) then 915 begin 916 Consume(AS_ID); 917 AddLabelOperand(hl); 918 end 919 else 920 { probably a variable or normal expression } 921 { or a procedure (such as in CALL ID) } 922 Begin 923 { is it a constant ? } 924 if SearchIConstant(actasmpattern,l) then 925 Begin 926 if not (oper.opr.typ in [OPR_NONE,OPR_CONSTANT]) then 927 Message(asmr_e_invalid_operand_type); 928 BuildConstantOperand(oper); 929 end 930 else 931 begin 932 expr:=actasmpattern; 933 Consume(AS_ID); 934 { typecasting? } 935 if (actasmtoken=AS_LPAREN) and 936 SearchType(expr,typesize) then 937 begin 938 oper.hastype:=true; 939 Consume(AS_LPAREN); 940 BuildOperand(oper); 941 Consume(AS_RPAREN); 942 if oper.opr.typ in [OPR_REFERENCE,OPR_LOCAL] then 943 oper.SetSize(typesize,true); 944 end 945 else 946 begin 947 if not(oper.SetupVar(expr,false)) then 948 Begin 949 { look for special symbols ... } 950 if expr= '__HIGH' then 951 begin 952 consume(AS_LPAREN); 953 if not oper.setupvar('high'+actasmpattern,false) then 954 Message1(sym_e_unknown_id,'high'+actasmpattern); 955 consume(AS_ID); 956 consume(AS_RPAREN); 957 end 958 else 959 if expr = '__RESULT' then 960 oper.SetUpResult 961 else 962 if expr = '__SELF' then 963 oper.SetupSelf 964 else 965 if expr = '__OLDEBP' then 966 oper.SetupOldEBP 967 else 968 Message1(sym_e_unknown_id,expr); 969 end; 970 end; 971 end; 972 if actasmtoken=AS_DOT then 973 MaybeRecordOffset; 974 { add a constant expression? } 975 if (actasmtoken=AS_PLUS) then 976 begin 977 l:=BuildConstExpression(true,false); 978 case oper.opr.typ of 979 OPR_CONSTANT : 980 inc(oper.opr.val,l); 981 OPR_LOCAL : 982 inc(oper.opr.localsymofs,l); 983 OPR_REFERENCE : 984 inc(oper.opr.ref.offset,l); 985 else 986 internalerror(200309202); 987 end; 988 end 989 end; 990 { Do we have a indexing reference, then parse it also } 991 if actasmtoken=AS_LPAREN then 992 BuildReference(oper); 993 end; 994 995 { Register, a variable reference or a constant reference } 996 AS_REGISTER: 997 Begin 998 { save the type of register used. } 999 tempreg:=actasmregister; 1000 Consume(AS_REGISTER); 1001 if (actasmtoken in [AS_end,AS_SEPARATOR,AS_COMMA]) then 1002 Begin 1003 if not (oper.opr.typ in [OPR_NONE,OPR_REGISTER]) then 1004 Message(asmr_e_invalid_operand_type); 1005 oper.opr.typ:=OPR_REGISTER; 1006 oper.opr.reg:=tempreg; 1007 end 1008 else if (actasmtoken=AS_NOT) and (actopcode in [A_LDM,A_STM,A_FLDM,A_FSTM,A_VLDM,A_VSTM,A_SRS,A_RFE]) then 1009 begin 1010 consume(AS_NOT); 1011 oper.opr.typ:=OPR_REFERENCE; 1012 oper.opr.ref.addressmode:=AM_PREINDEXED; 1013 oper.opr.ref.index:=tempreg; 1014 end 1015 else 1016 Message(asmr_e_syn_operand); 1017 end; 1018 1019 { Registerset } 1020 AS_LSBRACKET: 1021 begin 1022 consume(AS_LSBRACKET); 1023 registerset:=[]; 1024 regtype:=R_INVALIDREGISTER; 1025 subreg:=R_SUBNONE; 1026 while actasmtoken<>AS_RSBRACKET do 1027 begin 1028 if actasmtoken=AS_REGISTER then 1029 begin 1030 include(registerset,getregsetindex(actasmregister)); 1031 if regtype<>R_INVALIDREGISTER then 1032 begin 1033 if (getregtype(actasmregister)<>regtype) or 1034 (getsubreg(actasmregister)<>subreg) then 1035 Message(asmr_e_mixing_regtypes); 1036 end 1037 else 1038 begin 1039 regtype:=getregtype(actasmregister); 1040 subreg:=getsubreg(actasmregister); 1041 end; 1042 tempreg:=actasmregister; 1043 consume(AS_REGISTER); 1044 if actasmtoken=AS_MINUS then 1045 begin 1046 consume(AS_MINUS); 1047 for ireg:=getregsetindex(tempreg) to getregsetindex(actasmregister) do 1048 include(registerset,ireg); 1049 consume(AS_REGISTER); 1050 end; 1051 end 1052 else 1053 consume(AS_REGISTER); 1054 if actasmtoken=AS_COMMA then 1055 consume(AS_COMMA) 1056 else 1057 break; 1058 end; 1059 consume(AS_RSBRACKET); 1060 oper.opr.typ:=OPR_REGSET; 1061 oper.opr.regtype:=regtype; 1062 oper.opr.subreg:=subreg; 1063 oper.opr.regset:=registerset; 1064 if actasmtoken=AS_XOR then 1065 begin 1066 consume(AS_XOR); 1067 oper.opr.usermode:=true; 1068 end 1069 else 1070 oper.opr.usermode:=false; 1071 if (registerset=[]) then 1072 Message(asmr_e_empty_regset); 1073 end; 1074 AS_end, 1075 AS_SEPARATOR, 1076 AS_COMMA: ; 1077 else 1078 Begin 1079 Message(asmr_e_syn_operand); 1080 Consume(actasmtoken); 1081 end; 1082 end; { end case } 1083 end; 1084 1085 procedure tarmattreader.BuildSpecialreg(oper: tarmoperand); 1086 var 1087 hs, reg : String; 1088 ch : char; 1089 i, t : longint; 1090 hreg : tregister; 1091 flags : tspecialregflags; 1092 begin 1093 hreg:=NR_NO; 1094 case actasmtoken of 1095 AS_REGISTER: 1096 begin 1097 oper.opr.typ:=OPR_REGISTER; 1098 oper.opr.reg:=actasmregister; 1099 Consume(AS_REGISTER); 1100 end; 1101 AS_ID: 1102 begin 1103 t := pos('_', actasmpattern); 1104 if t > 0 then 1105 begin 1106 hs:=lower(actasmpattern); 1107 reg:=copy(hs, 1, t-1); 1108 delete(hs, 1, t); 1109 1110 if length(hs) < 1 then 1111 Message(asmr_e_invalid_operand_type); 1112 1113 if reg = 'cpsr' then 1114 hreg:=NR_CPSR 1115 else if reg='spsr' then 1116 hreg:=NR_SPSR 1117 else 1118 Message(asmr_e_invalid_register); 1119 1120 flags:=[]; 1121 for i := 1 to length(hs) do 1122 begin 1123 ch:=hs[i]; 1124 if ch='c' then 1125 include(flags, srC) 1126 else if ch='x' then 1127 include(flags, srX) 1128 else if ch='f' then 1129 include(flags, srF) 1130 else if ch='s' then 1131 include(flags, srS) 1132 else 1133 message(asmr_e_invalid_operand_type); 1134 end; 1135 1136 oper.opr.typ:=OPR_SPECIALREG; 1137 oper.opr.specialreg:=hreg; 1138 oper.opr.specialregflags:=flags; 1139 1140 consume(AS_ID); 1141 end 1142 else 1143 Message(asmr_e_invalid_operand_type); // Otherwise it would have been seen as a AS_REGISTER 1144 end; 1145 end; 1146 end; 1147 1148 1149 {***************************************************************************** 1150 tarmattreader 1151 *****************************************************************************} 1152 1153 procedure tarmattreader.BuildOpCode(instr : tarminstruction); 1154 var 1155 operandnum : longint; 1156 Begin 1157 { opcode } 1158 if (actasmtoken<>AS_OPCODE) then 1159 Begin 1160 Message(asmr_e_invalid_or_missing_opcode); 1161 RecoverConsume(true); 1162 exit; 1163 end; 1164 { Fill the instr object with the current state } 1165 with instr do 1166 begin 1167 Opcode:=ActOpcode; 1168 condition:=ActCondition; 1169 oppostfix:=actoppostfix; 1170 wideformat:=actwideformat; 1171 end; 1172 1173 { We are reading operands, so opcode will be an AS_ID } 1174 operandnum:=1; 1175 Consume(AS_OPCODE); 1176 { Zero operand opcode ? } 1177 if actasmtoken in [AS_SEPARATOR,AS_end] then 1178 begin 1179 operandnum:=0; 1180 exit; 1181 end; 1182 { Read the operands } 1183 repeat 1184 case actasmtoken of 1185 AS_COMMA: { Operand delimiter } 1186 Begin 1187 if ((instr.opcode in [A_MOV,A_MVN,A_CMP,A_CMN,A_TST,A_TEQ, 1188 A_UXTB,A_UXTH,A_UXTB16, 1189 A_SXTB,A_SXTH,A_SXTB16]) and 1190 (operandnum=2)) or 1191 ((operandnum=3) and not(instr.opcode in [A_UMLAL,A_UMULL,A_SMLAL,A_SMULL,A_MLA,A_UMAAL,A_MLS, 1192 A_SMLABB,A_SMLABT,A_SMLATB,A_SMLATT,A_SMMLA,A_SMMLS,A_SMLAD,A_SMLALD,A_SMLSD, 1193 A_SMLALBB,A_SMLALBT,A_SMLALTB,A_SMLALTT,A_SMLSLD, 1194 A_SMLAWB,A_SMLAWT, 1195 A_MRC,A_MCR,A_MCRR,A_MRRC,A_MRC2,A_MCR2,A_MCRR2,A_MRRC2, 1196 A_STREXD,A_STRD, 1197 A_USADA8, 1198 A_VMOV, 1199 A_SBFX,A_UBFX,A_BFI])) then 1200 begin 1201 Consume(AS_COMMA); 1202 if not(TryBuildShifterOp(instr.Operands[operandnum+1] as tarmoperand)) then 1203 Message(asmr_e_illegal_shifterop_syntax); 1204 Inc(operandnum); 1205 end 1206 else 1207 begin 1208 if operandnum>Max_Operands then 1209 Message(asmr_e_too_many_operands) 1210 else 1211 Inc(operandnum); 1212 Consume(AS_COMMA); 1213 end; 1214 end; 1215 AS_SEPARATOR, 1216 AS_end : { End of asm operands for this opcode } 1217 begin 1218 break; 1219 end; 1220 else 1221 if ((instr.opcode = A_MRS) and (operandnum = 2)) or 1222 ((instr.opcode = A_MSR) and (operandnum = 1)) then 1223 BuildSpecialreg(instr.Operands[operandnum] as tarmoperand) 1224 else 1225 BuildOperand(instr.Operands[operandnum] as tarmoperand); 1226 end; { end case } 1227 until false; 1228 instr.Ops:=operandnum; 1229 end; 1230 1231 tarmattreader.is_asmopcodenull1232 function tarmattreader.is_asmopcode(const s: string):boolean; 1233 1234 const 1235 { sorted by length so longer postfixes will match first } 1236 postfix2strsorted : array[1..70] of string[9] = ( 1237 '.F32.S32','.F32.U32','.S32.F32','.U32.F32','.F64.S32','.F64.U32','.S32.F64','.U32.F64', 1238 '.F32.S16','.F32.U16','.S16.F32','.U16.F32','.F64.S16','.F64.U16','.S16.F64','.U16.F64', 1239 '.F32.F64','.F64.F32', 1240 '.I16','.I32','.I64','.S16','.S32','.S64','.U16','.U32','.U64','.F32','.F64', 1241 'IAD','DBD','FDD','EAD','IAS','DBS','FDS','EAS','IAX','DBX','FDX','EAX', 1242 '.16','.32','.64','.I8','.S8','.U8','.P8', 1243 'EP','SB','BT','SH','IA','IB','DA','DB','FD','FA','ED','EA', 1244 '.8','S','D','E','P','X','R','B','H','T'); 1245 1246 postfixsorted : array[1..70] of TOpPostfix = ( 1247 PF_F32S32,PF_F32U32,PF_S32F32,PF_U32F32,PF_F64S32,PF_F64U32,PF_S32F64,PF_U32F64, 1248 PF_F32S16,PF_F32U16,PF_S16F32,PF_U16F32,PF_F64S16,PF_F64U16,PF_S16F64,PF_U16F64, 1249 PF_F32F64,PF_F64F32, 1250 PF_I16,PF_I32, 1251 PF_I64,PF_S16,PF_S32,PF_S64,PF_U16,PF_U32,PF_U64,PF_F32, 1252 PF_F64,PF_IAD,PF_DBD,PF_FDD,PF_EAD, 1253 PF_IAS,PF_DBS,PF_FDS,PF_EAS,PF_IAX, 1254 PF_DBX,PF_FDX,PF_EAX,PF_16,PF_32, 1255 PF_64,PF_I8,PF_S8,PF_U8,PF_P8, 1256 PF_EP,PF_SB,PF_BT,PF_SH,PF_IA, 1257 PF_IB,PF_DA,PF_DB,PF_FD,PF_FA, 1258 PF_ED,PF_EA,PF_8,PF_S,PF_D,PF_E, 1259 PF_P,PF_X,PF_R,PF_B,PF_H,PF_T); 1260 1261 var 1262 j, j2 : longint; 1263 hs,hs2 : string; 1264 maxlen : longint; 1265 icond : tasmcond; 1266 Begin 1267 { making s a value parameter would break other assembler readers } 1268 hs:=s; 1269 is_asmopcode:=false; 1270 1271 { clear op code } 1272 actopcode:=A_None; 1273 1274 actcondition:=C_None; 1275 1276 { first, handle B else BLS is read wrong } 1277 if ((hs[1]='B') and (length(hs)=3)) then 1278 begin 1279 for icond:=low(tasmcond) to high(tasmcond) do 1280 begin 1281 if copy(hs,2,3)=uppercond2str[icond] then 1282 begin 1283 actopcode:=A_B; 1284 actasmtoken:=AS_OPCODE; 1285 actcondition:=icond; 1286 is_asmopcode:=true; 1287 exit; 1288 end; 1289 end; 1290 end; 1291 maxlen:=min(length(hs),6); 1292 actopcode:=A_NONE; 1293 j2:=maxlen; 1294 hs2:=hs; 1295 while j2>=1 do 1296 begin 1297 hs:=hs2; 1298 while j2>=1 do 1299 begin 1300 actopcode:=tasmop(PtrUInt(iasmops.Find(copy(hs,1,j2)))); 1301 if actopcode<>A_NONE then 1302 begin 1303 actasmtoken:=AS_OPCODE; 1304 { strip op code } 1305 delete(hs,1,j2); 1306 dec(j2); 1307 break; 1308 end; 1309 dec(j2); 1310 end; 1311 1312 if actopcode=A_NONE then 1313 exit; 1314 1315 if is_unified then 1316 begin 1317 { check for postfix } 1318 if (length(hs)>0) and (actoppostfix=PF_None) then 1319 begin 1320 for j:=low(postfixsorted) to high(postfixsorted) do 1321 begin 1322 if copy(hs,1,length(postfix2strsorted[j]))=postfix2strsorted[j] then 1323 begin 1324 if not ((length(hs)-length(postfix2strsorted[j])) in [0,2,4]) then 1325 continue; 1326 1327 actoppostfix:=postfixsorted[j]; 1328 { strip postfix } 1329 delete(hs,1,length(postfix2strsorted[j])); 1330 break; 1331 end; 1332 end; 1333 end; 1334 { search for condition, conditions are always 2 chars } 1335 if length(hs)>1 then 1336 begin 1337 for icond:=low(tasmcond) to high(tasmcond) do 1338 begin 1339 if copy(hs,1,2)=uppercond2str[icond] then 1340 begin 1341 actcondition:=icond; 1342 { strip condition } 1343 delete(hs,1,2); 1344 break; 1345 end; 1346 end; 1347 end; 1348 { check for postfix } 1349 if (length(hs)>0) and (actoppostfix=PF_None) then 1350 begin 1351 for j:=low(postfixsorted) to high(postfixsorted) do 1352 begin 1353 if copy(hs,1,length(postfix2strsorted[j]))=postfix2strsorted[j] then 1354 begin 1355 if not ((length(hs)-length(postfix2strsorted[j])) = 0) then 1356 continue; 1357 1358 actoppostfix:=postfixsorted[j]; 1359 { strip postfix } 1360 delete(hs,1,length(postfix2strsorted[j])); 1361 break; 1362 end; 1363 end; 1364 end; 1365 end 1366 else 1367 begin 1368 { search for condition, conditions are always 2 chars } 1369 if length(hs)>1 then 1370 begin 1371 for icond:=low(tasmcond) to high(tasmcond) do 1372 begin 1373 if copy(hs,1,2)=uppercond2str[icond] then 1374 begin 1375 actcondition:=icond; 1376 { strip condition } 1377 delete(hs,1,2); 1378 break; 1379 end; 1380 end; 1381 end; 1382 { check for postfix } 1383 if (length(hs)>0) and (actoppostfix=PF_None) then 1384 begin 1385 for j:=low(postfixsorted) to high(postfixsorted) do 1386 begin 1387 if copy(hs,1,length(postfix2strsorted[j]))=postfix2strsorted[j] then 1388 begin 1389 actoppostfix:=postfixsorted[j]; 1390 { strip postfix } 1391 delete(hs,1,length(postfix2strsorted[j])); 1392 break; 1393 end; 1394 end; 1395 end; 1396 end; 1397 { check for format postfix } 1398 if length(hs)>0 then 1399 begin 1400 if copy(hs,1,2) = '.W' then 1401 begin 1402 actwideformat:=true; 1403 delete(hs,1,2); 1404 end; 1405 end; 1406 { if we stripped all postfixes, it's a valid opcode } 1407 is_asmopcode:=length(hs)=0; 1408 if is_asmopcode = true then 1409 break; 1410 end; 1411 end; 1412 1413 1414 procedure tarmattreader.ConvertCalljmp(instr : tarminstruction); 1415 var 1416 newopr : toprrec; 1417 begin 1418 if instr.Operands[1].opr.typ=OPR_REFERENCE then 1419 begin 1420 newopr.typ:=OPR_SYMBOL; 1421 newopr.symbol:=instr.Operands[1].opr.ref.symbol; 1422 newopr.symofs:=instr.Operands[1].opr.ref.offset; 1423 if (instr.Operands[1].opr.ref.base<>NR_NO) or 1424 (instr.Operands[1].opr.ref.index<>NR_NO) then 1425 Message(asmr_e_syn_operand); 1426 instr.Operands[1].opr:=newopr; 1427 end; 1428 end; 1429 1430 1431 procedure tarmattreader.HandleTargetDirective; 1432 var 1433 symname, 1434 symval : String; 1435 val : tcgint; 1436 symtyp : TAsmsymtype; 1437 begin 1438 case actasmpattern of 1439 '.thumb_set': 1440 begin 1441 consume(AS_TARGET_DIRECTIVE); 1442 BuildConstSymbolExpression(true,false,false, val,symname,symtyp); 1443 Consume(AS_COMMA); 1444 BuildConstSymbolExpression(true,false,false, val,symval,symtyp); 1445 1446 curList.concat(tai_symbolpair.create(spk_thumb_set,symname,symval)); 1447 end; 1448 '.code': 1449 begin 1450 consume(AS_TARGET_DIRECTIVE); 1451 val:=BuildConstExpression(false,false); 1452 if not(val in [16,32]) then 1453 Message(asmr_e_invalid_code_value); 1454 curList.concat(tai_directive.create(asd_code,tostr(val))); 1455 end; 1456 '.thumb_func': 1457 begin 1458 consume(AS_TARGET_DIRECTIVE); 1459 curList.concat(tai_directive.create(asd_thumb_func,'')); 1460 end 1461 else 1462 inherited HandleTargetDirective; 1463 end; 1464 end; 1465 1466 tarmattreader.is_unifiednull1467 function tarmattreader.is_unified: boolean; 1468 begin 1469 result:=false; 1470 end; 1471 1472 1473 procedure tarmattreader.handleopcode; 1474 var 1475 instr : tarminstruction; 1476 begin 1477 instr:=TarmInstruction.Create(TarmOperand); 1478 BuildOpcode(instr); 1479 if is_calljmp(instr.opcode) then 1480 ConvertCalljmp(instr); 1481 { 1482 instr.AddReferenceSizes; 1483 instr.SetInstructionOpsize; 1484 instr.CheckOperandSizes; 1485 } 1486 instr.ConcatInstruction(curlist); 1487 instr.Free; 1488 actoppostfix:=PF_None; 1489 actwideformat:=false; 1490 end; 1491 1492 1493 {***************************************************************************** 1494 Initialize 1495 *****************************************************************************} 1496 1497 const 1498 asmmode_arm_att_info : tasmmodeinfo = 1499 ( 1500 id : asmmode_arm_gas; 1501 idtxt : 'DIVIDED'; 1502 casmreader : tarmattreader; 1503 ); 1504 1505 asmmode_arm_att_unified_info : tasmmodeinfo = 1506 ( 1507 id : asmmode_arm_gas_unified; 1508 idtxt : 'UNIFIED'; 1509 casmreader : tarmunifiedattreader; 1510 ); 1511 1512 asmmode_arm_standard_info : tasmmodeinfo = 1513 ( 1514 id : asmmode_standard; 1515 idtxt : 'STANDARD'; 1516 casmreader : tarmattreader; 1517 ); 1518 1519 initialization 1520 RegisterAsmMode(asmmode_arm_att_info); 1521 RegisterAsmMode(asmmode_arm_att_unified_info); 1522 RegisterAsmMode(asmmode_arm_standard_info); 1523 end. 1524