assemble.pas 79 KB

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