123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755175617571758175917601761176217631764176517661767176817691770177117721773177417751776177717781779178017811782178317841785178617871788178917901791179217931794179517961797179817991800180118021803180418051806180718081809181018111812181318141815181618171818181918201821182218231824182518261827182818291830183118321833183418351836183718381839184018411842184318441845184618471848184918501851185218531854185518561857185818591860186118621863186418651866186718681869187018711872187318741875187618771878187918801881188218831884188518861887188818891890189118921893189418951896189718981899190019011902190319041905190619071908190919101911191219131914191519161917191819191920192119221923192419251926192719281929193019311932193319341935193619371938193919401941194219431944194519461947194819491950195119521953195419551956195719581959196019611962196319641965196619671968196919701971197219731974197519761977197819791980198119821983198419851986198719881989199019911992199319941995199619971998199920002001200220032004200520062007200820092010201120122013201420152016201720182019202020212022202320242025202620272028202920302031203220332034203520362037203820392040204120422043204420452046204720482049205020512052205320542055205620572058205920602061206220632064206520662067206820692070207120722073207420752076207720782079208020812082208320842085208620872088208920902091209220932094209520962097209820992100210121022103210421052106210721082109211021112112211321142115211621172118211921202121212221232124212521262127212821292130213121322133213421352136213721382139214021412142214321442145214621472148214921502151215221532154215521562157215821592160216121622163216421652166216721682169217021712172217321742175217621772178217921802181218221832184218521862187218821892190219121922193219421952196219721982199220022012202220322042205220622072208220922102211221222132214221522162217221822192220222122222223222422252226222722282229223022312232223322342235223622372238223922402241224222432244224522462247224822492250225122522253225422552256225722582259226022612262226322642265226622672268226922702271227222732274227522762277227822792280228122822283228422852286228722882289229022912292229322942295229622972298229923002301230223032304230523062307230823092310231123122313231423152316231723182319232023212322232323242325232623272328232923302331233223332334233523362337233823392340234123422343234423452346234723482349235023512352235323542355235623572358235923602361236223632364236523662367236823692370237123722373237423752376237723782379238023812382238323842385238623872388238923902391239223932394239523962397239823992400240124022403240424052406240724082409241024112412241324142415241624172418241924202421242224232424242524262427242824292430243124322433243424352436243724382439244024412442244324442445244624472448244924502451245224532454245524562457245824592460246124622463246424652466246724682469247024712472247324742475247624772478247924802481248224832484248524862487248824892490249124922493249424952496249724982499250025012502250325042505250625072508250925102511251225132514251525162517251825192520252125222523252425252526252725282529253025312532253325342535253625372538253925402541254225432544254525462547254825492550255125522553255425552556255725582559256025612562 |
- {
- Copyright (c) 1998-2004 by Peter Vreman
- This unit handles the assemblerfile write and assembler calls of FPC
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- {# @abstract(This unit handles the assembler file write and assembler calls of FPC)
- Handles the calls to the actual external assemblers, as well as the generation
- of object files for smart linking. Also contains the base class for writing
- the assembler statements to file.
- }
- unit assemble;
- {$i fpcdefs.inc}
- interface
- uses
- SysUtils,
- systems,globtype,globals,aasmbase,aasmtai,aasmdata,ogbase,owbase,finput;
- const
- { maximum of aasmoutput lists there will be }
- maxoutputlists = ord(high(tasmlisttype))+1;
- { buffer size for writing the .s file }
- AsmOutSize=32768*4;
- type
- TAssembler=class(TObject)
- public
- {assembler info}
- asminfo : pasminfo;
- {filenames}
- path : TPathStr;
- name : string;
- AsmFileName, { current .s and .o file }
- ObjFileName,
- ppufilename : TPathStr;
- asmprefix : string;
- SmartAsm : boolean;
- SmartFilesCount,
- SmartHeaderCount : longint;
- Constructor Create(info: pasminfo; smart:boolean);virtual;
- Destructor Destroy;override;
- procedure NextSmartName(place:tcutplace);
- procedure MakeObject;virtual;abstract;
- end;
- TExternalAssembler = class;
- IExternalAssemblerOutputFileDecorator=interface
- function LinePrefix: AnsiString;
- function LinePostfix: AnsiString;
- function LineFilter(const s: AnsiString): AnsiString;
- function LineEnding(const deflineending: ShortString): ShortString;
- end;
- TExternalAssemblerOutputFile=class
- private
- fdecorator: IExternalAssemblerOutputFileDecorator;
- protected
- owner: TExternalAssembler;
- {outfile}
- AsmSize,
- AsmStartSize,
- outcnt : longint;
- outbuf : array[0..AsmOutSize-1] of char;
- outfile : file;
- fioerror : boolean;
- linestart: boolean;
- Procedure AsmClear;
- Procedure MaybeAddLinePrefix;
- Procedure MaybeAddLinePostfix;
- Procedure AsmWriteAnsiStringUnfiltered(const s: ansistring);
- public
- Constructor Create(_owner: TExternalAssembler);
- Procedure RemoveAsm;virtual;
- Procedure AsmFlush;
- { mark the current output as the "empty" state (i.e., it only contains
- headers/directives etc }
- Procedure MarkEmpty;
- { clears the assembler output if nothing was added since it was marked
- as empty, and returns whether it was empty }
- function ClearIfEmpty: boolean;
- { these routines will write the filtered version of their argument
- according to the current decorator }
- procedure AsmWriteFiltered(const c:char);
- procedure AsmWriteFiltered(const s:string);
- procedure AsmWriteFiltered(const s:ansistring);
- procedure AsmWriteFiltered(p:pchar; len: longint);
- {# Write a string to the assembler file }
- Procedure AsmWrite(const c:char);
- Procedure AsmWrite(const s:string);
- Procedure AsmWrite(const s:ansistring);
- {# Write a string to the assembler file }
- Procedure AsmWritePChar(p:pchar);
- {# Write a string to the assembler file followed by a new line }
- Procedure AsmWriteLn(const c:char);
- Procedure AsmWriteLn(const s:string);
- Procedure AsmWriteLn(const s:ansistring);
- {# Write a new line to the assembler file }
- Procedure AsmLn; virtual;
- procedure AsmCreate(Aplace:tcutplace);
- procedure AsmClose;
- property ioerror: boolean read fioerror;
- property decorator: IExternalAssemblerOutputFileDecorator read fdecorator write fdecorator;
- end;
- {# This is the base class which should be overridden for each each
- assembler writer. It is used to actually assembler a file,
- and write the output to the assembler file.
- }
- TExternalAssembler=class(TAssembler)
- private
- { output writer }
- fwriter: TExternalAssemblerOutputFile;
- ffreewriter: boolean;
- procedure CreateSmartLinkPath(const s:TPathStr);
- protected
- {input source info}
- lastfileinfo : tfileposinfo;
- infile,
- lastinfile : tinputfile;
- {last section type written}
- lastsectype : TAsmSectionType;
- procedure WriteSourceLine(hp: tailineinfo);
- procedure WriteTempalloc(hp: tai_tempalloc);
- procedure WriteRealConstAsBytes(hp: tai_realconst; const dbdir: string; do_line: boolean);
- function single2str(d : single) : string; virtual;
- function double2str(d : double) : string; virtual;
- function extended2str(e : extended) : string; virtual;
- Function DoPipe:boolean; virtual;
- function CreateNewAsmWriter: TExternalAssemblerOutputFile; virtual;
- {# Return true if the external assembler should run again }
- function RerunAssembler: boolean; virtual;
- public
- {# Returns the complete path and executable name of the assembler
- program.
- It first tries looking in the UTIL directory if specified,
- otherwise it searches in the free pascal binary directory, in
- the current working directory and then in the directories
- in the $PATH environment.}
- Function FindAssembler:string;
- {# Actually does the call to the assembler file. Returns false
- if the assembling of the file failed.}
- Function CallAssembler(const command:string; const para:TCmdStr):Boolean;
- Function DoAssemble:boolean;virtual;
- {# This routine should be overridden for each assembler, it is used
- to actually write the abstract assembler stream to file.}
- procedure WriteTree(p:TAsmList);virtual;
- {# This routine should be overridden for each assembler, it is used
- to actually write all the different abstract assembler streams
- by calling for each stream type, the @var(WriteTree) method.}
- procedure WriteAsmList;virtual;
- {# Constructs the command line for calling the assembler }
- function MakeCmdLine: TCmdStr; virtual;
- public
- Constructor Create(info: pasminfo; smart: boolean); override; final;
- Constructor CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter, smart: boolean); virtual;
- procedure MakeObject;override;
- destructor Destroy; override;
- property writer: TExternalAssemblerOutputFile read fwriter;
- end;
- TExternalAssemblerClass = class of TExternalAssembler;
- { TInternalAssembler }
- TInternalAssembler=class(TAssembler)
- private
- FCObjOutput : TObjOutputclass;
- FCInternalAr : TObjectWriterClass;
- { the aasmoutput lists that need to be processed }
- lists : byte;
- list : array[1..maxoutputlists] of TAsmList;
- { current processing }
- currlistidx : byte;
- currlist : TAsmList;
- procedure WriteStab(p:pchar);
- function MaybeNextList(var hp:Tai):boolean;
- function SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean;
- function TreePass0(hp:Tai):Tai;
- function TreePass1(hp:Tai):Tai;
- function TreePass2(hp:Tai):Tai;
- procedure writetree;
- procedure writetreesmart;
- protected
- ObjData : TObjData;
- ObjOutput : tObjOutput;
- property CObjOutput:TObjOutputclass read FCObjOutput write FCObjOutput;
- property CInternalAr : TObjectWriterClass read FCInternalAr write FCInternalAr;
- public
- constructor Create(info: pasminfo; smart: boolean);override;
- destructor destroy;override;
- procedure MakeObject;override;
- end;
- TAssemblerClass = class of TAssembler;
- Procedure GenerateAsm(smart:boolean);
- { get an instance of an external GNU-style assembler that is compatible
- with the current target, reusing an existing writer. Used by the LLVM
- target to write inline assembler }
- function GetExternalGnuAssemblerWithAsmInfoWriter(info: pasminfo; wr: TExternalAssemblerOutputFile): TExternalAssembler;
- procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
- Implementation
- uses
- {$ifdef hasunix}
- unix,
- {$endif}
- cutils,cfileutl,
- {$ifdef memdebug}
- cclasses,
- {$endif memdebug}
- {$ifdef OMFOBJSUPPORT}
- omfbase,
- ogomf,
- {$endif OMFOBJSUPPORT}
- {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
- {$else}
- {$ifdef FPC_SOFT_FPUX80}
- sfpux80,
- {$endif FPC_SOFT_FPUX80}
- {$endif}
- cscript,fmodule,verbose,
- cpuinfo,
- aasmcpu;
- var
- CAssembler : array[tasm] of TAssemblerClass;
- function fixline(s:string):string;
- {
- return s with all leading and ending spaces and tabs removed
- }
- var
- i,j,k : integer;
- begin
- i:=length(s);
- while (i>0) and (s[i] in [#9,' ']) do
- dec(i);
- j:=1;
- while (j<i) and (s[j] in [#9,' ']) do
- inc(j);
- for k:=j to i do
- if s[k] in [#0..#31,#127..#255] then
- s[k]:='.';
- fixline:=Copy(s,j,i-j+1);
- end;
- {*****************************************************************************
- TAssembler
- *****************************************************************************}
- Constructor TAssembler.Create(info: pasminfo; smart: boolean);
- begin
- asminfo:=info;
- { load start values }
- AsmFileName:=current_module.AsmFilename;
- ObjFileName:=current_module.ObjFileName;
- name:=Lower(current_module.modulename^);
- path:=current_module.outputpath;
- asmprefix := current_module.asmprefix^;
- if current_module.outputpath = '' then
- ppufilename := ''
- else
- ppufilename := current_module.ppufilename;
- SmartAsm:=smart;
- SmartFilesCount:=0;
- SmartHeaderCount:=0;
- SmartLinkOFiles.Clear;
- end;
- Destructor TAssembler.Destroy;
- begin
- end;
- procedure TAssembler.NextSmartName(place:tcutplace);
- var
- s : string;
- begin
- inc(SmartFilesCount);
- if SmartFilesCount>999999 then
- Message(asmw_f_too_many_asm_files);
- case place of
- cut_begin :
- begin
- inc(SmartHeaderCount);
- s:=asmprefix+tostr(SmartHeaderCount)+'h';
- end;
- cut_normal :
- s:=asmprefix+tostr(SmartHeaderCount)+'s';
- cut_end :
- s:=asmprefix+tostr(SmartHeaderCount)+'t';
- end;
- AsmFileName:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext);
- ObjFileName:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext);
- { insert in container so it can be cleared after the linking }
- SmartLinkOFiles.Insert(ObjFileName);
- end;
- {*****************************************************************************
- TAssemblerOutputFile
- *****************************************************************************}
- procedure TExternalAssemblerOutputFile.RemoveAsm;
- var
- g : file;
- begin
- if cs_asm_leave in current_settings.globalswitches then
- exit;
- if cs_asm_extern in current_settings.globalswitches then
- AsmRes.AddDeleteCommand(owner.AsmFileName)
- else
- begin
- assign(g,owner.AsmFileName);
- {$push} {$I-}
- erase(g);
- {$pop}
- if ioresult<>0 then;
- end;
- end;
- Procedure TExternalAssemblerOutputFile.AsmFlush;
- begin
- if outcnt>0 then
- begin
- { suppress i/o error }
- {$push} {$I-}
- BlockWrite(outfile,outbuf,outcnt);
- {$pop}
- fioerror:=fioerror or (ioresult<>0);
- outcnt:=0;
- end;
- end;
- procedure TExternalAssemblerOutputFile.MarkEmpty;
- begin
- AsmStartSize:=AsmSize
- end;
- function TExternalAssemblerOutputFile.ClearIfEmpty: boolean;
- begin
- result:=AsmSize=AsmStartSize;
- if result then
- AsmClear;
- end;
- procedure TExternalAssemblerOutputFile.AsmWriteFiltered(const c: char);
- begin
- MaybeAddLinePrefix;
- AsmWriteAnsiStringUnfiltered(decorator.LineFilter(c));
- end;
- procedure TExternalAssemblerOutputFile.AsmWriteFiltered(const s: string);
- begin
- MaybeAddLinePrefix;
- AsmWriteAnsiStringUnfiltered(decorator.LineFilter(s));
- end;
- procedure TExternalAssemblerOutputFile.AsmWriteFiltered(const s: ansistring);
- begin
- MaybeAddLinePrefix;
- AsmWriteAnsiStringUnfiltered(decorator.LineFilter(s));
- end;
- procedure TExternalAssemblerOutputFile.AsmWriteFiltered(p: pchar; len: longint);
- var
- s: ansistring;
- begin
- MaybeAddLinePrefix;
- s:='';
- setlength(s,len);
- move(p^,s[1],len);
- AsmWriteAnsiStringUnfiltered(decorator.LineFilter(s));
- end;
- Procedure TExternalAssemblerOutputFile.AsmClear;
- begin
- outcnt:=0;
- end;
- procedure TExternalAssemblerOutputFile.MaybeAddLinePrefix;
- begin
- if assigned(decorator) and
- linestart then
- begin
- AsmWriteAnsiStringUnfiltered(decorator.LinePrefix);
- linestart:=false;
- end;
- end;
- procedure TExternalAssemblerOutputFile.MaybeAddLinePostfix;
- begin
- if assigned(decorator) and
- not linestart then
- begin
- AsmWriteAnsiStringUnfiltered(decorator.LinePostfix);
- linestart:=true;
- end;
- end;
- procedure TExternalAssemblerOutputFile.AsmWriteAnsiStringUnfiltered(const s: ansistring);
- var
- StartIndex, ToWrite: longint;
- begin
- if s='' then
- exit;
- if OutCnt+length(s)>=AsmOutSize then
- AsmFlush;
- StartIndex:=1;
- ToWrite:=length(s);
- while ToWrite>AsmOutSize do
- begin
- Move(s[StartIndex],OutBuf[OutCnt],AsmOutSize);
- inc(OutCnt,AsmOutSize);
- inc(AsmSize,AsmOutSize);
- AsmFlush;
- inc(StartIndex,AsmOutSize);
- dec(ToWrite,AsmOutSize);
- end;
- Move(s[StartIndex],OutBuf[OutCnt],ToWrite);
- inc(OutCnt,ToWrite);
- inc(AsmSize,ToWrite);
- end;
- constructor TExternalAssemblerOutputFile.Create(_owner: TExternalAssembler);
- begin
- owner:=_owner;
- linestart:=true;
- end;
- Procedure TExternalAssemblerOutputFile.AsmWrite(const c: char);
- begin
- if assigned(decorator) then
- AsmWriteFiltered(c)
- else
- begin
- if OutCnt+1>=AsmOutSize then
- AsmFlush;
- OutBuf[OutCnt]:=c;
- inc(OutCnt);
- inc(AsmSize);
- end;
- end;
- Procedure TExternalAssemblerOutputFile.AsmWrite(const s:string);
- begin
- if s='' then
- exit;
- if assigned(decorator) then
- AsmWriteFiltered(s)
- else
- begin
- if OutCnt+length(s)>=AsmOutSize then
- AsmFlush;
- Move(s[1],OutBuf[OutCnt],length(s));
- inc(OutCnt,length(s));
- inc(AsmSize,length(s));
- end;
- end;
- Procedure TExternalAssemblerOutputFile.AsmWrite(const s:ansistring);
- begin
- if s='' then
- exit;
- if assigned(decorator) then
- AsmWriteFiltered(s)
- else
- AsmWriteAnsiStringUnfiltered(s);
- end;
- procedure TExternalAssemblerOutputFile.AsmWriteLn(const c: char);
- begin
- AsmWrite(c);
- AsmLn;
- end;
- Procedure TExternalAssemblerOutputFile.AsmWriteLn(const s:string);
- begin
- AsmWrite(s);
- AsmLn;
- end;
- Procedure TExternalAssemblerOutputFile.AsmWriteLn(const s: ansistring);
- begin
- AsmWrite(s);
- AsmLn;
- end;
- Procedure TExternalAssemblerOutputFile.AsmWritePChar(p:pchar);
- var
- i,j : longint;
- begin
- i:=StrLen(p);
- if i=0 then
- exit;
- if assigned(decorator) then
- AsmWriteFiltered(p,i)
- else
- begin
- j:=i;
- while j>0 do
- begin
- i:=min(j,AsmOutSize);
- if OutCnt+i>=AsmOutSize then
- AsmFlush;
- Move(p[0],OutBuf[OutCnt],i);
- inc(OutCnt,i);
- inc(AsmSize,i);
- dec(j,i);
- p:=pchar(@p[i]);
- end;
- end;
- end;
- Procedure TExternalAssemblerOutputFile.AsmLn;
- var
- newline: pshortstring;
- newlineres: shortstring;
- index: longint;
- begin
- MaybeAddLinePostfix;
- if (cs_link_on_target in current_settings.globalswitches) then
- newline:=@target_info.newline
- else
- newline:=@source_info.newline;
- if assigned(decorator) then
- begin
- newlineres:=decorator.LineEnding(newline^);
- newline:=@newlineres;
- end;
- if OutCnt>=AsmOutSize-length(newline^) then
- AsmFlush;
- index:=1;
- repeat
- OutBuf[OutCnt]:=newline^[index];
- inc(OutCnt);
- inc(AsmSize);
- inc(index);
- until index>length(newline^);
- end;
- procedure TExternalAssemblerOutputFile.AsmCreate(Aplace:tcutplace);
- {$ifdef hasamiga}
- var
- tempFileName: TPathStr;
- {$endif}
- begin
- if owner.SmartAsm then
- owner.NextSmartName(Aplace);
- {$ifdef hasamiga}
- { on Amiga/MorphOS try to redirect .s files to the T: assign, which is
- for temp files, and usually (default setting) located in the RAM: drive.
- This highly improves assembling speed for complex projects like the
- compiler itself, especially on hardware with slow disk I/O.
- Consider this as a poor man's pipe on Amiga, because real pipe handling
- would be much more complex and error prone to implement. (KB) }
- if (([cs_asm_extern,cs_asm_leave,cs_link_on_target] * current_settings.globalswitches) = []) then
- begin
- { try to have an unique name for the .s file }
- tempFileName:=HexStr(GetProcessID shr 4,7)+ExtractFileName(owner.AsmFileName);
- {$ifndef morphos}
- { old Amiga RAM: handler only allows filenames up to 30 char }
- if Length(tempFileName) < 30 then
- {$endif}
- owner.AsmFileName:='T:'+tempFileName;
- end;
- {$endif}
- {$ifdef hasunix}
- if owner.DoPipe then
- begin
- if owner.SmartAsm then
- begin
- if (owner.SmartFilesCount<=1) then
- Message1(exec_i_assembling_smart,owner.name);
- end
- else
- Message1(exec_i_assembling_pipe,owner.AsmFileName);
- if checkverbosity(V_Executable) then
- comment(V_Executable,'Executing "'+maybequoted(owner.FindAssembler)+'" with command line "'+
- owner.MakeCmdLine+'"');
- POpen(outfile,maybequoted(owner.FindAssembler)+' '+owner.MakeCmdLine,'W');
- end
- else
- {$endif}
- begin
- Assign(outfile,owner.AsmFileName);
- {$push} {$I-}
- Rewrite(outfile,1);
- {$pop}
- if ioresult<>0 then
- begin
- fioerror:=true;
- Message1(exec_d_cant_create_asmfile,owner.AsmFileName);
- end;
- end;
- outcnt:=0;
- AsmSize:=0;
- AsmStartSize:=0;
- end;
- procedure TExternalAssemblerOutputFile.AsmClose;
- var
- f : file;
- FileAge : longint;
- begin
- AsmFlush;
- {$ifdef hasunix}
- if owner.DoPipe then
- begin
- if PClose(outfile) <> 0 then
- GenerateError;
- end
- else
- {$endif}
- begin
- {Touch Assembler time to ppu time is there is a ppufilename}
- if owner.ppufilename<>'' then
- begin
- Assign(f,owner.ppufilename);
- {$push} {$I-}
- reset(f,1);
- {$pop}
- if ioresult=0 then
- begin
- FileAge := FileGetDate(GetFileHandle(f));
- close(f);
- reset(outfile,1);
- FileSetDate(GetFileHandle(outFile),FileAge);
- end;
- end;
- close(outfile);
- end;
- end;
- {*****************************************************************************
- TExternalAssembler
- *****************************************************************************}
- function TExternalAssembler.single2str(d : single) : string;
- var
- hs : string;
- begin
- str(d,hs);
- { replace space with + }
- if hs[1]=' ' then
- hs[1]:='+';
- single2str:='0d'+hs
- end;
- function TExternalAssembler.double2str(d : double) : string;
- var
- hs : string;
- begin
- str(d,hs);
- { replace space with + }
- if hs[1]=' ' then
- hs[1]:='+';
- double2str:='0d'+hs
- end;
- function TExternalAssembler.extended2str(e : extended) : string;
- var
- hs : string;
- begin
- str(e,hs);
- { replace space with + }
- if hs[1]=' ' then
- hs[1]:='+';
- extended2str:='0d'+hs
- end;
- Function TExternalAssembler.DoPipe:boolean;
- begin
- {$ifdef hasunix}
- DoPipe:=(cs_asm_pipe in current_settings.globalswitches) and
- (([cs_asm_extern,cs_asm_leave,cs_link_on_target] * current_settings.globalswitches) = []) and
- ((asminfo^.id in [as_gas,as_ggas,as_darwin,as_powerpc_xcoff,as_clang,as_solaris_as]));
- {$else hasunix}
- DoPipe:=false;
- {$endif}
- end;
- function TExternalAssembler.CreateNewAsmWriter: TExternalAssemblerOutputFile;
- begin
- result:=TExternalAssemblerOutputFile.Create(self);
- end;
- Constructor TExternalAssembler.Create(info: pasminfo; smart: boolean);
- begin
- CreateWithWriter(info,CreateNewAsmWriter,true,smart);
- end;
- constructor TExternalAssembler.CreateWithWriter(info: pasminfo; wr: TExternalAssemblerOutputFile; freewriter,smart: boolean);
- begin
- inherited Create(info,smart);
- fwriter:=wr;
- ffreewriter:=freewriter;
- if SmartAsm then
- begin
- path:=FixPath(ChangeFileExt(AsmFileName,target_info.smartext),false);
- CreateSmartLinkPath(path);
- end;
- end;
- procedure TExternalAssembler.CreateSmartLinkPath(const s:TPathStr);
- procedure DeleteFilesWithExt(const AExt:string);
- var
- dir : TRawByteSearchRec;
- begin
- if findfirst(FixPath(s,false)+'*'+AExt,faAnyFile,dir) = 0 then
- begin
- repeat
- DeleteFile(s+source_info.dirsep+dir.name);
- until findnext(dir) <> 0;
- end;
- findclose(dir);
- end;
- var
- hs : TPathStr;
- begin
- if PathExists(s,false) then
- begin
- { the path exists, now we clean only all the .o and .s files }
- DeleteFilesWithExt(target_info.objext);
- DeleteFilesWithExt(target_info.asmext);
- end
- else
- begin
- hs:=s;
- if hs[length(hs)] in ['/','\'] then
- delete(hs,length(hs),1);
- {$push} {$I-}
- mkdir(hs);
- {$pop}
- if ioresult<>0 then;
- end;
- end;
- const
- lastas : byte=255;
- var
- LastASBin : TCmdStr;
- Function TExternalAssembler.FindAssembler:string;
- var
- asfound : boolean;
- UtilExe : string;
- begin
- asfound:=false;
- if cs_link_on_target in current_settings.globalswitches then
- begin
- { If linking on target, don't add any path PM }
- FindAssembler:=utilsprefix+ChangeFileExt(asminfo^.asmbin,target_info.exeext);
- exit;
- end
- else
- UtilExe:=utilsprefix+ChangeFileExt(asminfo^.asmbin,source_info.exeext);
- if lastas<>ord(asminfo^.id) then
- begin
- lastas:=ord(asminfo^.id);
- { is an assembler passed ? }
- if utilsdirectory<>'' then
- asfound:=FindFile(UtilExe,utilsdirectory,false,LastASBin);
- if not AsFound then
- asfound:=FindExe(UtilExe,false,LastASBin);
- if (not asfound) and not(cs_asm_extern in current_settings.globalswitches) then
- begin
- Message1(exec_e_assembler_not_found,LastASBin);
- current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern];
- end;
- if asfound then
- Message1(exec_t_using_assembler,LastASBin);
- end;
- FindAssembler:=LastASBin;
- end;
- Function TExternalAssembler.CallAssembler(const command:string; const para:TCmdStr):Boolean;
- var
- DosExitCode : Integer;
- begin
- result:=true;
- if (cs_asm_extern in current_settings.globalswitches) then
- begin
- if SmartAsm then
- AsmRes.AddAsmCommand(command,para,Name+'('+TosTr(SmartFilesCount)+')')
- else
- AsmRes.AddAsmCommand(command,para,name);
- exit;
- end;
- try
- FlushOutput;
- DosExitCode:=RequotedExecuteProcess(command,para);
- if DosExitCode<>0
- then begin
- Message1(exec_e_error_while_assembling,tostr(dosexitcode));
- result:=false;
- end;
- except on E:EOSError do
- begin
- Message1(exec_e_cant_call_assembler,tostr(E.ErrorCode));
- current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern];
- result:=false;
- end;
- end;
- end;
- Function TExternalAssembler.DoAssemble:boolean;
- begin
- result:=true;
- if DoPipe then
- exit;
- if not(cs_asm_extern in current_settings.globalswitches) then
- begin
- if SmartAsm then
- begin
- if (SmartFilesCount<=1) then
- Message1(exec_i_assembling_smart,name);
- end
- else
- Message1(exec_i_assembling,name);
- end;
- repeat
- result:=CallAssembler(FindAssembler,MakeCmdLine)
- until not(result) or not RerunAssembler;
- if result then
- writer.RemoveAsm
- else
- GenerateError;
- end;
- function TExternalAssembler.MakeCmdLine: TCmdStr;
- function section_high_bound:longint;
- var
- alt : tasmlisttype;
- begin
- result:=0;
- for alt:=low(tasmlisttype) to high(tasmlisttype) do
- result:=result+current_asmdata.asmlists[alt].section_count;
- end;
- const
- min_big_obj_section_count = $7fff;
- begin
- result:=asminfo^.asmcmd;
- { for Xcode 7.x and later }
- if MacOSXVersionMin<>'' then
- Replace(result,'$DARWINVERSION','-mmacosx-version-min='+MacOSXVersionMin)
- else if iPhoneOSVersionMin<>'' then
- Replace(result,'$DARWINVERSION','-miphoneos-version-min='+iPhoneOSVersionMin)
- else
- Replace(result,'$DARWINVERSION','');
- {$ifdef arm}
- if (target_info.system=system_arm_darwin) then
- Replace(result,'$ARCH',lower(cputypestr[current_settings.cputype]));
- {$endif arm}
- if (cs_link_on_target in current_settings.globalswitches) then
- begin
- Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName)));
- Replace(result,'$OBJ',maybequoted(ScriptFixFileName(ObjFileName)));
- end
- else
- begin
- {$ifdef hasunix}
- if DoPipe then
- if asminfo^.id<>as_clang then
- Replace(result,'$ASM','')
- else
- Replace(result,'$ASM','-')
- else
- {$endif}
- Replace(result,'$ASM',maybequoted(AsmFileName));
- Replace(result,'$OBJ',maybequoted(ObjFileName));
- end;
- if (cs_create_pic in current_settings.moduleswitches) then
- Replace(result,'$PIC','-KPIC')
- else
- Replace(result,'$PIC','');
- if (cs_asm_source in current_settings.globalswitches) then
- Replace(result,'$NOWARN','')
- else
- Replace(result,'$NOWARN','-W');
- if target_info.endian=endian_little then
- Replace(result,'$ENDIAN','-mlittle')
- else
- Replace(result,'$ENDIAN','-mbig');
- { as we don't keep track of the amount of sections we created we simply
- enable Big Obj COFF files always for targets that need them }
- if (cs_asm_pre_binutils_2_25 in current_settings.globalswitches) or
- not (target_info.system in systems_all_windows+systems_nativent-[system_i8086_win16]) or
- (section_high_bound<min_big_obj_section_count) then
- Replace(result,'$BIGOBJ','')
- else
- Replace(result,'$BIGOBJ','-mbig-obj');
- Replace(result,'$EXTRAOPT',asmextraopt);
- end;
- function TExternalAssembler.RerunAssembler: boolean;
- begin
- result:=false;
- end;
- procedure TExternalAssembler.WriteSourceLine(hp: tailineinfo);
- var
- module : tmodule;
- begin
- { load infile }
- if (lastfileinfo.moduleindex<>hp.fileinfo.moduleindex) or
- (lastfileinfo.fileindex<>hp.fileinfo.fileindex) then
- begin
- { in case of a generic the module can be different }
- if current_module.unit_index=hp.fileinfo.moduleindex then
- module:=current_module
- else
- module:=get_module(hp.fileinfo.moduleindex);
- { during the compilation of the system unit there are cases when
- the fileinfo contains just zeros => invalid }
- if assigned(module) then
- infile:=module.sourcefiles.get_file(hp.fileinfo.fileindex)
- else
- infile:=nil;
- if assigned(infile) then
- begin
- { open only if needed !! }
- if (cs_asm_source in current_settings.globalswitches) then
- infile.open;
- end;
- { avoid unnecessary reopens of the same file !! }
- lastfileinfo.fileindex:=hp.fileinfo.fileindex;
- lastfileinfo.moduleindex:=hp.fileinfo.moduleindex;
- { be sure to change line !! }
- lastfileinfo.line:=-1;
- end;
- { write source }
- if (cs_asm_source in current_settings.globalswitches) and
- assigned(infile) then
- begin
- if (infile<>lastinfile) then
- begin
- writer.AsmWriteLn(asminfo^.comment+'['+infile.name+']');
- if assigned(lastinfile) then
- lastinfile.close;
- end;
- if (hp.fileinfo.line<>lastfileinfo.line) and
- (hp.fileinfo.line<infile.maxlinebuf) then
- begin
- if (hp.fileinfo.line<>0) and
- (infile.linebuf^[hp.fileinfo.line]>=0) then
- writer.AsmWriteLn(asminfo^.comment+'['+tostr(hp.fileinfo.line)+'] '+
- fixline(infile.GetLineStr(hp.fileinfo.line)));
- { set it to a negative value !
- to make that is has been read already !! PM }
- if (infile.linebuf^[hp.fileinfo.line]>=0) then
- infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1;
- end;
- end;
- lastfileinfo:=hp.fileinfo;
- lastinfile:=infile;
- end;
- procedure TExternalAssembler.WriteTempalloc(hp: tai_tempalloc);
- begin
- {$ifdef EXTDEBUG}
- if assigned(hp.problem) then
- writer.AsmWriteLn(asminfo^.comment+'Temp '+tostr(hp.temppos)+','+
- tostr(hp.tempsize)+' '+hp.problem^)
- else
- {$endif EXTDEBUG}
- writer.AsmWriteLn(asminfo^.comment+'Temp '+tostr(hp.temppos)+','+
- tostr(hp.tempsize)+' '+tempallocstr[hp.allocation]);
- end;
- procedure TExternalAssembler.WriteRealConstAsBytes(hp: tai_realconst; const dbdir: string; do_line: boolean);
- var
- pdata: pbyte;
- index, step, swapmask, count: longint;
- ssingle: single;
- ddouble: double;
- ccomp: comp;
- {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
- eextended: extended;
- {$else}
- {$ifdef FPC_SOFT_FPUX80}
- eextended: floatx80;
- {$endif}
- {$endif cpuextended}
- begin
- if do_line then
- begin
- case tai_realconst(hp).realtyp of
- aitrealconst_s32bit:
- writer.AsmWriteLn(asminfo^.comment+'value: '+single2str(tai_realconst(hp).value.s32val));
- aitrealconst_s64bit:
- writer.AsmWriteLn(asminfo^.comment+'value: '+double2str(tai_realconst(hp).value.s64val));
- {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
- { can't write full 80 bit floating point constants yet on non-x86 }
- aitrealconst_s80bit:
- writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s80val));
- {$else}
- {$ifdef FPC_SOFT_FPUX80}
- {$push}{$warn 6018 off} { Unreachable code due to compile time evaluation }
- aitrealconst_s80bit:
- begin
- if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then
- writer.AsmWriteLn(asminfo^.comment+'value: '+double2str(tai_realconst(hp).value.s80val))
- else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then
- writer.AsmWriteLn(asminfo^.comment+'value: '+single2str(tai_realconst(hp).value.s80val))
- else
- internalerror(2017091901);
- end;
- {$pop}
- {$endif}
- {$endif cpuextended}
- aitrealconst_s64comp:
- writer.AsmWriteLn(asminfo^.comment+'value: '+extended2str(tai_realconst(hp).value.s64compval));
- else
- internalerror(2014050604);
- end;
- end;
- writer.AsmWrite(dbdir);
- { generic float writing code: get start address of value, then write
- byte by byte. Can't use fields directly, because e.g ts64comp is
- defined as extended on x86 }
- case tai_realconst(hp).realtyp of
- aitrealconst_s32bit:
- begin
- ssingle:=single(tai_realconst(hp).value.s32val);
- pdata:=@ssingle;
- end;
- aitrealconst_s64bit:
- begin
- ddouble:=double(tai_realconst(hp).value.s64val);
- pdata:=@ddouble;
- end;
- {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
- { can't write full 80 bit floating point constants yet on non-x86 }
- aitrealconst_s80bit:
- begin
- eextended:=extended(tai_realconst(hp).value.s80val);
- pdata:=@eextended;
- end;
- {$else}
- {$ifdef FPC_SOFT_FPUX80}
- {$push}{$warn 6018 off} { Unreachable code due to compile time evaluation }
- aitrealconst_s80bit:
- begin
- if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then
- eextended:=float64_to_floatx80(float64(double(tai_realconst(hp).value.s80val)))
- else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then
- eextended:=float32_to_floatx80(float32(single(tai_realconst(hp).value.s80val)))
- else
- internalerror(2017091901);
- pdata:=@eextended;
- end;
- {$pop}
- {$endif}
- {$endif cpuextended}
- aitrealconst_s64comp:
- begin
- ccomp:=comp(tai_realconst(hp).value.s64compval);
- pdata:=@ccomp;
- end;
- else
- internalerror(2014051001);
- end;
- count:=tai_realconst(hp).datasize;
- { write bytes in inverse order if source and target endianess don't
- match }
- if source_info.endian<>target_info.endian then
- begin
- { go from back to front }
- index:=count-1;
- step:=-1;
- end
- else
- begin
- index:=0;
- step:=1;
- end;
- {$ifdef ARM}
- { ARM-specific: low and high dwords of a double may be swapped }
- if tai_realconst(hp).formatoptions=fo_hiloswapped then
- begin
- { only supported for double }
- if tai_realconst(hp).datasize<>8 then
- internalerror(2014050605);
- { switch bit of the index so that the words are written in
- the opposite order }
- swapmask:=4;
- end
- else
- {$endif ARM}
- swapmask:=0;
- repeat
- writer.AsmWrite(tostr(pdata[index xor swapmask]));
- inc(index,step);
- dec(count);
- if count<>0 then
- writer.AsmWrite(',');
- until count=0;
- { padding }
- for count:=tai_realconst(hp).datasize+1 to tai_realconst(hp).savesize do
- writer.AsmWrite(',0');
- writer.AsmLn;
- end;
- procedure TExternalAssembler.WriteTree(p:TAsmList);
- begin
- end;
- procedure TExternalAssembler.WriteAsmList;
- begin
- end;
- procedure TExternalAssembler.MakeObject;
- begin
- writer.AsmCreate(cut_normal);
- FillChar(lastfileinfo, sizeof(lastfileinfo), 0);
- lastfileinfo.line := -1;
- lastinfile := nil;
- lastsectype := sec_none;
- WriteAsmList;
- writer.AsmClose;
- if not(writer.ioerror) then
- DoAssemble;
- end;
- destructor TExternalAssembler.Destroy;
- begin
- if ffreewriter then
- writer.Free;
- inherited;
- end;
- {*****************************************************************************
- TInternalAssembler
- *****************************************************************************}
- constructor TInternalAssembler.Create(info: pasminfo; smart: boolean);
- begin
- inherited;
- ObjOutput:=nil;
- ObjData:=nil;
- SmartAsm:=smart;
- end;
- destructor TInternalAssembler.destroy;
- begin
- if assigned(ObjData) then
- ObjData.free;
- if assigned(ObjOutput) then
- ObjOutput.free;
- end;
- procedure TInternalAssembler.WriteStab(p:pchar);
- function consumecomma(var p:pchar):boolean;
- begin
- while (p^=' ') do
- inc(p);
- result:=(p^=',');
- inc(p);
- end;
- function consumenumber(var p:pchar;out value:longint):boolean;
- var
- hs : string;
- len,
- code : integer;
- begin
- value:=0;
- while (p^=' ') do
- inc(p);
- len:=0;
- while (p^ in ['0'..'9']) do
- begin
- inc(len);
- hs[len]:=p^;
- inc(p);
- end;
- if len>0 then
- begin
- hs[0]:=chr(len);
- val(hs,value,code);
- end
- else
- code:=-1;
- result:=(code=0);
- end;
- function consumeoffset(var p:pchar;out relocsym:tobjsymbol;out value:longint):boolean;
- var
- hs : string;
- len,
- code : integer;
- pstart : pchar;
- sym : tobjsymbol;
- exprvalue : longint;
- gotmin,
- have_first_symbol,
- have_second_symbol,
- dosub : boolean;
- begin
- result:=false;
- value:=0;
- relocsym:=nil;
- gotmin:=false;
- have_first_symbol:=false;
- have_second_symbol:=false;
- repeat
- dosub:=false;
- exprvalue:=0;
- if gotmin then
- begin
- dosub:=true;
- gotmin:=false;
- end;
- while (p^=' ') do
- inc(p);
- case p^ of
- #0 :
- break;
- ' ' :
- inc(p);
- '0'..'9' :
- begin
- len:=0;
- while (p^ in ['0'..'9']) do
- begin
- inc(len);
- hs[len]:=p^;
- inc(p);
- end;
- hs[0]:=chr(len);
- val(hs,exprvalue,code);
- if code<>0 then
- internalerror(200702251);
- end;
- '.','_',
- 'A'..'Z',
- 'a'..'z' :
- begin
- pstart:=p;
- while not(p^ in [#0,' ','-','+']) do
- inc(p);
- len:=p-pstart;
- if len>255 then
- internalerror(200509187);
- move(pstart^,hs[1],len);
- hs[0]:=chr(len);
- sym:=objdata.symbolref(hs);
- { Second symbol? }
- if assigned(relocsym) then
- begin
- if have_second_symbol then
- internalerror(2007032201);
- have_second_symbol:=true;
- if not have_first_symbol then
- internalerror(2007032202);
- { second symbol should substracted to first }
- if not dosub then
- internalerror(2007032203);
- if (relocsym.objsection<>sym.objsection) then
- internalerror(2005091810);
- exprvalue:=relocsym.address-sym.address;
- relocsym:=nil;
- dosub:=false;
- end
- else
- begin
- relocsym:=sym;
- if assigned(sym.objsection) then
- begin
- { first symbol should be + }
- if not have_first_symbol and dosub then
- internalerror(2007032204);
- have_first_symbol:=true;
- end;
- end;
- end;
- '+' :
- begin
- { nothing, by default addition is done }
- inc(p);
- end;
- '-' :
- begin
- gotmin:=true;
- inc(p);
- end;
- else
- internalerror(200509189);
- end;
- if dosub then
- dec(value,exprvalue)
- else
- inc(value,exprvalue);
- until false;
- result:=true;
- end;
- var
- stabstrlen,
- ofs,
- nline,
- nidx,
- nother,
- i : longint;
- stab : TObjStabEntry;
- relocsym : TObjSymbol;
- pstr,
- pcurr,
- pendquote : pchar;
- oldsec : TObjSection;
- begin
- pcurr:=nil;
- pstr:=nil;
- pendquote:=nil;
- relocsym:=nil;
- ofs:=0;
- { Parse string part }
- if (p[0]='"') then
- begin
- pstr:=@p[1];
- { Ignore \" inside the string }
- i:=1;
- while not((p[i]='"') and (p[i-1]<>'\')) and
- (p[i]<>#0) do
- inc(i);
- pendquote:=@p[i];
- pendquote^:=#0;
- pcurr:=@p[i+1];
- if not consumecomma(pcurr) then
- internalerror(200509181);
- end
- else
- pcurr:=p;
- { When in pass 1 then only alloc and leave }
- if ObjData.currpass=1 then
- begin
- ObjData.StabsSec.Alloc(sizeof(TObjStabEntry));
- if assigned(pstr) and (pstr[0]<>#0) then
- ObjData.StabStrSec.Alloc(strlen(pstr)+1);
- end
- else
- begin
- { Stabs format: nidx,nother,nline[,offset] }
- if not consumenumber(pcurr,nidx) then
- internalerror(200509182);
- if not consumecomma(pcurr) then
- internalerror(200509183);
- if not consumenumber(pcurr,nother) then
- internalerror(200509184);
- if not consumecomma(pcurr) then
- internalerror(200509185);
- if not consumenumber(pcurr,nline) then
- internalerror(200509186);
- if consumecomma(pcurr) then
- consumeoffset(pcurr,relocsym,ofs);
- { Generate stab entry }
- if assigned(pstr) and (pstr[0]<>#0) then
- begin
- stabstrlen:=strlen(pstr);
- {$ifdef optimizestabs}
- StabStrEntry:=nil;
- if (nidx=N_SourceFile) or (nidx=N_IncludeFile) then
- begin
- hs:=strpas(pstr);
- StabstrEntry:=StabStrDict.Find(hs);
- if not assigned(StabstrEntry) then
- begin
- StabstrEntry:=TStabStrEntry.Create(hs);
- StabstrEntry:=StabStrSec.Size;
- StabStrDict.Insert(StabstrEntry);
- { generate new stab }
- StabstrEntry:=nil;
- end;
- end;
- if assigned(StabstrEntry) then
- stab.strpos:=StabstrEntry.strpos
- else
- {$endif optimizestabs}
- begin
- stab.strpos:=ObjData.StabStrSec.Size;
- ObjData.StabStrSec.write(pstr^,stabstrlen+1);
- end;
- end
- else
- stab.strpos:=0;
- stab.ntype:=byte(nidx);
- stab.ndesc:=word(nline);
- stab.nother:=byte(nother);
- stab.nvalue:=ofs;
- { Write the stab first without the value field. Then
- write a the value field with relocation }
- oldsec:=ObjData.CurrObjSec;
- ObjData.SetSection(ObjData.StabsSec);
- ObjData.Writebytes(stab,sizeof(TObjStabEntry)-4);
- ObjData.Writereloc(stab.nvalue,4,relocsym,RELOC_ABSOLUTE32);
- ObjData.setsection(oldsec);
- end;
- if assigned(pendquote) then
- pendquote^:='"';
- end;
- function TInternalAssembler.MaybeNextList(var hp:Tai):boolean;
- begin
- { maybe end of list }
- while not assigned(hp) do
- begin
- if currlistidx<lists then
- begin
- inc(currlistidx);
- currlist:=list[currlistidx];
- hp:=Tai(currList.first);
- end
- else
- begin
- MaybeNextList:=false;
- exit;
- end;
- end;
- MaybeNextList:=true;
- end;
- function TInternalAssembler.SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean;
- var
- objsym : TObjSymbol;
- indsym : TObjSymbol;
- begin
- Result:=
- Assigned(hp) and
- (hp.typ=ait_symbol);
- if not Result then
- Exit;
- objsym:=Objdata.SymbolRef(tai_symbol(hp).sym);
- objsym.size:=0;
- indsym := TObjSymbol(ObjData.ObjSymbolList.Find(indirectname));
- if not Assigned(indsym) then
- begin
- { it's possible that indirect symbol is not present in the list,
- so we must create it as undefined }
- indsym:=ObjData.CObjSymbol.Create(ObjData.ObjSymbolList, indirectname);
- indsym.typ:=AT_NONE;
- indsym.bind:=AB_NONE;
- end;
- objsym.indsymbol:=indsym;
- Result:=true;
- end;
- function TInternalAssembler.TreePass0(hp:Tai):Tai;
- var
- objsym,
- objsymend : TObjSymbol;
- cpu: tcputype;
- eabi_section, TmpSection: TObjSection;
- begin
- while assigned(hp) do
- begin
- case hp.typ of
- ait_align :
- begin
- if tai_align_abstract(hp).aligntype>1 then
- begin
- { always use the maximum fillsize in this pass to avoid possible
- short jumps to become out of range }
- Tai_align_abstract(hp).fillsize:=Tai_align_abstract(hp).aligntype;
- ObjData.alloc(Tai_align_abstract(hp).fillsize);
- { may need to increase alignment of section }
- if tai_align_abstract(hp).aligntype>ObjData.CurrObjSec.secalign then
- ObjData.CurrObjSec.secalign:=tai_align_abstract(hp).aligntype;
- end
- else
- Tai_align_abstract(hp).fillsize:=0;
- end;
- ait_datablock :
- begin
- {$ifdef USE_COMM_IN_BSS}
- if writingpackages and
- Tai_datablock(hp).is_global then
- ObjData.SymbolDefine(Tai_datablock(hp).sym)
- else
- {$endif USE_COMM_IN_BSS}
- begin
- ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
- ObjData.SymbolDefine(Tai_datablock(hp).sym);
- ObjData.alloc(Tai_datablock(hp).size);
- end;
- end;
- ait_realconst:
- ObjData.alloc(tai_realconst(hp).savesize);
- ait_const:
- begin
- { if symbols are provided we can calculate the value for relative symbols.
- This is required for length calculation of leb128 constants }
- if assigned(tai_const(hp).sym) then
- begin
- objsym:=Objdata.SymbolRef(tai_const(hp).sym);
- { objsym already defined and there is endsym? }
- if assigned(objsym.objsection) and assigned(tai_const(hp).endsym) then
- begin
- objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
- { objsymend already defined? }
- if assigned(objsymend.objsection) then
- begin
- if objsymend.objsection<>objsym.objsection then
- begin
- { leb128 relative constants are not relocatable, but other types are,
- given that objsym belongs to the current section. }
- if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or
- (objsym.objsection<>ObjData.CurrObjSec) then
- InternalError(200404124);
- end
- {$push} {$R-}{$Q-}
- else
- Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
- end;
- {$pop}
- end;
- end;
- ObjData.alloc(tai_const(hp).size);
- end;
- ait_directive:
- begin
- case tai_directive(hp).directive of
- asd_indirect_symbol:
- { handled in TreePass1 }
- ;
- asd_lazy_reference:
- begin
- if tai_directive(hp).name='' then
- Internalerror(2009112101);
- objsym:=ObjData.symbolref(tai_directive(hp).name);
- objsym.bind:=AB_LAZY;
- end;
- asd_reference:
- { ignore for now, but should be added}
- ;
- asd_cpu:
- begin
- ObjData.CPUType:=cpu_none;
- for cpu:=low(tcputype) to high(tcputype) do
- if cputypestr[cpu]=tai_directive(hp).name then
- begin
- ObjData.CPUType:=cpu;
- break;
- end;
- end;
- {$ifdef OMFOBJSUPPORT}
- asd_omf_linnum_line:
- { ignore for now, but should be added}
- ;
- {$endif OMFOBJSUPPORT}
- {$ifdef ARM}
- asd_thumb_func:
- ObjData.ThumbFunc:=true;
- asd_code:
- { ai_directive(hp).name can be only 16 or 32, this is checked by the reader }
- ObjData.ThumbFunc:=tai_directive(hp).name='16';
- {$endif ARM}
- {$ifdef RISCV}
- asd_option:
- internalerror(2019031701);
- {$endif RISCV}
- else
- internalerror(2010011101);
- end;
- end;
- ait_section:
- begin
- if Tai_section(hp).sectype=sec_user then
- ObjData.CreateSection(Tai_section(hp).sectype,Tai_section(hp).secflags,Tai_section(hp).secprogbits,Tai_section(hp).name^,Tai_section(hp).secorder)
- else
- ObjData.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secorder);
- Tai_section(hp).sec:=ObjData.CurrObjSec;
- end;
- ait_symbol :
- begin
- { needs extra support in the internal assembler }
- { the value is just ignored }
- {if tai_symbol(hp).has_value then
- internalerror(2009090804); ;}
- ObjData.SymbolDefine(Tai_symbol(hp).sym);
- end;
- ait_label :
- ObjData.SymbolDefine(Tai_label(hp).labsym);
- ait_string :
- ObjData.alloc(Tai_string(hp).len);
- ait_instruction :
- begin
- { reset instructions which could change in pass 2 }
- Taicpu(hp).resetpass2;
- ObjData.alloc(Taicpu(hp).Pass1(ObjData));
- end;
- ait_cutobject :
- if SmartAsm then
- break;
- ait_eabi_attribute :
- begin
- eabi_section:=ObjData.findsection('.ARM.attributes');
- if not(assigned(eabi_section)) then
- begin
- TmpSection:=ObjData.CurrObjSec;
- ObjData.CreateSection(sec_arm_attribute,[],SPB_ARM_ATTRIBUTES,'',secorder_default);
- eabi_section:=ObjData.CurrObjSec;
- ObjData.setsection(TmpSection);
- end;
- if eabi_section.Size=0 then
- eabi_section.alloc(16);
- eabi_section.alloc(LengthUleb128(tai_eabi_attribute(hp).tag));
- case tai_eabi_attribute(hp).eattr_typ of
- eattrtype_dword:
- eabi_section.alloc(LengthUleb128(tai_eabi_attribute(hp).value));
- eattrtype_ntbs:
- eabi_section.alloc(Length(tai_eabi_attribute(hp).valuestr^)+1);
- else
- Internalerror(2019100701);
- end;
- end;
- else
- ;
- end;
- hp:=Tai(hp.next);
- end;
- TreePass0:=hp;
- end;
- function TInternalAssembler.TreePass1(hp:Tai):Tai;
- var
- objsym,
- objsymend : TObjSymbol;
- cpu: tcputype;
- eabi_section: TObjSection;
- begin
- while assigned(hp) do
- begin
- case hp.typ of
- ait_align :
- begin
- if tai_align_abstract(hp).aligntype>1 then
- begin
- { here we must determine the fillsize which is used in pass2 }
- Tai_align_abstract(hp).fillsize:=align(ObjData.CurrObjSec.Size,Tai_align_abstract(hp).aligntype)-
- ObjData.CurrObjSec.Size;
- { maximum number of bytes for alignment exeeded? }
- if (Tai_align_abstract(hp).aligntype<>Tai_align_abstract(hp).maxbytes) and
- (Tai_align_abstract(hp).fillsize>Tai_align_abstract(hp).maxbytes) then
- Tai_align_abstract(hp).fillsize:=align(ObjData.CurrObjSec.Size,Byte(Tai_align_abstract(hp).aligntype div 2))-
- ObjData.CurrObjSec.Size;
- ObjData.alloc(Tai_align_abstract(hp).fillsize);
- end;
- end;
- ait_datablock :
- begin
- if (oso_data in ObjData.CurrObjSec.secoptions) and
- not (oso_sparse_data in ObjData.CurrObjSec.secoptions) then
- Message(asmw_e_alloc_data_only_in_bss);
- {$ifdef USE_COMM_IN_BSS}
- if writingpackages and
- Tai_datablock(hp).is_global then
- begin
- objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
- objsym.size:=Tai_datablock(hp).size;
- objsym.bind:=AB_COMMON;
- objsym.alignment:=needtowritealignmentalsoforELF;
- end
- else
- {$endif USE_COMM_IN_BSS}
- begin
- ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
- objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
- objsym.size:=Tai_datablock(hp).size;
- ObjData.alloc(Tai_datablock(hp).size);
- end;
- end;
- ait_realconst:
- ObjData.alloc(tai_realconst(hp).savesize);
- ait_const:
- begin
- { Recalculate relative symbols }
- if assigned(tai_const(hp).sym) and
- assigned(tai_const(hp).endsym) then
- begin
- objsym:=Objdata.SymbolRef(tai_const(hp).sym);
- objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
- if Tai_const(hp).consttype in [aitconst_gottpoff,aitconst_tlsgd,aitconst_tlsdesc] then
- begin
- if objsymend.objsection<>ObjData.CurrObjSec then
- Internalerror(2019092801);
- Tai_const(hp).value:=objsymend.address-ObjData.CurrObjSec.Size+Tai_const(hp).symofs;
- end
- else if objsymend.objsection<>objsym.objsection then
- begin
- if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or
- (objsym.objsection<>ObjData.CurrObjSec) then
- internalerror(200905042);
- end
- {$push} {$R-}{$Q-}
- else
- Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
- end;
- {$pop}
- if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) then
- Tai_const(hp).fixsize;
- ObjData.alloc(tai_const(hp).size);
- end;
- ait_section:
- begin
- { use cached value }
- ObjData.setsection(Tai_section(hp).sec);
- end;
- ait_stab :
- begin
- if assigned(Tai_stab(hp).str) then
- WriteStab(Tai_stab(hp).str);
- end;
- ait_symbol :
- ObjData.SymbolDefine(Tai_symbol(hp).sym);
- ait_symbol_end :
- begin
- objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
- objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
- end;
- ait_label :
- ObjData.SymbolDefine(Tai_label(hp).labsym);
- ait_string :
- ObjData.alloc(Tai_string(hp).len);
- ait_instruction :
- ObjData.alloc(Taicpu(hp).Pass1(ObjData));
- ait_cutobject :
- if SmartAsm then
- break;
- ait_directive :
- begin
- case tai_directive(hp).directive of
- asd_indirect_symbol:
- if tai_directive(hp).name='' then
- Internalerror(2009101103)
- else if not SetIndirectToSymbol(Tai(hp.Previous), tai_directive(hp).name) then
- Internalerror(2009101102);
- asd_lazy_reference:
- { handled in TreePass0 }
- ;
- asd_reference:
- { ignore for now, but should be added}
- ;
- asd_thumb_func:
- { ignore for now, but should be added}
- ;
- asd_code:
- { ignore for now, but should be added}
- ;
- asd_option:
- { ignore for now, but should be added}
- ;
- {$ifdef OMFOBJSUPPORT}
- asd_omf_linnum_line:
- { ignore for now, but should be added}
- ;
- {$endif OMFOBJSUPPORT}
- asd_cpu:
- begin
- ObjData.CPUType:=cpu_none;
- for cpu:=low(tcputype) to high(tcputype) do
- if cputypestr[cpu]=tai_directive(hp).name then
- begin
- ObjData.CPUType:=cpu;
- break;
- end;
- end;
- else
- internalerror(2010011102);
- end;
- end;
- ait_eabi_attribute :
- begin
- eabi_section:=ObjData.findsection('.ARM.attributes');
- if not(assigned(eabi_section)) then
- Internalerror(2019100702);
- if eabi_section.Size=0 then
- eabi_section.alloc(16);
- eabi_section.alloc(LengthUleb128(tai_eabi_attribute(hp).tag));
- case tai_eabi_attribute(hp).eattr_typ of
- eattrtype_dword:
- eabi_section.alloc(LengthUleb128(tai_eabi_attribute(hp).value));
- eattrtype_ntbs:
- eabi_section.alloc(Length(tai_eabi_attribute(hp).valuestr^)+1);
- else
- Internalerror(2019100703);
- end;
- end;
- else
- ;
- end;
- hp:=Tai(hp.next);
- end;
- TreePass1:=hp;
- end;
- function TInternalAssembler.TreePass2(hp:Tai):Tai;
- var
- fillbuffer : tfillbuffer;
- leblen : byte;
- lebbuf : array[0..63] of byte;
- objsym,
- ref,
- objsymend : TObjSymbol;
- zerobuf : array[0..63] of byte;
- relative_reloc: boolean;
- pdata : pointer;
- ssingle : single;
- ddouble : double;
- {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
- eextended : extended;
- {$else}
- {$ifdef FPC_SOFT_FPUX80}
- eextended : floatx80;
- {$endif}
- {$endif}
- ccomp : comp;
- tmp : word;
- cpu: tcputype;
- ddword : dword;
- eabi_section: TObjSection;
- s: String;
- TmpDataPos: TObjSectionOfs;
- begin
- fillchar(zerobuf,sizeof(zerobuf),0);
- fillchar(objsym,sizeof(objsym),0);
- fillchar(objsymend,sizeof(objsymend),0);
- { main loop }
- while assigned(hp) do
- begin
- case hp.typ of
- ait_align :
- begin
- if tai_align_abstract(hp).aligntype>ObjData.CurrObjSec.secalign then
- InternalError(2012072301);
- if oso_data in ObjData.CurrObjSec.secoptions then
- ObjData.writebytes(Tai_align_abstract(hp).calculatefillbuf(fillbuffer,oso_executable in ObjData.CurrObjSec.secoptions)^,
- Tai_align_abstract(hp).fillsize)
- else
- ObjData.alloc(Tai_align_abstract(hp).fillsize);
- end;
- ait_section :
- begin
- { use cached value }
- ObjData.setsection(Tai_section(hp).sec);
- end;
- ait_symbol :
- begin
- ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_symbol(hp).sym));
- end;
- ait_symbol_end :
- begin
- { recalculate size, as some preceding instructions
- could have been changed to smaller size }
- objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
- objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
- end;
- ait_datablock :
- begin
- ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_datablock(hp).sym));
- {$ifdef USE_COMM_IN_BSS}
- if not(writingpackages and
- Tai_datablock(hp).is_global) then
- {$endif USE_COMM_IN_BSS}
- begin
- ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
- ObjData.alloc(Tai_datablock(hp).size);
- end;
- end;
- ait_realconst:
- begin
- case tai_realconst(hp).realtyp of
- aitrealconst_s32bit:
- begin
- ssingle:=single(tai_realconst(hp).value.s32val);
- pdata:=@ssingle;
- end;
- aitrealconst_s64bit:
- begin
- ddouble:=double(tai_realconst(hp).value.s64val);
- pdata:=@ddouble;
- end;
- {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
- { can't write full 80 bit floating point constants yet on non-x86 }
- aitrealconst_s80bit:
- begin
- eextended:=extended(tai_realconst(hp).value.s80val);
- pdata:=@eextended;
- end;
- {$else}
- {$ifdef FPC_SOFT_FPUX80}
- {$push}{$warn 6018 off} { Unreachable code due to compile time evaluation }
- aitrealconst_s80bit:
- begin
- if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then
- eextended:=float64_to_floatx80(float64(double(tai_realconst(hp).value.s80val)))
- else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then
- eextended:=float32_to_floatx80(float32(single(tai_realconst(hp).value.s80val)))
- else
- internalerror(2017091901);
- pdata:=@eextended;
- end;
- {$pop}
- {$endif}
- {$endif cpuextended}
- aitrealconst_s64comp:
- begin
- ccomp:=comp(tai_realconst(hp).value.s64compval);
- pdata:=@ccomp;
- end;
- else
- internalerror(2015030501);
- end;
- ObjData.writebytes(pdata^,tai_realconst(hp).datasize);
- ObjData.writebytes(zerobuf,tai_realconst(hp).savesize-tai_realconst(hp).datasize);
- end;
- ait_string :
- ObjData.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
- ait_const :
- begin
- { Recalculate relative symbols, addresses of forward references
- can be changed in treepass1 }
- relative_reloc:=false;
- if assigned(tai_const(hp).sym) and
- assigned(tai_const(hp).endsym) then
- begin
- objsym:=Objdata.SymbolRef(tai_const(hp).sym);
- objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
- relative_reloc:=(objsym.objsection<>objsymend.objsection);
- if Tai_const(hp).consttype in [aitconst_gottpoff] then
- begin
- if objsymend.objsection<>ObjData.CurrObjSec then
- Internalerror(2019092802);
- Tai_const(hp).value:=objsymend.address-ObjData.CurrObjSec.Size+Tai_const(hp).symofs;
- end
- else if Tai_const(hp).consttype in [aitconst_tlsgd,aitconst_tlsdesc] then
- begin
- if objsymend.objsection<>ObjData.CurrObjSec then
- Internalerror(2019092802);
- Tai_const(hp).value:=ObjData.CurrObjSec.Size-objsymend.address+Tai_const(hp).symofs;
- end
- else if objsymend.objsection<>objsym.objsection then
- begin
- if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or
- (objsym.objsection<>ObjData.CurrObjSec) then
- internalerror(2019010301);
- end
- else
- {$push} {$R-}{$Q-}
- Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
- end;
- {$pop}
- case tai_const(hp).consttype of
- aitconst_64bit,
- aitconst_32bit,
- aitconst_16bit,
- aitconst_64bit_unaligned,
- aitconst_32bit_unaligned,
- aitconst_16bit_unaligned,
- aitconst_8bit :
- begin
- if assigned(tai_const(hp).sym) and
- not assigned(tai_const(hp).endsym) then
- ObjData.writereloc(Tai_const(hp).symofs,tai_const(hp).size,Objdata.SymbolRef(tai_const(hp).sym),RELOC_ABSOLUTE)
- else if relative_reloc then
- ObjData.writereloc(ObjData.CurrObjSec.size+tai_const(hp).size-objsym.address+tai_const(hp).symofs,tai_const(hp).size,objsymend,RELOC_RELATIVE)
- else
- ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
- end;
- aitconst_rva_symbol :
- begin
- { PE32+? }
- if target_info.system=system_x86_64_win64 then
- ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA)
- else
- ObjData.writereloc(Tai_const(hp).symofs,sizeof(pint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA);
- end;
- aitconst_secrel32_symbol :
- begin
- { Required for DWARF2 support under Windows }
- ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_SECREL32);
- end;
- {$ifdef i8086}
- aitconst_farptr :
- if assigned(tai_const(hp).sym) and
- not assigned(tai_const(hp).endsym) then
- ObjData.writereloc(Tai_const(hp).symofs,tai_const(hp).size,Objdata.SymbolRef(tai_const(hp).sym),RELOC_FARPTR)
- else if relative_reloc then
- internalerror(2015040601)
- else
- ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
- aitconst_seg:
- if assigned(tai_const(hp).sym) and (tai_const(hp).size=2) then
- ObjData.writereloc(0,2,Objdata.SymbolRef(tai_const(hp).sym),RELOC_SEG)
- else
- internalerror(2015110502);
- aitconst_dgroup:
- ObjData.writereloc(0,2,nil,RELOC_DGROUP);
- aitconst_fardataseg:
- ObjData.writereloc(0,2,nil,RELOC_FARDATASEG);
- {$endif i8086}
- {$ifdef arm}
- aitconst_got:
- ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_GOT32);
- { aitconst_gottpoff:
- ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_TPOFF); }
- aitconst_tpoff:
- ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_TPOFF);
- aitconst_tlsgd:
- ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_TLSGD);
- aitconst_tlsdesc:
- begin
- { must be a relative symbol, thus value being valid }
- if not(assigned(tai_const(hp).sym)) or not(assigned(tai_const(hp).endsym)) then
- Internalerror(2019092904);
- ObjData.writereloc(Tai_const(hp).value,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_TLSDESC);
- end;
- {$endif arm}
- aitconst_dtpoff:
- { so far, the size of dtpoff is fixed to 4 bytes }
- ObjData.writereloc(Tai_const(hp).symofs,4,Objdata.SymbolRef(tai_const(hp).sym),RELOC_DTPOFF);
- aitconst_gotoff_symbol:
- ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_GOTOFF);
- aitconst_uleb128bit,
- aitconst_sleb128bit :
- begin
- if Tai_const(hp).fixed_size=0 then
- Internalerror(2019030302);
- if tai_const(hp).consttype=aitconst_uleb128bit then
- leblen:=EncodeUleb128(qword(Tai_const(hp).value),lebbuf,Tai_const(hp).fixed_size)
- else
- leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf,Tai_const(hp).fixed_size);
- if leblen<>tai_const(hp).fixed_size then
- internalerror(200709271);
- ObjData.writebytes(lebbuf,leblen);
- end;
- aitconst_darwin_dwarf_delta32,
- aitconst_darwin_dwarf_delta64:
- ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
- aitconst_half16bit,
- aitconst_gs:
- begin
- tmp:=Tai_const(hp).value div 2;
- ObjData.writebytes(tmp,2);
- end;
- else
- internalerror(200603254);
- end;
- end;
- ait_label :
- begin
- { exporting shouldn't be necessary as labels are local,
- but it's better to be on the safe side (PFV) }
- ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_label(hp).labsym));
- end;
- ait_instruction :
- Taicpu(hp).Pass2(ObjData);
- ait_stab :
- WriteStab(Tai_stab(hp).str);
- ait_function_name,
- ait_force_line : ;
- ait_cutobject :
- if SmartAsm then
- break;
- ait_directive :
- begin
- case tai_directive(hp).directive of
- asd_weak_definition,
- asd_weak_reference:
- begin
- objsym:=ObjData.symbolref(tai_directive(hp).name);
- if objsym.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL] then
- objsym.bind:=AB_WEAK_EXTERNAL
- else
- { TODO: should become a weak definition; for now, do
- the same as what was done for ait_weak }
- objsym.bind:=AB_WEAK_EXTERNAL;
- end;
- asd_cpu:
- begin
- ObjData.CPUType:=cpu_none;
- for cpu:=low(tcputype) to high(tcputype) do
- if cputypestr[cpu]=tai_directive(hp).name then
- begin
- ObjData.CPUType:=cpu;
- break;
- end;
- end;
- {$ifdef OMFOBJSUPPORT}
- asd_omf_linnum_line:
- begin
- TOmfObjSection(ObjData.CurrObjSec).LinNumEntries.Add(
- TOmfSubRecord_LINNUM_MsLink_Entry.Create(
- strtoint(tai_directive(hp).name),
- ObjData.CurrObjSec.Size
- ));
- end;
- {$endif OMFOBJSUPPORT}
- else
- ;
- end
- end;
- ait_symbolpair:
- begin
- if tai_symbolpair(hp).kind=spk_set then
- begin
- objsym:=ObjData.symbolref(tai_symbolpair(hp).sym^);
- ref:=objdata.symbolref(tai_symbolpair(hp).value^);
- objsym.offset:=ref.offset;
- objsym.objsection:=ref.objsection;
- {$ifdef arm}
- objsym.ThumbFunc:=ref.ThumbFunc;
- {$endif arm}
- end;
- end;
- {$ifndef DISABLE_WIN64_SEH}
- ait_seh_directive :
- tai_seh_directive(hp).generate_code(objdata);
- {$endif DISABLE_WIN64_SEH}
- ait_eabi_attribute :
- begin
- eabi_section:=ObjData.findsection('.ARM.attributes');
- if not(assigned(eabi_section)) then
- Internalerror(2019100704);
- if eabi_section.Size=0 then
- begin
- s:='A';
- eabi_section.write(s[1],1);
- ddword:=eabi_section.Size-1;
- eabi_section.write(ddword,4);
- s:='aeabi'#0;
- eabi_section.write(s[1],6);
- s:=#1;
- eabi_section.write(s[1],1);
- ddword:=eabi_section.Size-1-4-6-1;
- eabi_section.write(ddword,4);
- end;
- leblen:=EncodeUleb128(tai_eabi_attribute(hp).tag,lebbuf,0);
- eabi_section.write(lebbuf,leblen);
- case tai_eabi_attribute(hp).eattr_typ of
- eattrtype_dword:
- begin
- leblen:=EncodeUleb128(tai_eabi_attribute(hp).value,lebbuf,0);
- eabi_section.write(lebbuf,leblen);
- end;
- eattrtype_ntbs:
- begin
- s:=tai_eabi_attribute(hp).valuestr^+#0;
- eabi_section.write(s[1],Length(s));
- end
- else
- Internalerror(2019100705);
- end;
- { update size of attributes section, write directly to the dyn. arrays as
- we do not increase the size of section }
- TmpDataPos:=eabi_section.Data.Pos;
- eabi_section.Data.seek(1);
- ddword:=eabi_section.Size-1;
- eabi_section.Data.write(ddword,4);
- eabi_section.Data.seek(12);
- ddword:=eabi_section.Size-1-4-6;
- eabi_section.Data.write(ddword,4);
- eabi_section.Data.Seek(TmpDataPos);
- end;
- else
- ;
- end;
- hp:=Tai(hp.next);
- end;
- TreePass2:=hp;
- end;
- procedure TInternalAssembler.writetree;
- label
- doexit;
- var
- hp : Tai;
- ObjWriter : TObjectWriter;
- begin
- ObjWriter:=TObjectwriter.create;
- ObjOutput:=CObjOutput.Create(ObjWriter);
- ObjData:=ObjOutput.newObjData(ObjFileName);
- { Pass 0 }
- ObjData.currpass:=0;
- ObjData.createsection(sec_code);
- ObjData.beforealloc;
- { start with list 1 }
- currlistidx:=1;
- currlist:=list[currlistidx];
- hp:=Tai(currList.first);
- while assigned(hp) do
- begin
- hp:=TreePass0(hp);
- MaybeNextList(hp);
- end;
- ObjData.afteralloc;
- { leave if errors have occurred }
- if errorcount>0 then
- goto doexit;
- { Pass 1 }
- ObjData.currpass:=1;
- ObjData.resetsections;
- ObjData.beforealloc;
- ObjData.createsection(sec_code);
- { start with list 1 }
- currlistidx:=1;
- currlist:=list[currlistidx];
- hp:=Tai(currList.first);
- while assigned(hp) do
- begin
- hp:=TreePass1(hp);
- MaybeNextList(hp);
- end;
- ObjData.createsection(sec_code);
- ObjData.afteralloc;
- { leave if errors have occurred }
- if errorcount>0 then
- goto doexit;
- { Pass 2 }
- ObjData.currpass:=2;
- ObjData.resetsections;
- ObjData.beforewrite;
- ObjData.createsection(sec_code);
- { start with list 1 }
- currlistidx:=1;
- currlist:=list[currlistidx];
- hp:=Tai(currList.first);
- while assigned(hp) do
- begin
- hp:=TreePass2(hp);
- MaybeNextList(hp);
- end;
- ObjData.createsection(sec_code);
- ObjData.afterwrite;
- { don't write the .o file if errors have occurred }
- if errorcount=0 then
- begin
- { write objectfile }
- ObjOutput.startobjectfile(ObjFileName);
- ObjOutput.writeobjectfile(ObjData);
- end;
- doexit:
- { Cleanup }
- ObjData.free;
- ObjData:=nil;
- ObjWriter.free;
- end;
- procedure TInternalAssembler.writetreesmart;
- var
- hp : Tai;
- startsectype : TAsmSectiontype;
- place: tcutplace;
- ObjWriter : TObjectWriter;
- startsecname: String;
- startsecorder: TAsmSectionOrder;
- begin
- if not(cs_asm_leave in current_settings.globalswitches) and
- not(af_needar in asminfo^.flags) then
- ObjWriter:=CInternalAr.CreateAr(current_module.staticlibfilename)
- else
- ObjWriter:=TObjectwriter.create;
- NextSmartName(cut_normal);
- ObjOutput:=CObjOutput.Create(ObjWriter);
- startsectype:=sec_none;
- startsecname:='';
- startsecorder:=secorder_default;
- { start with list 1 }
- currlistidx:=1;
- currlist:=list[currlistidx];
- hp:=Tai(currList.first);
- while assigned(hp) do
- begin
- ObjData:=ObjOutput.newObjData(ObjFileName);
- { Pass 0 }
- ObjData.currpass:=0;
- ObjData.resetsections;
- ObjData.beforealloc;
- if startsectype<>sec_none then
- ObjData.CreateSection(startsectype,startsecname,startsecorder);
- TreePass0(hp);
- ObjData.afteralloc;
- { leave if errors have occurred }
- if errorcount>0 then
- break;
- { Pass 1 }
- ObjData.currpass:=1;
- ObjData.resetsections;
- ObjData.beforealloc;
- if startsectype<>sec_none then
- ObjData.CreateSection(startsectype,startsecname,startsecorder);
- TreePass1(hp);
- ObjData.afteralloc;
- { leave if errors have occurred }
- if errorcount>0 then
- break;
- { Pass 2 }
- ObjData.currpass:=2;
- ObjOutput.startobjectfile(ObjFileName);
- ObjData.resetsections;
- ObjData.beforewrite;
- if startsectype<>sec_none then
- ObjData.CreateSection(startsectype,startsecname,startsecorder);
- hp:=TreePass2(hp);
- ObjData.afterwrite;
- { leave if errors have occurred }
- if errorcount>0 then
- break;
- { write the current objectfile }
- ObjOutput.writeobjectfile(ObjData);
- ObjData.free;
- ObjData:=nil;
- { end of lists? }
- if not MaybeNextList(hp) then
- break;
- { we will start a new objectfile so reset everything }
- { The place can still change in the next while loop, so don't init }
- { the writer yet (JM) }
- if (hp.typ=ait_cutobject) then
- place := Tai_cutobject(hp).place
- else
- place := cut_normal;
- { avoid empty files }
- startsectype:=sec_none;
- startsecname:='';
- startsecorder:=secorder_default;
- while assigned(hp) and
- (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cutobject]) do
- begin
- if Tai(hp).typ=ait_section then
- begin
- startsectype:=Tai_section(hp).sectype;
- startsecname:=Tai_section(hp).name^;
- startsecorder:=Tai_section(hp).secorder;
- end;
- if (Tai(hp).typ=ait_cutobject) then
- place:=Tai_cutobject(hp).place;
- hp:=Tai(hp.next);
- end;
- if not MaybeNextList(hp) then
- break;
- { start next objectfile }
- NextSmartName(place);
- end;
- ObjData.free;
- ObjData:=nil;
- ObjWriter.free;
- end;
- procedure TInternalAssembler.MakeObject;
- var to_do:set of TasmlistType;
- i:TasmlistType;
- procedure addlist(p:TAsmList);
- begin
- inc(lists);
- list[lists]:=p;
- end;
- begin
- to_do:=[low(Tasmlisttype)..high(Tasmlisttype)];
- if usedeffileforexports then
- exclude(to_do,al_exports);
- if not(tf_section_threadvars in target_info.flags) then
- exclude(to_do,al_threadvars);
- for i:=low(TasmlistType) to high(TasmlistType) do
- if (i in to_do) and (current_asmdata.asmlists[i]<>nil) and
- (not current_asmdata.asmlists[i].empty) then
- addlist(current_asmdata.asmlists[i]);
- if SmartAsm then
- writetreesmart
- else
- writetree;
- end;
- {*****************************************************************************
- Generate Assembler Files Main Procedure
- *****************************************************************************}
- Procedure GenerateAsm(smart:boolean);
- var
- a : TAssembler;
- begin
- if not assigned(CAssembler[target_asm.id]) then
- Message(asmw_f_assembler_output_not_supported);
- a:=CAssembler[target_asm.id].Create(@target_asm,smart);
- a.MakeObject;
- a.Free;
- end;
- function GetExternalGnuAssemblerWithAsmInfoWriter(info: pasminfo; wr: TExternalAssemblerOutputFile): TExternalAssembler;
- var
- asmkind: tasm;
- begin
- for asmkind in [as_gas,as_ggas,as_darwin] do
- if assigned(asminfos[asmkind]) and
- (target_info.system in asminfos[asmkind]^.supported_targets) then
- begin
- result:=TExternalAssemblerClass(CAssembler[asmkind]).CreateWithWriter(asminfos[asmkind],wr,false,false);
- exit;
- end;
- Internalerror(2015090604);
- end;
- {*****************************************************************************
- Init/Done
- *****************************************************************************}
- procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
- var
- t : tasm;
- begin
- t:=r.id;
- if assigned(asminfos[t]) then
- writeln('Warning: Assembler is already registered!')
- else
- Getmem(asminfos[t],sizeof(tasminfo));
- asminfos[t]^:=r;
- CAssembler[t]:=c;
- end;
- end.
|