assemble.pas 91 KB

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