assemble.pas 93 KB

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