assemble.pas 52 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739
  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;
  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 ver1_0}
  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=as_gas));
  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:=AddExtension(target_asm.asmbin,target_info.exeext);
  291. exit;
  292. end
  293. else
  294. UtilExe:=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. OutBuf[OutCnt]:=target_info.newline[1];
  444. inc(OutCnt);
  445. inc(AsmSize);
  446. if length(target_info.newline)>1 then
  447. begin
  448. OutBuf[OutCnt]:=target_info.newline[2];
  449. inc(OutCnt);
  450. inc(AsmSize);
  451. end;
  452. end;
  453. procedure TExternalAssembler.AsmCreate(Aplace:tcutplace);
  454. begin
  455. if SmartAsm then
  456. NextSmartName(Aplace);
  457. {$ifdef hasunix}
  458. if DoPipe then
  459. begin
  460. Message1(exec_i_assembling_pipe,asmfile);
  461. POpen(outfile,'as -o '+objfile,'W');
  462. end
  463. else
  464. {$endif}
  465. begin
  466. Assign(outfile,asmfile);
  467. {$I-}
  468. Rewrite(outfile,1);
  469. {$I+}
  470. if ioresult<>0 then
  471. Message1(exec_d_cant_create_asmfile,asmfile);
  472. end;
  473. outcnt:=0;
  474. AsmSize:=0;
  475. AsmStartSize:=0;
  476. end;
  477. procedure TExternalAssembler.AsmClose;
  478. var
  479. f : file;
  480. l : longint;
  481. begin
  482. AsmFlush;
  483. {$ifdef hasunix}
  484. if DoPipe then
  485. PClose(outfile)
  486. else
  487. {$endif}
  488. begin
  489. {Touch Assembler time to ppu time is there is a ppufilename}
  490. if ppufilename<>'' then
  491. begin
  492. Assign(f,ppufilename);
  493. {$I-}
  494. reset(f,1);
  495. {$I+}
  496. if ioresult=0 then
  497. begin
  498. getftime(f,l);
  499. close(f);
  500. reset(outfile,1);
  501. setftime(outfile,l);
  502. end;
  503. end;
  504. close(outfile);
  505. end;
  506. end;
  507. procedure TExternalAssembler.WriteTree(p:TAAsmoutput);
  508. begin
  509. end;
  510. procedure TExternalAssembler.WriteAsmList;
  511. begin
  512. end;
  513. procedure TExternalAssembler.MakeObject;
  514. begin
  515. AsmCreate(cut_normal);
  516. WriteAsmList;
  517. AsmClose;
  518. DoAssemble;
  519. end;
  520. {*****************************************************************************
  521. TInternalAssembler
  522. *****************************************************************************}
  523. constructor TInternalAssembler.create(smart:boolean);
  524. begin
  525. inherited create(smart);
  526. objectoutput:=nil;
  527. objectdata:=nil;
  528. objectalloc:=TAsmObjectAlloc.create;
  529. SmartAsm:=smart;
  530. currpass:=0;
  531. end;
  532. destructor TInternalAssembler.destroy;
  533. {$ifdef MEMDEBUG}
  534. var
  535. d : tmemdebug;
  536. {$endif}
  537. begin
  538. {$ifdef MEMDEBUG}
  539. d := tmemdebug.create(name+' - agbin');
  540. {$endif}
  541. objectdata.free;
  542. objectoutput.free;
  543. objectalloc.free;
  544. {$ifdef MEMDEBUG}
  545. d.free;
  546. {$endif}
  547. end;
  548. {$ifdef GDB}
  549. procedure TInternalAssembler.convertstabs(p:pchar);
  550. var
  551. ofs,
  552. nidx,nother,ii,i,line,j : longint;
  553. code : integer;
  554. hp : pchar;
  555. reloc : boolean;
  556. sec : TSection;
  557. ps : tasmsymbol;
  558. s : string;
  559. begin
  560. ofs:=0;
  561. reloc:=true;
  562. ps:=nil;
  563. sec:=sec_none;
  564. if p[0]='"' then
  565. begin
  566. i:=1;
  567. { we can have \" inside the string !! PM }
  568. while not ((p[i]='"') and (p[i-1]<>'\')) do
  569. inc(i);
  570. p[i]:=#0;
  571. ii:=i;
  572. hp:=@p[1];
  573. s:=StrPas(@P[i+2]);
  574. end
  575. else
  576. begin
  577. hp:=nil;
  578. s:=StrPas(P);
  579. i:=-2; {needed below (PM) }
  580. end;
  581. { When in pass 1 then only alloc and leave }
  582. if currpass=1 then
  583. begin
  584. objectalloc.staballoc(hp);
  585. if assigned(hp) then
  586. p[i]:='"';
  587. exit;
  588. end;
  589. { Parse the rest of the stabs }
  590. if s='' then
  591. internalerror(33000);
  592. j:=pos(',',s);
  593. if j=0 then
  594. internalerror(33001);
  595. Val(Copy(s,1,j-1),nidx,code);
  596. if code<>0 then
  597. internalerror(33002);
  598. i:=i+2+j;
  599. Delete(s,1,j);
  600. j:=pos(',',s);
  601. if (j=0) then
  602. internalerror(33003);
  603. Val(Copy(s,1,j-1),nother,code);
  604. if code<>0 then
  605. internalerror(33004);
  606. i:=i+j;
  607. Delete(s,1,j);
  608. j:=pos(',',s);
  609. if j=0 then
  610. begin
  611. j:=256;
  612. ofs:=-1;
  613. end;
  614. Val(Copy(s,1,j-1),line,code);
  615. if code<>0 then
  616. internalerror(33005);
  617. if ofs=0 then
  618. begin
  619. Delete(s,1,j);
  620. i:=i+j;
  621. Val(s,ofs,code);
  622. if code=0 then
  623. reloc:=false
  624. else
  625. begin
  626. ofs:=0;
  627. s:=strpas(@p[i]);
  628. { handle asmsymbol or
  629. asmsymbol - asmsymbol }
  630. j:=pos(' ',s);
  631. if j=0 then
  632. j:=pos('-',s);
  633. { also try to handle
  634. asmsymbol + constant
  635. or
  636. asmsymbol - constant }
  637. if j=0 then
  638. j:=pos('+',s);
  639. if j<>0 then
  640. begin
  641. Val(Copy(s,j+1,255),ofs,code);
  642. if code<>0 then
  643. ofs:=0
  644. else
  645. { constant reading successful,
  646. avoid further treatment by
  647. setting s[j] to '+' }
  648. s[j]:='+';
  649. end
  650. else
  651. { single asmsymbol }
  652. j:=256;
  653. { the symbol can be external
  654. so we must use newasmsymbol and
  655. not getasmsymbol !! PM }
  656. ps:=objectlibrary.newasmsymbol(copy(s,1,j-1));
  657. if not assigned(ps) then
  658. internalerror(33006)
  659. else
  660. begin
  661. sec:=ps.section;
  662. ofs:=ofs+ps.address;
  663. reloc:=true;
  664. objectlibrary.UsedAsmSymbolListInsert(ps);
  665. end;
  666. if (j<256) and (s[j]<>'+') then
  667. begin
  668. i:=i+j;
  669. s:=strpas(@p[i]);
  670. if (s<>'') and (s[1]=' ') then
  671. begin
  672. j:=0;
  673. while (s[j+1]=' ') do
  674. inc(j);
  675. i:=i+j;
  676. s:=strpas(@p[i]);
  677. end;
  678. ps:=objectlibrary.getasmsymbol(s);
  679. if not assigned(ps) then
  680. internalerror(33007)
  681. else
  682. begin
  683. if ps.section<>sec then
  684. internalerror(33008);
  685. ofs:=ofs-ps.address;
  686. reloc:=false;
  687. objectlibrary.UsedAsmSymbolListInsert(ps);
  688. end;
  689. end;
  690. end;
  691. end;
  692. { external bss need speical handling (PM) }
  693. if assigned(ps) and (ps.section=sec_none) then
  694. begin
  695. if currpass=2 then
  696. begin
  697. objectdata.writesymbol(ps);
  698. objectoutput.exportsymbol(ps);
  699. end;
  700. objectdata.writeSymStabs(sec,ofs,hp,ps,nidx,nother,line,reloc)
  701. end
  702. else
  703. objectdata.writeStabs(sec,ofs,hp,nidx,nother,line,reloc);
  704. if assigned(hp) then
  705. p[ii]:='"';
  706. end;
  707. procedure TInternalAssembler.emitlineinfostabs(nidx,line : longint);
  708. var
  709. sec : TSection;
  710. begin
  711. if currpass=1 then
  712. begin
  713. objectalloc.staballoc(nil);
  714. exit;
  715. end;
  716. if (nidx=n_textline) and assigned(funcname) and
  717. (target_info.use_function_relative_addresses) then
  718. objectdata.writeStabs(sec_code,objectdata.sectionsize(sec_code)-funcname.address,
  719. nil,nidx,0,line,false)
  720. else
  721. begin
  722. if nidx=n_textline then
  723. sec:=sec_code
  724. else if nidx=n_dataline then
  725. sec:=sec_data
  726. else
  727. sec:=sec_bss;
  728. objectdata.writeStabs(sec,objectdata.sectionsize(sec),
  729. nil,nidx,0,line,true);
  730. end;
  731. end;
  732. procedure TInternalAssembler.emitstabs(s:string);
  733. begin
  734. s:=s+#0;
  735. ConvertStabs(@s[1]);
  736. end;
  737. procedure TInternalAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo);
  738. var
  739. curr_n : byte;
  740. hp : tasmsymbol;
  741. infile : tinputfile;
  742. begin
  743. if not ((cs_debuginfo in aktmoduleswitches) or
  744. (cs_gdb_lineinfo in aktglobalswitches)) then
  745. exit;
  746. { file changed ? (must be before line info) }
  747. if (fileinfo.fileindex<>0) and
  748. (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
  749. begin
  750. infile:=current_module.sourcefiles.get_file(fileinfo.fileindex);
  751. if assigned(infile) then
  752. begin
  753. if includecount=0 then
  754. curr_n:=n_sourcefile
  755. else
  756. curr_n:=n_includefile;
  757. { get symbol for this includefile }
  758. hp:=objectlibrary.newasmsymboltype('Ltext'+ToStr(IncludeCount),AB_LOCAL,AT_FUNCTION);
  759. if currpass=1 then
  760. begin
  761. hp.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  762. objectlibrary.UsedAsmSymbolListInsert(hp);
  763. end
  764. else
  765. objectdata.writesymbol(hp);
  766. { emit stabs }
  767. if (infile.path^<>'') then
  768. EmitStabs('"'+lower(BsToSlash(FixPath(infile.path^,false)))+'",'+tostr(curr_n)+
  769. ',0,0,Ltext'+ToStr(IncludeCount));
  770. EmitStabs('"'+lower(FixFileName(infile.name^))+'",'+tostr(curr_n)+
  771. ',0,0,Ltext'+ToStr(IncludeCount));
  772. inc(includecount);
  773. { force new line info }
  774. stabslastfileinfo.line:=-1;
  775. end;
  776. end;
  777. { line changed ? }
  778. if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
  779. emitlineinfostabs(n_line,fileinfo.line);
  780. stabslastfileinfo:=fileinfo;
  781. end;
  782. procedure TInternalAssembler.StartFileLineInfo;
  783. var
  784. fileinfo : tfileposinfo;
  785. begin
  786. FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
  787. n_line:=n_textline;
  788. funcname:=nil;
  789. linecount:=1;
  790. includecount:=0;
  791. fileinfo.fileindex:=1;
  792. fileinfo.line:=1;
  793. WriteFileLineInfo(fileinfo);
  794. end;
  795. procedure TInternalAssembler.EndFileLineInfo;
  796. var
  797. hp : tasmsymbol;
  798. store_sec : TSection;
  799. begin
  800. if not ((cs_debuginfo in aktmoduleswitches) or
  801. (cs_gdb_lineinfo in aktglobalswitches)) then
  802. exit;
  803. store_sec:=objectalloc.currsec;
  804. objectalloc.seTSection(sec_code);
  805. hp:=objectlibrary.newasmsymboltype('Letext',AB_LOCAL,AT_FUNCTION);
  806. if currpass=1 then
  807. begin
  808. hp.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  809. objectlibrary.UsedAsmSymbolListInsert(hp);
  810. end
  811. else
  812. objectdata.writesymbol(hp);
  813. EmitStabs('"",'+tostr(n_sourcefile)+',0,0,Letext');
  814. objectalloc.seTSection(store_sec);
  815. end;
  816. {$endif GDB}
  817. function TInternalAssembler.MaybeNextList(var hp:Tai):boolean;
  818. begin
  819. { maybe end of list }
  820. while not assigned(hp) do
  821. begin
  822. if currlistidx<lists then
  823. begin
  824. inc(currlistidx);
  825. currlist:=list[currlistidx];
  826. hp:=Tai(currList.first);
  827. end
  828. else
  829. begin
  830. MaybeNextList:=false;
  831. exit;
  832. end;
  833. end;
  834. MaybeNextList:=true;
  835. end;
  836. function TInternalAssembler.TreePass0(hp:Tai):Tai;
  837. var
  838. l : longint;
  839. begin
  840. while assigned(hp) do
  841. begin
  842. case hp.typ of
  843. ait_align :
  844. begin
  845. { always use the maximum fillsize in this pass to avoid possible
  846. short jumps to become out of range }
  847. Tai_align(hp).fillsize:=Tai_align(hp).aligntype;
  848. objectalloc.sectionalloc(Tai_align(hp).fillsize);
  849. end;
  850. ait_datablock :
  851. begin
  852. if not SmartAsm then
  853. begin
  854. if not Tai_datablock(hp).is_global then
  855. begin
  856. l:=Tai_datablock(hp).size;
  857. if l>2 then
  858. objectalloc.sectionalign(4)
  859. else if l>1 then
  860. objectalloc.sectionalign(2);
  861. objectalloc.sectionalloc(Tai_datablock(hp).size);
  862. end;
  863. end
  864. else
  865. begin
  866. l:=Tai_datablock(hp).size;
  867. if l>2 then
  868. objectalloc.sectionalign(4)
  869. else if l>1 then
  870. objectalloc.sectionalign(2);
  871. objectalloc.sectionalloc(Tai_datablock(hp).size);
  872. end;
  873. end;
  874. ait_const_32bit :
  875. objectalloc.sectionalloc(4);
  876. ait_const_16bit :
  877. objectalloc.sectionalloc(2);
  878. ait_const_8bit :
  879. objectalloc.sectionalloc(1);
  880. ait_real_80bit :
  881. objectalloc.sectionalloc(10);
  882. ait_real_64bit :
  883. objectalloc.sectionalloc(8);
  884. ait_real_32bit :
  885. objectalloc.sectionalloc(4);
  886. ait_comp_64bit :
  887. objectalloc.sectionalloc(8);
  888. ait_const_rva,
  889. ait_const_symbol :
  890. objectalloc.sectionalloc(4);
  891. ait_section:
  892. objectalloc.seTSection(Tai_section(hp).sec);
  893. ait_symbol :
  894. Tai_symbol(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  895. ait_label :
  896. Tai_label(hp).l.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  897. ait_string :
  898. objectalloc.sectionalloc(Tai_string(hp).len);
  899. ait_instruction :
  900. begin
  901. {$ifdef i386}
  902. {$ifndef NOAG386BIN}
  903. { reset instructions which could change in pass 2 }
  904. Taicpu(hp).resetpass2;
  905. objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
  906. {$endif NOAG386BIN}
  907. {$endif i386}
  908. end;
  909. ait_cut :
  910. if SmartAsm then
  911. break;
  912. end;
  913. hp:=Tai(hp.next);
  914. end;
  915. TreePass0:=hp;
  916. end;
  917. function TInternalAssembler.TreePass1(hp:Tai):Tai;
  918. var
  919. InlineLevel,
  920. i,l : longint;
  921. begin
  922. inlinelevel:=0;
  923. while assigned(hp) do
  924. begin
  925. {$ifdef GDB}
  926. { write stabs, no line info for inlined code }
  927. if (inlinelevel=0) and
  928. ((cs_debuginfo in aktmoduleswitches) or
  929. (cs_gdb_lineinfo in aktglobalswitches)) then
  930. begin
  931. if (objectalloc.currsec<>sec_none) and
  932. not(hp.typ in SkipLineInfo) then
  933. WriteFileLineInfo(tailineinfo(hp).fileinfo);
  934. end;
  935. {$endif GDB}
  936. case hp.typ of
  937. ait_align :
  938. begin
  939. { here we must determine the fillsize which is used in pass2 }
  940. Tai_align(hp).fillsize:=align(objectalloc.sectionsize,Tai_align(hp).aligntype)-
  941. objectalloc.sectionsize;
  942. objectalloc.sectionalloc(Tai_align(hp).fillsize);
  943. end;
  944. ait_datablock :
  945. begin
  946. if objectalloc.currsec<>sec_bss then
  947. Message(asmw_e_alloc_data_only_in_bss);
  948. if not SmartAsm then
  949. begin
  950. if Tai_datablock(hp).is_global then
  951. begin
  952. Tai_datablock(hp).sym.setaddress(currpass,sec_none,Tai_datablock(hp).size,Tai_datablock(hp).size);
  953. { force to be common/external, must be after setaddress as that would
  954. set it to AS_GLOBAL }
  955. Tai_datablock(hp).sym.currbind:=AB_COMMON;
  956. end
  957. else
  958. begin
  959. l:=Tai_datablock(hp).size;
  960. if l>2 then
  961. objectalloc.sectionalign(4)
  962. else if l>1 then
  963. objectalloc.sectionalign(2);
  964. Tai_datablock(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,
  965. Tai_datablock(hp).size);
  966. objectalloc.sectionalloc(Tai_datablock(hp).size);
  967. end;
  968. end
  969. else
  970. begin
  971. l:=Tai_datablock(hp).size;
  972. if l>2 then
  973. objectalloc.sectionalign(4)
  974. else if l>1 then
  975. objectalloc.sectionalign(2);
  976. Tai_datablock(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,Tai_datablock(hp).size);
  977. objectalloc.sectionalloc(Tai_datablock(hp).size);
  978. end;
  979. objectlibrary.UsedAsmSymbolListInsert(Tai_datablock(hp).sym);
  980. end;
  981. ait_const_32bit :
  982. objectalloc.sectionalloc(4);
  983. ait_const_16bit :
  984. objectalloc.sectionalloc(2);
  985. ait_const_8bit :
  986. objectalloc.sectionalloc(1);
  987. ait_real_80bit :
  988. objectalloc.sectionalloc(10);
  989. ait_real_64bit :
  990. objectalloc.sectionalloc(8);
  991. ait_real_32bit :
  992. objectalloc.sectionalloc(4);
  993. ait_comp_64bit :
  994. objectalloc.sectionalloc(8);
  995. ait_const_rva,
  996. ait_const_symbol :
  997. begin
  998. objectalloc.sectionalloc(4);
  999. objectlibrary.UsedAsmSymbolListInsert(Tai_const_symbol(hp).sym);
  1000. end;
  1001. ait_section:
  1002. begin
  1003. objectalloc.seTSection(Tai_section(hp).sec);
  1004. {$ifdef GDB}
  1005. case Tai_section(hp).sec of
  1006. sec_code : n_line:=n_textline;
  1007. sec_data : n_line:=n_dataline;
  1008. sec_bss : n_line:=n_bssline;
  1009. else
  1010. n_line:=n_dataline;
  1011. end;
  1012. stabslastfileinfo.line:=-1;
  1013. {$endif GDB}
  1014. end;
  1015. {$ifdef GDB}
  1016. ait_stabn :
  1017. convertstabs(Tai_stabn(hp).str);
  1018. ait_stabs :
  1019. convertstabs(Tai_stabs(hp).str);
  1020. ait_stab_function_name :
  1021. begin
  1022. if assigned(Tai_stab_function_name(hp).str) then
  1023. begin
  1024. funcname:=objectlibrary.getasmsymbol(strpas(Tai_stab_function_name(hp).str));
  1025. objectlibrary.UsedAsmSymbolListInsert(funcname);
  1026. end
  1027. else
  1028. funcname:=nil;
  1029. end;
  1030. ait_force_line :
  1031. stabslastfileinfo.line:=0;
  1032. {$endif}
  1033. ait_symbol :
  1034. begin
  1035. Tai_symbol(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  1036. objectlibrary.UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
  1037. end;
  1038. ait_symbol_end :
  1039. begin
  1040. if target_info.system in [system_i386_linux,system_i386_beos] then
  1041. begin
  1042. Tai_symbol_end(hp).sym.size:=objectalloc.sectionsize-Tai_symbol_end(hp).sym.address;
  1043. objectlibrary.UsedAsmSymbolListInsert(Tai_symbol_end(hp).sym);
  1044. end;
  1045. end;
  1046. ait_label :
  1047. begin
  1048. Tai_label(hp).l.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  1049. objectlibrary.UsedAsmSymbolListInsert(Tai_label(hp).l);
  1050. end;
  1051. ait_string :
  1052. objectalloc.sectionalloc(Tai_string(hp).len);
  1053. ait_instruction :
  1054. begin
  1055. {$ifdef i386}
  1056. {$ifndef NOAG386BIN}
  1057. objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
  1058. { fixup the references }
  1059. for i:=1 to Taicpu(hp).ops do
  1060. begin
  1061. with Taicpu(hp).oper[i-1] do
  1062. begin
  1063. case typ of
  1064. top_ref :
  1065. begin
  1066. if assigned(ref^.symbol) then
  1067. objectlibrary.UsedAsmSymbolListInsert(ref^.symbol);
  1068. end;
  1069. top_symbol :
  1070. begin
  1071. objectlibrary.UsedAsmSymbolListInsert(sym);
  1072. end;
  1073. end;
  1074. end;
  1075. end;
  1076. {$endif NOAG386BIN}
  1077. {$endif i386}
  1078. end;
  1079. ait_direct :
  1080. Message(asmw_f_direct_not_supported);
  1081. ait_cut :
  1082. if SmartAsm then
  1083. break;
  1084. ait_marker :
  1085. if tai_marker(hp).kind=InlineStart then
  1086. inc(InlineLevel)
  1087. else if tai_marker(hp).kind=InlineEnd then
  1088. dec(InlineLevel);
  1089. end;
  1090. hp:=Tai(hp.next);
  1091. end;
  1092. TreePass1:=hp;
  1093. end;
  1094. function TInternalAssembler.TreePass2(hp:Tai):Tai;
  1095. var
  1096. fillbuffer : tfillbuffer;
  1097. InlineLevel,
  1098. l : longint;
  1099. {$ifdef i386}
  1100. co : comp;
  1101. {$endif i386}
  1102. begin
  1103. inlinelevel:=0;
  1104. { main loop }
  1105. while assigned(hp) do
  1106. begin
  1107. {$ifdef GDB}
  1108. { write stabs, no line info for inlined code }
  1109. if (inlinelevel=0) and
  1110. ((cs_debuginfo in aktmoduleswitches) or
  1111. (cs_gdb_lineinfo in aktglobalswitches)) then
  1112. begin
  1113. if (objectdata.currsec<>sec_none) and
  1114. not(hp.typ in SkipLineInfo) then
  1115. WriteFileLineInfo(tailineinfo(hp).fileinfo);
  1116. end;
  1117. {$endif GDB}
  1118. case hp.typ of
  1119. ait_align :
  1120. begin
  1121. if objectdata.currsec=sec_bss then
  1122. objectdata.alloc(Tai_align(hp).fillsize)
  1123. else
  1124. objectdata.writebytes(Tai_align(hp).calculatefillbuf(fillbuffer)^,Tai_align(hp).fillsize);
  1125. end;
  1126. ait_section :
  1127. begin
  1128. objectdata.defaulTSection(Tai_section(hp).sec);
  1129. {$ifdef GDB}
  1130. case Tai_section(hp).sec of
  1131. sec_code : n_line:=n_textline;
  1132. sec_data : n_line:=n_dataline;
  1133. sec_bss : n_line:=n_bssline;
  1134. else
  1135. n_line:=n_dataline;
  1136. end;
  1137. stabslastfileinfo.line:=-1;
  1138. {$endif GDB}
  1139. end;
  1140. ait_symbol :
  1141. begin
  1142. objectdata.writesymbol(Tai_symbol(hp).sym);
  1143. objectoutput.exportsymbol(Tai_symbol(hp).sym);
  1144. end;
  1145. ait_datablock :
  1146. begin
  1147. objectdata.writesymbol(Tai_datablock(hp).sym);
  1148. objectoutput.exportsymbol(Tai_datablock(hp).sym);
  1149. if SmartAsm or (not Tai_datablock(hp).is_global) then
  1150. begin
  1151. l:=Tai_datablock(hp).size;
  1152. if l>2 then
  1153. objectdata.allocalign(4)
  1154. else if l>1 then
  1155. objectdata.allocalign(2);
  1156. objectdata.alloc(Tai_datablock(hp).size);
  1157. end;
  1158. end;
  1159. ait_const_32bit :
  1160. objectdata.writebytes(Tai_const(hp).value,4);
  1161. ait_const_16bit :
  1162. objectdata.writebytes(Tai_const(hp).value,2);
  1163. ait_const_8bit :
  1164. objectdata.writebytes(Tai_const(hp).value,1);
  1165. ait_real_80bit :
  1166. objectdata.writebytes(Tai_real_80bit(hp).value,10);
  1167. ait_real_64bit :
  1168. objectdata.writebytes(Tai_real_64bit(hp).value,8);
  1169. ait_real_32bit :
  1170. objectdata.writebytes(Tai_real_32bit(hp).value,4);
  1171. ait_comp_64bit :
  1172. begin
  1173. {$ifdef i386}
  1174. {$ifdef FPC}
  1175. co:=comp(Tai_comp_64bit(hp).value);
  1176. {$else}
  1177. co:=Tai_comp_64bit(hp).value;
  1178. {$endif}
  1179. objectdata.writebytes(co,8);
  1180. {$endif i386}
  1181. end;
  1182. ait_string :
  1183. objectdata.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
  1184. ait_const_rva :
  1185. objectdata.writereloc(Tai_const_symbol(hp).offset,4,
  1186. Tai_const_symbol(hp).sym,RELOC_RVA);
  1187. ait_const_symbol :
  1188. objectdata.writereloc(Tai_const_symbol(hp).offset,4,
  1189. Tai_const_symbol(hp).sym,RELOC_ABSOLUTE);
  1190. ait_label :
  1191. begin
  1192. objectdata.writesymbol(Tai_label(hp).l);
  1193. { exporting shouldn't be necessary as labels are local,
  1194. but it's better to be on the safe side (PFV) }
  1195. objectoutput.exportsymbol(Tai_label(hp).l);
  1196. end;
  1197. {$ifdef i386}
  1198. {$ifndef NOAG386BIN}
  1199. ait_instruction :
  1200. Taicpu(hp).Pass2(objectdata);
  1201. {$endif NOAG386BIN}
  1202. {$endif i386}
  1203. {$ifdef GDB}
  1204. ait_stabn :
  1205. convertstabs(Tai_stabn(hp).str);
  1206. ait_stabs :
  1207. convertstabs(Tai_stabs(hp).str);
  1208. ait_stab_function_name :
  1209. if assigned(Tai_stab_function_name(hp).str) then
  1210. funcname:=objectlibrary.getasmsymbol(strpas(Tai_stab_function_name(hp).str))
  1211. else
  1212. funcname:=nil;
  1213. ait_force_line :
  1214. stabslastfileinfo.line:=0;
  1215. {$endif}
  1216. ait_cut :
  1217. if SmartAsm then
  1218. break;
  1219. ait_marker :
  1220. if tai_marker(hp).kind=InlineStart then
  1221. inc(InlineLevel)
  1222. else if tai_marker(hp).kind=InlineEnd then
  1223. dec(InlineLevel);
  1224. end;
  1225. hp:=Tai(hp.next);
  1226. end;
  1227. TreePass2:=hp;
  1228. end;
  1229. procedure TInternalAssembler.writetree;
  1230. var
  1231. hp : Tai;
  1232. label
  1233. doexit;
  1234. begin
  1235. objectalloc.reseTSections;
  1236. objectalloc.seTSection(sec_code);
  1237. objectdata:=objectoutput.newobjectdata(Objfile);
  1238. objectdata.defaulTSection(sec_code);
  1239. { reset the asmsymbol list }
  1240. objectlibrary.CreateUsedAsmsymbolList;
  1241. { Pass 0 }
  1242. currpass:=0;
  1243. objectalloc.seTSection(sec_code);
  1244. { start with list 1 }
  1245. currlistidx:=1;
  1246. currlist:=list[currlistidx];
  1247. hp:=Tai(currList.first);
  1248. while assigned(hp) do
  1249. begin
  1250. hp:=TreePass0(hp);
  1251. MaybeNextList(hp);
  1252. end;
  1253. { leave if errors have occured }
  1254. if errorcount>0 then
  1255. goto doexit;
  1256. { Pass 1 }
  1257. currpass:=1;
  1258. objectalloc.reseTSections;
  1259. objectalloc.seTSection(sec_code);
  1260. {$ifdef GDB}
  1261. StartFileLineInfo;
  1262. {$endif GDB}
  1263. { start with list 1 }
  1264. currlistidx:=1;
  1265. currlist:=list[currlistidx];
  1266. hp:=Tai(currList.first);
  1267. while assigned(hp) do
  1268. begin
  1269. hp:=TreePass1(hp);
  1270. MaybeNextList(hp);
  1271. end;
  1272. {$ifdef GDB}
  1273. EndFileLineInfo;
  1274. {$endif GDB}
  1275. { check for undefined labels and reset }
  1276. objectlibrary.UsedAsmSymbolListCheckUndefined;
  1277. { set section sizes }
  1278. objectdata.seTSectionsizes(objectalloc.secsize);
  1279. { leave if errors have occured }
  1280. if errorcount>0 then
  1281. goto doexit;
  1282. { Pass 2 }
  1283. currpass:=2;
  1284. {$ifdef GDB}
  1285. StartFileLineInfo;
  1286. {$endif GDB}
  1287. { start with list 1 }
  1288. currlistidx:=1;
  1289. currlist:=list[currlistidx];
  1290. hp:=Tai(currList.first);
  1291. while assigned(hp) do
  1292. begin
  1293. hp:=TreePass2(hp);
  1294. MaybeNextList(hp);
  1295. end;
  1296. {$ifdef GDB}
  1297. EndFileLineInfo;
  1298. {$endif GDB}
  1299. { don't write the .o file if errors have occured }
  1300. if errorcount=0 then
  1301. begin
  1302. { write objectfile }
  1303. objectoutput.startobjectfile(ObjFile);
  1304. objectoutput.writeobjectfile(objectdata);
  1305. objectdata.free;
  1306. objectdata:=nil;
  1307. end;
  1308. doexit:
  1309. { reset the used symbols back, must be after the .o has been
  1310. written }
  1311. objectlibrary.UsedAsmsymbolListReset;
  1312. objectlibrary.DestroyUsedAsmsymbolList;
  1313. end;
  1314. procedure TInternalAssembler.writetreesmart;
  1315. var
  1316. hp : Tai;
  1317. starTSec : TSection;
  1318. place: tcutplace;
  1319. begin
  1320. objectalloc.reseTSections;
  1321. objectalloc.seTSection(sec_code);
  1322. NextSmartName(cut_normal);
  1323. objectdata:=objectoutput.newobjectdata(Objfile);
  1324. objectdata.defaulTSection(sec_code);
  1325. starTSec:=sec_code;
  1326. { start with list 1 }
  1327. currlistidx:=1;
  1328. currlist:=list[currlistidx];
  1329. hp:=Tai(currList.first);
  1330. while assigned(hp) do
  1331. begin
  1332. { reset the asmsymbol list }
  1333. objectlibrary.CreateUsedAsmSymbolList;
  1334. { Pass 0 }
  1335. currpass:=0;
  1336. objectalloc.reseTSections;
  1337. objectalloc.seTSection(starTSec);
  1338. TreePass0(hp);
  1339. { leave if errors have occured }
  1340. if errorcount>0 then
  1341. exit;
  1342. { Pass 1 }
  1343. currpass:=1;
  1344. objectalloc.reseTSections;
  1345. objectalloc.seTSection(starTSec);
  1346. {$ifdef GDB}
  1347. StartFileLineInfo;
  1348. {$endif GDB}
  1349. TreePass1(hp);
  1350. {$ifdef GDB}
  1351. EndFileLineInfo;
  1352. {$endif GDB}
  1353. { check for undefined labels }
  1354. objectlibrary.UsedAsmSymbolListCheckUndefined;
  1355. { set section sizes }
  1356. objectdata.seTSectionsizes(objectalloc.secsize);
  1357. { leave if errors have occured }
  1358. if errorcount>0 then
  1359. exit;
  1360. { Pass 2 }
  1361. currpass:=2;
  1362. objectoutput.startobjectfile(Objfile);
  1363. objectdata.defaulTSection(starTSec);
  1364. {$ifdef GDB}
  1365. StartFileLineInfo;
  1366. {$endif GDB}
  1367. hp:=TreePass2(hp);
  1368. {$ifdef GDB}
  1369. EndFileLineInfo;
  1370. {$endif GDB}
  1371. { leave if errors have occured }
  1372. if errorcount>0 then
  1373. exit;
  1374. { write the current objectfile }
  1375. objectoutput.writeobjectfile(objectdata);
  1376. objectdata.free;
  1377. objectdata:=nil;
  1378. { reset the used symbols back, must be after the .o has been
  1379. written }
  1380. objectlibrary.UsedAsmsymbolListReset;
  1381. objectlibrary.DestroyUsedAsmsymbolList;
  1382. { end of lists? }
  1383. if not MaybeNextList(hp) then
  1384. break;
  1385. { save section for next loop }
  1386. { this leads to a problem if starTSec is sec_none !! PM }
  1387. starTSec:=objectalloc.currsec;
  1388. { we will start a new objectfile so reset everything }
  1389. { The place can still change in the next while loop, so don't init }
  1390. { the writer yet (JM) }
  1391. if (hp.typ=ait_cut) then
  1392. place := Tai_cut(hp).place
  1393. else
  1394. place := cut_normal;
  1395. { avoid empty files }
  1396. while assigned(hp) and
  1397. (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cut]) do
  1398. begin
  1399. if Tai(hp).typ=ait_section then
  1400. starTSec:=Tai_section(hp).sec
  1401. else if (Tai(hp).typ=ait_cut) then
  1402. place := Tai_cut(hp).place;
  1403. hp:=Tai(hp.next);
  1404. end;
  1405. if not MaybeNextList(hp) then
  1406. break;
  1407. { start next objectfile }
  1408. NextSmartName(place);
  1409. objectdata:=objectoutput.newobjectdata(Objfile);
  1410. { there is a problem if starTSec is sec_none !! PM }
  1411. if starTSec=sec_none then
  1412. starTSec:=sec_code;
  1413. end;
  1414. end;
  1415. procedure TInternalAssembler.MakeObject;
  1416. procedure addlist(p:TAAsmoutput);
  1417. begin
  1418. inc(lists);
  1419. list[lists]:=p;
  1420. end;
  1421. begin
  1422. if cs_debuginfo in aktmoduleswitches then
  1423. addlist(debuglist);
  1424. addlist(codesegment);
  1425. addlist(datasegment);
  1426. addlist(consts);
  1427. addlist(rttilist);
  1428. if assigned(resourcestringlist) then
  1429. addlist(resourcestringlist);
  1430. addlist(bsssegment);
  1431. if assigned(importssection) then
  1432. addlist(importssection);
  1433. if assigned(exportssection) and not UseDeffileForExport then
  1434. addlist(exportssection);
  1435. if assigned(resourcesection) then
  1436. addlist(resourcesection);
  1437. if SmartAsm then
  1438. writetreesmart
  1439. else
  1440. writetree;
  1441. end;
  1442. {*****************************************************************************
  1443. Generate Assembler Files Main Procedure
  1444. *****************************************************************************}
  1445. Procedure GenerateAsm(smart:boolean);
  1446. var
  1447. a : TAssembler;
  1448. begin
  1449. if not assigned(CAssembler[target_asm.id]) then
  1450. Message(asmw_f_assembler_output_not_supported);
  1451. a:=CAssembler[target_asm.id].Create(smart);
  1452. a.MakeObject;
  1453. a.Free;
  1454. end;
  1455. Procedure OnlyAsm;
  1456. var
  1457. a : TExternalAssembler;
  1458. begin
  1459. a:=TExternalAssembler.Create(false);
  1460. a.DoAssemble;
  1461. a.Free;
  1462. end;
  1463. {*****************************************************************************
  1464. Init/Done
  1465. *****************************************************************************}
  1466. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  1467. var
  1468. t : tasm;
  1469. begin
  1470. t:=r.id;
  1471. if assigned(asminfos[t]) then
  1472. writeln('Warning: Assembler is already registered!')
  1473. else
  1474. Getmem(asminfos[t],sizeof(tasminfo));
  1475. asminfos[t]^:=r;
  1476. CAssembler[t]:=c;
  1477. end;
  1478. procedure InitAssembler;
  1479. begin
  1480. { target_asm is already set by readarguments }
  1481. initoutputformat:=target_asm.id;
  1482. aktoutputformat:=target_asm.id;
  1483. end;
  1484. procedure DoneAssembler;
  1485. begin
  1486. end;
  1487. end.
  1488. {
  1489. $Log$
  1490. Revision 1.53 2003-07-04 22:40:58 pierre
  1491. * add support for constant offset in stabs address, needed by threadvar debugging support
  1492. Revision 1.52 2003/04/23 13:48:07 peter
  1493. * m68k fix
  1494. Revision 1.51 2003/04/22 14:33:38 peter
  1495. * removed some notes/hints
  1496. Revision 1.50 2003/03/10 18:16:00 olle
  1497. * niceified comments
  1498. Revision 1.49 2003/01/10 21:49:00 marco
  1499. * more hasunix fixes
  1500. Revision 1.48 2002/11/24 18:21:49 carl
  1501. - remove some unused defines
  1502. Revision 1.47 2002/11/17 16:31:55 carl
  1503. * memory optimization (3-4%) : cleanup of tai fields,
  1504. cleanup of tdef and tsym fields.
  1505. * make it work for m68k
  1506. Revision 1.46 2002/11/15 01:58:46 peter
  1507. * merged changes from 1.0.7 up to 04-11
  1508. - -V option for generating bug report tracing
  1509. - more tracing for option parsing
  1510. - errors for cdecl and high()
  1511. - win32 import stabs
  1512. - win32 records<=8 are returned in eax:edx (turned off by default)
  1513. - heaptrc update
  1514. - more info for temp management in .s file with EXTDEBUG
  1515. Revision 1.45 2002/10/30 21:01:14 peter
  1516. * always include lineno after fileswitch. valgrind requires this
  1517. Revision 1.44 2002/09/05 19:29:42 peter
  1518. * memdebug enhancements
  1519. Revision 1.43 2002/08/20 16:55:38 peter
  1520. * don't write (stabs)line info when inlining a procedure
  1521. Revision 1.42 2002/08/12 15:08:39 carl
  1522. + stab register indexes for powerpc (moved from gdb to cpubase)
  1523. + tprocessor enumeration moved to cpuinfo
  1524. + linker in target_info is now a class
  1525. * many many updates for m68k (will soon start to compile)
  1526. - removed some ifdef or correct them for correct cpu
  1527. Revision 1.41 2002/08/11 14:32:26 peter
  1528. * renamed current_library to objectlibrary
  1529. Revision 1.40 2002/08/11 13:24:10 peter
  1530. * saving of asmsymbols in ppu supported
  1531. * asmsymbollist global is removed and moved into a new class
  1532. tasmlibrarydata that will hold the info of a .a file which
  1533. corresponds with a single module. Added librarydata to tmodule
  1534. to keep the library info stored for the module. In the future the
  1535. objectfiles will also be stored to the tasmlibrarydata class
  1536. * all getlabel/newasmsymbol and friends are moved to the new class
  1537. Revision 1.39 2002/07/26 21:15:37 florian
  1538. * rewrote the system handling
  1539. Revision 1.38 2002/07/10 07:24:40 jonas
  1540. * memory leak fixes from Sergey Korshunoff
  1541. Revision 1.37 2002/07/01 18:46:21 peter
  1542. * internal linker
  1543. * reorganized aasm layer
  1544. Revision 1.36 2002/05/18 13:34:05 peter
  1545. * readded missing revisions
  1546. Revision 1.35 2002/05/16 19:46:35 carl
  1547. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1548. + try to fix temp allocation (still in ifdef)
  1549. + generic constructor calls
  1550. + start of tassembler / tmodulebase class cleanup
  1551. Revision 1.33 2002/04/10 08:07:55 jonas
  1552. * fix for the ie9999 under Linux (patch from Peter)
  1553. Revision 1.32 2002/04/07 13:19:14 carl
  1554. + more documentation
  1555. Revision 1.31 2002/04/04 19:05:54 peter
  1556. * removed unused units
  1557. * use tlocation.size in cg.a_*loc*() routines
  1558. Revision 1.30 2002/04/02 17:11:27 peter
  1559. * tlocation,treference update
  1560. * LOC_CONSTANT added for better constant handling
  1561. * secondadd splitted in multiple routines
  1562. * location_force_reg added for loading a location to a register
  1563. of a specified size
  1564. * secondassignment parses now first the right and then the left node
  1565. (this is compatible with Kylix). This saves a lot of push/pop especially
  1566. with string operations
  1567. * adapted some routines to use the new cg methods
  1568. }