assemble.pas 92 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973197419751976197719781979198019811982198319841985198619871988198919901991199219931994199519961997199819992000200120022003200420052006200720082009201020112012201320142015201620172018201920202021202220232024202520262027202820292030203120322033203420352036203720382039204020412042204320442045204620472048204920502051205220532054205520562057205820592060206120622063206420652066206720682069207020712072207320742075207620772078207920802081208220832084208520862087208820892090209120922093209420952096209720982099210021012102210321042105210621072108210921102111211221132114211521162117211821192120212121222123212421252126212721282129213021312132213321342135213621372138213921402141214221432144214521462147214821492150215121522153215421552156215721582159216021612162216321642165216621672168216921702171217221732174217521762177217821792180218121822183218421852186218721882189219021912192219321942195219621972198219922002201220222032204220522062207220822092210221122122213221422152216221722182219222022212222222322242225222622272228222922302231223222332234223522362237223822392240224122422243224422452246224722482249225022512252225322542255225622572258225922602261226222632264226522662267226822692270227122722273227422752276227722782279228022812282228322842285228622872288228922902291229222932294229522962297229822992300230123022303230423052306230723082309231023112312231323142315231623172318231923202321232223232324232523262327232823292330233123322333233423352336233723382339234023412342234323442345234623472348234923502351235223532354235523562357235823592360236123622363236423652366236723682369237023712372237323742375237623772378237923802381238223832384238523862387238823892390239123922393239423952396239723982399240024012402240324042405240624072408240924102411241224132414241524162417241824192420242124222423242424252426242724282429243024312432243324342435243624372438243924402441244224432444244524462447244824492450245124522453245424552456245724582459246024612462246324642465246624672468246924702471247224732474247524762477247824792480248124822483248424852486248724882489249024912492249324942495249624972498249925002501250225032504250525062507250825092510251125122513251425152516251725182519252025212522252325242525252625272528252925302531253225332534253525362537253825392540254125422543254425452546254725482549255025512552255325542555255625572558255925602561256225632564256525662567256825692570257125722573257425752576257725782579258025812582258325842585258625872588258925902591259225932594259525962597259825992600260126022603260426052606260726082609261026112612261326142615261626172618261926202621262226232624262526262627262826292630263126322633263426352636263726382639264026412642264326442645264626472648264926502651265226532654265526562657265826592660266126622663266426652666266726682669267026712672267326742675267626772678267926802681268226832684268526862687
  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. {$endif WASM}
  1662. else
  1663. ;
  1664. end;
  1665. hp:=Tai(hp.next);
  1666. end;
  1667. TreePass0:=hp;
  1668. end;
  1669. function TInternalAssembler.TreePass1(hp:Tai):Tai;
  1670. var
  1671. objsym,
  1672. objsymend : TObjSymbol;
  1673. cpu: tcputype;
  1674. eabi_section: TObjSection;
  1675. begin
  1676. while assigned(hp) do
  1677. begin
  1678. case hp.typ of
  1679. ait_align :
  1680. begin
  1681. if tai_align_abstract(hp).aligntype>1 then
  1682. begin
  1683. { here we must determine the fillsize which is used in pass2 }
  1684. Tai_align_abstract(hp).fillsize:=align(ObjData.CurrObjSec.Size,Tai_align_abstract(hp).aligntype)-
  1685. ObjData.CurrObjSec.Size;
  1686. { maximum number of bytes for alignment exeeded? }
  1687. if (Tai_align_abstract(hp).aligntype<>Tai_align_abstract(hp).maxbytes) and
  1688. (Tai_align_abstract(hp).fillsize>Tai_align_abstract(hp).maxbytes) then
  1689. Tai_align_abstract(hp).fillsize:=align(ObjData.CurrObjSec.Size,Byte(Tai_align_abstract(hp).aligntype div 2))-
  1690. ObjData.CurrObjSec.Size;
  1691. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  1692. end;
  1693. end;
  1694. ait_datablock :
  1695. begin
  1696. if (oso_data in ObjData.CurrObjSec.secoptions) and
  1697. not (oso_sparse_data in ObjData.CurrObjSec.secoptions) then
  1698. Message(asmw_e_alloc_data_only_in_bss);
  1699. {$ifdef USE_COMM_IN_BSS}
  1700. if writingpackages and
  1701. Tai_datablock(hp).is_global then
  1702. begin
  1703. objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1704. objsym.size:=Tai_datablock(hp).size;
  1705. objsym.bind:=AB_COMMON;
  1706. objsym.alignment:=needtowritealignmentalsoforELF;
  1707. end
  1708. else
  1709. {$endif USE_COMM_IN_BSS}
  1710. begin
  1711. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1712. objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1713. objsym.size:=Tai_datablock(hp).size;
  1714. ObjData.alloc(Tai_datablock(hp).size);
  1715. end;
  1716. end;
  1717. ait_realconst:
  1718. ObjData.alloc(tai_realconst(hp).savesize);
  1719. ait_const:
  1720. begin
  1721. { Recalculate relative symbols }
  1722. if assigned(tai_const(hp).sym) and
  1723. assigned(tai_const(hp).endsym) then
  1724. begin
  1725. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1726. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1727. if Tai_const(hp).consttype in [aitconst_gottpoff,aitconst_tlsgd,aitconst_tlsdesc] then
  1728. begin
  1729. if objsymend.objsection<>ObjData.CurrObjSec then
  1730. Internalerror(2019092801);
  1731. Tai_const(hp).value:=objsymend.address-ObjData.CurrObjSec.Size+Tai_const(hp).symofs;
  1732. end
  1733. else if objsymend.objsection<>objsym.objsection then
  1734. begin
  1735. if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or
  1736. (objsym.objsection<>ObjData.CurrObjSec) then
  1737. internalerror(200905042);
  1738. end
  1739. {$push} {$R-}{$Q-}
  1740. else
  1741. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1742. end;
  1743. {$pop}
  1744. if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) then
  1745. Tai_const(hp).fixsize;
  1746. ObjData.alloc(tai_const(hp).size);
  1747. end;
  1748. ait_section:
  1749. begin
  1750. { use cached value }
  1751. ObjData.setsection(Tai_section(hp).sec);
  1752. end;
  1753. ait_stab :
  1754. begin
  1755. if assigned(Tai_stab(hp).str) then
  1756. WriteStab(Tai_stab(hp).str);
  1757. end;
  1758. ait_symbol :
  1759. ObjData.SymbolDefine(Tai_symbol(hp).sym);
  1760. ait_symbol_end :
  1761. begin
  1762. objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
  1763. objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
  1764. end;
  1765. ait_label :
  1766. ObjData.SymbolDefine(Tai_label(hp).labsym);
  1767. ait_string :
  1768. ObjData.alloc(Tai_string(hp).len);
  1769. ait_instruction :
  1770. ObjData.alloc(Taicpu(hp).Pass1(ObjData));
  1771. ait_cutobject :
  1772. if SmartAsm then
  1773. break;
  1774. ait_directive :
  1775. begin
  1776. case tai_directive(hp).directive of
  1777. asd_indirect_symbol:
  1778. if tai_directive(hp).name='' then
  1779. Internalerror(2009101103)
  1780. else if not SetIndirectToSymbol(Tai(hp.Previous), tai_directive(hp).name) then
  1781. Internalerror(2009101102);
  1782. asd_lazy_reference:
  1783. { handled in TreePass0 }
  1784. ;
  1785. asd_reference:
  1786. { ignore for now, but should be added}
  1787. ;
  1788. asd_thumb_func:
  1789. { ignore for now, but should be added}
  1790. ;
  1791. asd_force_thumb:
  1792. { ignore for now, but should be added}
  1793. ;
  1794. asd_code:
  1795. { ignore for now, but should be added}
  1796. ;
  1797. asd_option:
  1798. { ignore for now, but should be added}
  1799. ;
  1800. {$ifdef OMFOBJSUPPORT}
  1801. asd_omf_linnum_line:
  1802. { ignore for now, but should be added}
  1803. ;
  1804. {$endif OMFOBJSUPPORT}
  1805. asd_cpu:
  1806. begin
  1807. ObjData.CPUType:=cpu_none;
  1808. for cpu:=low(tcputype) to high(tcputype) do
  1809. if cputypestr[cpu]=tai_directive(hp).name then
  1810. begin
  1811. ObjData.CPUType:=cpu;
  1812. break;
  1813. end;
  1814. end;
  1815. else
  1816. internalerror(2010011102);
  1817. end;
  1818. end;
  1819. ait_eabi_attribute :
  1820. begin
  1821. eabi_section:=ObjData.findsection('.ARM.attributes');
  1822. if not(assigned(eabi_section)) then
  1823. Internalerror(2019100702);
  1824. if eabi_section.Size=0 then
  1825. eabi_section.alloc(16);
  1826. eabi_section.alloc(LengthUleb128(tai_eabi_attribute(hp).tag));
  1827. case tai_eabi_attribute(hp).eattr_typ of
  1828. eattrtype_dword:
  1829. eabi_section.alloc(LengthUleb128(tai_eabi_attribute(hp).value));
  1830. eattrtype_ntbs:
  1831. if assigned(tai_eabi_attribute(hp).valuestr) then
  1832. eabi_section.alloc(Length(tai_eabi_attribute(hp).valuestr^)+1)
  1833. else
  1834. eabi_section.alloc(1);
  1835. else
  1836. Internalerror(2019100703);
  1837. end;
  1838. end;
  1839. else
  1840. ;
  1841. end;
  1842. hp:=Tai(hp.next);
  1843. end;
  1844. TreePass1:=hp;
  1845. end;
  1846. function TInternalAssembler.TreePass2(hp:Tai):Tai;
  1847. var
  1848. fillbuffer : tfillbuffer;
  1849. leblen : byte;
  1850. lebbuf : array[0..63] of byte;
  1851. objsym,
  1852. ref,
  1853. objsymend : TObjSymbol;
  1854. zerobuf : array[0..63] of byte;
  1855. relative_reloc: boolean;
  1856. pdata : pointer;
  1857. ssingle : single;
  1858. ddouble : double;
  1859. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  1860. eextended : extended;
  1861. {$else}
  1862. {$ifdef FPC_SOFT_FPUX80}
  1863. eextended : floatx80;
  1864. {$endif}
  1865. {$endif}
  1866. ccomp : comp;
  1867. tmp : word;
  1868. cpu: tcputype;
  1869. ddword : dword;
  1870. eabi_section: TObjSection;
  1871. s: String;
  1872. TmpDataPos: TObjSectionOfs;
  1873. begin
  1874. fillchar(zerobuf,sizeof(zerobuf),0);
  1875. fillchar(objsym,sizeof(objsym),0);
  1876. fillchar(objsymend,sizeof(objsymend),0);
  1877. { main loop }
  1878. while assigned(hp) do
  1879. begin
  1880. case hp.typ of
  1881. ait_align :
  1882. begin
  1883. if tai_align_abstract(hp).aligntype>ObjData.CurrObjSec.secalign then
  1884. InternalError(2012072301);
  1885. if oso_data in ObjData.CurrObjSec.secoptions then
  1886. ObjData.writebytes(Tai_align_abstract(hp).calculatefillbuf(fillbuffer,oso_executable in ObjData.CurrObjSec.secoptions)^,
  1887. Tai_align_abstract(hp).fillsize)
  1888. else
  1889. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  1890. end;
  1891. ait_section :
  1892. begin
  1893. { use cached value }
  1894. ObjData.setsection(Tai_section(hp).sec);
  1895. end;
  1896. ait_symbol :
  1897. begin
  1898. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_symbol(hp).sym));
  1899. end;
  1900. ait_symbol_end :
  1901. begin
  1902. { recalculate size, as some preceding instructions
  1903. could have been changed to smaller size }
  1904. objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
  1905. objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
  1906. end;
  1907. ait_datablock :
  1908. begin
  1909. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_datablock(hp).sym));
  1910. {$ifdef USE_COMM_IN_BSS}
  1911. if not(writingpackages and
  1912. Tai_datablock(hp).is_global) then
  1913. {$endif USE_COMM_IN_BSS}
  1914. begin
  1915. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1916. ObjData.alloc(Tai_datablock(hp).size);
  1917. end;
  1918. end;
  1919. ait_realconst:
  1920. begin
  1921. case tai_realconst(hp).realtyp of
  1922. aitrealconst_s32bit:
  1923. begin
  1924. ssingle:=single(tai_realconst(hp).value.s32val);
  1925. pdata:=@ssingle;
  1926. end;
  1927. aitrealconst_s64bit:
  1928. begin
  1929. ddouble:=double(tai_realconst(hp).value.s64val);
  1930. pdata:=@ddouble;
  1931. end;
  1932. {$if defined(cpuextended) and defined(FPC_HAS_TYPE_EXTENDED)}
  1933. { can't write full 80 bit floating point constants yet on non-x86 }
  1934. aitrealconst_s80bit:
  1935. begin
  1936. eextended:=extended(tai_realconst(hp).value.s80val);
  1937. pdata:=@eextended;
  1938. end;
  1939. {$else}
  1940. {$ifdef FPC_SOFT_FPUX80}
  1941. {$push}{$warn 6018 off} { Unreachable code due to compile time evaluation }
  1942. aitrealconst_s80bit:
  1943. begin
  1944. if sizeof(tai_realconst(hp).value.s80val) = sizeof(double) then
  1945. eextended:=float64_to_floatx80(float64(double(tai_realconst(hp).value.s80val)))
  1946. else if sizeof(tai_realconst(hp).value.s80val) = sizeof(single) then
  1947. eextended:=float32_to_floatx80(float32(single(tai_realconst(hp).value.s80val)))
  1948. else
  1949. internalerror(2017091903);
  1950. pdata:=@eextended;
  1951. end;
  1952. {$pop}
  1953. {$endif}
  1954. {$endif cpuextended}
  1955. aitrealconst_s64comp:
  1956. begin
  1957. ccomp:=comp(tai_realconst(hp).value.s64compval);
  1958. pdata:=@ccomp;
  1959. end;
  1960. else
  1961. internalerror(2015030501);
  1962. end;
  1963. ObjData.writebytes(pdata^,tai_realconst(hp).datasize);
  1964. ObjData.writebytes(zerobuf,tai_realconst(hp).savesize-tai_realconst(hp).datasize);
  1965. end;
  1966. ait_string :
  1967. ObjData.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
  1968. ait_const :
  1969. begin
  1970. { Recalculate relative symbols, addresses of forward references
  1971. can be changed in treepass1 }
  1972. relative_reloc:=false;
  1973. if assigned(tai_const(hp).sym) and
  1974. assigned(tai_const(hp).endsym) then
  1975. begin
  1976. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1977. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1978. relative_reloc:=(objsym.objsection<>objsymend.objsection);
  1979. if Tai_const(hp).consttype in [aitconst_gottpoff] then
  1980. begin
  1981. if objsymend.objsection<>ObjData.CurrObjSec then
  1982. Internalerror(2019092802);
  1983. Tai_const(hp).value:=objsymend.address-ObjData.CurrObjSec.Size+Tai_const(hp).symofs;
  1984. end
  1985. else if Tai_const(hp).consttype in [aitconst_tlsgd,aitconst_tlsdesc] then
  1986. begin
  1987. if objsymend.objsection<>ObjData.CurrObjSec then
  1988. Internalerror(2019092803);
  1989. Tai_const(hp).value:=ObjData.CurrObjSec.Size-objsymend.address+Tai_const(hp).symofs;
  1990. end
  1991. else if objsymend.objsection<>objsym.objsection then
  1992. begin
  1993. if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or
  1994. (objsym.objsection<>ObjData.CurrObjSec) then
  1995. internalerror(2019010301);
  1996. end
  1997. else
  1998. {$push} {$R-}{$Q-}
  1999. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  2000. end;
  2001. {$pop}
  2002. case tai_const(hp).consttype of
  2003. aitconst_64bit,
  2004. aitconst_32bit,
  2005. aitconst_16bit,
  2006. aitconst_64bit_unaligned,
  2007. aitconst_32bit_unaligned,
  2008. aitconst_16bit_unaligned,
  2009. aitconst_8bit :
  2010. begin
  2011. if assigned(tai_const(hp).sym) and
  2012. not assigned(tai_const(hp).endsym) then
  2013. ObjData.writereloc(Tai_const(hp).symofs,tai_const(hp).size,Objdata.SymbolRef(tai_const(hp).sym),RELOC_ABSOLUTE)
  2014. else if relative_reloc then
  2015. ObjData.writereloc(ObjData.CurrObjSec.size+tai_const(hp).size-objsym.address+tai_const(hp).symofs,tai_const(hp).size,objsymend,RELOC_RELATIVE)
  2016. else
  2017. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  2018. end;
  2019. aitconst_rva_symbol :
  2020. begin
  2021. { PE32+? }
  2022. if target_info.system in systems_peoptplus then
  2023. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA)
  2024. else
  2025. ObjData.writereloc(Tai_const(hp).symofs,sizeof(pint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA);
  2026. end;
  2027. aitconst_secrel32_symbol :
  2028. begin
  2029. { Required for DWARF2 support under Windows }
  2030. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_SECREL32);
  2031. end;
  2032. {$ifdef i8086}
  2033. aitconst_farptr :
  2034. if assigned(tai_const(hp).sym) and
  2035. not assigned(tai_const(hp).endsym) then
  2036. ObjData.writereloc(Tai_const(hp).symofs,tai_const(hp).size,Objdata.SymbolRef(tai_const(hp).sym),RELOC_FARPTR)
  2037. else if relative_reloc then
  2038. internalerror(2015040601)
  2039. else
  2040. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  2041. aitconst_seg:
  2042. if assigned(tai_const(hp).sym) and (tai_const(hp).size=2) then
  2043. ObjData.writereloc(0,2,Objdata.SymbolRef(tai_const(hp).sym),RELOC_SEG)
  2044. else
  2045. internalerror(2015110502);
  2046. aitconst_dgroup:
  2047. ObjData.writereloc(0,2,nil,RELOC_DGROUP);
  2048. aitconst_fardataseg:
  2049. ObjData.writereloc(0,2,nil,RELOC_FARDATASEG);
  2050. {$endif i8086}
  2051. {$ifdef arm}
  2052. aitconst_got:
  2053. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_GOT32);
  2054. { aitconst_gottpoff:
  2055. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_TPOFF); }
  2056. aitconst_tpoff:
  2057. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_TPOFF);
  2058. aitconst_tlsgd:
  2059. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_TLSGD);
  2060. aitconst_tlsdesc:
  2061. begin
  2062. { must be a relative symbol, thus value being valid }
  2063. if not(assigned(tai_const(hp).sym)) or not(assigned(tai_const(hp).endsym)) then
  2064. Internalerror(2019092904);
  2065. ObjData.writereloc(Tai_const(hp).value,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_TLSDESC);
  2066. end;
  2067. {$endif arm}
  2068. aitconst_dtpoff:
  2069. { so far, the size of dtpoff is fixed to 4 bytes }
  2070. ObjData.writereloc(Tai_const(hp).symofs,4,Objdata.SymbolRef(tai_const(hp).sym),RELOC_DTPOFF);
  2071. aitconst_gotoff_symbol:
  2072. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_GOTOFF);
  2073. aitconst_uleb128bit,
  2074. aitconst_sleb128bit :
  2075. begin
  2076. if Tai_const(hp).fixed_size=0 then
  2077. Internalerror(2019030302);
  2078. if tai_const(hp).consttype=aitconst_uleb128bit then
  2079. leblen:=EncodeUleb128(qword(Tai_const(hp).value),lebbuf,Tai_const(hp).fixed_size)
  2080. else
  2081. leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf,Tai_const(hp).fixed_size);
  2082. if leblen<>tai_const(hp).fixed_size then
  2083. internalerror(200709271);
  2084. ObjData.writebytes(lebbuf,leblen);
  2085. end;
  2086. aitconst_darwin_dwarf_delta32,
  2087. aitconst_darwin_dwarf_delta64:
  2088. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  2089. aitconst_half16bit,
  2090. aitconst_gs:
  2091. begin
  2092. tmp:=Tai_const(hp).value div 2;
  2093. ObjData.writebytes(tmp,2);
  2094. end;
  2095. else
  2096. internalerror(200603254);
  2097. end;
  2098. end;
  2099. ait_label :
  2100. begin
  2101. { exporting shouldn't be necessary as labels are local,
  2102. but it's better to be on the safe side (PFV) }
  2103. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_label(hp).labsym));
  2104. end;
  2105. ait_instruction :
  2106. Taicpu(hp).Pass2(ObjData);
  2107. ait_stab :
  2108. WriteStab(Tai_stab(hp).str);
  2109. ait_function_name,
  2110. ait_force_line : ;
  2111. ait_cutobject :
  2112. if SmartAsm then
  2113. break;
  2114. ait_directive :
  2115. begin
  2116. case tai_directive(hp).directive of
  2117. asd_weak_definition,
  2118. asd_weak_reference:
  2119. begin
  2120. objsym:=ObjData.symbolref(tai_directive(hp).name);
  2121. if objsym.bind in [AB_EXTERNAL,AB_WEAK_EXTERNAL] then
  2122. objsym.bind:=AB_WEAK_EXTERNAL
  2123. else
  2124. { TODO: should become a weak definition; for now, do
  2125. the same as what was done for ait_weak }
  2126. objsym.bind:=AB_WEAK_EXTERNAL;
  2127. end;
  2128. asd_cpu:
  2129. begin
  2130. ObjData.CPUType:=cpu_none;
  2131. for cpu:=low(tcputype) to high(tcputype) do
  2132. if cputypestr[cpu]=tai_directive(hp).name then
  2133. begin
  2134. ObjData.CPUType:=cpu;
  2135. break;
  2136. end;
  2137. end;
  2138. {$ifdef OMFOBJSUPPORT}
  2139. asd_omf_linnum_line:
  2140. begin
  2141. TOmfObjSection(ObjData.CurrObjSec).LinNumEntries.Add(
  2142. TOmfSubRecord_LINNUM_MsLink_Entry.Create(
  2143. strtoint(tai_directive(hp).name),
  2144. ObjData.CurrObjSec.Size
  2145. ));
  2146. end;
  2147. {$endif OMFOBJSUPPORT}
  2148. else
  2149. ;
  2150. end
  2151. end;
  2152. ait_symbolpair:
  2153. begin
  2154. if tai_symbolpair(hp).kind=spk_set then
  2155. begin
  2156. objsym:=ObjData.symbolref(tai_symbolpair(hp).sym^);
  2157. ref:=objdata.symbolref(tai_symbolpair(hp).value^);
  2158. objsym.offset:=ref.offset;
  2159. objsym.objsection:=ref.objsection;
  2160. {$ifdef arm}
  2161. objsym.ThumbFunc:=ref.ThumbFunc;
  2162. {$endif arm}
  2163. end;
  2164. end;
  2165. {$ifndef DISABLE_WIN64_SEH}
  2166. ait_seh_directive :
  2167. tai_seh_directive(hp).generate_code(objdata);
  2168. {$endif DISABLE_WIN64_SEH}
  2169. ait_eabi_attribute :
  2170. begin
  2171. eabi_section:=ObjData.findsection('.ARM.attributes');
  2172. if not(assigned(eabi_section)) then
  2173. Internalerror(2019100704);
  2174. if eabi_section.Size=0 then
  2175. begin
  2176. s:='A';
  2177. eabi_section.write(s[1],1);
  2178. ddword:=eabi_section.Size-1;
  2179. eabi_section.write(ddword,4);
  2180. s:='aeabi'#0;
  2181. eabi_section.write(s[1],6);
  2182. s:=#1;
  2183. eabi_section.write(s[1],1);
  2184. ddword:=eabi_section.Size-1-4-6-1;
  2185. eabi_section.write(ddword,4);
  2186. end;
  2187. leblen:=EncodeUleb128(tai_eabi_attribute(hp).tag,lebbuf,0);
  2188. eabi_section.write(lebbuf,leblen);
  2189. case tai_eabi_attribute(hp).eattr_typ of
  2190. eattrtype_dword:
  2191. begin
  2192. leblen:=EncodeUleb128(tai_eabi_attribute(hp).value,lebbuf,0);
  2193. eabi_section.write(lebbuf,leblen);
  2194. end;
  2195. eattrtype_ntbs:
  2196. begin
  2197. if assigned(tai_eabi_attribute(hp).valuestr) then
  2198. s:=tai_eabi_attribute(hp).valuestr^+#0
  2199. else
  2200. s:=#0;
  2201. eabi_section.write(s[1],Length(s));
  2202. end
  2203. else
  2204. Internalerror(2019100705);
  2205. end;
  2206. { update size of attributes section, write directly to the dyn. arrays as
  2207. we do not increase the size of section }
  2208. TmpDataPos:=eabi_section.Data.Pos;
  2209. eabi_section.Data.seek(1);
  2210. ddword:=eabi_section.Size-1;
  2211. eabi_section.Data.write(ddword,4);
  2212. eabi_section.Data.seek(12);
  2213. ddword:=eabi_section.Size-1-4-6;
  2214. eabi_section.Data.write(ddword,4);
  2215. eabi_section.Data.Seek(TmpDataPos);
  2216. end;
  2217. else
  2218. ;
  2219. end;
  2220. hp:=Tai(hp.next);
  2221. end;
  2222. TreePass2:=hp;
  2223. end;
  2224. procedure TInternalAssembler.writetree;
  2225. label
  2226. doexit;
  2227. var
  2228. hp : Tai;
  2229. ObjWriter : TObjectWriter;
  2230. begin
  2231. ObjWriter:=TObjectwriter.create;
  2232. ObjOutput:=CObjOutput.Create(ObjWriter);
  2233. ObjData:=ObjOutput.newObjData(ObjFileName);
  2234. { Pass 0 }
  2235. ObjData.currpass:=0;
  2236. ObjData.createsection(sec_code);
  2237. ObjData.beforealloc;
  2238. { start with list 1 }
  2239. currlistidx:=1;
  2240. currlist:=list[currlistidx];
  2241. hp:=Tai(currList.first);
  2242. while assigned(hp) do
  2243. begin
  2244. hp:=TreePass0(hp);
  2245. MaybeNextList(hp);
  2246. end;
  2247. ObjData.afteralloc;
  2248. { leave if errors have occurred }
  2249. if errorcount>0 then
  2250. goto doexit;
  2251. { Pass 1 }
  2252. ObjData.currpass:=1;
  2253. ObjData.resetsections;
  2254. ObjData.beforealloc;
  2255. ObjData.createsection(sec_code);
  2256. { start with list 1 }
  2257. currlistidx:=1;
  2258. currlist:=list[currlistidx];
  2259. hp:=Tai(currList.first);
  2260. while assigned(hp) do
  2261. begin
  2262. hp:=TreePass1(hp);
  2263. MaybeNextList(hp);
  2264. end;
  2265. ObjData.createsection(sec_code);
  2266. ObjData.afteralloc;
  2267. { leave if errors have occurred }
  2268. if errorcount>0 then
  2269. goto doexit;
  2270. { Pass 2 }
  2271. ObjData.currpass:=2;
  2272. ObjData.resetsections;
  2273. ObjData.beforewrite;
  2274. ObjData.createsection(sec_code);
  2275. { start with list 1 }
  2276. currlistidx:=1;
  2277. currlist:=list[currlistidx];
  2278. hp:=Tai(currList.first);
  2279. while assigned(hp) do
  2280. begin
  2281. hp:=TreePass2(hp);
  2282. MaybeNextList(hp);
  2283. end;
  2284. ObjData.createsection(sec_code);
  2285. ObjData.afterwrite;
  2286. { don't write the .o file if errors have occurred }
  2287. if errorcount=0 then
  2288. begin
  2289. { write objectfile }
  2290. ObjOutput.startobjectfile(ObjFileName);
  2291. ObjOutput.writeobjectfile(ObjData);
  2292. end;
  2293. doexit:
  2294. { Cleanup }
  2295. ObjData.free;
  2296. ObjData:=nil;
  2297. ObjWriter.free;
  2298. end;
  2299. procedure TInternalAssembler.writetreesmart;
  2300. var
  2301. hp : Tai;
  2302. startsectype : TAsmSectiontype;
  2303. place: tcutplace;
  2304. ObjWriter : TObjectWriter;
  2305. startsecname: String;
  2306. startsecorder: TAsmSectionOrder;
  2307. begin
  2308. if not(cs_asm_leave in current_settings.globalswitches) and
  2309. not(af_needar in asminfo^.flags) then
  2310. ObjWriter:=CInternalAr.CreateAr(current_module.staticlibfilename)
  2311. else
  2312. ObjWriter:=TObjectwriter.create;
  2313. NextSmartName(cut_normal);
  2314. ObjOutput:=CObjOutput.Create(ObjWriter);
  2315. startsectype:=sec_none;
  2316. startsecname:='';
  2317. startsecorder:=secorder_default;
  2318. { start with list 1 }
  2319. currlistidx:=1;
  2320. currlist:=list[currlistidx];
  2321. hp:=Tai(currList.first);
  2322. while assigned(hp) do
  2323. begin
  2324. ObjData:=ObjOutput.newObjData(ObjFileName);
  2325. { Pass 0 }
  2326. ObjData.currpass:=0;
  2327. ObjData.resetsections;
  2328. ObjData.beforealloc;
  2329. if startsectype<>sec_none then
  2330. ObjData.CreateSection(startsectype,startsecname,startsecorder);
  2331. TreePass0(hp);
  2332. ObjData.afteralloc;
  2333. { leave if errors have occurred }
  2334. if errorcount>0 then
  2335. break;
  2336. { Pass 1 }
  2337. ObjData.currpass:=1;
  2338. ObjData.resetsections;
  2339. ObjData.beforealloc;
  2340. if startsectype<>sec_none then
  2341. ObjData.CreateSection(startsectype,startsecname,startsecorder);
  2342. TreePass1(hp);
  2343. ObjData.afteralloc;
  2344. { leave if errors have occurred }
  2345. if errorcount>0 then
  2346. break;
  2347. { Pass 2 }
  2348. ObjData.currpass:=2;
  2349. ObjOutput.startobjectfile(ObjFileName);
  2350. ObjData.resetsections;
  2351. ObjData.beforewrite;
  2352. if startsectype<>sec_none then
  2353. ObjData.CreateSection(startsectype,startsecname,startsecorder);
  2354. hp:=TreePass2(hp);
  2355. ObjData.afterwrite;
  2356. { leave if errors have occurred }
  2357. if errorcount>0 then
  2358. break;
  2359. { write the current objectfile }
  2360. ObjOutput.writeobjectfile(ObjData);
  2361. ObjData.free;
  2362. ObjData:=nil;
  2363. { end of lists? }
  2364. if not MaybeNextList(hp) then
  2365. break;
  2366. { we will start a new objectfile so reset everything }
  2367. { The place can still change in the next while loop, so don't init }
  2368. { the writer yet (JM) }
  2369. if (hp.typ=ait_cutobject) then
  2370. place := Tai_cutobject(hp).place
  2371. else
  2372. place := cut_normal;
  2373. { avoid empty files }
  2374. startsectype:=sec_none;
  2375. startsecname:='';
  2376. startsecorder:=secorder_default;
  2377. while assigned(hp) and
  2378. (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cutobject]) do
  2379. begin
  2380. if Tai(hp).typ=ait_section then
  2381. begin
  2382. startsectype:=Tai_section(hp).sectype;
  2383. startsecname:=Tai_section(hp).name^;
  2384. startsecorder:=Tai_section(hp).secorder;
  2385. end;
  2386. if (Tai(hp).typ=ait_cutobject) then
  2387. place:=Tai_cutobject(hp).place;
  2388. hp:=Tai(hp.next);
  2389. end;
  2390. if not MaybeNextList(hp) then
  2391. break;
  2392. { start next objectfile }
  2393. NextSmartName(place);
  2394. end;
  2395. ObjData.free;
  2396. ObjData:=nil;
  2397. ObjWriter.free;
  2398. end;
  2399. procedure TInternalAssembler.MakeObject;
  2400. var to_do:set of TasmlistType;
  2401. i:TasmlistType;
  2402. procedure addlist(p:TAsmList);
  2403. begin
  2404. inc(lists);
  2405. list[lists]:=p;
  2406. end;
  2407. begin
  2408. to_do:=[low(Tasmlisttype)..high(Tasmlisttype)];
  2409. if usedeffileforexports then
  2410. exclude(to_do,al_exports);
  2411. if not(tf_section_threadvars in target_info.flags) then
  2412. exclude(to_do,al_threadvars);
  2413. for i:=low(TasmlistType) to high(TasmlistType) do
  2414. if (i in to_do) and (current_asmdata.asmlists[i]<>nil) and
  2415. (not current_asmdata.asmlists[i].empty) then
  2416. addlist(current_asmdata.asmlists[i]);
  2417. if SmartAsm then
  2418. writetreesmart
  2419. else
  2420. writetree;
  2421. end;
  2422. {*****************************************************************************
  2423. Generate Assembler Files Main Procedure
  2424. *****************************************************************************}
  2425. Procedure GenerateAsm(smart:boolean);
  2426. var
  2427. a : TAssembler;
  2428. begin
  2429. if not assigned(CAssembler[target_asm.id]) then
  2430. Message(asmw_f_assembler_output_not_supported);
  2431. a:=CAssembler[target_asm.id].Create(@target_asm,smart);
  2432. a.MakeObject;
  2433. a.Free;
  2434. end;
  2435. function GetExternalGnuAssemblerWithAsmInfoWriter(info: pasminfo; wr: TExternalAssemblerOutputFile): TExternalAssembler;
  2436. var
  2437. asmkind: tasm;
  2438. begin
  2439. for asmkind in [as_gas,as_ggas,as_darwin,as_clang_gas,as_clang_asdarwin] do
  2440. if assigned(asminfos[asmkind]) and
  2441. (target_info.system in asminfos[asmkind]^.supported_targets) then
  2442. begin
  2443. result:=TExternalAssemblerClass(CAssembler[asmkind]).CreateWithWriter(asminfos[asmkind],wr,false,false);
  2444. exit;
  2445. end;
  2446. Internalerror(2015090604);
  2447. end;
  2448. {*****************************************************************************
  2449. Init/Done
  2450. *****************************************************************************}
  2451. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  2452. var
  2453. t : tasm;
  2454. begin
  2455. t:=r.id;
  2456. if assigned(asminfos[t]) then
  2457. writeln('Warning: Assembler is already registered!')
  2458. else
  2459. Getmem(asminfos[t],sizeof(tasminfo));
  2460. asminfos[t]^:=r;
  2461. CAssembler[t]:=c;
  2462. end;
  2463. end.