assemble.pas 55 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826
  1. {
  2. $Id$
  3. Copyright (c) 1998-2002 by Peter Vreman
  4. This unit handles the assemblerfile write and assembler calls of FPC
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. {# @abstract(This unit handles the assembler file write and assembler calls of FPC)
  19. Handles the calls to the actual external assemblers, as well as the generation
  20. of object files for smart linking. Also contains the base class for writing
  21. the assembler statements to file.
  22. }
  23. unit assemble;
  24. {$i fpcdefs.inc}
  25. interface
  26. uses
  27. {$ifdef Delphi}
  28. sysutils,
  29. dmisc,
  30. {$else Delphi}
  31. strings,
  32. dos,
  33. {$endif Delphi}
  34. systems,globtype,globals,aasmbase,aasmtai,ogbase;
  35. const
  36. { maximum of aasmoutput lists there will be }
  37. maxoutputlists = 10;
  38. { buffer size for writing the .s file }
  39. AsmOutSize=32768;
  40. type
  41. TAssembler=class(TAbstractAssembler)
  42. public
  43. {filenames}
  44. path : pathstr;
  45. name : namestr;
  46. asmfile, { current .s and .o file }
  47. objfile : string;
  48. ppufilename : string;
  49. asmprefix : string;
  50. SmartAsm : boolean;
  51. SmartFilesCount,
  52. SmartHeaderCount : longint;
  53. Constructor Create(smart:boolean);virtual;
  54. Destructor Destroy;override;
  55. procedure NextSmartName(place:tcutplace);
  56. procedure MakeObject;virtual;abstract;
  57. end;
  58. {# This is the base class which should be overriden for each each
  59. assembler writer. It is used to actually assembler a file,
  60. and write the output to the assembler file.
  61. }
  62. TExternalAssembler=class(TAssembler)
  63. private
  64. procedure CreateSmartLinkPath(const s:string);
  65. protected
  66. {outfile}
  67. AsmSize,
  68. AsmStartSize,
  69. outcnt : longint;
  70. outbuf : array[0..AsmOutSize-1] of char;
  71. outfile : file;
  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,para:string):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 overriden for each assembler, it is used
  98. to actually write the abstract assembler stream to file.}
  99. procedure WriteTree(p:TAAsmoutput);virtual;
  100. {# This routine should be overriden 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. public
  105. Constructor Create(smart:boolean);override;
  106. procedure MakeObject;override;
  107. end;
  108. TInternalAssembler=class(TAssembler)
  109. public
  110. constructor create(smart:boolean);override;
  111. destructor destroy;override;
  112. procedure MakeObject;override;
  113. protected
  114. { object alloc and output }
  115. objectalloc : TAsmObjectAlloc;
  116. objectdata : TAsmObjectData;
  117. objectoutput : tobjectoutput;
  118. private
  119. { the aasmoutput lists that need to be processed }
  120. lists : byte;
  121. list : array[1..maxoutputlists] of TAAsmoutput;
  122. { current processing }
  123. currlistidx : byte;
  124. currlist : TAAsmoutput;
  125. currpass : byte;
  126. {$ifdef GDB}
  127. n_line : byte; { different types of source lines }
  128. linecount,
  129. includecount : longint;
  130. funcname : tasmsymbol;
  131. stabslastfileinfo : tfileposinfo;
  132. procedure convertstabs(p:pchar);
  133. procedure emitlineinfostabs(nidx,line : longint);
  134. procedure emitstabs(s:string);
  135. procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
  136. procedure StartFileLineInfo(sec:tsection);
  137. procedure EndFileLineInfo;
  138. {$endif}
  139. function MaybeNextList(var hp:Tai):boolean;
  140. function TreePass0(hp:Tai):Tai;
  141. function TreePass1(hp:Tai):Tai;
  142. function TreePass2(hp:Tai):Tai;
  143. procedure writetree;
  144. procedure writetreesmart;
  145. end;
  146. TAssemblerClass = class of TAssembler;
  147. Procedure GenerateAsm(smart:boolean);
  148. Procedure OnlyAsm;
  149. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  150. procedure InitAssembler;
  151. procedure DoneAssembler;
  152. Implementation
  153. uses
  154. {$ifdef hasunix}
  155. {$ifdef havelinuxrtl10}
  156. linux,
  157. {$else}
  158. unix,
  159. {$endif}
  160. {$endif}
  161. cutils,script,fmodule,verbose,
  162. {$ifdef memdebug}
  163. cclasses,
  164. {$endif memdebug}
  165. {$ifdef GDB}
  166. finput,
  167. gdb,
  168. {$endif GDB}
  169. {$ifdef m68k}
  170. cpuinfo,
  171. {$endif m68k}
  172. cpubase,aasmcpu
  173. ;
  174. var
  175. CAssembler : array[tasm] of TAssemblerClass;
  176. {*****************************************************************************
  177. TAssembler
  178. *****************************************************************************}
  179. Constructor TAssembler.Create(smart:boolean);
  180. begin
  181. { load start values }
  182. asmfile:=current_module.get_asmfilename;
  183. objfile:=current_module.objfilename^;
  184. name:=Lower(current_module.modulename^);
  185. path:=current_module.outputpath^;
  186. asmprefix := current_module.asmprefix^;
  187. if not assigned(current_module.outputpath) then
  188. ppufilename := ''
  189. else
  190. ppufilename := current_module.ppufilename^;
  191. SmartAsm:=smart;
  192. SmartFilesCount:=0;
  193. SmartHeaderCount:=0;
  194. SmartLinkOFiles.Clear;
  195. end;
  196. Destructor TAssembler.Destroy;
  197. begin
  198. end;
  199. procedure TAssembler.NextSmartName(place:tcutplace);
  200. var
  201. s : string;
  202. begin
  203. inc(SmartFilesCount);
  204. if SmartFilesCount>999999 then
  205. Message(asmw_f_too_many_asm_files);
  206. case place of
  207. cut_begin :
  208. begin
  209. inc(SmartHeaderCount);
  210. s:=asmprefix+tostr(SmartHeaderCount)+'h';
  211. end;
  212. cut_normal :
  213. s:=asmprefix+tostr(SmartHeaderCount)+'s';
  214. cut_end :
  215. s:=asmprefix+tostr(SmartHeaderCount)+'t';
  216. end;
  217. AsmFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext);
  218. ObjFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext);
  219. { insert in container so it can be cleared after the linking }
  220. SmartLinkOFiles.Insert(Objfile);
  221. end;
  222. {*****************************************************************************
  223. TExternalAssembler
  224. *****************************************************************************}
  225. Function DoPipe:boolean;
  226. begin
  227. DoPipe:=(cs_asm_pipe in aktglobalswitches) and
  228. not(cs_asm_leave in aktglobalswitches)
  229. and ((aktoutputformat in [as_gas,as_darwin]));
  230. end;
  231. Constructor TExternalAssembler.Create(smart:boolean);
  232. begin
  233. inherited Create(smart);
  234. if SmartAsm then
  235. begin
  236. path:=FixPath(path+FixFileName(name)+target_info.smartext,false);
  237. CreateSmartLinkPath(path);
  238. end;
  239. Outcnt:=0;
  240. end;
  241. procedure TExternalAssembler.CreateSmartLinkPath(const s:string);
  242. var
  243. dir : searchrec;
  244. hs : string;
  245. begin
  246. if PathExists(s) then
  247. begin
  248. { the path exists, now we clean only all the .o and .s files }
  249. { .o files }
  250. findfirst(s+source_info.dirsep+'*'+target_info.objext,anyfile,dir);
  251. while (doserror=0) do
  252. begin
  253. RemoveFile(s+source_info.dirsep+dir.name);
  254. findnext(dir);
  255. end;
  256. findclose(dir);
  257. { .s files }
  258. findfirst(s+source_info.dirsep+'*'+target_info.asmext,anyfile,dir);
  259. while (doserror=0) do
  260. begin
  261. RemoveFile(s+source_info.dirsep+dir.name);
  262. findnext(dir);
  263. end;
  264. findclose(dir);
  265. end
  266. else
  267. begin
  268. hs:=s;
  269. if hs[length(hs)] in ['/','\'] then
  270. delete(hs,length(hs),1);
  271. {$I-}
  272. mkdir(hs);
  273. {$I+}
  274. if ioresult<>0 then;
  275. end;
  276. end;
  277. const
  278. lastas : byte=255;
  279. var
  280. LastASBin : pathstr;
  281. Function TExternalAssembler.FindAssembler:string;
  282. var
  283. asfound : boolean;
  284. UtilExe : string;
  285. begin
  286. asfound:=false;
  287. if cs_link_on_target in aktglobalswitches then
  288. begin
  289. { If linking on target, don't add any path PM }
  290. FindAssembler:=utilsprefix+AddExtension(target_asm.asmbin,target_info.exeext);
  291. exit;
  292. end
  293. else
  294. UtilExe:=utilsprefix+AddExtension(target_asm.asmbin,source_info.exeext);
  295. if lastas<>ord(target_asm.id) then
  296. begin
  297. lastas:=ord(target_asm.id);
  298. { is an assembler passed ? }
  299. if utilsdirectory<>'' then
  300. asfound:=FindFile(UtilExe,utilsdirectory,LastASBin);
  301. if not AsFound then
  302. asfound:=FindExe(UtilExe,LastASBin);
  303. if (not asfound) and not(cs_asm_extern in aktglobalswitches) then
  304. begin
  305. Message1(exec_e_assembler_not_found,LastASBin);
  306. aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
  307. end;
  308. if asfound then
  309. Message1(exec_t_using_assembler,LastASBin);
  310. end;
  311. FindAssembler:=LastASBin;
  312. end;
  313. Function TExternalAssembler.CallAssembler(const command,para:string):Boolean;
  314. begin
  315. callassembler:=true;
  316. if not(cs_asm_extern in aktglobalswitches) then
  317. begin
  318. swapvectors;
  319. exec(command,para);
  320. swapvectors;
  321. if (doserror<>0) then
  322. begin
  323. Message1(exec_e_cant_call_assembler,tostr(doserror));
  324. aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
  325. callassembler:=false;
  326. end
  327. else
  328. if (dosexitcode<>0) then
  329. begin
  330. Message1(exec_e_error_while_assembling,tostr(dosexitcode));
  331. callassembler:=false;
  332. end;
  333. end
  334. else
  335. AsmRes.AddAsmCommand(command,para,name);
  336. end;
  337. procedure TExternalAssembler.RemoveAsm;
  338. var
  339. g : file;
  340. begin
  341. if cs_asm_leave in aktglobalswitches then
  342. exit;
  343. if cs_asm_extern in aktglobalswitches then
  344. AsmRes.AddDeleteCommand(AsmFile)
  345. else
  346. begin
  347. assign(g,AsmFile);
  348. {$I-}
  349. erase(g);
  350. {$I+}
  351. if ioresult<>0 then;
  352. end;
  353. end;
  354. Function TExternalAssembler.DoAssemble:boolean;
  355. var
  356. s : string;
  357. begin
  358. DoAssemble:=true;
  359. if DoPipe then
  360. exit;
  361. if not(cs_asm_extern in aktglobalswitches) then
  362. begin
  363. if SmartAsm then
  364. begin
  365. if (SmartFilesCount<=1) then
  366. Message1(exec_i_assembling_smart,name);
  367. end
  368. else
  369. Message1(exec_i_assembling,name);
  370. end;
  371. s:=target_asm.asmcmd;
  372. {$ifdef m68k}
  373. if aktoptprocessor = MC68020 then
  374. s:='-m68020 '+s
  375. else
  376. s:='-m68000 '+s;
  377. {$endif}
  378. if (cs_link_on_target in aktglobalswitches) then
  379. begin
  380. Replace(s,'$ASM',ScriptFixFileName(AsmFile));
  381. Replace(s,'$OBJ',ScriptFixFileName(ObjFile));
  382. end
  383. else
  384. begin
  385. Replace(s,'$ASM',AsmFile);
  386. Replace(s,'$OBJ',ObjFile);
  387. end;
  388. if CallAssembler(FindAssembler,s) then
  389. RemoveAsm
  390. else
  391. begin
  392. DoAssemble:=false;
  393. GenerateError;
  394. end;
  395. end;
  396. Procedure TExternalAssembler.AsmFlush;
  397. begin
  398. if outcnt>0 then
  399. begin
  400. BlockWrite(outfile,outbuf,outcnt);
  401. outcnt:=0;
  402. end;
  403. end;
  404. Procedure TExternalAssembler.AsmClear;
  405. begin
  406. outcnt:=0;
  407. end;
  408. Procedure TExternalAssembler.AsmWrite(const s:string);
  409. begin
  410. if OutCnt+length(s)>=AsmOutSize then
  411. AsmFlush;
  412. Move(s[1],OutBuf[OutCnt],length(s));
  413. inc(OutCnt,length(s));
  414. inc(AsmSize,length(s));
  415. end;
  416. Procedure TExternalAssembler.AsmWriteLn(const s:string);
  417. begin
  418. AsmWrite(s);
  419. AsmLn;
  420. end;
  421. Procedure TExternalAssembler.AsmWritePChar(p:pchar);
  422. var
  423. i,j : longint;
  424. begin
  425. i:=StrLen(p);
  426. j:=i;
  427. while j>0 do
  428. begin
  429. i:=min(j,AsmOutSize);
  430. if OutCnt+i>=AsmOutSize then
  431. AsmFlush;
  432. Move(p[0],OutBuf[OutCnt],i);
  433. inc(OutCnt,i);
  434. inc(AsmSize,i);
  435. dec(j,i);
  436. p:=pchar(@p[i]);
  437. end;
  438. end;
  439. Procedure TExternalAssembler.AsmLn;
  440. begin
  441. if OutCnt>=AsmOutSize-2 then
  442. AsmFlush;
  443. if (cs_link_on_target in aktglobalswitches) then
  444. begin
  445. OutBuf[OutCnt]:=target_info.newline[1];
  446. inc(OutCnt);
  447. inc(AsmSize);
  448. if length(target_info.newline)>1 then
  449. begin
  450. OutBuf[OutCnt]:=target_info.newline[2];
  451. inc(OutCnt);
  452. inc(AsmSize);
  453. end;
  454. end
  455. else
  456. begin
  457. OutBuf[OutCnt]:=source_info.newline[1];
  458. inc(OutCnt);
  459. inc(AsmSize);
  460. if length(source_info.newline)>1 then
  461. begin
  462. OutBuf[OutCnt]:=source_info.newline[2];
  463. inc(OutCnt);
  464. inc(AsmSize);
  465. end;
  466. end;
  467. end;
  468. procedure TExternalAssembler.AsmCreate(Aplace:tcutplace);
  469. begin
  470. if SmartAsm then
  471. NextSmartName(Aplace);
  472. {$ifdef hasunix}
  473. if DoPipe then
  474. begin
  475. Message1(exec_i_assembling_pipe,asmfile);
  476. POpen(outfile,'as -o '+objfile,'W');
  477. end
  478. else
  479. {$endif}
  480. begin
  481. Assign(outfile,asmfile);
  482. {$I-}
  483. Rewrite(outfile,1);
  484. {$I+}
  485. if ioresult<>0 then
  486. Message1(exec_d_cant_create_asmfile,asmfile);
  487. end;
  488. outcnt:=0;
  489. AsmSize:=0;
  490. AsmStartSize:=0;
  491. end;
  492. procedure TExternalAssembler.AsmClose;
  493. var
  494. f : file;
  495. l : longint;
  496. begin
  497. AsmFlush;
  498. {$ifdef hasunix}
  499. if DoPipe then
  500. PClose(outfile)
  501. else
  502. {$endif}
  503. begin
  504. {Touch Assembler time to ppu time is there is a ppufilename}
  505. if ppufilename<>'' then
  506. begin
  507. Assign(f,ppufilename);
  508. {$I-}
  509. reset(f,1);
  510. {$I+}
  511. if ioresult=0 then
  512. begin
  513. getftime(f,l);
  514. close(f);
  515. reset(outfile,1);
  516. setftime(outfile,l);
  517. end;
  518. end;
  519. close(outfile);
  520. end;
  521. end;
  522. procedure TExternalAssembler.WriteTree(p:TAAsmoutput);
  523. begin
  524. end;
  525. procedure TExternalAssembler.WriteAsmList;
  526. begin
  527. end;
  528. procedure TExternalAssembler.MakeObject;
  529. begin
  530. AsmCreate(cut_normal);
  531. WriteAsmList;
  532. AsmClose;
  533. DoAssemble;
  534. end;
  535. {*****************************************************************************
  536. TInternalAssembler
  537. *****************************************************************************}
  538. constructor TInternalAssembler.create(smart:boolean);
  539. begin
  540. inherited create(smart);
  541. objectoutput:=nil;
  542. objectdata:=nil;
  543. objectalloc:=TAsmObjectAlloc.create;
  544. SmartAsm:=smart;
  545. currpass:=0;
  546. end;
  547. destructor TInternalAssembler.destroy;
  548. {$ifdef MEMDEBUG}
  549. var
  550. d : tmemdebug;
  551. {$endif}
  552. begin
  553. {$ifdef MEMDEBUG}
  554. d := tmemdebug.create(name+' - agbin');
  555. {$endif}
  556. objectdata.free;
  557. objectoutput.free;
  558. objectalloc.free;
  559. {$ifdef MEMDEBUG}
  560. d.free;
  561. {$endif}
  562. end;
  563. {$ifdef GDB}
  564. procedure TInternalAssembler.convertstabs(p:pchar);
  565. var
  566. ofs,
  567. nidx,nother,ii,i,line,j : longint;
  568. code : integer;
  569. hp : pchar;
  570. reloc : boolean;
  571. sec : TSection;
  572. ps : tasmsymbol;
  573. s : string;
  574. begin
  575. ofs:=0;
  576. reloc:=true;
  577. ps:=nil;
  578. sec:=sec_none;
  579. if p[0]='"' then
  580. begin
  581. i:=1;
  582. { we can have \" inside the string !! PM }
  583. while not ((p[i]='"') and (p[i-1]<>'\')) do
  584. inc(i);
  585. p[i]:=#0;
  586. ii:=i;
  587. hp:=@p[1];
  588. s:=StrPas(@P[i+2]);
  589. end
  590. else
  591. begin
  592. hp:=nil;
  593. s:=StrPas(P);
  594. i:=-2; {needed below (PM) }
  595. end;
  596. { When in pass 1 then only alloc and leave }
  597. if currpass=1 then
  598. begin
  599. objectalloc.staballoc(hp);
  600. if assigned(hp) then
  601. p[i]:='"';
  602. exit;
  603. end;
  604. { Parse the rest of the stabs }
  605. if s='' then
  606. internalerror(33000);
  607. j:=pos(',',s);
  608. if j=0 then
  609. internalerror(33001);
  610. Val(Copy(s,1,j-1),nidx,code);
  611. if code<>0 then
  612. internalerror(33002);
  613. i:=i+2+j;
  614. Delete(s,1,j);
  615. j:=pos(',',s);
  616. if (j=0) then
  617. internalerror(33003);
  618. Val(Copy(s,1,j-1),nother,code);
  619. if code<>0 then
  620. internalerror(33004);
  621. i:=i+j;
  622. Delete(s,1,j);
  623. j:=pos(',',s);
  624. if j=0 then
  625. begin
  626. j:=256;
  627. ofs:=-1;
  628. end;
  629. Val(Copy(s,1,j-1),line,code);
  630. if code<>0 then
  631. internalerror(33005);
  632. if ofs=0 then
  633. begin
  634. Delete(s,1,j);
  635. i:=i+j;
  636. Val(s,ofs,code);
  637. if code=0 then
  638. reloc:=false
  639. else
  640. begin
  641. ofs:=0;
  642. s:=strpas(@p[i]);
  643. { handle asmsymbol or
  644. asmsymbol - asmsymbol }
  645. j:=pos(' ',s);
  646. if j=0 then
  647. j:=pos('-',s);
  648. { also try to handle
  649. asmsymbol + constant
  650. or
  651. asmsymbol - constant }
  652. if j=0 then
  653. j:=pos('+',s);
  654. if j<>0 then
  655. begin
  656. Val(Copy(s,j+1,255),ofs,code);
  657. if code<>0 then
  658. ofs:=0
  659. else
  660. { constant reading successful,
  661. avoid further treatment by
  662. setting s[j] to '+' }
  663. s[j]:='+';
  664. end
  665. else
  666. { single asmsymbol }
  667. j:=256;
  668. { the symbol can be external
  669. so we must use newasmsymbol and
  670. not getasmsymbol !! PM }
  671. ps:=objectlibrary.newasmsymbol(copy(s,1,j-1),AB_EXTERNAL,AT_NONE);
  672. if not assigned(ps) then
  673. internalerror(33006)
  674. else
  675. begin
  676. sec:=ps.section;
  677. ofs:=ofs+ps.address;
  678. reloc:=true;
  679. objectlibrary.UsedAsmSymbolListInsert(ps);
  680. end;
  681. if (j<256) and (s[j]<>'+') then
  682. begin
  683. i:=i+j;
  684. s:=strpas(@p[i]);
  685. if (s<>'') and (s[1]=' ') then
  686. begin
  687. j:=0;
  688. while (s[j+1]=' ') do
  689. inc(j);
  690. i:=i+j;
  691. s:=strpas(@p[i]);
  692. end;
  693. ps:=objectlibrary.getasmsymbol(s);
  694. if not assigned(ps) then
  695. internalerror(33007)
  696. else
  697. begin
  698. if ps.section<>sec then
  699. internalerror(33008);
  700. ofs:=ofs-ps.address;
  701. reloc:=false;
  702. objectlibrary.UsedAsmSymbolListInsert(ps);
  703. end;
  704. end;
  705. end;
  706. end;
  707. { external bss need speical handling (PM) }
  708. if assigned(ps) and (ps.section=sec_none) then
  709. begin
  710. if currpass=2 then
  711. begin
  712. objectdata.writesymbol(ps);
  713. objectoutput.exportsymbol(ps);
  714. end;
  715. objectdata.writeSymStabs(sec,ofs,hp,ps,nidx,nother,line,reloc)
  716. end
  717. else
  718. objectdata.writeStabs(sec,ofs,hp,nidx,nother,line,reloc);
  719. if assigned(hp) then
  720. p[ii]:='"';
  721. end;
  722. procedure TInternalAssembler.emitlineinfostabs(nidx,line : longint);
  723. var
  724. sec : TSection;
  725. begin
  726. if currpass=1 then
  727. begin
  728. objectalloc.staballoc(nil);
  729. exit;
  730. end;
  731. if (nidx=n_textline) and assigned(funcname) and
  732. (target_info.use_function_relative_addresses) then
  733. objectdata.writeStabs(sec_code,objectdata.sectionsize(sec_code)-funcname.address,
  734. nil,nidx,0,line,false)
  735. else
  736. begin
  737. if nidx=n_textline then
  738. sec:=sec_code
  739. else if nidx=n_dataline then
  740. sec:=sec_data
  741. else
  742. sec:=sec_bss;
  743. objectdata.writeStabs(sec,objectdata.sectionsize(sec),
  744. nil,nidx,0,line,true);
  745. end;
  746. end;
  747. procedure TInternalAssembler.emitstabs(s:string);
  748. begin
  749. s:=s+#0;
  750. ConvertStabs(@s[1]);
  751. end;
  752. procedure TInternalAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo);
  753. var
  754. curr_n : byte;
  755. hp : tasmsymbol;
  756. infile : tinputfile;
  757. begin
  758. if not ((cs_debuginfo in aktmoduleswitches) or
  759. (cs_gdb_lineinfo in aktglobalswitches)) then
  760. exit;
  761. { file changed ? (must be before line info) }
  762. if (fileinfo.fileindex<>0) and
  763. (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
  764. begin
  765. infile:=current_module.sourcefiles.get_file(fileinfo.fileindex);
  766. if assigned(infile) then
  767. begin
  768. if includecount=0 then
  769. curr_n:=n_sourcefile
  770. else
  771. curr_n:=n_includefile;
  772. { get symbol for this includefile }
  773. hp:=objectlibrary.newasmsymbol('Ltext'+ToStr(IncludeCount),AB_LOCAL,AT_FUNCTION);
  774. if currpass=1 then
  775. begin
  776. hp.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  777. objectlibrary.UsedAsmSymbolListInsert(hp);
  778. end
  779. else
  780. objectdata.writesymbol(hp);
  781. { emit stabs }
  782. if (infile.path^<>'') then
  783. EmitStabs('"'+lower(BsToSlash(FixPath(infile.path^,false)))+'",'+tostr(curr_n)+
  784. ',0,0,Ltext'+ToStr(IncludeCount));
  785. EmitStabs('"'+lower(FixFileName(infile.name^))+'",'+tostr(curr_n)+
  786. ',0,0,Ltext'+ToStr(IncludeCount));
  787. inc(includecount);
  788. { force new line info }
  789. stabslastfileinfo.line:=-1;
  790. end;
  791. end;
  792. { line changed ? }
  793. if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
  794. emitlineinfostabs(n_line,fileinfo.line);
  795. stabslastfileinfo:=fileinfo;
  796. end;
  797. procedure TInternalAssembler.StartFileLineInfo(sec:tsection);
  798. var
  799. fileinfo : tfileposinfo;
  800. begin
  801. FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
  802. case sec of
  803. sec_code : n_line:=n_textline;
  804. sec_data : n_line:=n_dataline;
  805. sec_bss : n_line:=n_bssline;
  806. else
  807. n_line:=n_bssline;
  808. end;
  809. funcname:=nil;
  810. linecount:=1;
  811. includecount:=0;
  812. fileinfo.fileindex:=1;
  813. fileinfo.line:=1;
  814. WriteFileLineInfo(fileinfo);
  815. end;
  816. procedure TInternalAssembler.EndFileLineInfo;
  817. var
  818. hp : tasmsymbol;
  819. store_sec : TSection;
  820. begin
  821. if not ((cs_debuginfo in aktmoduleswitches) or
  822. (cs_gdb_lineinfo in aktglobalswitches)) then
  823. exit;
  824. store_sec:=objectalloc.currsec;
  825. objectalloc.seTSection(sec_code);
  826. hp:=objectlibrary.newasmsymbol('Letext',AB_LOCAL,AT_FUNCTION);
  827. if currpass=1 then
  828. begin
  829. hp.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  830. objectlibrary.UsedAsmSymbolListInsert(hp);
  831. end
  832. else
  833. objectdata.writesymbol(hp);
  834. EmitStabs('"",'+tostr(n_sourcefile)+',0,0,Letext');
  835. objectalloc.seTSection(store_sec);
  836. end;
  837. {$endif GDB}
  838. function TInternalAssembler.MaybeNextList(var hp:Tai):boolean;
  839. begin
  840. { maybe end of list }
  841. while not assigned(hp) do
  842. begin
  843. if currlistidx<lists then
  844. begin
  845. inc(currlistidx);
  846. currlist:=list[currlistidx];
  847. hp:=Tai(currList.first);
  848. end
  849. else
  850. begin
  851. MaybeNextList:=false;
  852. exit;
  853. end;
  854. end;
  855. MaybeNextList:=true;
  856. end;
  857. function TInternalAssembler.TreePass0(hp:Tai):Tai;
  858. var
  859. l : longint;
  860. begin
  861. while assigned(hp) do
  862. begin
  863. case hp.typ of
  864. ait_align :
  865. begin
  866. { always use the maximum fillsize in this pass to avoid possible
  867. short jumps to become out of range }
  868. Tai_align(hp).fillsize:=Tai_align(hp).aligntype;
  869. objectalloc.sectionalloc(Tai_align(hp).fillsize);
  870. end;
  871. ait_datablock :
  872. begin
  873. if not SmartAsm then
  874. begin
  875. if not Tai_datablock(hp).is_global then
  876. begin
  877. l:=Tai_datablock(hp).size;
  878. if l>2 then
  879. objectalloc.sectionalign(4)
  880. else if l>1 then
  881. objectalloc.sectionalign(2);
  882. objectalloc.sectionalloc(Tai_datablock(hp).size);
  883. end;
  884. end
  885. else
  886. begin
  887. l:=Tai_datablock(hp).size;
  888. if l>2 then
  889. objectalloc.sectionalign(4)
  890. else if l>1 then
  891. objectalloc.sectionalign(2);
  892. objectalloc.sectionalloc(Tai_datablock(hp).size);
  893. end;
  894. end;
  895. ait_const_32bit :
  896. objectalloc.sectionalloc(4);
  897. ait_const_16bit :
  898. objectalloc.sectionalloc(2);
  899. ait_const_8bit :
  900. objectalloc.sectionalloc(1);
  901. ait_real_80bit :
  902. objectalloc.sectionalloc(10);
  903. ait_real_64bit :
  904. objectalloc.sectionalloc(8);
  905. ait_real_32bit :
  906. objectalloc.sectionalloc(4);
  907. ait_comp_64bit :
  908. objectalloc.sectionalloc(8);
  909. ait_const_rva,
  910. ait_const_symbol :
  911. objectalloc.sectionalloc(4);
  912. ait_section:
  913. objectalloc.seTSection(Tai_section(hp).sec);
  914. ait_symbol :
  915. Tai_symbol(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  916. ait_label :
  917. Tai_label(hp).l.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  918. ait_string :
  919. objectalloc.sectionalloc(Tai_string(hp).len);
  920. ait_instruction :
  921. begin
  922. {$ifdef i386}
  923. {$ifndef NOAG386BIN}
  924. { reset instructions which could change in pass 2 }
  925. Taicpu(hp).resetpass2;
  926. objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
  927. {$endif NOAG386BIN}
  928. {$endif i386}
  929. end;
  930. ait_cut :
  931. if SmartAsm then
  932. break;
  933. end;
  934. hp:=Tai(hp.next);
  935. end;
  936. TreePass0:=hp;
  937. end;
  938. function TInternalAssembler.TreePass1(hp:Tai):Tai;
  939. var
  940. InlineLevel,
  941. l : longint;
  942. {$ifdef i386}
  943. {$ifndef NOAG386BIN}
  944. i : longint;
  945. {$endif NOAG386BIN}
  946. {$endif i386}
  947. begin
  948. inlinelevel:=0;
  949. while assigned(hp) do
  950. begin
  951. {$ifdef GDB}
  952. { write stabs, no line info for inlined code }
  953. if (inlinelevel=0) and
  954. ((cs_debuginfo in aktmoduleswitches) or
  955. (cs_gdb_lineinfo in aktglobalswitches)) then
  956. begin
  957. if (objectalloc.currsec<>sec_none) and
  958. not(hp.typ in SkipLineInfo) then
  959. WriteFileLineInfo(tailineinfo(hp).fileinfo);
  960. end;
  961. {$endif GDB}
  962. case hp.typ of
  963. ait_align :
  964. begin
  965. { here we must determine the fillsize which is used in pass2 }
  966. Tai_align(hp).fillsize:=align(objectalloc.sectionsize,Tai_align(hp).aligntype)-
  967. objectalloc.sectionsize;
  968. objectalloc.sectionalloc(Tai_align(hp).fillsize);
  969. end;
  970. ait_datablock :
  971. begin
  972. if objectalloc.currsec<>sec_bss then
  973. Message(asmw_e_alloc_data_only_in_bss);
  974. if not SmartAsm then
  975. begin
  976. if Tai_datablock(hp).is_global then
  977. begin
  978. Tai_datablock(hp).sym.setaddress(currpass,sec_none,Tai_datablock(hp).size,Tai_datablock(hp).size);
  979. { force to be common/external, must be after setaddress as that would
  980. set it to AS_GLOBAL }
  981. Tai_datablock(hp).sym.currbind:=AB_COMMON;
  982. end
  983. else
  984. begin
  985. l:=Tai_datablock(hp).size;
  986. if l>2 then
  987. objectalloc.sectionalign(4)
  988. else if l>1 then
  989. objectalloc.sectionalign(2);
  990. Tai_datablock(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,
  991. Tai_datablock(hp).size);
  992. objectalloc.sectionalloc(Tai_datablock(hp).size);
  993. end;
  994. end
  995. else
  996. begin
  997. l:=Tai_datablock(hp).size;
  998. if l>2 then
  999. objectalloc.sectionalign(4)
  1000. else if l>1 then
  1001. objectalloc.sectionalign(2);
  1002. Tai_datablock(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,Tai_datablock(hp).size);
  1003. objectalloc.sectionalloc(Tai_datablock(hp).size);
  1004. end;
  1005. objectlibrary.UsedAsmSymbolListInsert(Tai_datablock(hp).sym);
  1006. end;
  1007. ait_const_32bit :
  1008. objectalloc.sectionalloc(4);
  1009. ait_const_16bit :
  1010. objectalloc.sectionalloc(2);
  1011. ait_const_8bit :
  1012. objectalloc.sectionalloc(1);
  1013. ait_real_80bit :
  1014. objectalloc.sectionalloc(10);
  1015. ait_real_64bit :
  1016. objectalloc.sectionalloc(8);
  1017. ait_real_32bit :
  1018. objectalloc.sectionalloc(4);
  1019. ait_comp_64bit :
  1020. objectalloc.sectionalloc(8);
  1021. ait_const_rva,
  1022. ait_const_symbol :
  1023. begin
  1024. objectalloc.sectionalloc(4);
  1025. objectlibrary.UsedAsmSymbolListInsert(Tai_const_symbol(hp).sym);
  1026. end;
  1027. ait_section:
  1028. begin
  1029. objectalloc.seTSection(Tai_section(hp).sec);
  1030. {$ifdef GDB}
  1031. case Tai_section(hp).sec of
  1032. sec_code : n_line:=n_textline;
  1033. sec_data : n_line:=n_dataline;
  1034. sec_bss : n_line:=n_bssline;
  1035. else
  1036. n_line:=n_dataline;
  1037. end;
  1038. stabslastfileinfo.line:=-1;
  1039. {$endif GDB}
  1040. end;
  1041. {$ifdef GDB}
  1042. ait_stabn :
  1043. begin
  1044. if assigned(Tai_stabn(hp).str) then
  1045. convertstabs(Tai_stabn(hp).str);
  1046. end;
  1047. ait_stabs :
  1048. begin
  1049. if assigned(Tai_stabs(hp).str) then
  1050. convertstabs(Tai_stabs(hp).str);
  1051. end;
  1052. ait_stab_function_name :
  1053. begin
  1054. if assigned(Tai_stab_function_name(hp).str) then
  1055. begin
  1056. funcname:=objectlibrary.getasmsymbol(strpas(Tai_stab_function_name(hp).str));
  1057. objectlibrary.UsedAsmSymbolListInsert(funcname);
  1058. end
  1059. else
  1060. funcname:=nil;
  1061. end;
  1062. ait_force_line :
  1063. stabslastfileinfo.line:=0;
  1064. {$endif}
  1065. ait_symbol :
  1066. begin
  1067. Tai_symbol(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  1068. objectlibrary.UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
  1069. end;
  1070. ait_symbol_end :
  1071. begin
  1072. if target_info.system in [system_i386_linux,system_i386_beos] then
  1073. begin
  1074. Tai_symbol_end(hp).sym.size:=objectalloc.sectionsize-Tai_symbol_end(hp).sym.address;
  1075. objectlibrary.UsedAsmSymbolListInsert(Tai_symbol_end(hp).sym);
  1076. end;
  1077. end;
  1078. ait_label :
  1079. begin
  1080. Tai_label(hp).l.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  1081. objectlibrary.UsedAsmSymbolListInsert(Tai_label(hp).l);
  1082. end;
  1083. ait_string :
  1084. objectalloc.sectionalloc(Tai_string(hp).len);
  1085. ait_instruction :
  1086. begin
  1087. {$ifdef i386}
  1088. {$ifndef NOAG386BIN}
  1089. objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
  1090. { fixup the references }
  1091. for i:=1 to Taicpu(hp).ops do
  1092. begin
  1093. with Taicpu(hp).oper[i-1]^ do
  1094. begin
  1095. case typ of
  1096. top_ref :
  1097. begin
  1098. if assigned(ref^.symbol) then
  1099. objectlibrary.UsedAsmSymbolListInsert(ref^.symbol);
  1100. if assigned(ref^.relsymbol) then
  1101. objectlibrary.UsedAsmSymbolListInsert(ref^.symbol);
  1102. end;
  1103. end;
  1104. end;
  1105. end;
  1106. {$endif NOAG386BIN}
  1107. {$endif i386}
  1108. end;
  1109. ait_direct :
  1110. Message(asmw_f_direct_not_supported);
  1111. ait_cut :
  1112. if SmartAsm then
  1113. break;
  1114. ait_marker :
  1115. if tai_marker(hp).kind=InlineStart then
  1116. inc(InlineLevel)
  1117. else if tai_marker(hp).kind=InlineEnd then
  1118. dec(InlineLevel);
  1119. end;
  1120. hp:=Tai(hp.next);
  1121. end;
  1122. TreePass1:=hp;
  1123. end;
  1124. function TInternalAssembler.TreePass2(hp:Tai):Tai;
  1125. var
  1126. fillbuffer : tfillbuffer;
  1127. InlineLevel,
  1128. l : longint;
  1129. {$ifdef x86}
  1130. co : comp;
  1131. {$endif x86}
  1132. begin
  1133. inlinelevel:=0;
  1134. { main loop }
  1135. while assigned(hp) do
  1136. begin
  1137. {$ifdef GDB}
  1138. { write stabs, no line info for inlined code }
  1139. if (inlinelevel=0) and
  1140. ((cs_debuginfo in aktmoduleswitches) or
  1141. (cs_gdb_lineinfo in aktglobalswitches)) then
  1142. begin
  1143. if (objectdata.currsec<>sec_none) and
  1144. not(hp.typ in SkipLineInfo) then
  1145. WriteFileLineInfo(tailineinfo(hp).fileinfo);
  1146. end;
  1147. {$endif GDB}
  1148. case hp.typ of
  1149. ait_align :
  1150. begin
  1151. if objectdata.currsec=sec_bss then
  1152. objectdata.alloc(Tai_align(hp).fillsize)
  1153. else
  1154. objectdata.writebytes(Tai_align(hp).calculatefillbuf(fillbuffer)^,Tai_align(hp).fillsize);
  1155. end;
  1156. ait_section :
  1157. begin
  1158. objectdata.defaulTSection(Tai_section(hp).sec);
  1159. {$ifdef GDB}
  1160. case Tai_section(hp).sec of
  1161. sec_code : n_line:=n_textline;
  1162. sec_data : n_line:=n_dataline;
  1163. sec_bss : n_line:=n_bssline;
  1164. else
  1165. n_line:=n_dataline;
  1166. end;
  1167. stabslastfileinfo.line:=-1;
  1168. {$endif GDB}
  1169. end;
  1170. ait_symbol :
  1171. begin
  1172. objectdata.writesymbol(Tai_symbol(hp).sym);
  1173. objectoutput.exportsymbol(Tai_symbol(hp).sym);
  1174. end;
  1175. ait_datablock :
  1176. begin
  1177. objectdata.writesymbol(Tai_datablock(hp).sym);
  1178. objectoutput.exportsymbol(Tai_datablock(hp).sym);
  1179. if SmartAsm or (not Tai_datablock(hp).is_global) then
  1180. begin
  1181. l:=Tai_datablock(hp).size;
  1182. if l>2 then
  1183. objectdata.allocalign(4)
  1184. else if l>1 then
  1185. objectdata.allocalign(2);
  1186. objectdata.alloc(Tai_datablock(hp).size);
  1187. end;
  1188. end;
  1189. ait_const_32bit :
  1190. objectdata.writebytes(Tai_const(hp).value,4);
  1191. ait_const_16bit :
  1192. objectdata.writebytes(Tai_const(hp).value,2);
  1193. ait_const_8bit :
  1194. objectdata.writebytes(Tai_const(hp).value,1);
  1195. ait_real_80bit :
  1196. objectdata.writebytes(Tai_real_80bit(hp).value,10);
  1197. ait_real_64bit :
  1198. objectdata.writebytes(Tai_real_64bit(hp).value,8);
  1199. ait_real_32bit :
  1200. objectdata.writebytes(Tai_real_32bit(hp).value,4);
  1201. ait_comp_64bit :
  1202. begin
  1203. {$ifdef x86}
  1204. {$ifdef FPC}
  1205. co:=comp(Tai_comp_64bit(hp).value);
  1206. {$else}
  1207. co:=Tai_comp_64bit(hp).value;
  1208. {$endif}
  1209. objectdata.writebytes(co,8);
  1210. {$endif x86}
  1211. end;
  1212. ait_string :
  1213. objectdata.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
  1214. ait_const_rva :
  1215. objectdata.writereloc(Tai_const_symbol(hp).offset,4,
  1216. Tai_const_symbol(hp).sym,RELOC_RVA);
  1217. ait_const_symbol :
  1218. objectdata.writereloc(Tai_const_symbol(hp).offset,4,
  1219. Tai_const_symbol(hp).sym,RELOC_ABSOLUTE);
  1220. ait_label :
  1221. begin
  1222. objectdata.writesymbol(Tai_label(hp).l);
  1223. { exporting shouldn't be necessary as labels are local,
  1224. but it's better to be on the safe side (PFV) }
  1225. objectoutput.exportsymbol(Tai_label(hp).l);
  1226. end;
  1227. {$ifdef i386}
  1228. {$ifndef NOAG386BIN}
  1229. ait_instruction :
  1230. Taicpu(hp).Pass2(objectdata);
  1231. {$endif NOAG386BIN}
  1232. {$endif i386}
  1233. {$ifdef GDB}
  1234. ait_stabn :
  1235. convertstabs(Tai_stabn(hp).str);
  1236. ait_stabs :
  1237. convertstabs(Tai_stabs(hp).str);
  1238. ait_stab_function_name :
  1239. if assigned(Tai_stab_function_name(hp).str) then
  1240. funcname:=objectlibrary.getasmsymbol(strpas(Tai_stab_function_name(hp).str))
  1241. else
  1242. funcname:=nil;
  1243. ait_force_line :
  1244. stabslastfileinfo.line:=0;
  1245. {$endif}
  1246. ait_cut :
  1247. if SmartAsm then
  1248. break;
  1249. ait_marker :
  1250. if tai_marker(hp).kind=InlineStart then
  1251. inc(InlineLevel)
  1252. else if tai_marker(hp).kind=InlineEnd then
  1253. dec(InlineLevel);
  1254. end;
  1255. hp:=Tai(hp.next);
  1256. end;
  1257. TreePass2:=hp;
  1258. end;
  1259. procedure TInternalAssembler.writetree;
  1260. var
  1261. hp : Tai;
  1262. label
  1263. doexit;
  1264. begin
  1265. objectalloc.reseTSections;
  1266. objectalloc.seTSection(sec_code);
  1267. objectdata:=objectoutput.newobjectdata(Objfile);
  1268. objectdata.defaulTSection(sec_code);
  1269. { reset the asmsymbol list }
  1270. objectlibrary.CreateUsedAsmsymbolList;
  1271. { Pass 0 }
  1272. currpass:=0;
  1273. objectalloc.seTSection(sec_code);
  1274. { start with list 1 }
  1275. currlistidx:=1;
  1276. currlist:=list[currlistidx];
  1277. hp:=Tai(currList.first);
  1278. while assigned(hp) do
  1279. begin
  1280. hp:=TreePass0(hp);
  1281. MaybeNextList(hp);
  1282. end;
  1283. { leave if errors have occured }
  1284. if errorcount>0 then
  1285. goto doexit;
  1286. { Pass 1 }
  1287. currpass:=1;
  1288. objectalloc.reseTSections;
  1289. objectalloc.seTSection(sec_code);
  1290. {$ifdef GDB}
  1291. StartFileLineInfo(sec_code);
  1292. {$endif GDB}
  1293. { start with list 1 }
  1294. currlistidx:=1;
  1295. currlist:=list[currlistidx];
  1296. hp:=Tai(currList.first);
  1297. while assigned(hp) do
  1298. begin
  1299. hp:=TreePass1(hp);
  1300. MaybeNextList(hp);
  1301. end;
  1302. {$ifdef GDB}
  1303. EndFileLineInfo;
  1304. {$endif GDB}
  1305. { check for undefined labels and reset }
  1306. objectlibrary.UsedAsmSymbolListCheckUndefined;
  1307. { set section sizes }
  1308. objectdata.seTSectionsizes(objectalloc.secsize);
  1309. { leave if errors have occured }
  1310. if errorcount>0 then
  1311. goto doexit;
  1312. { Pass 2 }
  1313. currpass:=2;
  1314. {$ifdef GDB}
  1315. StartFileLineInfo(sec_code);
  1316. {$endif GDB}
  1317. { start with list 1 }
  1318. currlistidx:=1;
  1319. currlist:=list[currlistidx];
  1320. hp:=Tai(currList.first);
  1321. while assigned(hp) do
  1322. begin
  1323. hp:=TreePass2(hp);
  1324. MaybeNextList(hp);
  1325. end;
  1326. {$ifdef GDB}
  1327. EndFileLineInfo;
  1328. {$endif GDB}
  1329. { don't write the .o file if errors have occured }
  1330. if errorcount=0 then
  1331. begin
  1332. { write objectfile }
  1333. objectoutput.startobjectfile(ObjFile);
  1334. objectoutput.writeobjectfile(objectdata);
  1335. objectdata.free;
  1336. objectdata:=nil;
  1337. end;
  1338. doexit:
  1339. { reset the used symbols back, must be after the .o has been
  1340. written }
  1341. objectlibrary.UsedAsmsymbolListReset;
  1342. objectlibrary.DestroyUsedAsmsymbolList;
  1343. end;
  1344. procedure TInternalAssembler.writetreesmart;
  1345. var
  1346. hp : Tai;
  1347. starTSec : TSection;
  1348. place: tcutplace;
  1349. begin
  1350. objectalloc.reseTSections;
  1351. objectalloc.seTSection(sec_code);
  1352. NextSmartName(cut_normal);
  1353. objectdata:=objectoutput.newobjectdata(Objfile);
  1354. objectdata.defaulTSection(sec_code);
  1355. starTSec:=sec_code;
  1356. { start with list 1 }
  1357. currlistidx:=1;
  1358. currlist:=list[currlistidx];
  1359. hp:=Tai(currList.first);
  1360. while assigned(hp) do
  1361. begin
  1362. { reset the asmsymbol list }
  1363. objectlibrary.CreateUsedAsmSymbolList;
  1364. { Pass 0 }
  1365. currpass:=0;
  1366. objectalloc.reseTSections;
  1367. objectalloc.seTSection(starTSec);
  1368. TreePass0(hp);
  1369. { leave if errors have occured }
  1370. if errorcount>0 then
  1371. exit;
  1372. { Pass 1 }
  1373. currpass:=1;
  1374. objectalloc.reseTSections;
  1375. objectalloc.seTSection(starTSec);
  1376. {$ifdef GDB}
  1377. StartFileLineInfo(startsec);
  1378. {$endif GDB}
  1379. TreePass1(hp);
  1380. {$ifdef GDB}
  1381. EndFileLineInfo;
  1382. {$endif GDB}
  1383. { check for undefined labels }
  1384. objectlibrary.UsedAsmSymbolListCheckUndefined;
  1385. { set section sizes }
  1386. objectdata.seTSectionsizes(objectalloc.secsize);
  1387. { leave if errors have occured }
  1388. if errorcount>0 then
  1389. exit;
  1390. { Pass 2 }
  1391. currpass:=2;
  1392. objectoutput.startobjectfile(Objfile);
  1393. objectdata.defaulTSection(starTSec);
  1394. {$ifdef GDB}
  1395. StartFileLineInfo(startsec);
  1396. {$endif GDB}
  1397. hp:=TreePass2(hp);
  1398. {$ifdef GDB}
  1399. EndFileLineInfo;
  1400. {$endif GDB}
  1401. { leave if errors have occured }
  1402. if errorcount>0 then
  1403. exit;
  1404. { write the current objectfile }
  1405. objectoutput.writeobjectfile(objectdata);
  1406. objectdata.free;
  1407. objectdata:=nil;
  1408. { reset the used symbols back, must be after the .o has been
  1409. written }
  1410. objectlibrary.UsedAsmsymbolListReset;
  1411. objectlibrary.DestroyUsedAsmsymbolList;
  1412. { end of lists? }
  1413. if not MaybeNextList(hp) then
  1414. break;
  1415. { save section for next loop }
  1416. { this leads to a problem if starTSec is sec_none !! PM }
  1417. starTSec:=objectalloc.currsec;
  1418. { we will start a new objectfile so reset everything }
  1419. { The place can still change in the next while loop, so don't init }
  1420. { the writer yet (JM) }
  1421. if (hp.typ=ait_cut) then
  1422. place := Tai_cut(hp).place
  1423. else
  1424. place := cut_normal;
  1425. { avoid empty files }
  1426. while assigned(hp) and
  1427. (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cut]) do
  1428. begin
  1429. if Tai(hp).typ=ait_section then
  1430. starTSec:=Tai_section(hp).sec
  1431. else if (Tai(hp).typ=ait_cut) then
  1432. place := Tai_cut(hp).place;
  1433. hp:=Tai(hp.next);
  1434. end;
  1435. if not MaybeNextList(hp) then
  1436. break;
  1437. { start next objectfile }
  1438. NextSmartName(place);
  1439. objectdata:=objectoutput.newobjectdata(Objfile);
  1440. { there is a problem if starTSec is sec_none !! PM }
  1441. if starTSec=sec_none then
  1442. starTSec:=sec_code;
  1443. end;
  1444. end;
  1445. procedure TInternalAssembler.MakeObject;
  1446. procedure addlist(p:TAAsmoutput);
  1447. begin
  1448. inc(lists);
  1449. list[lists]:=p;
  1450. end;
  1451. begin
  1452. if cs_debuginfo in aktmoduleswitches then
  1453. addlist(debuglist);
  1454. addlist(codesegment);
  1455. addlist(datasegment);
  1456. addlist(consts);
  1457. addlist(rttilist);
  1458. addlist(picdata);
  1459. if assigned(resourcestringlist) then
  1460. addlist(resourcestringlist);
  1461. addlist(bsssegment);
  1462. if assigned(importssection) then
  1463. addlist(importssection);
  1464. if assigned(exportssection) and not UseDeffileForExport then
  1465. addlist(exportssection);
  1466. if assigned(resourcesection) then
  1467. addlist(resourcesection);
  1468. if SmartAsm then
  1469. writetreesmart
  1470. else
  1471. writetree;
  1472. end;
  1473. {*****************************************************************************
  1474. Generate Assembler Files Main Procedure
  1475. *****************************************************************************}
  1476. Procedure GenerateAsm(smart:boolean);
  1477. var
  1478. a : TAssembler;
  1479. begin
  1480. if not assigned(CAssembler[target_asm.id]) then
  1481. Message(asmw_f_assembler_output_not_supported);
  1482. a:=CAssembler[target_asm.id].Create(smart);
  1483. a.MakeObject;
  1484. a.Free;
  1485. end;
  1486. Procedure OnlyAsm;
  1487. var
  1488. a : TExternalAssembler;
  1489. begin
  1490. a:=TExternalAssembler.Create(false);
  1491. a.DoAssemble;
  1492. a.Free;
  1493. end;
  1494. {*****************************************************************************
  1495. Init/Done
  1496. *****************************************************************************}
  1497. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  1498. var
  1499. t : tasm;
  1500. begin
  1501. t:=r.id;
  1502. if assigned(asminfos[t]) then
  1503. writeln('Warning: Assembler is already registered!')
  1504. else
  1505. Getmem(asminfos[t],sizeof(tasminfo));
  1506. asminfos[t]^:=r;
  1507. CAssembler[t]:=c;
  1508. end;
  1509. procedure InitAssembler;
  1510. begin
  1511. { target_asm is already set by readarguments }
  1512. initoutputformat:=target_asm.id;
  1513. aktoutputformat:=target_asm.id;
  1514. end;
  1515. procedure DoneAssembler;
  1516. begin
  1517. end;
  1518. end.
  1519. {
  1520. $Log$
  1521. Revision 1.67 2004-05-21 22:43:36 peter
  1522. * set correct n_line type when starting new .o file by passing
  1523. the current section type
  1524. Revision 1.66 2004/03/22 09:28:34 michael
  1525. + Patch from peter for stack overflow
  1526. Revision 1.65 2004/03/15 21:50:09 peter
  1527. * start with bssline
  1528. Revision 1.64 2004/03/02 17:32:12 florian
  1529. * make cycle fixed
  1530. + pic support for darwin
  1531. + support of importing vars from shared libs on darwin implemented
  1532. Revision 1.63 2004/03/02 00:36:33 olle
  1533. * big transformation of Tai_[const_]Symbol.Create[data]name*
  1534. Revision 1.62 2004/02/27 10:21:05 florian
  1535. * top_symbol killed
  1536. + refaddr to treference added
  1537. + refsymbol to treference added
  1538. * top_local stuff moved to an extra record to save memory
  1539. + aint introduced
  1540. * tppufile.get/putint64/aint implemented
  1541. Revision 1.61 2004/01/31 17:45:17 peter
  1542. * Change several $ifdef i386 to x86
  1543. * Change several OS_32 to OS_INT/OS_ADDR
  1544. Revision 1.60 2004/01/30 15:44:23 jonas
  1545. + support for piped assembling under Darwin
  1546. Revision 1.59 2003/11/10 17:22:28 marco
  1547. * havelinuxrtl10 fixes
  1548. Revision 1.58 2003/10/21 15:15:36 peter
  1549. * taicpu_abstract.oper[] changed to pointers
  1550. Revision 1.57 2003/10/03 14:16:48 marco
  1551. * -XP<prefix> support
  1552. Revision 1.56 2003/09/30 19:54:23 peter
  1553. * better link on target support
  1554. Revision 1.55 2003/09/23 17:56:05 peter
  1555. * locals and paras are allocated in the code generation
  1556. * tvarsym.localloc contains the location of para/local when
  1557. generating code for the current procedure
  1558. Revision 1.54 2003/09/03 15:55:00 peter
  1559. * NEWRA branch merged
  1560. Revision 1.53.2.1 2003/09/01 21:02:55 peter
  1561. * sparc updates for new tregister
  1562. Revision 1.53 2003/07/04 22:40:58 pierre
  1563. * add support for constant offset in stabs address, needed by threadvar debugging support
  1564. Revision 1.52 2003/04/23 13:48:07 peter
  1565. * m68k fix
  1566. Revision 1.51 2003/04/22 14:33:38 peter
  1567. * removed some notes/hints
  1568. Revision 1.50 2003/03/10 18:16:00 olle
  1569. * niceified comments
  1570. Revision 1.49 2003/01/10 21:49:00 marco
  1571. * more hasunix fixes
  1572. Revision 1.48 2002/11/24 18:21:49 carl
  1573. - remove some unused defines
  1574. Revision 1.47 2002/11/17 16:31:55 carl
  1575. * memory optimization (3-4%) : cleanup of tai fields,
  1576. cleanup of tdef and tsym fields.
  1577. * make it work for m68k
  1578. Revision 1.46 2002/11/15 01:58:46 peter
  1579. * merged changes from 1.0.7 up to 04-11
  1580. - -V option for generating bug report tracing
  1581. - more tracing for option parsing
  1582. - errors for cdecl and high()
  1583. - win32 import stabs
  1584. - win32 records<=8 are returned in eax:edx (turned off by default)
  1585. - heaptrc update
  1586. - more info for temp management in .s file with EXTDEBUG
  1587. Revision 1.45 2002/10/30 21:01:14 peter
  1588. * always include lineno after fileswitch. valgrind requires this
  1589. Revision 1.44 2002/09/05 19:29:42 peter
  1590. * memdebug enhancements
  1591. Revision 1.43 2002/08/20 16:55:38 peter
  1592. * don't write (stabs)line info when inlining a procedure
  1593. Revision 1.42 2002/08/12 15:08:39 carl
  1594. + stab register indexes for powerpc (moved from gdb to cpubase)
  1595. + tprocessor enumeration moved to cpuinfo
  1596. + linker in target_info is now a class
  1597. * many many updates for m68k (will soon start to compile)
  1598. - removed some ifdef or correct them for correct cpu
  1599. Revision 1.41 2002/08/11 14:32:26 peter
  1600. * renamed current_library to objectlibrary
  1601. Revision 1.40 2002/08/11 13:24:10 peter
  1602. * saving of asmsymbols in ppu supported
  1603. * asmsymbollist global is removed and moved into a new class
  1604. tasmlibrarydata that will hold the info of a .a file which
  1605. corresponds with a single module. Added librarydata to tmodule
  1606. to keep the library info stored for the module. In the future the
  1607. objectfiles will also be stored to the tasmlibrarydata class
  1608. * all getlabel/newasmsymbol and friends are moved to the new class
  1609. Revision 1.39 2002/07/26 21:15:37 florian
  1610. * rewrote the system handling
  1611. Revision 1.38 2002/07/10 07:24:40 jonas
  1612. * memory leak fixes from Sergey Korshunoff
  1613. Revision 1.37 2002/07/01 18:46:21 peter
  1614. * internal linker
  1615. * reorganized aasm layer
  1616. Revision 1.36 2002/05/18 13:34:05 peter
  1617. * readded missing revisions
  1618. Revision 1.35 2002/05/16 19:46:35 carl
  1619. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1620. + try to fix temp allocation (still in ifdef)
  1621. + generic constructor calls
  1622. + start of tassembler / tmodulebase class cleanup
  1623. Revision 1.33 2002/04/10 08:07:55 jonas
  1624. * fix for the ie9999 under Linux (patch from Peter)
  1625. Revision 1.32 2002/04/07 13:19:14 carl
  1626. + more documentation
  1627. Revision 1.31 2002/04/04 19:05:54 peter
  1628. * removed unused units
  1629. * use tlocation.size in cg.a_*loc*() routines
  1630. Revision 1.30 2002/04/02 17:11:27 peter
  1631. * tlocation,treference update
  1632. * LOC_CONSTANT added for better constant handling
  1633. * secondadd splitted in multiple routines
  1634. * location_force_reg added for loading a location to a register
  1635. of a specified size
  1636. * secondassignment parses now first the right and then the left node
  1637. (this is compatible with Kylix). This saves a lot of push/pop especially
  1638. with string operations
  1639. * adapted some routines to use the new cg methods
  1640. }