assemble.pas 80 KB

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