assemble.pas 53 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750
  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. l : longint;
  921. {$ifdef i386}
  922. {$ifndef NOAG386BIN}
  923. i : longint;
  924. {$endif NOAG386BIN}
  925. {$endif i386}
  926. begin
  927. inlinelevel:=0;
  928. while assigned(hp) do
  929. begin
  930. {$ifdef GDB}
  931. { write stabs, no line info for inlined code }
  932. if (inlinelevel=0) and
  933. ((cs_debuginfo in aktmoduleswitches) or
  934. (cs_gdb_lineinfo in aktglobalswitches)) then
  935. begin
  936. if (objectalloc.currsec<>sec_none) and
  937. not(hp.typ in SkipLineInfo) then
  938. WriteFileLineInfo(tailineinfo(hp).fileinfo);
  939. end;
  940. {$endif GDB}
  941. case hp.typ of
  942. ait_align :
  943. begin
  944. { here we must determine the fillsize which is used in pass2 }
  945. Tai_align(hp).fillsize:=align(objectalloc.sectionsize,Tai_align(hp).aligntype)-
  946. objectalloc.sectionsize;
  947. objectalloc.sectionalloc(Tai_align(hp).fillsize);
  948. end;
  949. ait_datablock :
  950. begin
  951. if objectalloc.currsec<>sec_bss then
  952. Message(asmw_e_alloc_data_only_in_bss);
  953. if not SmartAsm then
  954. begin
  955. if Tai_datablock(hp).is_global then
  956. begin
  957. Tai_datablock(hp).sym.setaddress(currpass,sec_none,Tai_datablock(hp).size,Tai_datablock(hp).size);
  958. { force to be common/external, must be after setaddress as that would
  959. set it to AS_GLOBAL }
  960. Tai_datablock(hp).sym.currbind:=AB_COMMON;
  961. end
  962. else
  963. begin
  964. l:=Tai_datablock(hp).size;
  965. if l>2 then
  966. objectalloc.sectionalign(4)
  967. else if l>1 then
  968. objectalloc.sectionalign(2);
  969. Tai_datablock(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,
  970. Tai_datablock(hp).size);
  971. objectalloc.sectionalloc(Tai_datablock(hp).size);
  972. end;
  973. end
  974. else
  975. begin
  976. l:=Tai_datablock(hp).size;
  977. if l>2 then
  978. objectalloc.sectionalign(4)
  979. else if l>1 then
  980. objectalloc.sectionalign(2);
  981. Tai_datablock(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,Tai_datablock(hp).size);
  982. objectalloc.sectionalloc(Tai_datablock(hp).size);
  983. end;
  984. objectlibrary.UsedAsmSymbolListInsert(Tai_datablock(hp).sym);
  985. end;
  986. ait_const_32bit :
  987. objectalloc.sectionalloc(4);
  988. ait_const_16bit :
  989. objectalloc.sectionalloc(2);
  990. ait_const_8bit :
  991. objectalloc.sectionalloc(1);
  992. ait_real_80bit :
  993. objectalloc.sectionalloc(10);
  994. ait_real_64bit :
  995. objectalloc.sectionalloc(8);
  996. ait_real_32bit :
  997. objectalloc.sectionalloc(4);
  998. ait_comp_64bit :
  999. objectalloc.sectionalloc(8);
  1000. ait_const_rva,
  1001. ait_const_symbol :
  1002. begin
  1003. objectalloc.sectionalloc(4);
  1004. objectlibrary.UsedAsmSymbolListInsert(Tai_const_symbol(hp).sym);
  1005. end;
  1006. ait_section:
  1007. begin
  1008. objectalloc.seTSection(Tai_section(hp).sec);
  1009. {$ifdef GDB}
  1010. case Tai_section(hp).sec of
  1011. sec_code : n_line:=n_textline;
  1012. sec_data : n_line:=n_dataline;
  1013. sec_bss : n_line:=n_bssline;
  1014. else
  1015. n_line:=n_dataline;
  1016. end;
  1017. stabslastfileinfo.line:=-1;
  1018. {$endif GDB}
  1019. end;
  1020. {$ifdef GDB}
  1021. ait_stabn :
  1022. convertstabs(Tai_stabn(hp).str);
  1023. ait_stabs :
  1024. convertstabs(Tai_stabs(hp).str);
  1025. ait_stab_function_name :
  1026. begin
  1027. if assigned(Tai_stab_function_name(hp).str) then
  1028. begin
  1029. funcname:=objectlibrary.getasmsymbol(strpas(Tai_stab_function_name(hp).str));
  1030. objectlibrary.UsedAsmSymbolListInsert(funcname);
  1031. end
  1032. else
  1033. funcname:=nil;
  1034. end;
  1035. ait_force_line :
  1036. stabslastfileinfo.line:=0;
  1037. {$endif}
  1038. ait_symbol :
  1039. begin
  1040. Tai_symbol(hp).sym.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  1041. objectlibrary.UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
  1042. end;
  1043. ait_symbol_end :
  1044. begin
  1045. if target_info.system in [system_i386_linux,system_i386_beos] then
  1046. begin
  1047. Tai_symbol_end(hp).sym.size:=objectalloc.sectionsize-Tai_symbol_end(hp).sym.address;
  1048. objectlibrary.UsedAsmSymbolListInsert(Tai_symbol_end(hp).sym);
  1049. end;
  1050. end;
  1051. ait_label :
  1052. begin
  1053. Tai_label(hp).l.setaddress(currpass,objectalloc.currsec,objectalloc.sectionsize,0);
  1054. objectlibrary.UsedAsmSymbolListInsert(Tai_label(hp).l);
  1055. end;
  1056. ait_string :
  1057. objectalloc.sectionalloc(Tai_string(hp).len);
  1058. ait_instruction :
  1059. begin
  1060. {$ifdef i386}
  1061. {$ifndef NOAG386BIN}
  1062. objectalloc.sectionalloc(Taicpu(hp).Pass1(objectalloc.sectionsize));
  1063. { fixup the references }
  1064. for i:=1 to Taicpu(hp).ops do
  1065. begin
  1066. with Taicpu(hp).oper[i-1] do
  1067. begin
  1068. case typ of
  1069. top_ref :
  1070. begin
  1071. if assigned(ref^.symbol) then
  1072. objectlibrary.UsedAsmSymbolListInsert(ref^.symbol);
  1073. end;
  1074. top_symbol :
  1075. begin
  1076. objectlibrary.UsedAsmSymbolListInsert(sym);
  1077. end;
  1078. end;
  1079. end;
  1080. end;
  1081. {$endif NOAG386BIN}
  1082. {$endif i386}
  1083. end;
  1084. ait_direct :
  1085. Message(asmw_f_direct_not_supported);
  1086. ait_cut :
  1087. if SmartAsm then
  1088. break;
  1089. ait_marker :
  1090. if tai_marker(hp).kind=InlineStart then
  1091. inc(InlineLevel)
  1092. else if tai_marker(hp).kind=InlineEnd then
  1093. dec(InlineLevel);
  1094. end;
  1095. hp:=Tai(hp.next);
  1096. end;
  1097. TreePass1:=hp;
  1098. end;
  1099. function TInternalAssembler.TreePass2(hp:Tai):Tai;
  1100. var
  1101. fillbuffer : tfillbuffer;
  1102. InlineLevel,
  1103. l : longint;
  1104. {$ifdef i386}
  1105. co : comp;
  1106. {$endif i386}
  1107. begin
  1108. inlinelevel:=0;
  1109. { main loop }
  1110. while assigned(hp) do
  1111. begin
  1112. {$ifdef GDB}
  1113. { write stabs, no line info for inlined code }
  1114. if (inlinelevel=0) and
  1115. ((cs_debuginfo in aktmoduleswitches) or
  1116. (cs_gdb_lineinfo in aktglobalswitches)) then
  1117. begin
  1118. if (objectdata.currsec<>sec_none) and
  1119. not(hp.typ in SkipLineInfo) then
  1120. WriteFileLineInfo(tailineinfo(hp).fileinfo);
  1121. end;
  1122. {$endif GDB}
  1123. case hp.typ of
  1124. ait_align :
  1125. begin
  1126. if objectdata.currsec=sec_bss then
  1127. objectdata.alloc(Tai_align(hp).fillsize)
  1128. else
  1129. objectdata.writebytes(Tai_align(hp).calculatefillbuf(fillbuffer)^,Tai_align(hp).fillsize);
  1130. end;
  1131. ait_section :
  1132. begin
  1133. objectdata.defaulTSection(Tai_section(hp).sec);
  1134. {$ifdef GDB}
  1135. case Tai_section(hp).sec of
  1136. sec_code : n_line:=n_textline;
  1137. sec_data : n_line:=n_dataline;
  1138. sec_bss : n_line:=n_bssline;
  1139. else
  1140. n_line:=n_dataline;
  1141. end;
  1142. stabslastfileinfo.line:=-1;
  1143. {$endif GDB}
  1144. end;
  1145. ait_symbol :
  1146. begin
  1147. objectdata.writesymbol(Tai_symbol(hp).sym);
  1148. objectoutput.exportsymbol(Tai_symbol(hp).sym);
  1149. end;
  1150. ait_datablock :
  1151. begin
  1152. objectdata.writesymbol(Tai_datablock(hp).sym);
  1153. objectoutput.exportsymbol(Tai_datablock(hp).sym);
  1154. if SmartAsm or (not Tai_datablock(hp).is_global) then
  1155. begin
  1156. l:=Tai_datablock(hp).size;
  1157. if l>2 then
  1158. objectdata.allocalign(4)
  1159. else if l>1 then
  1160. objectdata.allocalign(2);
  1161. objectdata.alloc(Tai_datablock(hp).size);
  1162. end;
  1163. end;
  1164. ait_const_32bit :
  1165. objectdata.writebytes(Tai_const(hp).value,4);
  1166. ait_const_16bit :
  1167. objectdata.writebytes(Tai_const(hp).value,2);
  1168. ait_const_8bit :
  1169. objectdata.writebytes(Tai_const(hp).value,1);
  1170. ait_real_80bit :
  1171. objectdata.writebytes(Tai_real_80bit(hp).value,10);
  1172. ait_real_64bit :
  1173. objectdata.writebytes(Tai_real_64bit(hp).value,8);
  1174. ait_real_32bit :
  1175. objectdata.writebytes(Tai_real_32bit(hp).value,4);
  1176. ait_comp_64bit :
  1177. begin
  1178. {$ifdef i386}
  1179. {$ifdef FPC}
  1180. co:=comp(Tai_comp_64bit(hp).value);
  1181. {$else}
  1182. co:=Tai_comp_64bit(hp).value;
  1183. {$endif}
  1184. objectdata.writebytes(co,8);
  1185. {$endif i386}
  1186. end;
  1187. ait_string :
  1188. objectdata.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
  1189. ait_const_rva :
  1190. objectdata.writereloc(Tai_const_symbol(hp).offset,4,
  1191. Tai_const_symbol(hp).sym,RELOC_RVA);
  1192. ait_const_symbol :
  1193. objectdata.writereloc(Tai_const_symbol(hp).offset,4,
  1194. Tai_const_symbol(hp).sym,RELOC_ABSOLUTE);
  1195. ait_label :
  1196. begin
  1197. objectdata.writesymbol(Tai_label(hp).l);
  1198. { exporting shouldn't be necessary as labels are local,
  1199. but it's better to be on the safe side (PFV) }
  1200. objectoutput.exportsymbol(Tai_label(hp).l);
  1201. end;
  1202. {$ifdef i386}
  1203. {$ifndef NOAG386BIN}
  1204. ait_instruction :
  1205. Taicpu(hp).Pass2(objectdata);
  1206. {$endif NOAG386BIN}
  1207. {$endif i386}
  1208. {$ifdef GDB}
  1209. ait_stabn :
  1210. convertstabs(Tai_stabn(hp).str);
  1211. ait_stabs :
  1212. convertstabs(Tai_stabs(hp).str);
  1213. ait_stab_function_name :
  1214. if assigned(Tai_stab_function_name(hp).str) then
  1215. funcname:=objectlibrary.getasmsymbol(strpas(Tai_stab_function_name(hp).str))
  1216. else
  1217. funcname:=nil;
  1218. ait_force_line :
  1219. stabslastfileinfo.line:=0;
  1220. {$endif}
  1221. ait_cut :
  1222. if SmartAsm then
  1223. break;
  1224. ait_marker :
  1225. if tai_marker(hp).kind=InlineStart then
  1226. inc(InlineLevel)
  1227. else if tai_marker(hp).kind=InlineEnd then
  1228. dec(InlineLevel);
  1229. end;
  1230. hp:=Tai(hp.next);
  1231. end;
  1232. TreePass2:=hp;
  1233. end;
  1234. procedure TInternalAssembler.writetree;
  1235. var
  1236. hp : Tai;
  1237. label
  1238. doexit;
  1239. begin
  1240. objectalloc.reseTSections;
  1241. objectalloc.seTSection(sec_code);
  1242. objectdata:=objectoutput.newobjectdata(Objfile);
  1243. objectdata.defaulTSection(sec_code);
  1244. { reset the asmsymbol list }
  1245. objectlibrary.CreateUsedAsmsymbolList;
  1246. { Pass 0 }
  1247. currpass:=0;
  1248. objectalloc.seTSection(sec_code);
  1249. { start with list 1 }
  1250. currlistidx:=1;
  1251. currlist:=list[currlistidx];
  1252. hp:=Tai(currList.first);
  1253. while assigned(hp) do
  1254. begin
  1255. hp:=TreePass0(hp);
  1256. MaybeNextList(hp);
  1257. end;
  1258. { leave if errors have occured }
  1259. if errorcount>0 then
  1260. goto doexit;
  1261. { Pass 1 }
  1262. currpass:=1;
  1263. objectalloc.reseTSections;
  1264. objectalloc.seTSection(sec_code);
  1265. {$ifdef GDB}
  1266. StartFileLineInfo;
  1267. {$endif GDB}
  1268. { start with list 1 }
  1269. currlistidx:=1;
  1270. currlist:=list[currlistidx];
  1271. hp:=Tai(currList.first);
  1272. while assigned(hp) do
  1273. begin
  1274. hp:=TreePass1(hp);
  1275. MaybeNextList(hp);
  1276. end;
  1277. {$ifdef GDB}
  1278. EndFileLineInfo;
  1279. {$endif GDB}
  1280. { check for undefined labels and reset }
  1281. objectlibrary.UsedAsmSymbolListCheckUndefined;
  1282. { set section sizes }
  1283. objectdata.seTSectionsizes(objectalloc.secsize);
  1284. { leave if errors have occured }
  1285. if errorcount>0 then
  1286. goto doexit;
  1287. { Pass 2 }
  1288. currpass:=2;
  1289. {$ifdef GDB}
  1290. StartFileLineInfo;
  1291. {$endif GDB}
  1292. { start with list 1 }
  1293. currlistidx:=1;
  1294. currlist:=list[currlistidx];
  1295. hp:=Tai(currList.first);
  1296. while assigned(hp) do
  1297. begin
  1298. hp:=TreePass2(hp);
  1299. MaybeNextList(hp);
  1300. end;
  1301. {$ifdef GDB}
  1302. EndFileLineInfo;
  1303. {$endif GDB}
  1304. { don't write the .o file if errors have occured }
  1305. if errorcount=0 then
  1306. begin
  1307. { write objectfile }
  1308. objectoutput.startobjectfile(ObjFile);
  1309. objectoutput.writeobjectfile(objectdata);
  1310. objectdata.free;
  1311. objectdata:=nil;
  1312. end;
  1313. doexit:
  1314. { reset the used symbols back, must be after the .o has been
  1315. written }
  1316. objectlibrary.UsedAsmsymbolListReset;
  1317. objectlibrary.DestroyUsedAsmsymbolList;
  1318. end;
  1319. procedure TInternalAssembler.writetreesmart;
  1320. var
  1321. hp : Tai;
  1322. starTSec : TSection;
  1323. place: tcutplace;
  1324. begin
  1325. objectalloc.reseTSections;
  1326. objectalloc.seTSection(sec_code);
  1327. NextSmartName(cut_normal);
  1328. objectdata:=objectoutput.newobjectdata(Objfile);
  1329. objectdata.defaulTSection(sec_code);
  1330. starTSec:=sec_code;
  1331. { start with list 1 }
  1332. currlistidx:=1;
  1333. currlist:=list[currlistidx];
  1334. hp:=Tai(currList.first);
  1335. while assigned(hp) do
  1336. begin
  1337. { reset the asmsymbol list }
  1338. objectlibrary.CreateUsedAsmSymbolList;
  1339. { Pass 0 }
  1340. currpass:=0;
  1341. objectalloc.reseTSections;
  1342. objectalloc.seTSection(starTSec);
  1343. TreePass0(hp);
  1344. { leave if errors have occured }
  1345. if errorcount>0 then
  1346. exit;
  1347. { Pass 1 }
  1348. currpass:=1;
  1349. objectalloc.reseTSections;
  1350. objectalloc.seTSection(starTSec);
  1351. {$ifdef GDB}
  1352. StartFileLineInfo;
  1353. {$endif GDB}
  1354. TreePass1(hp);
  1355. {$ifdef GDB}
  1356. EndFileLineInfo;
  1357. {$endif GDB}
  1358. { check for undefined labels }
  1359. objectlibrary.UsedAsmSymbolListCheckUndefined;
  1360. { set section sizes }
  1361. objectdata.seTSectionsizes(objectalloc.secsize);
  1362. { leave if errors have occured }
  1363. if errorcount>0 then
  1364. exit;
  1365. { Pass 2 }
  1366. currpass:=2;
  1367. objectoutput.startobjectfile(Objfile);
  1368. objectdata.defaulTSection(starTSec);
  1369. {$ifdef GDB}
  1370. StartFileLineInfo;
  1371. {$endif GDB}
  1372. hp:=TreePass2(hp);
  1373. {$ifdef GDB}
  1374. EndFileLineInfo;
  1375. {$endif GDB}
  1376. { leave if errors have occured }
  1377. if errorcount>0 then
  1378. exit;
  1379. { write the current objectfile }
  1380. objectoutput.writeobjectfile(objectdata);
  1381. objectdata.free;
  1382. objectdata:=nil;
  1383. { reset the used symbols back, must be after the .o has been
  1384. written }
  1385. objectlibrary.UsedAsmsymbolListReset;
  1386. objectlibrary.DestroyUsedAsmsymbolList;
  1387. { end of lists? }
  1388. if not MaybeNextList(hp) then
  1389. break;
  1390. { save section for next loop }
  1391. { this leads to a problem if starTSec is sec_none !! PM }
  1392. starTSec:=objectalloc.currsec;
  1393. { we will start a new objectfile so reset everything }
  1394. { The place can still change in the next while loop, so don't init }
  1395. { the writer yet (JM) }
  1396. if (hp.typ=ait_cut) then
  1397. place := Tai_cut(hp).place
  1398. else
  1399. place := cut_normal;
  1400. { avoid empty files }
  1401. while assigned(hp) and
  1402. (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cut]) do
  1403. begin
  1404. if Tai(hp).typ=ait_section then
  1405. starTSec:=Tai_section(hp).sec
  1406. else if (Tai(hp).typ=ait_cut) then
  1407. place := Tai_cut(hp).place;
  1408. hp:=Tai(hp.next);
  1409. end;
  1410. if not MaybeNextList(hp) then
  1411. break;
  1412. { start next objectfile }
  1413. NextSmartName(place);
  1414. objectdata:=objectoutput.newobjectdata(Objfile);
  1415. { there is a problem if starTSec is sec_none !! PM }
  1416. if starTSec=sec_none then
  1417. starTSec:=sec_code;
  1418. end;
  1419. end;
  1420. procedure TInternalAssembler.MakeObject;
  1421. procedure addlist(p:TAAsmoutput);
  1422. begin
  1423. inc(lists);
  1424. list[lists]:=p;
  1425. end;
  1426. begin
  1427. if cs_debuginfo in aktmoduleswitches then
  1428. addlist(debuglist);
  1429. addlist(codesegment);
  1430. addlist(datasegment);
  1431. addlist(consts);
  1432. addlist(rttilist);
  1433. if assigned(resourcestringlist) then
  1434. addlist(resourcestringlist);
  1435. addlist(bsssegment);
  1436. if assigned(importssection) then
  1437. addlist(importssection);
  1438. if assigned(exportssection) and not UseDeffileForExport then
  1439. addlist(exportssection);
  1440. if assigned(resourcesection) then
  1441. addlist(resourcesection);
  1442. if SmartAsm then
  1443. writetreesmart
  1444. else
  1445. writetree;
  1446. end;
  1447. {*****************************************************************************
  1448. Generate Assembler Files Main Procedure
  1449. *****************************************************************************}
  1450. Procedure GenerateAsm(smart:boolean);
  1451. var
  1452. a : TAssembler;
  1453. begin
  1454. if not assigned(CAssembler[target_asm.id]) then
  1455. Message(asmw_f_assembler_output_not_supported);
  1456. a:=CAssembler[target_asm.id].Create(smart);
  1457. a.MakeObject;
  1458. a.Free;
  1459. end;
  1460. Procedure OnlyAsm;
  1461. var
  1462. a : TExternalAssembler;
  1463. begin
  1464. a:=TExternalAssembler.Create(false);
  1465. a.DoAssemble;
  1466. a.Free;
  1467. end;
  1468. {*****************************************************************************
  1469. Init/Done
  1470. *****************************************************************************}
  1471. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  1472. var
  1473. t : tasm;
  1474. begin
  1475. t:=r.id;
  1476. if assigned(asminfos[t]) then
  1477. writeln('Warning: Assembler is already registered!')
  1478. else
  1479. Getmem(asminfos[t],sizeof(tasminfo));
  1480. asminfos[t]^:=r;
  1481. CAssembler[t]:=c;
  1482. end;
  1483. procedure InitAssembler;
  1484. begin
  1485. { target_asm is already set by readarguments }
  1486. initoutputformat:=target_asm.id;
  1487. aktoutputformat:=target_asm.id;
  1488. end;
  1489. procedure DoneAssembler;
  1490. begin
  1491. end;
  1492. end.
  1493. {
  1494. $Log$
  1495. Revision 1.54 2003-09-03 15:55:00 peter
  1496. * NEWRA branch merged
  1497. Revision 1.53.2.1 2003/09/01 21:02:55 peter
  1498. * sparc updates for new tregister
  1499. Revision 1.53 2003/07/04 22:40:58 pierre
  1500. * add support for constant offset in stabs address, needed by threadvar debugging support
  1501. Revision 1.52 2003/04/23 13:48:07 peter
  1502. * m68k fix
  1503. Revision 1.51 2003/04/22 14:33:38 peter
  1504. * removed some notes/hints
  1505. Revision 1.50 2003/03/10 18:16:00 olle
  1506. * niceified comments
  1507. Revision 1.49 2003/01/10 21:49:00 marco
  1508. * more hasunix fixes
  1509. Revision 1.48 2002/11/24 18:21:49 carl
  1510. - remove some unused defines
  1511. Revision 1.47 2002/11/17 16:31:55 carl
  1512. * memory optimization (3-4%) : cleanup of tai fields,
  1513. cleanup of tdef and tsym fields.
  1514. * make it work for m68k
  1515. Revision 1.46 2002/11/15 01:58:46 peter
  1516. * merged changes from 1.0.7 up to 04-11
  1517. - -V option for generating bug report tracing
  1518. - more tracing for option parsing
  1519. - errors for cdecl and high()
  1520. - win32 import stabs
  1521. - win32 records<=8 are returned in eax:edx (turned off by default)
  1522. - heaptrc update
  1523. - more info for temp management in .s file with EXTDEBUG
  1524. Revision 1.45 2002/10/30 21:01:14 peter
  1525. * always include lineno after fileswitch. valgrind requires this
  1526. Revision 1.44 2002/09/05 19:29:42 peter
  1527. * memdebug enhancements
  1528. Revision 1.43 2002/08/20 16:55:38 peter
  1529. * don't write (stabs)line info when inlining a procedure
  1530. Revision 1.42 2002/08/12 15:08:39 carl
  1531. + stab register indexes for powerpc (moved from gdb to cpubase)
  1532. + tprocessor enumeration moved to cpuinfo
  1533. + linker in target_info is now a class
  1534. * many many updates for m68k (will soon start to compile)
  1535. - removed some ifdef or correct them for correct cpu
  1536. Revision 1.41 2002/08/11 14:32:26 peter
  1537. * renamed current_library to objectlibrary
  1538. Revision 1.40 2002/08/11 13:24:10 peter
  1539. * saving of asmsymbols in ppu supported
  1540. * asmsymbollist global is removed and moved into a new class
  1541. tasmlibrarydata that will hold the info of a .a file which
  1542. corresponds with a single module. Added librarydata to tmodule
  1543. to keep the library info stored for the module. In the future the
  1544. objectfiles will also be stored to the tasmlibrarydata class
  1545. * all getlabel/newasmsymbol and friends are moved to the new class
  1546. Revision 1.39 2002/07/26 21:15:37 florian
  1547. * rewrote the system handling
  1548. Revision 1.38 2002/07/10 07:24:40 jonas
  1549. * memory leak fixes from Sergey Korshunoff
  1550. Revision 1.37 2002/07/01 18:46:21 peter
  1551. * internal linker
  1552. * reorganized aasm layer
  1553. Revision 1.36 2002/05/18 13:34:05 peter
  1554. * readded missing revisions
  1555. Revision 1.35 2002/05/16 19:46:35 carl
  1556. + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
  1557. + try to fix temp allocation (still in ifdef)
  1558. + generic constructor calls
  1559. + start of tassembler / tmodulebase class cleanup
  1560. Revision 1.33 2002/04/10 08:07:55 jonas
  1561. * fix for the ie9999 under Linux (patch from Peter)
  1562. Revision 1.32 2002/04/07 13:19:14 carl
  1563. + more documentation
  1564. Revision 1.31 2002/04/04 19:05:54 peter
  1565. * removed unused units
  1566. * use tlocation.size in cg.a_*loc*() routines
  1567. Revision 1.30 2002/04/02 17:11:27 peter
  1568. * tlocation,treference update
  1569. * LOC_CONSTANT added for better constant handling
  1570. * secondadd splitted in multiple routines
  1571. * location_force_reg added for loading a location to a register
  1572. of a specified size
  1573. * secondassignment parses now first the right and then the left node
  1574. (this is compatible with Kylix). This saves a lot of push/pop especially
  1575. with string operations
  1576. * adapted some routines to use the new cg methods
  1577. }