assemble.pas 74 KB

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