assemble.pas 90 KB

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