assemble.pas 92 KB

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