assemble.pas 49 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583
  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,finput;
  28. const
  29. { maximum of aasmoutput lists there will be }
  30. maxoutputlists = 20;
  31. { buffer size for writing the .s file }
  32. AsmOutSize=32768*4;
  33. type
  34. TAssembler=class(TAbstractAssembler)
  35. public
  36. {filenames}
  37. path : string;
  38. name : string;
  39. AsmFileName, { current .s and .o file }
  40. ObjFileName,
  41. ppufilename : string;
  42. asmprefix : string;
  43. SmartAsm : boolean;
  44. SmartFilesCount,
  45. SmartHeaderCount : longint;
  46. Constructor Create(smart:boolean);virtual;
  47. Destructor Destroy;override;
  48. procedure NextSmartName(place:tcutplace);
  49. procedure MakeObject;virtual;abstract;
  50. end;
  51. {# This is the base class which should be overridden for each each
  52. assembler writer. It is used to actually assembler a file,
  53. and write the output to the assembler file.
  54. }
  55. TExternalAssembler=class(TAssembler)
  56. private
  57. procedure CreateSmartLinkPath(const s:string);
  58. protected
  59. {outfile}
  60. AsmSize,
  61. AsmStartSize,
  62. outcnt : longint;
  63. outbuf : array[0..AsmOutSize-1] of char;
  64. outfile : file;
  65. ioerror : boolean;
  66. {input source info}
  67. lastfileinfo : tfileposinfo;
  68. infile,
  69. lastinfile : tinputfile;
  70. {last section type written}
  71. lastsectype : TAsmSectionType;
  72. public
  73. {# Returns the complete path and executable name of the assembler
  74. program.
  75. It first tries looking in the UTIL directory if specified,
  76. otherwise it searches in the free pascal binary directory, in
  77. the current working directory and then in the directories
  78. in the $PATH environment.}
  79. Function FindAssembler:string;
  80. {# Actually does the call to the assembler file. Returns false
  81. if the assembling of the file failed.}
  82. Function CallAssembler(const command:string; const para:TCmdStr):Boolean;
  83. Function DoAssemble:boolean;virtual;
  84. Procedure RemoveAsm;
  85. Procedure AsmFlush;
  86. Procedure AsmClear;
  87. {# Write a string to the assembler file }
  88. Procedure AsmWrite(const s:string);
  89. {# Write a string to the assembler file }
  90. Procedure AsmWritePChar(p:pchar);
  91. {# Write a string to the assembler file followed by a new line }
  92. Procedure AsmWriteLn(const s:string);
  93. {# Write a new line to the assembler file }
  94. Procedure AsmLn;
  95. procedure AsmCreate(Aplace:tcutplace);
  96. procedure AsmClose;
  97. {# This routine should be overridden for each assembler, it is used
  98. to actually write the abstract assembler stream to file.}
  99. procedure WriteTree(p:TAsmList);virtual;
  100. {# This routine should be overridden for each assembler, it is used
  101. to actually write all the different abstract assembler streams
  102. by calling for each stream type, the @var(WriteTree) method.}
  103. procedure WriteAsmList;virtual;
  104. {# Constructs the command line for calling the assembler }
  105. function MakeCmdLine: TCmdStr; virtual;
  106. public
  107. Constructor Create(smart:boolean);override;
  108. procedure MakeObject;override;
  109. end;
  110. { TInternalAssembler }
  111. TInternalAssembler=class(TAssembler)
  112. private
  113. FCObjOutput : TObjOutputclass;
  114. { the aasmoutput lists that need to be processed }
  115. lists : byte;
  116. list : array[1..maxoutputlists] of TAsmList;
  117. { current processing }
  118. currlistidx : byte;
  119. currlist : TAsmList;
  120. procedure WriteStab(p:pchar);
  121. function MaybeNextList(var hp:Tai):boolean;
  122. function SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean;
  123. function TreePass0(hp:Tai):Tai;
  124. function TreePass1(hp:Tai):Tai;
  125. function TreePass2(hp:Tai):Tai;
  126. procedure writetree;
  127. procedure writetreesmart;
  128. protected
  129. ObjData : TObjData;
  130. ObjOutput : tObjOutput;
  131. property CObjOutput:TObjOutputclass read FCObjOutput write FCObjOutput;
  132. public
  133. constructor create(smart:boolean);override;
  134. destructor destroy;override;
  135. procedure MakeObject;override;
  136. end;
  137. TAssemblerClass = class of TAssembler;
  138. Procedure GenerateAsm(smart:boolean);
  139. Procedure OnlyAsm;
  140. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  141. Implementation
  142. uses
  143. {$ifdef hasunix}
  144. unix,
  145. {$endif}
  146. cutils,cfileutl,
  147. {$ifdef memdebug}
  148. cclasses,
  149. {$endif memdebug}
  150. script,fmodule,verbose,
  151. {$if defined(m68k) or defined(arm)}
  152. cpuinfo,
  153. {$endif m68k or arm}
  154. aasmcpu,
  155. owbase,owar
  156. ;
  157. var
  158. CAssembler : array[tasm] of TAssemblerClass;
  159. {*****************************************************************************
  160. TAssembler
  161. *****************************************************************************}
  162. Constructor TAssembler.Create(smart:boolean);
  163. begin
  164. { load start values }
  165. AsmFileName:=current_module.AsmFilename^;
  166. ObjFileName:=current_module.ObjFileName^;
  167. name:=Lower(current_module.modulename^);
  168. path:=current_module.outputpath^;
  169. asmprefix := current_module.asmprefix^;
  170. if not assigned(current_module.outputpath) then
  171. ppufilename := ''
  172. else
  173. ppufilename := current_module.ppufilename^;
  174. SmartAsm:=smart;
  175. SmartFilesCount:=0;
  176. SmartHeaderCount:=0;
  177. SmartLinkOFiles.Clear;
  178. end;
  179. Destructor TAssembler.Destroy;
  180. begin
  181. end;
  182. procedure TAssembler.NextSmartName(place:tcutplace);
  183. var
  184. s : string;
  185. begin
  186. inc(SmartFilesCount);
  187. if SmartFilesCount>999999 then
  188. Message(asmw_f_too_many_asm_files);
  189. case place of
  190. cut_begin :
  191. begin
  192. inc(SmartHeaderCount);
  193. s:=asmprefix+tostr(SmartHeaderCount)+'h';
  194. end;
  195. cut_normal :
  196. s:=asmprefix+tostr(SmartHeaderCount)+'s';
  197. cut_end :
  198. s:=asmprefix+tostr(SmartHeaderCount)+'t';
  199. end;
  200. AsmFileName:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext);
  201. ObjFileName:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext);
  202. { insert in container so it can be cleared after the linking }
  203. SmartLinkOFiles.Insert(ObjFileName);
  204. end;
  205. {*****************************************************************************
  206. TExternalAssembler
  207. *****************************************************************************}
  208. Function DoPipe:boolean;
  209. begin
  210. DoPipe:=(cs_asm_pipe in current_settings.globalswitches) and
  211. (([cs_asm_leave,cs_link_on_target] * current_settings.globalswitches) = []) and
  212. ((target_asm.id in [as_gas,as_ggas,as_darwin]));
  213. end;
  214. Constructor TExternalAssembler.Create(smart:boolean);
  215. begin
  216. inherited Create(smart);
  217. if SmartAsm then
  218. begin
  219. path:=FixPath(ChangeFileExt(AsmFileName,target_info.smartext),false);
  220. CreateSmartLinkPath(path);
  221. end;
  222. Outcnt:=0;
  223. end;
  224. procedure TExternalAssembler.CreateSmartLinkPath(const s:string);
  225. procedure DeleteFilesWithExt(const AExt:string);
  226. var
  227. dir : TSearchRec;
  228. begin
  229. if findfirst(s+source_info.dirsep+'*'+AExt,faAnyFile,dir) = 0 then
  230. begin
  231. repeat
  232. DeleteFile(s+source_info.dirsep+dir.name);
  233. until findnext(dir) <> 0;
  234. end;
  235. findclose(dir);
  236. end;
  237. var
  238. hs : string;
  239. begin
  240. if PathExists(s,false) then
  241. begin
  242. { the path exists, now we clean only all the .o and .s files }
  243. DeleteFilesWithExt(target_info.objext);
  244. DeleteFilesWithExt(target_info.asmext);
  245. end
  246. else
  247. begin
  248. hs:=s;
  249. if hs[length(hs)] in ['/','\'] then
  250. delete(hs,length(hs),1);
  251. {$I-}
  252. mkdir(hs);
  253. {$I+}
  254. if ioresult<>0 then;
  255. end;
  256. end;
  257. const
  258. lastas : byte=255;
  259. var
  260. LastASBin : TCmdStr;
  261. Function TExternalAssembler.FindAssembler:string;
  262. var
  263. asfound : boolean;
  264. UtilExe : string;
  265. begin
  266. asfound:=false;
  267. if cs_link_on_target in current_settings.globalswitches then
  268. begin
  269. { If linking on target, don't add any path PM }
  270. FindAssembler:=utilsprefix+ChangeFileExt(target_asm.asmbin,target_info.exeext);
  271. exit;
  272. end
  273. else
  274. UtilExe:=utilsprefix+ChangeFileExt(target_asm.asmbin,source_info.exeext);
  275. if lastas<>ord(target_asm.id) then
  276. begin
  277. lastas:=ord(target_asm.id);
  278. { is an assembler passed ? }
  279. if utilsdirectory<>'' then
  280. asfound:=FindFile(UtilExe,utilsdirectory,false,LastASBin);
  281. if not AsFound then
  282. asfound:=FindExe(UtilExe,false,LastASBin);
  283. if (not asfound) and not(cs_asm_extern in current_settings.globalswitches) then
  284. begin
  285. Message1(exec_e_assembler_not_found,LastASBin);
  286. current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern];
  287. end;
  288. if asfound then
  289. Message1(exec_t_using_assembler,LastASBin);
  290. end;
  291. FindAssembler:=LastASBin;
  292. end;
  293. Function TExternalAssembler.CallAssembler(const command:string; const para:TCmdStr):Boolean;
  294. var
  295. DosExitCode : Integer;
  296. begin
  297. result:=true;
  298. if (cs_asm_extern in current_settings.globalswitches) then
  299. begin
  300. AsmRes.AddAsmCommand(command,para,name);
  301. exit;
  302. end;
  303. try
  304. FlushOutput;
  305. DosExitCode := ExecuteProcess(command,para);
  306. if DosExitCode <>0
  307. then begin
  308. Message1(exec_e_error_while_assembling,tostr(dosexitcode));
  309. result:=false;
  310. end;
  311. except on E:EOSError do
  312. begin
  313. Message1(exec_e_cant_call_assembler,tostr(E.ErrorCode));
  314. current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern];
  315. result:=false;
  316. end;
  317. end;
  318. end;
  319. procedure TExternalAssembler.RemoveAsm;
  320. var
  321. g : file;
  322. begin
  323. if cs_asm_leave in current_settings.globalswitches then
  324. exit;
  325. if cs_asm_extern in current_settings.globalswitches then
  326. AsmRes.AddDeleteCommand(AsmFileName)
  327. else
  328. begin
  329. assign(g,AsmFileName);
  330. {$I-}
  331. erase(g);
  332. {$I+}
  333. if ioresult<>0 then;
  334. end;
  335. end;
  336. Function TExternalAssembler.DoAssemble:boolean;
  337. begin
  338. DoAssemble:=true;
  339. if DoPipe then
  340. exit;
  341. if not(cs_asm_extern in current_settings.globalswitches) then
  342. begin
  343. if SmartAsm then
  344. begin
  345. if (SmartFilesCount<=1) then
  346. Message1(exec_i_assembling_smart,name);
  347. end
  348. else
  349. Message1(exec_i_assembling,name);
  350. end;
  351. if CallAssembler(FindAssembler,MakeCmdLine) then
  352. RemoveAsm
  353. else
  354. begin
  355. DoAssemble:=false;
  356. GenerateError;
  357. end;
  358. end;
  359. Procedure TExternalAssembler.AsmFlush;
  360. begin
  361. if outcnt>0 then
  362. begin
  363. { suppress i/o error }
  364. {$i-}
  365. BlockWrite(outfile,outbuf,outcnt);
  366. {$i+}
  367. ioerror:=ioerror or (ioresult<>0);
  368. outcnt:=0;
  369. end;
  370. end;
  371. Procedure TExternalAssembler.AsmClear;
  372. begin
  373. outcnt:=0;
  374. end;
  375. Procedure TExternalAssembler.AsmWrite(const s:string);
  376. begin
  377. if OutCnt+length(s)>=AsmOutSize then
  378. AsmFlush;
  379. Move(s[1],OutBuf[OutCnt],length(s));
  380. inc(OutCnt,length(s));
  381. inc(AsmSize,length(s));
  382. end;
  383. Procedure TExternalAssembler.AsmWriteLn(const s:string);
  384. begin
  385. AsmWrite(s);
  386. AsmLn;
  387. end;
  388. Procedure TExternalAssembler.AsmWritePChar(p:pchar);
  389. var
  390. i,j : longint;
  391. begin
  392. i:=StrLen(p);
  393. j:=i;
  394. while j>0 do
  395. begin
  396. i:=min(j,AsmOutSize);
  397. if OutCnt+i>=AsmOutSize then
  398. AsmFlush;
  399. Move(p[0],OutBuf[OutCnt],i);
  400. inc(OutCnt,i);
  401. inc(AsmSize,i);
  402. dec(j,i);
  403. p:=pchar(@p[i]);
  404. end;
  405. end;
  406. Procedure TExternalAssembler.AsmLn;
  407. begin
  408. if OutCnt>=AsmOutSize-2 then
  409. AsmFlush;
  410. if (cs_link_on_target in current_settings.globalswitches) then
  411. begin
  412. OutBuf[OutCnt]:=target_info.newline[1];
  413. inc(OutCnt);
  414. inc(AsmSize);
  415. if length(target_info.newline)>1 then
  416. begin
  417. OutBuf[OutCnt]:=target_info.newline[2];
  418. inc(OutCnt);
  419. inc(AsmSize);
  420. end;
  421. end
  422. else
  423. begin
  424. OutBuf[OutCnt]:=source_info.newline[1];
  425. inc(OutCnt);
  426. inc(AsmSize);
  427. if length(source_info.newline)>1 then
  428. begin
  429. OutBuf[OutCnt]:=source_info.newline[2];
  430. inc(OutCnt);
  431. inc(AsmSize);
  432. end;
  433. end;
  434. end;
  435. function TExternalAssembler.MakeCmdLine: TCmdStr;
  436. begin
  437. result:=target_asm.asmcmd;
  438. {$ifdef m68k}
  439. if current_settings.cputype = cpu_MC68020 then
  440. result:='-m68020 '+result
  441. else
  442. result:='-m68000 '+result;
  443. {$endif}
  444. {$ifdef arm}
  445. if (target_info.system=system_arm_darwin) then
  446. Replace(result,'$ARCH',lower(cputypestr[current_settings.cputype]));
  447. {$endif arm}
  448. if (cs_link_on_target in current_settings.globalswitches) then
  449. begin
  450. Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName)));
  451. Replace(result,'$OBJ',maybequoted(ScriptFixFileName(ObjFileName)));
  452. end
  453. else
  454. begin
  455. {$ifdef hasunix}
  456. if DoPipe then
  457. Replace(result,'$ASM','')
  458. else
  459. {$endif}
  460. Replace(result,'$ASM',maybequoted(AsmFileName));
  461. Replace(result,'$OBJ',maybequoted(ObjFileName));
  462. end;
  463. end;
  464. procedure TExternalAssembler.AsmCreate(Aplace:tcutplace);
  465. begin
  466. if SmartAsm then
  467. NextSmartName(Aplace);
  468. {$ifdef hasunix}
  469. if DoPipe then
  470. begin
  471. if SmartAsm then
  472. begin
  473. if (SmartFilesCount<=1) then
  474. Message1(exec_i_assembling_smart,name);
  475. end
  476. else
  477. Message1(exec_i_assembling_pipe,AsmFileName);
  478. POpen(outfile,FindAssembler+' '+MakeCmdLine,'W');
  479. end
  480. else
  481. {$endif}
  482. begin
  483. Assign(outfile,AsmFileName);
  484. {$I-}
  485. Rewrite(outfile,1);
  486. {$I+}
  487. if ioresult<>0 then
  488. begin
  489. ioerror:=true;
  490. Message1(exec_d_cant_create_asmfile,AsmFileName);
  491. end;
  492. end;
  493. outcnt:=0;
  494. AsmSize:=0;
  495. AsmStartSize:=0;
  496. end;
  497. procedure TExternalAssembler.AsmClose;
  498. var
  499. f : file;
  500. FileAge : longint;
  501. begin
  502. AsmFlush;
  503. {$ifdef hasunix}
  504. if DoPipe then
  505. begin
  506. if PClose(outfile) <> 0 then
  507. GenerateError;
  508. end
  509. else
  510. {$endif}
  511. begin
  512. {Touch Assembler time to ppu time is there is a ppufilename}
  513. if ppufilename<>'' then
  514. begin
  515. Assign(f,ppufilename);
  516. {$I-}
  517. reset(f,1);
  518. {$I+}
  519. if ioresult=0 then
  520. begin
  521. FileAge := FileGetDate(GetFileHandle(f));
  522. close(f);
  523. reset(outfile,1);
  524. FileSetDate(GetFileHandle(outFile),FileAge);
  525. end;
  526. end;
  527. close(outfile);
  528. end;
  529. end;
  530. procedure TExternalAssembler.WriteTree(p:TAsmList);
  531. begin
  532. end;
  533. procedure TExternalAssembler.WriteAsmList;
  534. begin
  535. end;
  536. procedure TExternalAssembler.MakeObject;
  537. begin
  538. AsmCreate(cut_normal);
  539. FillChar(lastfileinfo, sizeof(lastfileinfo), 0);
  540. lastfileinfo.line := -1;
  541. lastinfile := nil;
  542. lastsectype := sec_none;
  543. WriteAsmList;
  544. AsmClose;
  545. if not(ioerror) then
  546. DoAssemble;
  547. end;
  548. {*****************************************************************************
  549. TInternalAssembler
  550. *****************************************************************************}
  551. constructor TInternalAssembler.create(smart:boolean);
  552. begin
  553. inherited create(smart);
  554. ObjOutput:=nil;
  555. ObjData:=nil;
  556. SmartAsm:=smart;
  557. end;
  558. destructor TInternalAssembler.destroy;
  559. begin
  560. if assigned(ObjData) then
  561. ObjData.free;
  562. if assigned(ObjOutput) then
  563. ObjOutput.free;
  564. end;
  565. procedure TInternalAssembler.WriteStab(p:pchar);
  566. function consumecomma(var p:pchar):boolean;
  567. begin
  568. while (p^=' ') do
  569. inc(p);
  570. result:=(p^=',');
  571. inc(p);
  572. end;
  573. function consumenumber(var p:pchar;out value:longint):boolean;
  574. var
  575. hs : string;
  576. len,
  577. code : integer;
  578. begin
  579. value:=0;
  580. while (p^=' ') do
  581. inc(p);
  582. len:=0;
  583. while (p^ in ['0'..'9']) do
  584. begin
  585. inc(len);
  586. hs[len]:=p^;
  587. inc(p);
  588. end;
  589. if len>0 then
  590. begin
  591. hs[0]:=chr(len);
  592. val(hs,value,code);
  593. end
  594. else
  595. code:=-1;
  596. result:=(code=0);
  597. end;
  598. function consumeoffset(var p:pchar;out relocsym:tobjsymbol;out value:longint):boolean;
  599. var
  600. hs : string;
  601. len,
  602. code : integer;
  603. pstart : pchar;
  604. sym : tobjsymbol;
  605. exprvalue : longint;
  606. gotmin,
  607. have_first_symbol,
  608. have_second_symbol,
  609. dosub : boolean;
  610. begin
  611. result:=false;
  612. value:=0;
  613. relocsym:=nil;
  614. gotmin:=false;
  615. have_first_symbol:=false;
  616. have_second_symbol:=false;
  617. repeat
  618. dosub:=false;
  619. exprvalue:=0;
  620. if gotmin then
  621. begin
  622. dosub:=true;
  623. gotmin:=false;
  624. end;
  625. while (p^=' ') do
  626. inc(p);
  627. case p^ of
  628. #0 :
  629. break;
  630. ' ' :
  631. inc(p);
  632. '0'..'9' :
  633. begin
  634. len:=0;
  635. while (p^ in ['0'..'9']) do
  636. begin
  637. inc(len);
  638. hs[len]:=p^;
  639. inc(p);
  640. end;
  641. hs[0]:=chr(len);
  642. val(hs,exprvalue,code);
  643. if code<>0 then
  644. internalerror(200702251);
  645. end;
  646. '.','_',
  647. 'A'..'Z',
  648. 'a'..'z' :
  649. begin
  650. pstart:=p;
  651. while not(p^ in [#0,' ','-','+']) do
  652. inc(p);
  653. len:=p-pstart;
  654. if len>255 then
  655. internalerror(200509187);
  656. move(pstart^,hs[1],len);
  657. hs[0]:=chr(len);
  658. sym:=objdata.symbolref(hs);
  659. have_first_symbol:=true;
  660. { Second symbol? }
  661. if assigned(relocsym) then
  662. begin
  663. if have_second_symbol then
  664. internalerror(2007032201);
  665. have_second_symbol:=true;
  666. if not have_first_symbol then
  667. internalerror(2007032202);
  668. { second symbol should substracted to first }
  669. if not dosub then
  670. internalerror(2007032203);
  671. if (relocsym.objsection<>sym.objsection) then
  672. internalerror(2005091810);
  673. exprvalue:=relocsym.address-sym.address;
  674. relocsym:=nil;
  675. dosub:=false;
  676. end
  677. else
  678. begin
  679. relocsym:=sym;
  680. if assigned(sym.objsection) then
  681. begin
  682. { first symbol should be + }
  683. if not have_first_symbol and dosub then
  684. internalerror(2007032204);
  685. have_first_symbol:=true;
  686. end;
  687. end;
  688. end;
  689. '+' :
  690. begin
  691. { nothing, by default addition is done }
  692. inc(p);
  693. end;
  694. '-' :
  695. begin
  696. gotmin:=true;
  697. inc(p);
  698. end;
  699. else
  700. internalerror(200509189);
  701. end;
  702. if dosub then
  703. dec(value,exprvalue)
  704. else
  705. inc(value,exprvalue);
  706. until false;
  707. result:=true;
  708. end;
  709. var
  710. stabstrlen,
  711. ofs,
  712. nline,
  713. nidx,
  714. nother,
  715. i : longint;
  716. stab : TObjStabEntry;
  717. relocsym : TObjSymbol;
  718. pstr,
  719. pcurr,
  720. pendquote : pchar;
  721. oldsec : TObjSection;
  722. begin
  723. pcurr:=nil;
  724. pstr:=nil;
  725. pendquote:=nil;
  726. relocsym:=nil;
  727. ofs:=0;
  728. { Parse string part }
  729. if (p[0]='"') then
  730. begin
  731. pstr:=@p[1];
  732. { Ignore \" inside the string }
  733. i:=1;
  734. while not((p[i]='"') and (p[i-1]<>'\')) and
  735. (p[i]<>#0) do
  736. inc(i);
  737. pendquote:=@p[i];
  738. pendquote^:=#0;
  739. pcurr:=@p[i+1];
  740. if not consumecomma(pcurr) then
  741. internalerror(200509181);
  742. end
  743. else
  744. pcurr:=p;
  745. { When in pass 1 then only alloc and leave }
  746. if ObjData.currpass=1 then
  747. begin
  748. ObjData.StabsSec.Alloc(sizeof(TObjStabEntry));
  749. if assigned(pstr) and (pstr[0]<>#0) then
  750. ObjData.StabStrSec.Alloc(strlen(pstr)+1);
  751. end
  752. else
  753. begin
  754. { Stabs format: nidx,nother,nline[,offset] }
  755. if not consumenumber(pcurr,nidx) then
  756. internalerror(200509182);
  757. if not consumecomma(pcurr) then
  758. internalerror(200509183);
  759. if not consumenumber(pcurr,nother) then
  760. internalerror(200509184);
  761. if not consumecomma(pcurr) then
  762. internalerror(200509185);
  763. if not consumenumber(pcurr,nline) then
  764. internalerror(200509186);
  765. if consumecomma(pcurr) then
  766. consumeoffset(pcurr,relocsym,ofs);
  767. { Generate stab entry }
  768. if assigned(pstr) and (pstr[0]<>#0) then
  769. begin
  770. stabstrlen:=strlen(pstr);
  771. {$ifdef optimizestabs}
  772. StabStrEntry:=nil;
  773. if (nidx=N_SourceFile) or (nidx=N_IncludeFile) then
  774. begin
  775. hs:=strpas(pstr);
  776. StabstrEntry:=StabStrDict.Find(hs);
  777. if not assigned(StabstrEntry) then
  778. begin
  779. StabstrEntry:=TStabStrEntry.Create(hs);
  780. StabstrEntry:=StabStrSec.Size;
  781. StabStrDict.Insert(StabstrEntry);
  782. { generate new stab }
  783. StabstrEntry:=nil;
  784. end;
  785. end;
  786. if assigned(StabstrEntry) then
  787. stab.strpos:=StabstrEntry.strpos
  788. else
  789. {$endif optimizestabs}
  790. begin
  791. stab.strpos:=ObjData.StabStrSec.Size;
  792. ObjData.StabStrSec.write(pstr^,stabstrlen+1);
  793. end;
  794. end
  795. else
  796. stab.strpos:=0;
  797. stab.ntype:=byte(nidx);
  798. stab.ndesc:=word(nline);
  799. stab.nother:=byte(nother);
  800. stab.nvalue:=ofs;
  801. { Write the stab first without the value field. Then
  802. write a the value field with relocation }
  803. oldsec:=ObjData.CurrObjSec;
  804. ObjData.SetSection(ObjData.StabsSec);
  805. ObjData.Writebytes(stab,sizeof(TObjStabEntry)-4);
  806. ObjData.Writereloc(stab.nvalue,4,relocsym,RELOC_ABSOLUTE32);
  807. ObjData.setsection(oldsec);
  808. end;
  809. if assigned(pendquote) then
  810. pendquote^:='"';
  811. end;
  812. function TInternalAssembler.MaybeNextList(var hp:Tai):boolean;
  813. begin
  814. { maybe end of list }
  815. while not assigned(hp) do
  816. begin
  817. if currlistidx<lists then
  818. begin
  819. inc(currlistidx);
  820. currlist:=list[currlistidx];
  821. hp:=Tai(currList.first);
  822. end
  823. else
  824. begin
  825. MaybeNextList:=false;
  826. exit;
  827. end;
  828. end;
  829. MaybeNextList:=true;
  830. end;
  831. function TInternalAssembler.SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean;
  832. var
  833. objsym : TObjSymbol;
  834. indsym : TObjSymbol;
  835. begin
  836. Result:=
  837. Assigned(hp) and
  838. (hp.typ=ait_symbol);
  839. if not Result then
  840. Exit;
  841. objsym:=Objdata.SymbolRef(tai_symbol(hp).sym);
  842. objsym.size:=0;
  843. indsym := TObjSymbol(ObjData.ObjSymbolList.Find(indirectname));
  844. if not Assigned(indsym) then
  845. begin
  846. { it's possible that indirect symbol is not present in the list,
  847. so we must create it as undefined }
  848. indsym:=TObjSymbol.Create(ObjData.ObjSymbolList, indirectname);
  849. indsym.typ:=AT_NONE;
  850. indsym.bind:=AB_NONE;
  851. end;
  852. objsym.indsymbol:=indsym;
  853. Result:=true;
  854. end;
  855. function TInternalAssembler.TreePass0(hp:Tai):Tai;
  856. var
  857. objsym,
  858. objsymend : TObjSymbol;
  859. begin
  860. while assigned(hp) do
  861. begin
  862. case hp.typ of
  863. ait_align :
  864. begin
  865. if tai_align_abstract(hp).aligntype>1 then
  866. begin
  867. { always use the maximum fillsize in this pass to avoid possible
  868. short jumps to become out of range }
  869. Tai_align_abstract(hp).fillsize:=Tai_align_abstract(hp).aligntype;
  870. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  871. end
  872. else
  873. Tai_align_abstract(hp).fillsize:=0;
  874. end;
  875. ait_datablock :
  876. begin
  877. {$ifdef USE_COMM_IN_BSS}
  878. if writingpackages and
  879. Tai_datablock(hp).is_global then
  880. ObjData.SymbolDefine(Tai_datablock(hp).sym)
  881. else
  882. {$endif USE_COMM_IN_BSS}
  883. begin
  884. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  885. ObjData.SymbolDefine(Tai_datablock(hp).sym);
  886. ObjData.alloc(Tai_datablock(hp).size);
  887. end;
  888. end;
  889. ait_real_80bit :
  890. ObjData.alloc(tai_real_80bit(hp).savesize);
  891. ait_real_64bit :
  892. ObjData.alloc(8);
  893. ait_real_32bit :
  894. ObjData.alloc(4);
  895. ait_comp_64bit :
  896. ObjData.alloc(8);
  897. ait_const:
  898. begin
  899. { if symbols are provided we can calculate the value for relative symbols.
  900. This is required for length calculation of leb128 constants }
  901. if assigned(tai_const(hp).sym) then
  902. begin
  903. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  904. { objsym already defined and there is endsym? }
  905. if assigned(objsym.objsection) and assigned(tai_const(hp).endsym) then
  906. begin
  907. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  908. { objsymend already defined? }
  909. if assigned(objsymend.objsection) then
  910. begin
  911. if objsymend.objsection<>objsym.objsection then
  912. internalerror(200404124);
  913. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  914. end;
  915. end;
  916. end;
  917. ObjData.alloc(tai_const(hp).size);
  918. end;
  919. ait_directive:
  920. begin
  921. case tai_directive(hp).directive of
  922. asd_indirect_symbol:
  923. { handled in TreePass1 }
  924. ;
  925. asd_lazy_reference:
  926. begin
  927. if tai_directive(hp).name = nil then
  928. Internalerror(2009112101);
  929. objsym:=ObjData.symbolref(tai_directive(hp).name^);
  930. objsym.bind:=AB_LAZY;
  931. end;
  932. asd_reference:
  933. { ignore for now, but should be added}
  934. ;
  935. else
  936. internalerror(2010011101);
  937. end;
  938. end;
  939. ait_section:
  940. begin
  941. ObjData.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secorder);
  942. Tai_section(hp).sec:=ObjData.CurrObjSec;
  943. end;
  944. ait_symbol :
  945. begin
  946. { needs extra support in the internal assembler }
  947. { the value is just ignored }
  948. {if tai_symbol(hp).has_value then
  949. internalerror(2009090804); ;}
  950. ObjData.SymbolDefine(Tai_symbol(hp).sym);
  951. end;
  952. ait_label :
  953. ObjData.SymbolDefine(Tai_label(hp).labsym);
  954. ait_string :
  955. ObjData.alloc(Tai_string(hp).len);
  956. ait_instruction :
  957. begin
  958. { reset instructions which could change in pass 2 }
  959. Taicpu(hp).resetpass2;
  960. ObjData.alloc(Taicpu(hp).Pass1(ObjData));
  961. end;
  962. ait_cutobject :
  963. if SmartAsm then
  964. break;
  965. end;
  966. hp:=Tai(hp.next);
  967. end;
  968. TreePass0:=hp;
  969. end;
  970. function TInternalAssembler.TreePass1(hp:Tai):Tai;
  971. var
  972. objsym,
  973. objsymend : TObjSymbol;
  974. begin
  975. while assigned(hp) do
  976. begin
  977. case hp.typ of
  978. ait_align :
  979. begin
  980. if tai_align_abstract(hp).aligntype>1 then
  981. begin
  982. { here we must determine the fillsize which is used in pass2 }
  983. Tai_align_abstract(hp).fillsize:=align(ObjData.CurrObjSec.Size,Tai_align_abstract(hp).aligntype)-
  984. ObjData.CurrObjSec.Size;
  985. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  986. end;
  987. end;
  988. ait_datablock :
  989. begin
  990. if (oso_data in ObjData.CurrObjSec.secoptions) then
  991. Message(asmw_e_alloc_data_only_in_bss);
  992. {$ifdef USE_COMM_IN_BSS}
  993. if writingpackages and
  994. Tai_datablock(hp).is_global then
  995. begin
  996. objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
  997. objsym.size:=Tai_datablock(hp).size;
  998. objsym.bind:=AB_COMMON;
  999. objsym.alignment:=needtowritealignmentalsoforELF;
  1000. end
  1001. else
  1002. {$endif USE_COMM_IN_BSS}
  1003. begin
  1004. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1005. objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1006. objsym.size:=Tai_datablock(hp).size;
  1007. ObjData.alloc(Tai_datablock(hp).size);
  1008. end;
  1009. end;
  1010. ait_real_80bit :
  1011. ObjData.alloc(tai_real_80bit(hp).savesize);
  1012. ait_real_64bit :
  1013. ObjData.alloc(8);
  1014. ait_real_32bit :
  1015. ObjData.alloc(4);
  1016. ait_comp_64bit :
  1017. ObjData.alloc(8);
  1018. ait_const:
  1019. begin
  1020. { Recalculate relative symbols }
  1021. if assigned(tai_const(hp).sym) and
  1022. assigned(tai_const(hp).endsym) then
  1023. begin
  1024. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1025. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1026. if objsymend.objsection<>objsym.objsection then
  1027. internalerror(200905042);
  1028. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1029. end;
  1030. ObjData.alloc(tai_const(hp).size);
  1031. end;
  1032. ait_section:
  1033. begin
  1034. { use cached value }
  1035. ObjData.setsection(Tai_section(hp).sec);
  1036. end;
  1037. ait_stab :
  1038. begin
  1039. if assigned(Tai_stab(hp).str) then
  1040. WriteStab(Tai_stab(hp).str);
  1041. end;
  1042. ait_symbol :
  1043. ObjData.SymbolDefine(Tai_symbol(hp).sym);
  1044. ait_symbol_end :
  1045. begin
  1046. objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
  1047. objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
  1048. end;
  1049. ait_label :
  1050. ObjData.SymbolDefine(Tai_label(hp).labsym);
  1051. ait_string :
  1052. ObjData.alloc(Tai_string(hp).len);
  1053. ait_instruction :
  1054. ObjData.alloc(Taicpu(hp).Pass1(ObjData));
  1055. ait_cutobject :
  1056. if SmartAsm then
  1057. break;
  1058. ait_directive :
  1059. begin
  1060. case tai_directive(hp).directive of
  1061. asd_indirect_symbol:
  1062. if tai_directive(hp).name = nil then
  1063. Internalerror(2009101103)
  1064. else if not SetIndirectToSymbol(Tai(hp.Previous), tai_directive(hp).name^) then
  1065. Internalerror(2009101102);
  1066. asd_lazy_reference:
  1067. { handled in TreePass0 }
  1068. ;
  1069. asd_reference:
  1070. { ignore for now, but should be added}
  1071. ;
  1072. else
  1073. internalerror(2010011102);
  1074. end;
  1075. end;
  1076. end;
  1077. hp:=Tai(hp.next);
  1078. end;
  1079. TreePass1:=hp;
  1080. end;
  1081. function TInternalAssembler.TreePass2(hp:Tai):Tai;
  1082. var
  1083. fillbuffer : tfillbuffer;
  1084. {$ifdef x86}
  1085. co : comp;
  1086. {$endif x86}
  1087. leblen : byte;
  1088. lebbuf : array[0..63] of byte;
  1089. objsym,
  1090. objsymend : TObjSymbol;
  1091. zerobuf : array[0..63] of byte;
  1092. begin
  1093. fillchar(zerobuf,sizeof(zerobuf),0);
  1094. { main loop }
  1095. while assigned(hp) do
  1096. begin
  1097. case hp.typ of
  1098. ait_align :
  1099. begin
  1100. if oso_data in ObjData.CurrObjSec.secoptions then
  1101. ObjData.writebytes(Tai_align_abstract(hp).calculatefillbuf(fillbuffer,oso_executable in ObjData.CurrObjSec.secoptions)^,
  1102. Tai_align_abstract(hp).fillsize)
  1103. else
  1104. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  1105. end;
  1106. ait_section :
  1107. begin
  1108. { use cached value }
  1109. ObjData.setsection(Tai_section(hp).sec);
  1110. end;
  1111. ait_symbol :
  1112. begin
  1113. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_symbol(hp).sym));
  1114. end;
  1115. ait_datablock :
  1116. begin
  1117. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_datablock(hp).sym));
  1118. {$ifdef USE_COMM_IN_BSS}
  1119. if not(writingpackages and
  1120. Tai_datablock(hp).is_global) then
  1121. {$endif USE_COMM_IN_BSS}
  1122. begin
  1123. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1124. ObjData.alloc(Tai_datablock(hp).size);
  1125. end;
  1126. end;
  1127. ait_real_80bit :
  1128. begin
  1129. ObjData.writebytes(Tai_real_80bit(hp).value,10);
  1130. ObjData.writebytes(zerobuf,Tai_real_80bit(hp).savesize-10);
  1131. end;
  1132. ait_real_64bit :
  1133. ObjData.writebytes(Tai_real_64bit(hp).value,8);
  1134. ait_real_32bit :
  1135. ObjData.writebytes(Tai_real_32bit(hp).value,4);
  1136. ait_comp_64bit :
  1137. begin
  1138. {$ifdef x86}
  1139. co:=comp(Tai_comp_64bit(hp).value);
  1140. ObjData.writebytes(co,8);
  1141. {$endif x86}
  1142. end;
  1143. ait_string :
  1144. ObjData.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
  1145. ait_const :
  1146. begin
  1147. { Recalculate relative symbols, addresses of forward references
  1148. can be changed in treepass1 }
  1149. if assigned(tai_const(hp).sym) and
  1150. assigned(tai_const(hp).endsym) then
  1151. begin
  1152. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1153. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1154. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1155. end;
  1156. case tai_const(hp).consttype of
  1157. aitconst_64bit,
  1158. aitconst_32bit,
  1159. aitconst_16bit,
  1160. aitconst_8bit :
  1161. begin
  1162. if assigned(tai_const(hp).sym) and
  1163. not assigned(tai_const(hp).endsym) then
  1164. ObjData.writereloc(Tai_const(hp).symofs,tai_const(hp).size,Objdata.SymbolRef(tai_const(hp).sym),RELOC_ABSOLUTE)
  1165. else
  1166. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  1167. end;
  1168. aitconst_rva_symbol :
  1169. begin
  1170. { PE32+? }
  1171. if target_info.system=system_x86_64_win64 then
  1172. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA)
  1173. else
  1174. ObjData.writereloc(Tai_const(hp).symofs,sizeof(pint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA);
  1175. end;
  1176. aitconst_secrel32_symbol :
  1177. begin
  1178. { Required for DWARF2 support under Windows }
  1179. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_SECREL32);
  1180. end;
  1181. aitconst_uleb128bit,
  1182. aitconst_sleb128bit :
  1183. begin
  1184. if tai_const(hp).consttype=aitconst_uleb128bit then
  1185. leblen:=EncodeUleb128(qword(Tai_const(hp).value),lebbuf)
  1186. else
  1187. leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf);
  1188. if leblen<>tai_const(hp).size then
  1189. internalerror(200709271);
  1190. ObjData.writebytes(lebbuf,leblen);
  1191. end;
  1192. aitconst_darwin_dwarf_delta32,
  1193. aitconst_darwin_dwarf_delta64:
  1194. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  1195. else
  1196. internalerror(200603254);
  1197. end;
  1198. end;
  1199. ait_label :
  1200. begin
  1201. { exporting shouldn't be necessary as labels are local,
  1202. but it's better to be on the safe side (PFV) }
  1203. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_label(hp).labsym));
  1204. end;
  1205. ait_instruction :
  1206. Taicpu(hp).Pass2(ObjData);
  1207. ait_stab :
  1208. WriteStab(Tai_stab(hp).str);
  1209. ait_function_name,
  1210. ait_force_line : ;
  1211. ait_cutobject :
  1212. if SmartAsm then
  1213. break;
  1214. end;
  1215. hp:=Tai(hp.next);
  1216. end;
  1217. TreePass2:=hp;
  1218. end;
  1219. procedure TInternalAssembler.writetree;
  1220. label
  1221. doexit;
  1222. var
  1223. hp : Tai;
  1224. ObjWriter : TObjectWriter;
  1225. begin
  1226. ObjWriter:=TObjectwriter.create;
  1227. ObjOutput:=CObjOutput.Create(ObjWriter);
  1228. ObjData:=ObjOutput.newObjData(ObjFileName);
  1229. { Pass 0 }
  1230. ObjData.currpass:=0;
  1231. ObjData.createsection(sec_code);
  1232. ObjData.beforealloc;
  1233. { start with list 1 }
  1234. currlistidx:=1;
  1235. currlist:=list[currlistidx];
  1236. hp:=Tai(currList.first);
  1237. while assigned(hp) do
  1238. begin
  1239. hp:=TreePass0(hp);
  1240. MaybeNextList(hp);
  1241. end;
  1242. ObjData.afteralloc;
  1243. { leave if errors have occured }
  1244. if errorcount>0 then
  1245. goto doexit;
  1246. { Pass 1 }
  1247. ObjData.currpass:=1;
  1248. ObjData.resetsections;
  1249. ObjData.beforealloc;
  1250. ObjData.createsection(sec_code);
  1251. { start with list 1 }
  1252. currlistidx:=1;
  1253. currlist:=list[currlistidx];
  1254. hp:=Tai(currList.first);
  1255. while assigned(hp) do
  1256. begin
  1257. hp:=TreePass1(hp);
  1258. MaybeNextList(hp);
  1259. end;
  1260. ObjData.createsection(sec_code);
  1261. ObjData.afteralloc;
  1262. { leave if errors have occured }
  1263. if errorcount>0 then
  1264. goto doexit;
  1265. { Pass 2 }
  1266. ObjData.currpass:=2;
  1267. ObjData.resetsections;
  1268. ObjData.beforewrite;
  1269. ObjData.createsection(sec_code);
  1270. { start with list 1 }
  1271. currlistidx:=1;
  1272. currlist:=list[currlistidx];
  1273. hp:=Tai(currList.first);
  1274. while assigned(hp) do
  1275. begin
  1276. hp:=TreePass2(hp);
  1277. MaybeNextList(hp);
  1278. end;
  1279. ObjData.createsection(sec_code);
  1280. ObjData.afterwrite;
  1281. { don't write the .o file if errors have occured }
  1282. if errorcount=0 then
  1283. begin
  1284. { write objectfile }
  1285. ObjOutput.startobjectfile(ObjFileName);
  1286. ObjOutput.writeobjectfile(ObjData);
  1287. end;
  1288. doexit:
  1289. { Cleanup }
  1290. ObjData.free;
  1291. ObjData:=nil;
  1292. ObjWriter.free;
  1293. end;
  1294. procedure TInternalAssembler.writetreesmart;
  1295. var
  1296. hp : Tai;
  1297. startsectype : TAsmSectiontype;
  1298. place: tcutplace;
  1299. ObjWriter : TObjectWriter;
  1300. begin
  1301. if not(cs_asm_leave in current_settings.globalswitches) then
  1302. ObjWriter:=TARObjectWriter.create(current_module.staticlibfilename^)
  1303. else
  1304. ObjWriter:=TObjectwriter.create;
  1305. NextSmartName(cut_normal);
  1306. ObjOutput:=CObjOutput.Create(ObjWriter);
  1307. startsectype:=sec_code;
  1308. { start with list 1 }
  1309. currlistidx:=1;
  1310. currlist:=list[currlistidx];
  1311. hp:=Tai(currList.first);
  1312. while assigned(hp) do
  1313. begin
  1314. ObjData:=ObjOutput.newObjData(ObjFileName);
  1315. { Pass 0 }
  1316. ObjData.currpass:=0;
  1317. ObjData.resetsections;
  1318. ObjData.beforealloc;
  1319. ObjData.createsection(startsectype);
  1320. TreePass0(hp);
  1321. ObjData.afteralloc;
  1322. { leave if errors have occured }
  1323. if errorcount>0 then
  1324. break;
  1325. { Pass 1 }
  1326. ObjData.currpass:=1;
  1327. ObjData.resetsections;
  1328. ObjData.beforealloc;
  1329. ObjData.createsection(startsectype);
  1330. TreePass1(hp);
  1331. ObjData.afteralloc;
  1332. { leave if errors have occured }
  1333. if errorcount>0 then
  1334. break;
  1335. { Pass 2 }
  1336. ObjData.currpass:=2;
  1337. ObjOutput.startobjectfile(ObjFileName);
  1338. ObjData.resetsections;
  1339. ObjData.beforewrite;
  1340. ObjData.createsection(startsectype);
  1341. hp:=TreePass2(hp);
  1342. ObjData.afterwrite;
  1343. { leave if errors have occured }
  1344. if errorcount>0 then
  1345. break;
  1346. { write the current objectfile }
  1347. ObjOutput.writeobjectfile(ObjData);
  1348. ObjData.free;
  1349. ObjData:=nil;
  1350. { end of lists? }
  1351. if not MaybeNextList(hp) then
  1352. break;
  1353. { we will start a new objectfile so reset everything }
  1354. { The place can still change in the next while loop, so don't init }
  1355. { the writer yet (JM) }
  1356. if (hp.typ=ait_cutobject) then
  1357. place := Tai_cutobject(hp).place
  1358. else
  1359. place := cut_normal;
  1360. { avoid empty files }
  1361. startsectype:=sec_code;
  1362. while assigned(hp) and
  1363. (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cutobject]) do
  1364. begin
  1365. if Tai(hp).typ=ait_section then
  1366. startsectype:=Tai_section(hp).sectype;
  1367. if (Tai(hp).typ=ait_cutobject) then
  1368. place:=Tai_cutobject(hp).place;
  1369. hp:=Tai(hp.next);
  1370. end;
  1371. if not MaybeNextList(hp) then
  1372. break;
  1373. { start next objectfile }
  1374. NextSmartName(place);
  1375. end;
  1376. ObjData.free;
  1377. ObjData:=nil;
  1378. ObjWriter.free;
  1379. end;
  1380. procedure TInternalAssembler.MakeObject;
  1381. var to_do:set of TasmlistType;
  1382. i:TasmlistType;
  1383. procedure addlist(p:TAsmList);
  1384. begin
  1385. inc(lists);
  1386. list[lists]:=p;
  1387. end;
  1388. begin
  1389. to_do:=[low(Tasmlisttype)..high(Tasmlisttype)];
  1390. if usedeffileforexports then
  1391. exclude(to_do,al_exports);
  1392. if not(tf_section_threadvars in target_info.flags) then
  1393. exclude(to_do,al_threadvars);
  1394. for i:=low(TasmlistType) to high(TasmlistType) do
  1395. if (i in to_do) and (current_asmdata.asmlists[i]<>nil) then
  1396. addlist(current_asmdata.asmlists[i]);
  1397. if SmartAsm then
  1398. writetreesmart
  1399. else
  1400. writetree;
  1401. end;
  1402. {*****************************************************************************
  1403. Generate Assembler Files Main Procedure
  1404. *****************************************************************************}
  1405. Procedure GenerateAsm(smart:boolean);
  1406. var
  1407. a : TAssembler;
  1408. begin
  1409. if not assigned(CAssembler[target_asm.id]) then
  1410. Message(asmw_f_assembler_output_not_supported);
  1411. a:=CAssembler[target_asm.id].Create(smart);
  1412. a.MakeObject;
  1413. a.Free;
  1414. end;
  1415. Procedure OnlyAsm;
  1416. var
  1417. a : TExternalAssembler;
  1418. begin
  1419. a:=TExternalAssembler.Create(false);
  1420. a.DoAssemble;
  1421. a.Free;
  1422. end;
  1423. {*****************************************************************************
  1424. Init/Done
  1425. *****************************************************************************}
  1426. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  1427. var
  1428. t : tasm;
  1429. begin
  1430. t:=r.id;
  1431. if assigned(asminfos[t]) then
  1432. writeln('Warning: Assembler is already registered!')
  1433. else
  1434. Getmem(asminfos[t],sizeof(tasminfo));
  1435. asminfos[t]^:=r;
  1436. CAssembler[t]:=c;
  1437. end;
  1438. end.