assemble.pas 90 KB

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