1 { 2 Copyright (c) 1998-2004 by Peter Vreman 3 4 This unit handles the assemblerfile write and assembler calls of FPC 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 {# @abstract(This unit handles the assembler file write and assembler calls of FPC) 23 Handles the calls to the actual external assemblers, as well as the generation 24 of object files for smart linking. Also contains the base class for writing 25 the assembler statements to file. 26 } 27 unit assemble; 28 29 {$i fpcdefs.inc} 30 31 interface 32 33 34 uses 35 SysUtils, 36 systems,globtype,globals,aasmbase,aasmtai,aasmdata,ogbase,owbase,finput; 37 38 const 39 { maximum of aasmoutput lists there will be } 40 maxoutputlists = ord(high(tasmlisttype))+1; 41 { buffer size for writing the .s file } 42 AsmOutSize=32768*4; 43 44 type 45 TAssembler=class(TObject) 46 public 47 {assembler info} 48 asminfo : pasminfo; 49 {filenames} 50 path : TPathStr; 51 name : string; 52 AsmFileName, { current .s and .o file } 53 ObjFileName, 54 ppufilename : TPathStr; 55 asmprefix : string; 56 SmartAsm : boolean; 57 SmartFilesCount, 58 SmartHeaderCount : longint; 59 Constructor Create(info: pasminfo; smart:boolean);virtual; 60 Destructor Destroy;override; 61 procedure NextSmartName(place:tcutplace); 62 procedure MakeObject;virtual;abstract; 63 end; 64 65 TExternalAssembler = class; 66 67 IExternalAssemblerOutputFileDecorator=interface LinePrefixnull68 function LinePrefix: AnsiString; LinePostfixnull69 function LinePostfix: AnsiString; LineFilternull70 function LineFilter(const s: AnsiString): AnsiString; LineEndingnull71 function LineEnding(const deflineending: ShortString): ShortString; 72 end; 73 74 TExternalAssemblerOutputFile=class 75 private 76 fdecorator: IExternalAssemblerOutputFileDecorator; 77 protected 78 owner: TExternalAssembler; 79 {outfile} 80 AsmSize, 81 AsmStartSize, 82 outcnt : longint; 83 outbuf : array[0..AsmOutSize-1] of char; 84 outfile : file; 85 fioerror : boolean; 86 linestart: boolean; 87 88 Procedure AsmClear; 89 Procedure MaybeAddLinePrefix; 90 Procedure MaybeAddLinePostfix; 91 92 Procedure AsmWriteAnsiStringUnfiltered(const s: ansistring); 93 public 94 Constructor Create(_owner: TExternalAssembler); 95 96 Procedure RemoveAsm;virtual; 97 Procedure AsmFlush; 98 99 { mark the current output as the "empty" state (i.e., it only contains 100 headers/directives etc } 101 Procedure MarkEmpty; 102 { clears the assembler output if nothing was added since it was marked 103 as empty, and returns whether it was empty } ClearIfEmptynull104 function ClearIfEmpty: boolean; 105 { these routines will write the filtered version of their argument 106 according to the current decorator } 107 procedure AsmWriteFiltered(const c:char); 108 procedure AsmWriteFiltered(const s:string); 109 procedure AsmWriteFiltered(const s:ansistring); 110 procedure AsmWriteFiltered(p:pchar; len: longint); 111 112 {# Write a string to the assembler file } 113 Procedure AsmWrite(const c:char); 114 Procedure AsmWrite(const s:string); 115 Procedure AsmWrite(const s:ansistring); 116 117 {# Write a string to the assembler file } 118 Procedure AsmWritePChar(p:pchar); 119 120 {# Write a string to the assembler file followed by a new line } 121 Procedure AsmWriteLn(const c:char); 122 Procedure AsmWriteLn(const s:string); 123 Procedure AsmWriteLn(const s:ansistring); 124 125 {# Write a new line to the assembler file } 126 Procedure AsmLn; virtual; 127 128 procedure AsmCreate(Aplace:tcutplace); 129 procedure AsmClose; 130 131 property ioerror: boolean read fioerror; 132 property decorator: IExternalAssemblerOutputFileDecorator read fdecorator write fdecorator; 133 end; 134 135 {# This is the base class which should be overridden for each each 136 assembler writer. It is used to actually assembler a file, 137 and write the output to the assembler file. 138 } 139 TExternalAssembler=class(TAssembler) 140 private 141 { output writer } 142 fwriter: TExternalAssemblerOutputFile; 143 ffreewriter: boolean; 144 145 procedure CreateSmartLinkPath(const s:TPathStr); 146 protected 147 {input source info} 148 lastfileinfo : tfileposinfo; 149 infile, 150 lastinfile : tinputfile; 151 {last section type written} 152 lastsectype : TAsmSectionType; 153 procedure WriteSourceLine(hp: tailineinfo); 154 procedure WriteTempalloc(hp: tai_tempalloc); 155 procedure WriteRealConstAsBytes(hp: tai_realconst; const dbdir: string; do_line: boolean); single2strnull156 function single2str(d : single) : string; virtual; double2strnull157 function double2str(d : double) : string; virtual; extended2strnull158 function extended2str(e : extended) : string; virtual; DoPipenull159 Function DoPipe:boolean; 160 CreateNewAsmWriternull161 function CreateNewAsmWriter: TExternalAssemblerOutputFile; virtual; 162 public 163 164 {# Returns the complete path and executable name of the assembler 165 program. 166 167 It first tries looking in the UTIL directory if specified, 168 otherwise it searches in the free pascal binary directory, in 169 the current working directory and then in the directories 170 in the $PATH environment.} FindAssemblernull171 Function FindAssembler:string; 172 173 {# Actually does the call to the assembler file. Returns false 174 if the assembling of the file failed.} CallAssemblernull175 Function CallAssembler(const command:string; const para:TCmdStr):Boolean; 176 DoAssemblenull177 Function DoAssemble:boolean;virtual; 178 179 {# This routine should be overridden for each assembler, it is used 180 to actually write the abstract assembler stream to file.} 181 procedure WriteTree(p:TAsmList);virtual; 182 183 {# This routine should be overridden for each assembler, it is used 184 to actually write all the different abstract assembler streams 185 by calling for each stream type, the @var(WriteTree) method.} 186 procedure WriteAsmList;virtual; 187 188 {# Constructs the command line for calling the assembler } MakeCmdLinenull189 function MakeCmdLine: TCmdStr; virtual; 190 public 191 Constructor Create(info: pasminfo; smart: boolean); override; final; 192 Constructor CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean); virtual; 193 procedure MakeObject;override; 194 destructor Destroy; override; 195 196 property writer: TExternalAssemblerOutputFile read fwriter; 197 end; 198 TExternalAssemblerClass = class of TExternalAssembler; 199 200 { TInternalAssembler } 201 202 TInternalAssembler=class(TAssembler) 203 private 204 FCObjOutput : TObjOutputclass; 205 FCInternalAr : TObjectWriterClass; 206 { the aasmoutput lists that need to be processed } 207 lists : byte; 208 list : array[1..maxoutputlists] of TAsmList; 209 { current processing } 210 currlistidx : byte; 211 currlist : TAsmList; 212 procedure WriteStab(p:pchar); MaybeNextListnull213 function MaybeNextList(var hp:Tai):boolean; SetIndirectToSymbolnull214 function SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean; TreePass0null215 function TreePass0(hp:Tai):Tai; TreePass1null216 function TreePass1(hp:Tai):Tai; TreePass2null217 function TreePass2(hp:Tai):Tai; 218 procedure writetree; 219 procedure writetreesmart; 220 protected 221 ObjData : TObjData; 222 ObjOutput : tObjOutput; 223 property CObjOutput:TObjOutputclass read FCObjOutput write FCObjOutput; 224 property CInternalAr : TObjectWriterClass read FCInternalAr write FCInternalAr; 225 public 226 constructor Create(info: pasminfo; smart: boolean);override; 227 destructor destroy;override; 228 procedure MakeObject;override; 229 end; 230 231 TAssemblerClass = class of TAssembler; 232 233 Procedure GenerateAsm(smart:boolean); 234 235 { get an instance of an external GNU-style assembler that is compatible 236 with the current target, reusing an existing writer. Used by the LLVM 237 target to write inline assembler } GetExternalGnuAssemblerWithAsmInfoWriternull238 function GetExternalGnuAssemblerWithAsmInfoWriter(info: pasminfo; wr: TExternalAssemblerOutputFile): TExternalAssembler; 239 240 procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass); 241 242 243 Implementation 244 245 uses 246 {$ifdef hasunix} 247 unix, 248 {$endif} 249 cutils,cfileutl, 250 {$ifdef memdebug} 251 cclasses, 252 {$endif memdebug} 253 {$ifdef OMFOBJSUPPORT} 254 omfbase, 255 ogomf, 256 {$endif OMFOBJSUPPORT} 257 {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)} 258 {$else} 259 {$ifdef FPC_SOFT_FPUX80} 260 sfpux80, 261 {$endif FPC_SOFT_FPUX80} 262 {$endif} 263 cscript,fmodule,verbose, 264 cpuinfo,triplet, 265 aasmcpu; 266 267 var 268 CAssembler : array[tasm] of TAssemblerClass; 269 fixlinenull270 function fixline(s:string):string; 271 { 272 return s with all leading and ending spaces and tabs removed 273 } 274 var 275 i,j,k : integer; 276 begin 277 i:=length(s); 278 while (i>0) and (s[i] in [#9,' ']) do 279 dec(i); 280 j:=1; 281 while (j<i) and (s[j] in [#9,' ']) do 282 inc(j); 283 for k:=j to i do 284 if s[k] in [#0..#31,#127..#255] then 285 s[k]:='.'; 286 fixline:=Copy(s,j,i-j+1); 287 end; 288 289 {***************************************************************************** 290 TAssembler 291 *****************************************************************************} 292 293 Constructor TAssembler.Create(info: pasminfo; smart: boolean); 294 begin 295 asminfo:=info; 296 { load start values } 297 AsmFileName:=current_module.AsmFilename; 298 ObjFileName:=current_module.ObjFileName; 299 name:=Lower(current_module.modulename^); 300 path:=current_module.outputpath; 301 asmprefix := current_module.asmprefix^; 302 if current_module.outputpath = '' then 303 ppufilename := '' 304 else 305 ppufilename := current_module.ppufilename; 306 SmartAsm:=smart; 307 SmartFilesCount:=0; 308 SmartHeaderCount:=0; 309 SmartLinkOFiles.Clear; 310 end; 311 312 313 Destructor TAssembler.Destroy; 314 begin 315 end; 316 317 318 procedure TAssembler.NextSmartName(place:tcutplace); 319 var 320 s : string; 321 begin 322 inc(SmartFilesCount); 323 if SmartFilesCount>999999 then 324 Message(asmw_f_too_many_asm_files); 325 case place of 326 cut_begin : 327 begin 328 inc(SmartHeaderCount); 329 s:=asmprefix+tostr(SmartHeaderCount)+'h'; 330 end; 331 cut_normal : 332 s:=asmprefix+tostr(SmartHeaderCount)+'s'; 333 cut_end : 334 s:=asmprefix+tostr(SmartHeaderCount)+'t'; 335 end; 336 AsmFileName:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext); 337 ObjFileName:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext); 338 { insert in container so it can be cleared after the linking } 339 SmartLinkOFiles.Insert(ObjFileName); 340 end; 341 342 343 344 345 {***************************************************************************** 346 TAssemblerOutputFile 347 *****************************************************************************} 348 349 procedure TExternalAssemblerOutputFile.RemoveAsm; 350 var 351 g : file; 352 begin 353 if cs_asm_leave in current_settings.globalswitches then 354 exit; 355 if cs_asm_extern in current_settings.globalswitches then 356 AsmRes.AddDeleteCommand(owner.AsmFileName) 357 else 358 begin 359 assign(g,owner.AsmFileName); 360 {$push} {$I-} 361 erase(g); 362 {$pop} 363 if ioresult<>0 then; 364 end; 365 end; 366 367 368 Procedure TExternalAssemblerOutputFile.AsmFlush; 369 begin 370 if outcnt>0 then 371 begin 372 { suppress i/o error } 373 {$push} {$I-} 374 BlockWrite(outfile,outbuf,outcnt); 375 {$pop} 376 fioerror:=fioerror or (ioresult<>0); 377 outcnt:=0; 378 end; 379 end; 380 381 procedure TExternalAssemblerOutputFile.MarkEmpty; 382 begin 383 AsmStartSize:=AsmSize 384 end; 385 386 TExternalAssemblerOutputFile.ClearIfEmptynull387 function TExternalAssemblerOutputFile.ClearIfEmpty: boolean; 388 begin 389 result:=AsmSize=AsmStartSize; 390 if result then 391 AsmClear; 392 end; 393 394 395 procedure TExternalAssemblerOutputFile.AsmWriteFiltered(const c: char); 396 begin 397 MaybeAddLinePrefix; 398 AsmWriteAnsiStringUnfiltered(decorator.LineFilter(c)); 399 end; 400 401 402 procedure TExternalAssemblerOutputFile.AsmWriteFiltered(const s: string); 403 begin 404 MaybeAddLinePrefix; 405 AsmWriteAnsiStringUnfiltered(decorator.LineFilter(s)); 406 end; 407 408 409 procedure TExternalAssemblerOutputFile.AsmWriteFiltered(const s: ansistring); 410 begin 411 MaybeAddLinePrefix; 412 AsmWriteAnsiStringUnfiltered(decorator.LineFilter(s)); 413 end; 414 415 416 procedure TExternalAssemblerOutputFile.AsmWriteFiltered(p: pchar; len: longint); 417 var 418 s: ansistring; 419 begin 420 MaybeAddLinePrefix; 421 s:=''; 422 setlength(s,len); 423 move(p^,s[1],len); 424 AsmWriteAnsiStringUnfiltered(decorator.LineFilter(s)); 425 end; 426 427 428 Procedure TExternalAssemblerOutputFile.AsmClear; 429 begin 430 outcnt:=0; 431 end; 432 433 434 procedure TExternalAssemblerOutputFile.MaybeAddLinePrefix; 435 begin 436 if assigned(decorator) and 437 linestart then 438 begin 439 AsmWriteAnsiStringUnfiltered(decorator.LinePrefix); 440 linestart:=false; 441 end; 442 end; 443 444 445 procedure TExternalAssemblerOutputFile.MaybeAddLinePostfix; 446 begin 447 if assigned(decorator) and 448 not linestart then 449 begin 450 AsmWriteAnsiStringUnfiltered(decorator.LinePostfix); 451 linestart:=true; 452 end; 453 end; 454 455 456 procedure TExternalAssemblerOutputFile.AsmWriteAnsiStringUnfiltered(const s: ansistring); 457 var 458 StartIndex, ToWrite: longint; 459 begin 460 if s='' then 461 exit; 462 if OutCnt+length(s)>=AsmOutSize then 463 AsmFlush; 464 StartIndex:=1; 465 ToWrite:=length(s); 466 while ToWrite>AsmOutSize do 467 begin 468 Move(s[StartIndex],OutBuf[OutCnt],AsmOutSize); 469 inc(OutCnt,AsmOutSize); 470 inc(AsmSize,AsmOutSize); 471 AsmFlush; 472 inc(StartIndex,AsmOutSize); 473 dec(ToWrite,AsmOutSize); 474 end; 475 Move(s[StartIndex],OutBuf[OutCnt],ToWrite); 476 inc(OutCnt,ToWrite); 477 inc(AsmSize,ToWrite); 478 end; 479 480 481 constructor TExternalAssemblerOutputFile.Create(_owner: TExternalAssembler); 482 begin 483 owner:=_owner; 484 linestart:=true; 485 end; 486 487 488 Procedure TExternalAssemblerOutputFile.AsmWrite(const c: char); 489 begin 490 if assigned(decorator) then 491 AsmWriteFiltered(c) 492 else 493 begin 494 if OutCnt+1>=AsmOutSize then 495 AsmFlush; 496 OutBuf[OutCnt]:=c; 497 inc(OutCnt); 498 inc(AsmSize); 499 end; 500 end; 501 502 503 Procedure TExternalAssemblerOutputFile.AsmWrite(const s:string); 504 begin 505 if s='' then 506 exit; 507 if assigned(decorator) then 508 AsmWriteFiltered(s) 509 else 510 begin 511 if OutCnt+length(s)>=AsmOutSize then 512 AsmFlush; 513 Move(s[1],OutBuf[OutCnt],length(s)); 514 inc(OutCnt,length(s)); 515 inc(AsmSize,length(s)); 516 end; 517 end; 518 519 520 Procedure TExternalAssemblerOutputFile.AsmWrite(const s:ansistring); 521 begin 522 if s='' then 523 exit; 524 if assigned(decorator) then 525 AsmWriteFiltered(s) 526 else 527 AsmWriteAnsiStringUnfiltered(s); 528 end; 529 530 531 procedure TExternalAssemblerOutputFile.AsmWriteLn(const c: char); 532 begin 533 AsmWrite(c); 534 AsmLn; 535 end; 536 537 538 Procedure TExternalAssemblerOutputFile.AsmWriteLn(const s:string); 539 begin 540 AsmWrite(s); 541 AsmLn; 542 end; 543 544 545 Procedure TExternalAssemblerOutputFile.AsmWriteLn(const s: ansistring); 546 begin 547 AsmWrite(s); 548 AsmLn; 549 end; 550 551 552 Procedure TExternalAssemblerOutputFile.AsmWritePChar(p:pchar); 553 var 554 i,j : longint; 555 begin 556 i:=StrLen(p); 557 if i=0 then 558 exit; 559 if assigned(decorator) then 560 AsmWriteFiltered(p,i) 561 else 562 begin 563 j:=i; 564 while j>0 do 565 begin 566 i:=min(j,AsmOutSize); 567 if OutCnt+i>=AsmOutSize then 568 AsmFlush; 569 Move(p[0],OutBuf[OutCnt],i); 570 inc(OutCnt,i); 571 inc(AsmSize,i); 572 dec(j,i); 573 p:=pchar(@p[i]); 574 end; 575 end; 576 end; 577 578 579 Procedure TExternalAssemblerOutputFile.AsmLn; 580 var 581 newline: pshortstring; 582 newlineres: shortstring; 583 index: longint; 584 begin 585 MaybeAddLinePostfix; 586 if (cs_link_on_target in current_settings.globalswitches) then 587 newline:=@target_info.newline 588 else 589 newline:=@source_info.newline; 590 if assigned(decorator) then 591 begin 592 newlineres:=decorator.LineEnding(newline^); 593 newline:=@newlineres; 594 end; 595 if OutCnt>=AsmOutSize-length(newline^) then 596 AsmFlush; 597 index:=1; 598 repeat 599 OutBuf[OutCnt]:=newline^[index]; 600 inc(OutCnt); 601 inc(AsmSize); 602 inc(index); 603 until index>length(newline^); 604 end; 605 606 607 procedure TExternalAssemblerOutputFile.AsmCreate(Aplace:tcutplace); 608 {$ifdef hasamiga} 609 var 610 tempFileName: TPathStr; 611 {$endif} 612 begin 613 if owner.SmartAsm then 614 owner.NextSmartName(Aplace); 615 {$ifdef hasamiga} 616 { on Amiga/MorphOS try to redirect .s files to the T: assign, which is 617 for temp files, and usually (default setting) located in the RAM: drive. 618 This highly improves assembling speed for complex projects like the 619 compiler itself, especially on hardware with slow disk I/O. 620 Consider this as a poor man's pipe on Amiga, because real pipe handling 621 would be much more complex and error prone to implement. (KB) } 622 if (([cs_asm_extern,cs_asm_leave,cs_link_on_target] * current_settings.globalswitches) = []) then 623 begin 624 { try to have an unique name for the .s file } 625 tempFileName:=HexStr(GetProcessID shr 4,7)+ExtractFileName(owner.AsmFileName); 626 {$ifndef morphos} 627 { old Amiga RAM: handler only allows filenames up to 30 char } 628 if Length(tempFileName) < 30 then 629 {$endif} 630 owner.AsmFileName:='T:'+tempFileName; 631 end; 632 {$endif} 633 {$ifdef hasunix} 634 if owner.DoPipe then 635 begin 636 if owner.SmartAsm then 637 begin 638 if (owner.SmartFilesCount<=1) then 639 Message1(exec_i_assembling_smart,owner.name); 640 end 641 else 642 Message1(exec_i_assembling_pipe,owner.AsmFileName); 643 if checkverbosity(V_Executable) then 644 comment(V_Executable,'Executing "'+maybequoted(owner.FindAssembler)+'" with command line "'+ 645 owner.MakeCmdLine+'"'); 646 POpen(outfile,maybequoted(owner.FindAssembler)+' '+owner.MakeCmdLine,'W'); 647 end 648 else 649 {$endif} 650 begin 651 Assign(outfile,owner.AsmFileName); 652 {$push} {$I-} 653 Rewrite(outfile,1); 654 {$pop} 655 if ioresult<>0 then 656 begin 657 fioerror:=true; 658 Message1(exec_d_cant_create_asmfile,owner.AsmFileName); 659 end; 660 end; 661 outcnt:=0; 662 AsmSize:=0; 663 AsmStartSize:=0; 664 end; 665 666 667 procedure TExternalAssemblerOutputFile.AsmClose; 668 var 669 f : file; 670 FileAge : longint; 671 begin 672 AsmFlush; 673 {$ifdef hasunix} 674 if owner.DoPipe then 675 begin 676 if PClose(outfile) <> 0 then 677 GenerateError; 678 end 679 else 680 {$endif} 681 begin 682 {Touch Assembler time to ppu time is there is a ppufilename} 683 if owner.ppufilename<>'' then 684 begin 685 Assign(f,owner.ppufilename); 686 {$push} {$I-} 687 reset(f,1); 688 {$pop} 689 if ioresult=0 then 690 begin 691 FileAge := FileGetDate(GetFileHandle(f)); 692 close(f); 693 reset(outfile,1); 694 FileSetDate(GetFileHandle(outFile),FileAge); 695 end; 696 end; 697 close(outfile); 698 end; 699 end; 700 701 {***************************************************************************** 702 TExternalAssembler 703 *****************************************************************************} 704 705 TExternalAssembler.single2strnull706 function TExternalAssembler.single2str(d : single) : string; 707 var 708 hs : string; 709 begin 710 str(d,hs); 711 { replace space with + } 712 if hs[1]=' ' then 713 hs[1]:='+'; 714 single2str:='0d'+hs 715 end; 716 TExternalAssembler.double2strnull717 function TExternalAssembler.double2str(d : double) : string; 718 var 719 hs : string; 720 begin 721 str(d,hs); 722 { replace space with + } 723 if hs[1]=' ' then 724 hs[1]:='+'; 725 double2str:='0d'+hs 726 end; 727 TExternalAssembler.extended2strnull728 function TExternalAssembler.extended2str(e : extended) : string; 729 var 730 hs : string; 731 begin 732 str(e,hs); 733 { replace space with + } 734 if hs[1]=' ' then 735 hs[1]:='+'; 736 extended2str:='0d'+hs 737 end; 738 739 TExternalAssembler.DoPipenull740 Function TExternalAssembler.DoPipe:boolean; 741 begin 742 DoPipe:=(cs_asm_pipe in current_settings.globalswitches) and 743 (([cs_asm_extern,cs_asm_leave,cs_link_on_target] * current_settings.globalswitches) = []) and 744 ((asminfo^.id in [as_gas,as_ggas,as_darwin,as_powerpc_xcoff,as_clang_gas,as_clang_llvm,as_solaris_as])); 745 end; 746 747 TExternalAssembler.CreateNewAsmWriternull748 function TExternalAssembler.CreateNewAsmWriter: TExternalAssemblerOutputFile; 749 begin 750 result:=TExternalAssemblerOutputFile.Create(self); 751 end; 752 753 754 Constructor TExternalAssembler.Create(info: pasminfo; smart: boolean); 755 begin 756 CreateWithWriter(info,CreateNewAsmWriter,true,smart); 757 end; 758 759 760 constructor TExternalAssembler.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter,smart: boolean); 761 begin 762 inherited Create(info,smart); 763 fwriter:=wr; 764 ffreewriter:=freewriter; 765 if SmartAsm then 766 begin 767 path:=FixPath(ChangeFileExt(AsmFileName,target_info.smartext),false); 768 CreateSmartLinkPath(path); 769 end; 770 end; 771 772 773 procedure TExternalAssembler.CreateSmartLinkPath(const s:TPathStr); 774 775 procedure DeleteFilesWithExt(const AExt:string); 776 var 777 dir : TRawByteSearchRec; 778 begin 779 if findfirst(FixPath(s,false)+'*'+AExt,faAnyFile,dir) = 0 then 780 begin 781 repeat 782 DeleteFile(s+source_info.dirsep+dir.name); 783 until findnext(dir) <> 0; 784 end; 785 findclose(dir); 786 end; 787 788 var 789 hs : TPathStr; 790 begin 791 if PathExists(s,false) then 792 begin 793 { the path exists, now we clean only all the .o and .s files } 794 DeleteFilesWithExt(target_info.objext); 795 DeleteFilesWithExt(target_info.asmext); 796 end 797 else 798 begin 799 hs:=s; 800 if hs[length(hs)] in ['/','\'] then 801 delete(hs,length(hs),1); 802 {$push} {$I-} 803 mkdir(hs); 804 {$pop} 805 if ioresult<>0 then; 806 end; 807 end; 808 809 810 const 811 lastas : byte=255; 812 var 813 LastASBin : TCmdStr; TExternalAssembler.FindAssemblernull814 Function TExternalAssembler.FindAssembler:string; 815 var 816 asfound : boolean; 817 UtilExe : string; 818 begin 819 asfound:=false; 820 if cs_link_on_target in current_settings.globalswitches then 821 begin 822 { If linking on target, don't add any path PM } 823 FindAssembler:=utilsprefix+ChangeFileExt(asminfo^.asmbin,target_info.exeext); 824 exit; 825 end 826 else 827 UtilExe:=utilsprefix+ChangeFileExt(asminfo^.asmbin,source_info.exeext); 828 if lastas<>ord(asminfo^.id) then 829 begin 830 lastas:=ord(asminfo^.id); 831 { is an assembler passed ? } 832 if utilsdirectory<>'' then 833 asfound:=FindFile(UtilExe,utilsdirectory,false,LastASBin); 834 if not AsFound then 835 asfound:=FindExe(UtilExe,false,LastASBin); 836 if (not asfound) and not(cs_asm_extern in current_settings.globalswitches) then 837 begin 838 Message1(exec_e_assembler_not_found,LastASBin); 839 current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern]; 840 end; 841 if asfound then 842 Message1(exec_t_using_assembler,LastASBin); 843 end; 844 FindAssembler:=LastASBin; 845 end; 846 847 TExternalAssembler.CallAssemblernull848 Function TExternalAssembler.CallAssembler(const command:string; const para:TCmdStr):Boolean; 849 var 850 DosExitCode : Integer; 851 begin 852 result:=true; 853 if (cs_asm_extern in current_settings.globalswitches) then 854 begin 855 if SmartAsm then 856 AsmRes.AddAsmCommand(command,para,Name+'('+TosTr(SmartFilesCount)+')') 857 else 858 AsmRes.AddAsmCommand(command,para,name); 859 exit; 860 end; 861 try 862 FlushOutput; 863 DosExitCode:=RequotedExecuteProcess(command,para); 864 if DosExitCode<>0 865 then begin 866 Message1(exec_e_error_while_assembling,tostr(dosexitcode)); 867 result:=false; 868 end; 869 except on E:EOSError do 870 begin 871 Message1(exec_e_cant_call_assembler,tostr(E.ErrorCode)); 872 current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern]; 873 result:=false; 874 end; 875 end; 876 end; 877 878 TExternalAssembler.DoAssemblenull879 Function TExternalAssembler.DoAssemble:boolean; 880 begin 881 DoAssemble:=true; 882 if DoPipe then 883 exit; 884 if not(cs_asm_extern in current_settings.globalswitches) then 885 begin 886 if SmartAsm then 887 begin 888 if (SmartFilesCount<=1) then 889 Message1(exec_i_assembling_smart,name); 890 end 891 else 892 Message1(exec_i_assembling,name); 893 end; 894 895 if CallAssembler(FindAssembler,MakeCmdLine) then 896 writer.RemoveAsm 897 else 898 begin 899 DoAssemble:=false; 900 GenerateError; 901 end; 902 end; 903 904 TExternalAssembler.MakeCmdLinenull905 function TExternalAssembler.MakeCmdLine: TCmdStr; 906 section_high_boundnull907 function section_high_bound:longint; 908 var 909 alt : tasmlisttype; 910 begin 911 result:=0; 912 for alt:=low(tasmlisttype) to high(tasmlisttype) do 913 result:=result+current_asmdata.asmlists[alt].section_count; 914 end; 915 916 const 917 min_big_obj_section_count = $7fff; 918 919 begin 920 result:=asminfo^.asmcmd; 921 if af_llvm in target_asm.flags then 922 Replace(result,'$TRIPLET',targettriplet(triplet_llvm)) 923 {$ifdef arm} 924 else if (target_info.system=system_arm_ios) then 925 Replace(result,'$ARCH',lower(cputypestr[current_settings.cputype])) 926 {$endif arm} 927 ; 928 if (cs_link_on_target in current_settings.globalswitches) then 929 begin 930 Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName))); 931 Replace(result,'$OBJ',maybequoted(ScriptFixFileName(ObjFileName))); 932 end 933 else 934 begin 935 {$ifdef hasunix} 936 if DoPipe then 937 if not(asminfo^.id in [as_clang_gas,as_clang_asdarwin,as_clang_llvm]) then 938 Replace(result,'$ASM','') 939 else 940 Replace(result,'$ASM','-') 941 else 942 {$endif} 943 Replace(result,'$ASM',maybequoted(AsmFileName)); 944 Replace(result,'$OBJ',maybequoted(ObjFileName)); 945 end; 946 947 if (cs_create_pic in current_settings.moduleswitches) then 948 Replace(result,'$PIC','-KPIC') 949 else 950 Replace(result,'$PIC',''); 951 952 if (cs_asm_source in current_settings.globalswitches) then 953 Replace(result,'$NOWARN','') 954 else 955 Replace(result,'$NOWARN','-W'); 956 957 if target_info.endian=endian_little then 958 Replace(result,'$ENDIAN','-mlittle') 959 else 960 Replace(result,'$ENDIAN','-mbig'); 961 962 { as we don't keep track of the amount of sections we created we simply 963 enable Big Obj COFF files always for targets that need them } 964 if (cs_asm_pre_binutils_2_25 in current_settings.globalswitches) or 965 not (target_info.system in systems_all_windows+systems_nativent-[system_i8086_win16]) or 966 (section_high_bound<min_big_obj_section_count) then 967 Replace(result,'$BIGOBJ','') 968 else 969 Replace(result,'$BIGOBJ','-mbig-obj'); 970 971 Replace(result,'$EXTRAOPT',asmextraopt); 972 end; 973 974 975 procedure TExternalAssembler.WriteSourceLine(hp: tailineinfo); 976 var 977 module : tmodule; 978 begin 979 { load infile } 980 if (lastfileinfo.moduleindex<>hp.fileinfo.moduleindex) or 981 (lastfileinfo.fileindex<>hp.fileinfo.fileindex) then 982 begin 983 { in case of a generic the module can be different } 984 if current_module.unit_index=hp.fileinfo.moduleindex then 985 module:=current_module 986 else 987 module:=get_module(hp.fileinfo.moduleindex); 988 { during the compilation of the system unit there are cases when 989 the fileinfo contains just zeros => invalid } 990 if assigned(module) then 991 infile:=module.sourcefiles.get_file(hp.fileinfo.fileindex) 992 else 993 infile:=nil; 994 if assigned(infile) then 995 begin 996 { open only if needed !! } 997 if (cs_asm_source in current_settings.globalswitches) then 998 infile.open; 999 end; 1000 { avoid unnecessary reopens of the same file !! } 1001 lastfileinfo.fileindex:=hp.fileinfo.fileindex; 1002 lastfileinfo.moduleindex:=hp.fileinfo.moduleindex; 1003 { be sure to change line !! } 1004 lastfileinfo.line:=-1; 1005 end; 1006 { write source } 1007 if (cs_asm_source in current_settings.globalswitches) and 1008 assigned(infile) then 1009 begin 1010 if (infile<>lastinfile) then 1011 begin 1012 writer.AsmWriteLn(asminfo^.comment+'['+infile.name+']'); 1013 if assigned(lastinfile) then 1014 lastinfile.close; 1015 end; 1016 if (hp.fileinfo.line<>lastfileinfo.line) and 1017 (hp.fileinfo.line<infile.maxlinebuf) then 1018 begin 1019 if (hp.fileinfo.line<>0) and 1020 (infile.linebuf^[hp.fileinfo.line]>=0) then 1021 writer.AsmWriteLn(asminfo^.comment+'['+tostr(hp.fileinfo.line)+'] '+ 1022 fixline(infile.GetLineStr(hp.fileinfo.line))); 1023 { set it to a negative value ! 1024 to make that is has been read already !! PM } 1025 if (infile.linebuf^[hp.fileinfo.line]>=0) then 1026 infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1; 1027 end; 1028 end; 1029 lastfileinfo:=hp.fileinfo; 1030 lastinfile:=infile; 1031 end; 1032 1033 procedure TExternalAssembler.WriteTempalloc(hp: tai_tempalloc); 1034 begin 1035 {$ifdef EXTDEBUG} 1036 if assigned(hp.problem) then 1037 writer.AsmWriteLn(asminfo^.comment+'Temp '+tostr(hp.temppos)+','+ 1038 tostr(hp.tempsize)+' '+hp.problem^) 1039 else 1040 {$endif EXTDEBUG} 1041 writer.AsmWriteLn(asminfo^.comment+'Temp '+tostr(hp.temppos)+','+ 1042 tostr(hp.tempsize)+' '+tempallocstr[hp.allocation]); 1043 end; 1044 1045 1046 procedure TExternalAssembler.WriteRealConstAsBytes(hp: tai_realconst; const dbdir: string; do_line: boolean); 1047 var 1048 pdata: pbyte; 1049 index, step, swapmask, count: longint; 1050 ssingle: single; 1051 ddouble: double; 1052 ccomp: comp; 1053 {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)} 1054 eextended: extended; 1055 {$else} 1056 {$ifdef FPC_SOFT_FPUX80} 1057 eextended: floatx80; 1058 {$endif} 1059 {$endif cpuextended} 1060 begin 1061 if do_line then 1062 begin 1063 case tai_realconst(hp).realtyp of 1064 aitrealconst_s32bit: 1065 writer.AsmWriteLn(asminfo^.comment+'value: '+single2str(tai_realconst(hp).value.s32val)); 1066 aitrealconst_s64bit: 1067 writer.AsmWriteLn(asminfo^.comment+'value: '+double2str(tai_realconst(hp).value.s64val)); 1068 {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)} 1069 { can't write full 80 bit floating point constants yet on non-x86 } 1070 aitrealconst_s80bit: 1071 writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s80val)); 1072 {$else} 1073 {$ifdef FPC_SOFT_FPUX80} 1074 {$push}{$warn 6018 off} { Unreachable code due to compile time evaluation } 1075 aitrealconst_s80bit: 1076 begin 1077 if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then 1078 writer.AsmWriteLn(asminfo^.comment+'value: '+double2str(tai_realconst(hp).value.s80val)) 1079 else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then 1080 writer.AsmWriteLn(asminfo^.comment+'value: '+single2str(tai_realconst(hp).value.s80val)) 1081 else 1082 internalerror(2017091901); 1083 end; 1084 {$pop} 1085 {$endif} 1086 {$endif cpuextended} 1087 aitrealconst_s64comp: 1088 writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s64compval)); 1089 else 1090 internalerror(2014050604); 1091 end; 1092 end; 1093 writer.AsmWrite(dbdir); 1094 { generic float writing code: get start address of value, then write 1095 byte by byte. Can't use fields directly, because e.g ts64comp is 1096 defined as extended on x86 } 1097 case tai_realconst(hp).realtyp of 1098 aitrealconst_s32bit: 1099 begin 1100 ssingle:=single(tai_realconst(hp).value.s32val); 1101 pdata:=@ssingle; 1102 end; 1103 aitrealconst_s64bit: 1104 begin 1105 ddouble:=double(tai_realconst(hp).value.s64val); 1106 pdata:=@ddouble; 1107 end; 1108 {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)} 1109 { can't write full 80 bit floating point constants yet on non-x86 } 1110 aitrealconst_s80bit: 1111 begin 1112 eextended:=extended(tai_realconst(hp).value.s80val); 1113 pdata:=@eextended; 1114 end; 1115 {$else} 1116 {$ifdef FPC_SOFT_FPUX80} 1117 {$push}{$warn 6018 off} { Unreachable code due to compile time evaluation } 1118 aitrealconst_s80bit: 1119 begin 1120 if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then 1121 eextended:=float64_to_floatx80(float64(double(tai_realconst(hp).value.s80val))) 1122 else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then 1123 eextended:=float32_to_floatx80(float32(single(tai_realconst(hp).value.s80val))) 1124 else 1125 internalerror(2017091901); 1126 pdata:=@eextended; 1127 end; 1128 {$pop} 1129 {$endif} 1130 {$endif cpuextended} 1131 aitrealconst_s64comp: 1132 begin 1133 ccomp:=comp(tai_realconst(hp).value.s64compval); 1134 pdata:=@ccomp; 1135 end; 1136 else 1137 internalerror(2014051001); 1138 end; 1139 count:=tai_realconst(hp).datasize; 1140 { write bytes in inverse order if source and target endianess don't 1141 match } 1142 if source_info.endian<>target_info.endian then 1143 begin 1144 { go from back to front } 1145 index:=count-1; 1146 step:=-1; 1147 end 1148 else 1149 begin 1150 index:=0; 1151 step:=1; 1152 end; 1153 {$ifdef ARM} 1154 { ARM-specific: low and high dwords of a double may be swapped } 1155 if tai_realconst(hp).formatoptions=fo_hiloswapped then 1156 begin 1157 { only supported for double } 1158 if tai_realconst(hp).datasize<>8 then 1159 internalerror(2014050605); 1160 { switch bit of the index so that the words are written in 1161 the opposite order } 1162 swapmask:=4; 1163 end 1164 else 1165 {$endif ARM} 1166 swapmask:=0; 1167 repeat 1168 writer.AsmWrite(tostr(pdata[index xor swapmask])); 1169 inc(index,step); 1170 dec(count); 1171 if count<>0 then 1172 writer.AsmWrite(','); 1173 until count=0; 1174 { padding } 1175 for count:=tai_realconst(hp).datasize+1 to tai_realconst(hp).savesize do 1176 writer.AsmWrite(',0'); 1177 writer.AsmLn; 1178 end; 1179 1180 1181 procedure TExternalAssembler.WriteTree(p:TAsmList); 1182 begin 1183 end; 1184 1185 1186 procedure TExternalAssembler.WriteAsmList; 1187 begin 1188 end; 1189 1190 1191 procedure TExternalAssembler.MakeObject; 1192 begin 1193 writer.AsmCreate(cut_normal); 1194 FillChar(lastfileinfo, sizeof(lastfileinfo), 0); 1195 lastfileinfo.line := -1; 1196 lastinfile := nil; 1197 lastsectype := sec_none; 1198 WriteAsmList; 1199 writer.AsmClose; 1200 if not(writer.ioerror) then 1201 DoAssemble; 1202 end; 1203 1204 1205 destructor TExternalAssembler.Destroy; 1206 begin 1207 if ffreewriter then 1208 writer.Free; 1209 inherited; 1210 end; 1211 1212 1213 {***************************************************************************** 1214 TInternalAssembler 1215 *****************************************************************************} 1216 1217 constructor TInternalAssembler.Create(info: pasminfo; smart: boolean); 1218 begin 1219 inherited; 1220 ObjOutput:=nil; 1221 ObjData:=nil; 1222 SmartAsm:=smart; 1223 end; 1224 1225 1226 destructor TInternalAssembler.destroy; 1227 begin 1228 if assigned(ObjData) then 1229 ObjData.free; 1230 if assigned(ObjOutput) then 1231 ObjOutput.free; 1232 end; 1233 1234 1235 procedure TInternalAssembler.WriteStab(p:pchar); 1236 consumecommanull1237 function consumecomma(var p:pchar):boolean; 1238 begin 1239 while (p^=' ') do 1240 inc(p); 1241 result:=(p^=','); 1242 inc(p); 1243 end; 1244 consumenumbernull1245 function consumenumber(var p:pchar;out value:longint):boolean; 1246 var 1247 hs : string; 1248 len, 1249 code : integer; 1250 begin 1251 value:=0; 1252 while (p^=' ') do 1253 inc(p); 1254 len:=0; 1255 while (p^ in ['0'..'9']) do 1256 begin 1257 inc(len); 1258 hs[len]:=p^; 1259 inc(p); 1260 end; 1261 if len>0 then 1262 begin 1263 hs[0]:=chr(len); 1264 val(hs,value,code); 1265 end 1266 else 1267 code:=-1; 1268 result:=(code=0); 1269 end; 1270 consumeoffsetnull1271 function consumeoffset(var p:pchar;out relocsym:tobjsymbol;out value:longint):boolean; 1272 var 1273 hs : string; 1274 len, 1275 code : integer; 1276 pstart : pchar; 1277 sym : tobjsymbol; 1278 exprvalue : longint; 1279 gotmin, 1280 have_first_symbol, 1281 have_second_symbol, 1282 dosub : boolean; 1283 begin 1284 result:=false; 1285 value:=0; 1286 relocsym:=nil; 1287 gotmin:=false; 1288 have_first_symbol:=false; 1289 have_second_symbol:=false; 1290 repeat 1291 dosub:=false; 1292 exprvalue:=0; 1293 if gotmin then 1294 begin 1295 dosub:=true; 1296 gotmin:=false; 1297 end; 1298 while (p^=' ') do 1299 inc(p); 1300 case p^ of 1301 #0 : 1302 break; 1303 ' ' : 1304 inc(p); 1305 '0'..'9' : 1306 begin 1307 len:=0; 1308 while (p^ in ['0'..'9']) do 1309 begin 1310 inc(len); 1311 hs[len]:=p^; 1312 inc(p); 1313 end; 1314 hs[0]:=chr(len); 1315 val(hs,exprvalue,code); 1316 if code<>0 then 1317 internalerror(200702251); 1318 end; 1319 '.','_', 1320 'A'..'Z', 1321 'a'..'z' : 1322 begin 1323 pstart:=p; 1324 while not(p^ in [#0,' ','-','+']) do 1325 inc(p); 1326 len:=p-pstart; 1327 if len>255 then 1328 internalerror(200509187); 1329 move(pstart^,hs[1],len); 1330 hs[0]:=chr(len); 1331 sym:=objdata.symbolref(hs); 1332 { Second symbol? } 1333 if assigned(relocsym) then 1334 begin 1335 if have_second_symbol then 1336 internalerror(2007032201); 1337 have_second_symbol:=true; 1338 if not have_first_symbol then 1339 internalerror(2007032202); 1340 { second symbol should substracted to first } 1341 if not dosub then 1342 internalerror(2007032203); 1343 if (relocsym.objsection<>sym.objsection) then 1344 internalerror(2005091810); 1345 exprvalue:=relocsym.address-sym.address; 1346 relocsym:=nil; 1347 dosub:=false; 1348 end 1349 else 1350 begin 1351 relocsym:=sym; 1352 if assigned(sym.objsection) then 1353 begin 1354 { first symbol should be + } 1355 if not have_first_symbol and dosub then 1356 internalerror(2007032204); 1357 have_first_symbol:=true; 1358 end; 1359 end; 1360 end; 1361 '+' : 1362 begin 1363 { nothing, by default addition is done } 1364 inc(p); 1365 end; 1366 '-' : 1367 begin 1368 gotmin:=true; 1369 inc(p); 1370 end; 1371 else 1372 internalerror(200509189); 1373 end; 1374 if dosub then 1375 dec(value,exprvalue) 1376 else 1377 inc(value,exprvalue); 1378 until false; 1379 result:=true; 1380 end; 1381 1382 var 1383 stabstrlen, 1384 ofs, 1385 nline, 1386 nidx, 1387 nother, 1388 i : longint; 1389 stab : TObjStabEntry; 1390 relocsym : TObjSymbol; 1391 pstr, 1392 pcurr, 1393 pendquote : pchar; 1394 oldsec : TObjSection; 1395 begin 1396 pcurr:=nil; 1397 pstr:=nil; 1398 pendquote:=nil; 1399 relocsym:=nil; 1400 ofs:=0; 1401 1402 { Parse string part } 1403 if (p[0]='"') then 1404 begin 1405 pstr:=@p[1]; 1406 { Ignore \" inside the string } 1407 i:=1; 1408 while not((p[i]='"') and (p[i-1]<>'\')) and 1409 (p[i]<>#0) do 1410 inc(i); 1411 pendquote:=@p[i]; 1412 pendquote^:=#0; 1413 pcurr:=@p[i+1]; 1414 if not consumecomma(pcurr) then 1415 internalerror(200509181); 1416 end 1417 else 1418 pcurr:=p; 1419 1420 { When in pass 1 then only alloc and leave } 1421 if ObjData.currpass=1 then 1422 begin 1423 ObjData.StabsSec.Alloc(sizeof(TObjStabEntry)); 1424 if assigned(pstr) and (pstr[0]<>#0) then 1425 ObjData.StabStrSec.Alloc(strlen(pstr)+1); 1426 end 1427 else 1428 begin 1429 { Stabs format: nidx,nother,nline[,offset] } 1430 if not consumenumber(pcurr,nidx) then 1431 internalerror(200509182); 1432 if not consumecomma(pcurr) then 1433 internalerror(200509183); 1434 if not consumenumber(pcurr,nother) then 1435 internalerror(200509184); 1436 if not consumecomma(pcurr) then 1437 internalerror(200509185); 1438 if not consumenumber(pcurr,nline) then 1439 internalerror(200509186); 1440 if consumecomma(pcurr) then 1441 consumeoffset(pcurr,relocsym,ofs); 1442 1443 { Generate stab entry } 1444 if assigned(pstr) and (pstr[0]<>#0) then 1445 begin 1446 stabstrlen:=strlen(pstr); 1447 {$ifdef optimizestabs} 1448 StabStrEntry:=nil; 1449 if (nidx=N_SourceFile) or (nidx=N_IncludeFile) then 1450 begin 1451 hs:=strpas(pstr); 1452 StabstrEntry:=StabStrDict.Find(hs); 1453 if not assigned(StabstrEntry) then 1454 begin 1455 StabstrEntry:=TStabStrEntry.Create(hs); 1456 StabstrEntry:=StabStrSec.Size; 1457 StabStrDict.Insert(StabstrEntry); 1458 { generate new stab } 1459 StabstrEntry:=nil; 1460 end; 1461 end; 1462 if assigned(StabstrEntry) then 1463 stab.strpos:=StabstrEntry.strpos 1464 else 1465 {$endif optimizestabs} 1466 begin 1467 stab.strpos:=ObjData.StabStrSec.Size; 1468 ObjData.StabStrSec.write(pstr^,stabstrlen+1); 1469 end; 1470 end 1471 else 1472 stab.strpos:=0; 1473 stab.ntype:=byte(nidx); 1474 stab.ndesc:=word(nline); 1475 stab.nother:=byte(nother); 1476 stab.nvalue:=ofs; 1477 1478 { Write the stab first without the value field. Then 1479 write a the value field with relocation } 1480 oldsec:=ObjData.CurrObjSec; 1481 ObjData.SetSection(ObjData.StabsSec); 1482 ObjData.Writebytes(stab,sizeof(TObjStabEntry)-4); 1483 ObjData.Writereloc(stab.nvalue,4,relocsym,RELOC_ABSOLUTE32); 1484 ObjData.setsection(oldsec); 1485 end; 1486 if assigned(pendquote) then 1487 pendquote^:='"'; 1488 end; 1489 1490 TInternalAssembler.MaybeNextListnull1491 function TInternalAssembler.MaybeNextList(var hp:Tai):boolean; 1492 begin 1493 { maybe end of list } 1494 while not assigned(hp) do 1495 begin 1496 if currlistidx<lists then 1497 begin 1498 inc(currlistidx); 1499 currlist:=list[currlistidx]; 1500 hp:=Tai(currList.first); 1501 end 1502 else 1503 begin 1504 MaybeNextList:=false; 1505 exit; 1506 end; 1507 end; 1508 MaybeNextList:=true; 1509 end; 1510 1511 TInternalAssembler.SetIndirectToSymbolnull1512 function TInternalAssembler.SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean; 1513 var 1514 objsym : TObjSymbol; 1515 indsym : TObjSymbol; 1516 begin 1517 Result:= 1518 Assigned(hp) and 1519 (hp.typ=ait_symbol); 1520 if not Result then 1521 Exit; 1522 objsym:=Objdata.SymbolRef(tai_symbol(hp).sym); 1523 objsym.size:=0; 1524 1525 indsym := TObjSymbol(ObjData.ObjSymbolList.Find(indirectname)); 1526 if not Assigned(indsym) then 1527 begin 1528 { it's possible that indirect symbol is not present in the list, 1529 so we must create it as undefined } 1530 indsym:=ObjData.CObjSymbol.Create(ObjData.ObjSymbolList, indirectname); 1531 indsym.typ:=AT_NONE; 1532 indsym.bind:=AB_NONE; 1533 end; 1534 objsym.indsymbol:=indsym; 1535 Result:=true; 1536 end; 1537 1538 TInternalAssembler.TreePass0null1539 function TInternalAssembler.TreePass0(hp:Tai):Tai; 1540 var 1541 objsym, 1542 objsymend : TObjSymbol; 1543 cpu: tcputype; 1544 begin 1545 while assigned(hp) do 1546 begin 1547 case hp.typ of 1548 ait_align : 1549 begin 1550 if tai_align_abstract(hp).aligntype>1 then 1551 begin 1552 { always use the maximum fillsize in this pass to avoid possible 1553 short jumps to become out of range } 1554 Tai_align_abstract(hp).fillsize:=Tai_align_abstract(hp).aligntype; 1555 ObjData.alloc(Tai_align_abstract(hp).fillsize); 1556 { may need to increase alignment of section } 1557 if tai_align_abstract(hp).aligntype>ObjData.CurrObjSec.secalign then 1558 ObjData.CurrObjSec.secalign:=tai_align_abstract(hp).aligntype; 1559 end 1560 else 1561 Tai_align_abstract(hp).fillsize:=0; 1562 end; 1563 ait_datablock : 1564 begin 1565 {$ifdef USE_COMM_IN_BSS} 1566 if writingpackages and 1567 Tai_datablock(hp).is_global then 1568 ObjData.SymbolDefine(Tai_datablock(hp).sym) 1569 else 1570 {$endif USE_COMM_IN_BSS} 1571 begin 1572 ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign)); 1573 ObjData.SymbolDefine(Tai_datablock(hp).sym); 1574 ObjData.alloc(Tai_datablock(hp).size); 1575 end; 1576 end; 1577 ait_realconst: 1578 ObjData.alloc(tai_realconst(hp).savesize); 1579 ait_const: 1580 begin 1581 { if symbols are provided we can calculate the value for relative symbols. 1582 This is required for length calculation of leb128 constants } 1583 if assigned(tai_const(hp).sym) then 1584 begin 1585 objsym:=Objdata.SymbolRef(tai_const(hp).sym); 1586 { objsym already defined and there is endsym? } 1587 if assigned(objsym.objsection) and assigned(tai_const(hp).endsym) then 1588 begin 1589 objsymend:=Objdata.SymbolRef(tai_const(hp).endsym); 1590 { objsymend already defined? } 1591 if assigned(objsymend.objsection) then 1592 begin 1593 if objsymend.objsection<>objsym.objsection then 1594 begin 1595 { leb128 relative constants are not relocatable, but other types are, 1596 given that objsym belongs to the current section. } 1597 if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or 1598 (objsym.objsection<>ObjData.CurrObjSec) then 1599 InternalError(200404124); 1600 end 1601 else 1602 Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs; 1603 end; 1604 end; 1605 end; 1606 ObjData.alloc(tai_const(hp).size); 1607 end; 1608 ait_directive: 1609 begin 1610 case tai_directive(hp).directive of 1611 asd_indirect_symbol: 1612 { handled in TreePass1 } 1613 ; 1614 asd_lazy_reference: 1615 begin 1616 if tai_directive(hp).name='' then 1617 Internalerror(2009112101); 1618 objsym:=ObjData.symbolref(tai_directive(hp).name); 1619 objsym.bind:=AB_LAZY; 1620 end; 1621 asd_reference: 1622 { ignore for now, but should be added} 1623 ; 1624 asd_cpu: 1625 begin 1626 ObjData.CPUType:=cpu_none; 1627 for cpu:=low(tcputype) to high(tcputype) do 1628 if cputypestr[cpu]=tai_directive(hp).name then 1629 begin 1630 ObjData.CPUType:=cpu; 1631 break; 1632 end; 1633 end; 1634 {$ifdef OMFOBJSUPPORT} 1635 asd_omf_linnum_line: 1636 { ignore for now, but should be added} 1637 ; 1638 {$endif OMFOBJSUPPORT} 1639 {$ifdef ARM} 1640 asd_thumb_func: 1641 ObjData.ThumbFunc:=true; 1642 asd_code: 1643 { ai_directive(hp).name can be only 16 or 32, this is checked by the reader } 1644 ObjData.ThumbFunc:=tai_directive(hp).name='16'; 1645 {$endif ARM} 1646 else 1647 internalerror(2010011101); 1648 end; 1649 end; 1650 ait_section: 1651 begin 1652 ObjData.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secorder); 1653 Tai_section(hp).sec:=ObjData.CurrObjSec; 1654 end; 1655 ait_symbol : 1656 begin 1657 { needs extra support in the internal assembler } 1658 { the value is just ignored } 1659 {if tai_symbol(hp).has_value then 1660 internalerror(2009090804); ;} 1661 ObjData.SymbolDefine(Tai_symbol(hp).sym); 1662 end; 1663 ait_label : 1664 ObjData.SymbolDefine(Tai_label(hp).labsym); 1665 ait_string : 1666 ObjData.alloc(Tai_string(hp).len); 1667 ait_instruction : 1668 begin 1669 { reset instructions which could change in pass 2 } 1670 Taicpu(hp).resetpass2; 1671 ObjData.alloc(Taicpu(hp).Pass1(ObjData)); 1672 end; 1673 ait_cutobject : 1674 if SmartAsm then 1675 break; 1676 end; 1677 hp:=Tai(hp.next); 1678 end; 1679 TreePass0:=hp; 1680 end; 1681 1682 TInternalAssembler.TreePass1null1683 function TInternalAssembler.TreePass1(hp:Tai):Tai; 1684 var 1685 objsym, 1686 objsymend : TObjSymbol; 1687 cpu: tcputype; 1688 begin 1689 while assigned(hp) do 1690 begin 1691 case hp.typ of 1692 ait_align : 1693 begin 1694 if tai_align_abstract(hp).aligntype>1 then 1695 begin 1696 { here we must determine the fillsize which is used in pass2 } 1697 Tai_align_abstract(hp).fillsize:=align(ObjData.CurrObjSec.Size,Tai_align_abstract(hp).aligntype)- 1698 ObjData.CurrObjSec.Size; 1699 ObjData.alloc(Tai_align_abstract(hp).fillsize); 1700 end; 1701 end; 1702 ait_datablock : 1703 begin 1704 if (oso_data in ObjData.CurrObjSec.secoptions) and 1705 not (oso_sparse_data in ObjData.CurrObjSec.secoptions) then 1706 Message(asmw_e_alloc_data_only_in_bss); 1707 {$ifdef USE_COMM_IN_BSS} 1708 if writingpackages and 1709 Tai_datablock(hp).is_global then 1710 begin 1711 objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym); 1712 objsym.size:=Tai_datablock(hp).size; 1713 objsym.bind:=AB_COMMON; 1714 objsym.alignment:=needtowritealignmentalsoforELF; 1715 end 1716 else 1717 {$endif USE_COMM_IN_BSS} 1718 begin 1719 ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign)); 1720 objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym); 1721 objsym.size:=Tai_datablock(hp).size; 1722 ObjData.alloc(Tai_datablock(hp).size); 1723 end; 1724 end; 1725 ait_realconst: 1726 ObjData.alloc(tai_realconst(hp).savesize); 1727 ait_const: 1728 begin 1729 { Recalculate relative symbols } 1730 if assigned(tai_const(hp).sym) and 1731 assigned(tai_const(hp).endsym) then 1732 begin 1733 objsym:=Objdata.SymbolRef(tai_const(hp).sym); 1734 objsymend:=Objdata.SymbolRef(tai_const(hp).endsym); 1735 if objsymend.objsection<>objsym.objsection then 1736 begin 1737 if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or 1738 (objsym.objsection<>ObjData.CurrObjSec) then 1739 internalerror(200905042); 1740 end 1741 else 1742 Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs; 1743 end; 1744 ObjData.alloc(tai_const(hp).size); 1745 end; 1746 ait_section: 1747 begin 1748 { use cached value } 1749 ObjData.setsection(Tai_section(hp).sec); 1750 end; 1751 ait_stab : 1752 begin 1753 if assigned(Tai_stab(hp).str) then 1754 WriteStab(Tai_stab(hp).str); 1755 end; 1756 ait_symbol : 1757 ObjData.SymbolDefine(Tai_symbol(hp).sym); 1758 ait_symbol_end : 1759 begin 1760 objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym); 1761 objsym.size:=ObjData.CurrObjSec.Size-objsym.offset; 1762 end; 1763 ait_label : 1764 ObjData.SymbolDefine(Tai_label(hp).labsym); 1765 ait_string : 1766 ObjData.alloc(Tai_string(hp).len); 1767 ait_instruction : 1768 ObjData.alloc(Taicpu(hp).Pass1(ObjData)); 1769 ait_cutobject : 1770 if SmartAsm then 1771 break; 1772 ait_directive : 1773 begin 1774 case tai_directive(hp).directive of 1775 asd_indirect_symbol: 1776 if tai_directive(hp).name='' then 1777 Internalerror(2009101103) 1778 else if not SetIndirectToSymbol(Tai(hp.Previous), tai_directive(hp).name) then 1779 Internalerror(2009101102); 1780 asd_lazy_reference: 1781 { handled in TreePass0 } 1782 ; 1783 asd_reference: 1784 { ignore for now, but should be added} 1785 ; 1786 asd_thumb_func: 1787 { ignore for now, but should be added} 1788 ; 1789 asd_code: 1790 { ignore for now, but should be added} 1791 ; 1792 {$ifdef OMFOBJSUPPORT} 1793 asd_omf_linnum_line: 1794 { ignore for now, but should be added} 1795 ; 1796 {$endif OMFOBJSUPPORT} 1797 asd_cpu: 1798 begin 1799 ObjData.CPUType:=cpu_none; 1800 for cpu:=low(tcputype) to high(tcputype) do 1801 if cputypestr[cpu]=tai_directive(hp).name then 1802 begin 1803 ObjData.CPUType:=cpu; 1804 break; 1805 end; 1806 end; 1807 else 1808 internalerror(2010011102); 1809 end; 1810 end; 1811 end; 1812 hp:=Tai(hp.next); 1813 end; 1814 TreePass1:=hp; 1815 end; 1816 1817 TInternalAssembler.TreePass2null1818 function TInternalAssembler.TreePass2(hp:Tai):Tai; 1819 var 1820 fillbuffer : tfillbuffer; 1821 leblen : byte; 1822 lebbuf : array[0..63] of byte; 1823 objsym, 1824 ref, 1825 objsymend : TObjSymbol; 1826 zerobuf : array[0..63] of byte; 1827 relative_reloc: boolean; 1828 pdata : pointer; 1829 ssingle : single; 1830 ddouble : double; 1831 {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)} 1832 eextended : extended; 1833 {$else} 1834 {$ifdef FPC_SOFT_FPUX80} 1835 eextended : floatx80; 1836 {$endif} 1837 {$endif} 1838 ccomp : comp; 1839 tmp : word; 1840 cpu: tcputype; 1841 begin 1842 fillchar(zerobuf,sizeof(zerobuf),0); 1843 fillchar(objsym,sizeof(objsym),0); 1844 fillchar(objsymend,sizeof(objsymend),0); 1845 { main loop } 1846 while assigned(hp) do 1847 begin 1848 case hp.typ of 1849 ait_align : 1850 begin 1851 if tai_align_abstract(hp).aligntype>ObjData.CurrObjSec.secalign then 1852 InternalError(2012072301); 1853 if oso_data in ObjData.CurrObjSec.secoptions then 1854 ObjData.writebytes(Tai_align_abstract(hp).calculatefillbuf(fillbuffer,oso_executable in ObjData.CurrObjSec.secoptions)^, 1855 Tai_align_abstract(hp).fillsize) 1856 else 1857 ObjData.alloc(Tai_align_abstract(hp).fillsize); 1858 end; 1859 ait_section : 1860 begin 1861 { use cached value } 1862 ObjData.setsection(Tai_section(hp).sec); 1863 end; 1864 ait_symbol : 1865 begin 1866 ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_symbol(hp).sym)); 1867 end; 1868 ait_symbol_end : 1869 begin 1870 { recalculate size, as some preceding instructions 1871 could have been changed to smaller size } 1872 objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym); 1873 objsym.size:=ObjData.CurrObjSec.Size-objsym.offset; 1874 end; 1875 ait_datablock : 1876 begin 1877 ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_datablock(hp).sym)); 1878 {$ifdef USE_COMM_IN_BSS} 1879 if not(writingpackages and 1880 Tai_datablock(hp).is_global) then 1881 {$endif USE_COMM_IN_BSS} 1882 begin 1883 ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign)); 1884 ObjData.alloc(Tai_datablock(hp).size); 1885 end; 1886 end; 1887 ait_realconst: 1888 begin 1889 case tai_realconst(hp).realtyp of 1890 aitrealconst_s32bit: 1891 begin 1892 ssingle:=single(tai_realconst(hp).value.s32val); 1893 pdata:=@ssingle; 1894 end; 1895 aitrealconst_s64bit: 1896 begin 1897 ddouble:=double(tai_realconst(hp).value.s64val); 1898 pdata:=@ddouble; 1899 end; 1900 {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)} 1901 { can't write full 80 bit floating point constants yet on non-x86 } 1902 aitrealconst_s80bit: 1903 begin 1904 eextended:=extended(tai_realconst(hp).value.s80val); 1905 pdata:=@eextended; 1906 end; 1907 {$else} 1908 {$ifdef FPC_SOFT_FPUX80} 1909 {$push}{$warn 6018 off} { Unreachable code due to compile time evaluation } 1910 aitrealconst_s80bit: 1911 begin 1912 if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then 1913 eextended:=float64_to_floatx80(float64(double(tai_realconst(hp).value.s80val))) 1914 else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then 1915 eextended:=float32_to_floatx80(float32(single(tai_realconst(hp).value.s80val))) 1916 else 1917 internalerror(2017091901); 1918 pdata:=@eextended; 1919 end; 1920 {$pop} 1921 {$endif} 1922 {$endif cpuextended} 1923 aitrealconst_s64comp: 1924 begin 1925 ccomp:=comp(tai_realconst(hp).value.s64compval); 1926 pdata:=@ccomp; 1927 end; 1928 else 1929 internalerror(2015030501); 1930 end; 1931 ObjData.writebytes(pdata^,tai_realconst(hp).datasize); 1932 ObjData.writebytes(zerobuf,tai_realconst(hp).savesize-tai_realconst(hp).datasize); 1933 end; 1934 ait_string : 1935 ObjData.writebytes(Tai_string(hp).str^,Tai_string(hp).len); 1936 ait_const : 1937 begin 1938 { Recalculate relative symbols, addresses of forward references 1939 can be changed in treepass1 } 1940 relative_reloc:=false; 1941 if assigned(tai_const(hp).sym) and 1942 assigned(tai_const(hp).endsym) then 1943 begin 1944 objsym:=Objdata.SymbolRef(tai_const(hp).sym); 1945 objsymend:=Objdata.SymbolRef(tai_const(hp).endsym); 1946 relative_reloc:=(objsym.objsection<>objsymend.objsection); 1947 Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs; 1948 end; 1949 case tai_const(hp).consttype of 1950 aitconst_64bit, 1951 aitconst_32bit, 1952 aitconst_16bit, 1953 aitconst_64bit_unaligned, 1954 aitconst_32bit_unaligned, 1955 aitconst_16bit_unaligned, 1956 aitconst_8bit : 1957 begin 1958 if assigned(tai_const(hp).sym) and 1959 not assigned(tai_const(hp).endsym) then 1960 ObjData.writereloc(Tai_const(hp).symofs,tai_const(hp).size,Objdata.SymbolRef(tai_const(hp).sym),RELOC_ABSOLUTE) 1961 else if relative_reloc then 1962 ObjData.writereloc(ObjData.CurrObjSec.size+tai_const(hp).size-objsym.address+tai_const(hp).symofs,tai_const(hp).size,objsymend,RELOC_RELATIVE) 1963 else 1964 ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size); 1965 end; 1966 aitconst_rva_symbol : 1967 begin 1968 { PE32+? } 1969 if target_info.system=system_x86_64_win64 then 1970 ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA) 1971 else 1972 ObjData.writereloc(Tai_const(hp).symofs,sizeof(pint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA); 1973 end; 1974 aitconst_secrel32_symbol : 1975 begin 1976 { Required for DWARF2 support under Windows } 1977 ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_SECREL32); 1978 end; 1979 {$ifdef i8086} 1980 aitconst_farptr : 1981 if assigned(tai_const(hp).sym) and 1982 not assigned(tai_const(hp).endsym) then 1983 ObjData.writereloc(Tai_const(hp).symofs,tai_const(hp).size,Objdata.SymbolRef(tai_const(hp).sym),RELOC_FARPTR) 1984 else if relative_reloc then 1985 internalerror(2015040601) 1986 else 1987 ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size); 1988 aitconst_seg: 1989 if assigned(tai_const(hp).sym) and (tai_const(hp).size=2) then 1990 ObjData.writereloc(0,2,Objdata.SymbolRef(tai_const(hp).sym),RELOC_SEG) 1991 else 1992 internalerror(2015110502); 1993 aitconst_dgroup: 1994 ObjData.writereloc(0,2,nil,RELOC_DGROUP); 1995 aitconst_fardataseg: 1996 ObjData.writereloc(0,2,nil,RELOC_FARDATASEG); 1997 {$endif i8086} 1998 {$ifdef arm} 1999 aitconst_got: 2000 ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_GOT32); 2001 {$endif arm} 2002 aitconst_gotoff_symbol: 2003 ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_GOTOFF); 2004 aitconst_uleb128bit, 2005 aitconst_sleb128bit : 2006 begin 2007 if tai_const(hp).consttype=aitconst_uleb128bit then 2008 leblen:=EncodeUleb128(qword(Tai_const(hp).value),lebbuf) 2009 else 2010 leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf); 2011 if leblen<>tai_const(hp).size then 2012 internalerror(200709271); 2013 ObjData.writebytes(lebbuf,leblen); 2014 end; 2015 aitconst_darwin_dwarf_delta32, 2016 aitconst_darwin_dwarf_delta64: 2017 ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size); 2018 aitconst_half16bit, 2019 aitconst_gs: 2020 begin 2021 tmp:=Tai_const(hp).value div 2; 2022 ObjData.writebytes(tmp,2); 2023 end; 2024 else 2025 internalerror(200603254); 2026 end; 2027 end; 2028 ait_label : 2029 begin 2030 { exporting shouldn't be necessary as labels are local, 2031 but it's better to be on the safe side (PFV) } 2032 ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_label(hp).labsym)); 2033 end; 2034 ait_instruction : 2035 Taicpu(hp).Pass2(ObjData); 2036 ait_stab : 2037 WriteStab(Tai_stab(hp).str); 2038 ait_function_name, 2039 ait_force_line : ; 2040 ait_cutobject : 2041 if SmartAsm then 2042 break; 2043 ait_directive : 2044 begin 2045 case tai_directive(hp).directive of 2046 asd_weak_definition, 2047 asd_weak_reference: 2048 begin 2049 objsym:=ObjData.symbolref(tai_directive(hp).name); 2050 if objsym.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL] then 2051 objsym.bind:=AB_WEAK_EXTERNAL 2052 else 2053 { TODO: should become a weak definition; for now, do 2054 the same as what was done for ait_weak } 2055 objsym.bind:=AB_WEAK_EXTERNAL; 2056 end; 2057 asd_cpu: 2058 begin 2059 ObjData.CPUType:=cpu_none; 2060 for cpu:=low(tcputype) to high(tcputype) do 2061 if cputypestr[cpu]=tai_directive(hp).name then 2062 begin 2063 ObjData.CPUType:=cpu; 2064 break; 2065 end; 2066 end; 2067 {$ifdef OMFOBJSUPPORT} 2068 asd_omf_linnum_line: 2069 begin 2070 TOmfObjSection(ObjData.CurrObjSec).LinNumEntries.Add( 2071 TOmfSubRecord_LINNUM_MsLink_Entry.Create( 2072 strtoint(tai_directive(hp).name), 2073 ObjData.CurrObjSec.Size 2074 )); 2075 end; 2076 {$endif OMFOBJSUPPORT} 2077 end 2078 end; 2079 ait_symbolpair: 2080 begin 2081 if tai_symbolpair(hp).kind=spk_set then 2082 begin 2083 objsym:=ObjData.symbolref(tai_symbolpair(hp).sym^); 2084 ref:=objdata.symbolref(tai_symbolpair(hp).value^); 2085 2086 objsym.offset:=ref.offset; 2087 objsym.objsection:=ref.objsection; 2088 {$ifdef arm} 2089 objsym.ThumbFunc:=ref.ThumbFunc; 2090 {$endif arm} 2091 end; 2092 end; 2093 {$ifndef DISABLE_WIN64_SEH} 2094 ait_seh_directive : 2095 tai_seh_directive(hp).generate_code(objdata); 2096 {$endif DISABLE_WIN64_SEH} 2097 end; 2098 hp:=Tai(hp.next); 2099 end; 2100 TreePass2:=hp; 2101 end; 2102 2103 2104 procedure TInternalAssembler.writetree; 2105 label 2106 doexit; 2107 var 2108 hp : Tai; 2109 ObjWriter : TObjectWriter; 2110 begin 2111 ObjWriter:=TObjectwriter.create; 2112 ObjOutput:=CObjOutput.Create(ObjWriter); 2113 ObjData:=ObjOutput.newObjData(ObjFileName); 2114 2115 { Pass 0 } 2116 ObjData.currpass:=0; 2117 ObjData.createsection(sec_code); 2118 ObjData.beforealloc; 2119 { start with list 1 } 2120 currlistidx:=1; 2121 currlist:=list[currlistidx]; 2122 hp:=Tai(currList.first); 2123 while assigned(hp) do 2124 begin 2125 hp:=TreePass0(hp); 2126 MaybeNextList(hp); 2127 end; 2128 ObjData.afteralloc; 2129 { leave if errors have occurred } 2130 if errorcount>0 then 2131 goto doexit; 2132 2133 { Pass 1 } 2134 ObjData.currpass:=1; 2135 ObjData.resetsections; 2136 ObjData.beforealloc; 2137 ObjData.createsection(sec_code); 2138 { start with list 1 } 2139 currlistidx:=1; 2140 currlist:=list[currlistidx]; 2141 hp:=Tai(currList.first); 2142 while assigned(hp) do 2143 begin 2144 hp:=TreePass1(hp); 2145 MaybeNextList(hp); 2146 end; 2147 ObjData.createsection(sec_code); 2148 ObjData.afteralloc; 2149 2150 { leave if errors have occurred } 2151 if errorcount>0 then 2152 goto doexit; 2153 2154 { Pass 2 } 2155 ObjData.currpass:=2; 2156 ObjData.resetsections; 2157 ObjData.beforewrite; 2158 ObjData.createsection(sec_code); 2159 { start with list 1 } 2160 currlistidx:=1; 2161 currlist:=list[currlistidx]; 2162 hp:=Tai(currList.first); 2163 while assigned(hp) do 2164 begin 2165 hp:=TreePass2(hp); 2166 MaybeNextList(hp); 2167 end; 2168 ObjData.createsection(sec_code); 2169 ObjData.afterwrite; 2170 2171 { don't write the .o file if errors have occurred } 2172 if errorcount=0 then 2173 begin 2174 { write objectfile } 2175 ObjOutput.startobjectfile(ObjFileName); 2176 ObjOutput.writeobjectfile(ObjData); 2177 end; 2178 2179 doexit: 2180 { Cleanup } 2181 ObjData.free; 2182 ObjData:=nil; 2183 ObjWriter.free; 2184 end; 2185 2186 2187 procedure TInternalAssembler.writetreesmart; 2188 var 2189 hp : Tai; 2190 startsectype : TAsmSectiontype; 2191 place: tcutplace; 2192 ObjWriter : TObjectWriter; 2193 startsecname: String; 2194 startsecorder: TAsmSectionOrder; 2195 begin 2196 if not(cs_asm_leave in current_settings.globalswitches) and 2197 not(af_needar in asminfo^.flags) then 2198 ObjWriter:=CInternalAr.CreateAr(current_module.staticlibfilename) 2199 else 2200 ObjWriter:=TObjectwriter.create; 2201 2202 NextSmartName(cut_normal); 2203 ObjOutput:=CObjOutput.Create(ObjWriter); 2204 startsectype:=sec_none; 2205 startsecname:=''; 2206 startsecorder:=secorder_default; 2207 2208 { start with list 1 } 2209 currlistidx:=1; 2210 currlist:=list[currlistidx]; 2211 hp:=Tai(currList.first); 2212 while assigned(hp) do 2213 begin 2214 ObjData:=ObjOutput.newObjData(ObjFileName); 2215 2216 { Pass 0 } 2217 ObjData.currpass:=0; 2218 ObjData.resetsections; 2219 ObjData.beforealloc; 2220 if startsectype<>sec_none then 2221 ObjData.CreateSection(startsectype,startsecname,startsecorder); 2222 TreePass0(hp); 2223 ObjData.afteralloc; 2224 { leave if errors have occurred } 2225 if errorcount>0 then 2226 break; 2227 2228 { Pass 1 } 2229 ObjData.currpass:=1; 2230 ObjData.resetsections; 2231 ObjData.beforealloc; 2232 if startsectype<>sec_none then 2233 ObjData.CreateSection(startsectype,startsecname,startsecorder); 2234 TreePass1(hp); 2235 ObjData.afteralloc; 2236 2237 { leave if errors have occurred } 2238 if errorcount>0 then 2239 break; 2240 2241 { Pass 2 } 2242 ObjData.currpass:=2; 2243 ObjOutput.startobjectfile(ObjFileName); 2244 ObjData.resetsections; 2245 ObjData.beforewrite; 2246 if startsectype<>sec_none then 2247 ObjData.CreateSection(startsectype,startsecname,startsecorder); 2248 hp:=TreePass2(hp); 2249 ObjData.afterwrite; 2250 2251 { leave if errors have occurred } 2252 if errorcount>0 then 2253 break; 2254 2255 { write the current objectfile } 2256 ObjOutput.writeobjectfile(ObjData); 2257 ObjData.free; 2258 ObjData:=nil; 2259 2260 { end of lists? } 2261 if not MaybeNextList(hp) then 2262 break; 2263 2264 { we will start a new objectfile so reset everything } 2265 { The place can still change in the next while loop, so don't init } 2266 { the writer yet (JM) } 2267 if (hp.typ=ait_cutobject) then 2268 place := Tai_cutobject(hp).place 2269 else 2270 place := cut_normal; 2271 2272 { avoid empty files } 2273 startsectype:=sec_none; 2274 startsecname:=''; 2275 startsecorder:=secorder_default; 2276 while assigned(hp) and 2277 (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cutobject]) do 2278 begin 2279 if Tai(hp).typ=ait_section then 2280 begin 2281 startsectype:=Tai_section(hp).sectype; 2282 startsecname:=Tai_section(hp).name^; 2283 startsecorder:=Tai_section(hp).secorder; 2284 end; 2285 if (Tai(hp).typ=ait_cutobject) then 2286 place:=Tai_cutobject(hp).place; 2287 hp:=Tai(hp.next); 2288 end; 2289 2290 if not MaybeNextList(hp) then 2291 break; 2292 2293 { start next objectfile } 2294 NextSmartName(place); 2295 end; 2296 ObjData.free; 2297 ObjData:=nil; 2298 ObjWriter.free; 2299 end; 2300 2301 2302 procedure TInternalAssembler.MakeObject; 2303 2304 var to_do:set of TasmlistType; 2305 i:TasmlistType; 2306 2307 procedure addlist(p:TAsmList); 2308 begin 2309 inc(lists); 2310 list[lists]:=p; 2311 end; 2312 2313 begin 2314 to_do:=[low(Tasmlisttype)..high(Tasmlisttype)]; 2315 if usedeffileforexports then 2316 exclude(to_do,al_exports); 2317 if not(tf_section_threadvars in target_info.flags) then 2318 exclude(to_do,al_threadvars); 2319 for i:=low(TasmlistType) to high(TasmlistType) do 2320 if (i in to_do) and (current_asmdata.asmlists[i]<>nil) and 2321 (not current_asmdata.asmlists[i].empty) then 2322 addlist(current_asmdata.asmlists[i]); 2323 2324 if SmartAsm then 2325 writetreesmart 2326 else 2327 writetree; 2328 end; 2329 2330 2331 {***************************************************************************** 2332 Generate Assembler Files Main Procedure 2333 *****************************************************************************} 2334 2335 Procedure GenerateAsm(smart:boolean); 2336 var 2337 a : TAssembler; 2338 begin 2339 if not assigned(CAssembler[target_asm.id]) then 2340 Message(asmw_f_assembler_output_not_supported); 2341 a:=CAssembler[target_asm.id].Create(@target_asm,smart); 2342 a.MakeObject; 2343 a.Free; 2344 end; 2345 2346 GetExternalGnuAssemblerWithAsmInfoWriternull2347 function GetExternalGnuAssemblerWithAsmInfoWriter(info: pasminfo; wr: TExternalAssemblerOutputFile): TExternalAssembler; 2348 var 2349 asmkind: tasm; 2350 begin 2351 for asmkind in [as_gas,as_ggas,as_darwin,as_clang_gas,as_clang_asdarwin] do 2352 if assigned(asminfos[asmkind]) and 2353 (target_info.system in asminfos[asmkind]^.supported_targets) then 2354 begin 2355 result:=TExternalAssemblerClass(CAssembler[asmkind]).CreateWithWriter(asminfos[asmkind],wr,false,false); 2356 exit; 2357 end; 2358 Internalerror(2015090604); 2359 end; 2360 2361 {***************************************************************************** 2362 Init/Done 2363 *****************************************************************************} 2364 2365 procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass); 2366 var 2367 t : tasm; 2368 begin 2369 t:=r.id; 2370 if assigned(asminfos[t]) then 2371 writeln('Warning: Assembler is already registered!') 2372 else 2373 Getmem(asminfos[t],sizeof(tasminfo)); 2374 asminfos[t]^:=r; 2375 CAssembler[t]:=c; 2376 end; 2377 2378 end. 2379