assemble.pas 54 KB

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