1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819182018211822182318241825182618271828182918301831183218331834183518361837183818391840184118421843184418451846184718481849185018511852185318541855185618571858185918601861186218631864186518661867186818691870187118721873187418751876187718781879188018811882188318841885188618871888188918901891189218931894189518961897189818991900190119021903190419051906190719081909191019111912191319141915191619171918191919201921192219231924192519261927192819291930193119321933193419351936193719381939194019411942194319441945194619471948194919501951195219531954195519561957195819591960196119621963196419651966196719681969197019711972197319741975197619771978197919801981198219831984198519861987198819891990199119921993199419951996199719981999200020012002200320042005200620072008200920102011201220132014201520162017201820192020202120222023202420252026202720282029203020312032203320342035203620372038203920402041204220432044204520462047204820492050205120522053205420552056205720582059206020612062206320642065206620672068206920702071207220732074207520762077207820792080208120822083208420852086208720882089209020912092209320942095209620972098209921002101210221032104210521062107210821092110211121122113211421152116211721182119212021212122212321242125212621272128212921302131213221332134213521362137213821392140214121422143214421452146214721482149215021512152215321542155215621572158215921602161216221632164216521662167216821692170217121722173217421752176217721782179218021812182218321842185218621872188218921902191219221932194219521962197219821992200220122022203220422052206220722082209221022112212221322142215221622172218221922202221222222232224222522262227222822292230223122322233223422352236223722382239224022412242224322442245224622472248224922502251225222532254225522562257225822592260226122622263226422652266226722682269227022712272227322742275227622772278227922802281228222832284228522862287228822892290229122922293229422952296229722982299230023012302230323042305230623072308230923102311231223132314231523162317231823192320232123222323232423252326232723282329233023312332233323342335233623372338233923402341234223432344234523462347234823492350235123522353235423552356235723582359236023612362236323642365236623672368236923702371237223732374237523762377237823792380238123822383238423852386238723882389239023912392239323942395239623972398239924002401240224032404240524062407240824092410241124122413241424152416241724182419242024212422242324242425242624272428242924302431243224332434243524362437243824392440244124422443244424452446244724482449245024512452245324542455245624572458245924602461246224632464246524662467246824692470247124722473247424752476247724782479248024812482248324842485248624872488248924902491249224932494249524962497249824992500250125022503250425052506250725082509251025112512251325142515251625172518251925202521252225232524252525262527252825292530253125322533253425352536253725382539254025412542254325442545254625472548254925502551255225532554255525562557255825592560256125622563256425652566256725682569257025712572257325742575257625772578257925802581258225832584258525862587258825892590259125922593259425952596259725982599260026012602260326042605260626072608260926102611261226132614261526162617261826192620262126222623262426252626262726282629263026312632263326342635263626372638263926402641264226432644264526462647264826492650265126522653265426552656265726582659266026612662266326642665266626672668266926702671267226732674267526762677267826792680 |
- {
- 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 WriteComments(var hp: tai): boolean;
- function single2str(d : single) : string; virtual;
- function double2str(d : double) : string; virtual;
- function extended2str(e : extended) : string; virtual;
- function sleb128tostr(a : int64) : string;
- function uleb128tostr(a : qword) : string;
- 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
- {$ifdef ARM}
- { true, if thumb instructions are generated }
- Code16 : Boolean;
- {$endif ARM}
- 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,
- cpubase,cpuinfo,triplet,
- 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_assemble_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_assemble_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.sleb128tostr(a: int64): string;
- var
- i,len : longint;
- buf : array[0..31] of byte;
- begin
- result:='';
- len:=EncodeSleb128(a,buf,0);
- for i:=0 to len-1 do
- begin
- if (i > 0) then
- result:=result+',';
- result:=result+tostr(buf[i]);
- end;
- end;
- function TExternalAssembler.uleb128tostr(a: qword): string;
- var
- i,len : longint;
- buf : array[0..31] of byte;
- begin
- result:='';
- len:=EncodeUleb128(a,buf,0);
- for i:=0 to len-1 do
- begin
- if (i > 0) then
- result:=result+',';
- result:=result+tostr(buf[i]);
- end;
- end;
- Function TExternalAssembler.DoPipe:boolean;
- begin
- {$ifdef hasunix}
- DoPipe:=(cs_asm_pipe in current_settings.globalswitches) and
- (([cs_asm_extern,cs_asm_leave,cs_assemble_on_target] * current_settings.globalswitches) = []) and
- ((asminfo^.id in [as_gas,as_ggas,as_darwin,as_powerpc_xcoff,as_clang_gas,as_clang_llvm,as_solaris_as,as_clang_asdarwin]));
- {$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;
- asmbin : TCmdStr;
- begin
- asfound:=false;
- asmbin:=asminfo^.asmbin;
- if (af_llvm in asminfo^.flags) then
- asmbin:=asmbin+llvmutilssuffix;
- if cs_assemble_on_target in current_settings.globalswitches then
- begin
- { If assembling on target, don't add any path PM }
- FindAssembler:=utilsprefix+ChangeFileExt(asmbin,target_info.exeext);
- exit;
- end
- else
- UtilExe:=utilsprefix+ChangeFileExt(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;
- if af_llvm in target_asm.flags then
- Replace(result,'$TRIPLET',targettriplet(triplet_llvm))
- {$ifdef arm}
- else if (target_info.system=system_arm_ios) then
- Replace(result,'$ARCH',lower(cputypestr[current_settings.cputype]))
- {$endif arm}
- ;
- if (cs_assemble_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 not(asminfo^.id in [as_clang_gas,as_clang_asdarwin,as_clang_llvm]) 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(2017091902);
- 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;
- function TExternalAssembler.WriteComments(var hp: tai): boolean;
- begin
- result:=true;
- case hp.typ of
- ait_comment :
- Begin
- writer.AsmWrite(asminfo^.comment);
- writer.AsmWritePChar(tai_comment(hp).str);
- writer.AsmLn;
- End;
- ait_regalloc :
- begin
- if (cs_asm_regalloc in current_settings.globalswitches) then
- begin
- writer.AsmWrite(#9+asminfo^.comment+'Register ');
- repeat
- writer.AsmWrite(std_regname(Tai_regalloc(hp).reg));
- if (hp.next=nil) or
- (tai(hp.next).typ<>ait_regalloc) or
- (tai_regalloc(hp.next).ratype<>tai_regalloc(hp).ratype) then
- break;
- hp:=tai(hp.next);
- writer.AsmWrite(',');
- until false;
- writer.AsmWrite(' ');
- writer.AsmWriteLn(regallocstr[tai_regalloc(hp).ratype]);
- end;
- end;
- ait_tempalloc :
- begin
- if (cs_asm_tempalloc in current_settings.globalswitches) then
- WriteTempalloc(tai_tempalloc(hp));
- end;
- ait_varloc:
- begin
- { ait_varloc is present here only when register allocation is not done ( -sr option ) }
- if tai_varloc(hp).newlocationhi<>NR_NO then
- writer.AsmWriteLn(asminfo^.comment+'Var '+tai_varloc(hp).varsym.realname+' located in register '+
- std_regname(tai_varloc(hp).newlocationhi)+':'+std_regname(tai_varloc(hp).newlocation))
- else
- writer.AsmWriteLn(asminfo^.comment+'Var '+tai_varloc(hp).varsym.realname+' located in register '+
- std_regname(tai_varloc(hp).newlocation));
- end;
- else
- result:=false;
- end;
- 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;
- {$ifdef ARM}
- Code16:=current_settings.instructionset=is_thumb;
- {$endif ARM}
- 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);
- hs[0]:=chr(len);
- move(pstart^,hs[1],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_force_thumb:
- begin
- ObjData.ThumbFunc:=true;
- Code16:=true;
- end;
- asd_code:
- begin
- { ai_directive(hp).name can be only 16 or 32, this is checked by the reader }
- ObjData.ThumbFunc:=tai_directive(hp).name='16';
- Code16:=tai_directive(hp).name='16';
- end
- {$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
- {$ifdef arm}
- if code16 then
- include(taicpu(hp).flags,cf_thumb)
- else
- exclude(taicpu(hp).flags,cf_thumb);
- {$endif arm}
- { 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:
- if assigned(tai_eabi_attribute(hp).valuestr) then
- eabi_section.alloc(Length(tai_eabi_attribute(hp).valuestr^)+1)
- else
- eabi_section.alloc(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_force_thumb:
- { 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:
- if assigned(tai_eabi_attribute(hp).valuestr) then
- eabi_section.alloc(Length(tai_eabi_attribute(hp).valuestr^)+1)
- else
- eabi_section.alloc(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(2017091903);
- 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(2019092803);
- 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 in systems_peoptplus 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
- if assigned(tai_eabi_attribute(hp).valuestr) then
- s:=tai_eabi_attribute(hp).valuestr^+#0
- else
- s:=#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,as_clang_gas,as_clang_asdarwin] 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.
|