assemble.pas 100 KB

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