assemble.pas 52 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737
  1. {
  2. $Id$
  3. Copyright (c) 1998-2004 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 USE_SYSUTILS}
  28. sysutils,
  29. {$ELSE USE_SYSUTILS}
  30. strings,
  31. dos,
  32. {$ENDIF USE_SYSUTILS}
  33. systems,globtype,globals,aasmbase,aasmtai,ogbase;
  34. const
  35. { maximum of aasmoutput lists there will be }
  36. maxoutputlists = 10;
  37. { buffer size for writing the .s file }
  38. AsmOutSize=32768;
  39. type
  40. TAssembler=class(TAbstractAssembler)
  41. public
  42. {filenames}
  43. path : pathstr;
  44. name : namestr;
  45. asmfile, { current .s and .o file }
  46. objfile : string;
  47. ppufilename : string;
  48. asmprefix : string;
  49. SmartAsm : boolean;
  50. SmartFilesCount,
  51. SmartHeaderCount : longint;
  52. Constructor Create(smart:boolean);virtual;
  53. Destructor Destroy;override;
  54. procedure NextSmartName(place:tcutplace);
  55. procedure MakeObject;virtual;abstract;
  56. end;
  57. {# This is the base class which should be overriden for each each
  58. assembler writer. It is used to actually assembler a file,
  59. and write the output to the assembler file.
  60. }
  61. TExternalAssembler=class(TAssembler)
  62. private
  63. procedure CreateSmartLinkPath(const s:string);
  64. protected
  65. {outfile}
  66. AsmSize,
  67. AsmStartSize,
  68. outcnt : longint;
  69. outbuf : array[0..AsmOutSize-1] of char;
  70. outfile : file;
  71. ioerror : boolean;
  72. public
  73. {# Returns the complete path and executable name of the assembler
  74. program.
  75. It first tries looking in the UTIL directory if specified,
  76. otherwise it searches in the free pascal binary directory, in
  77. the current working directory and then in the directories
  78. in the $PATH environment.}
  79. Function FindAssembler:string;
  80. {# Actually does the call to the assembler file. Returns false
  81. if the assembling of the file failed.}
  82. Function CallAssembler(const command:string; const para:TCmdStr):Boolean;
  83. Function DoAssemble:boolean;virtual;
  84. Procedure RemoveAsm;
  85. Procedure AsmFlush;
  86. Procedure AsmClear;
  87. {# Write a string to the assembler file }
  88. Procedure AsmWrite(const s:string);
  89. {# Write a string to the assembler file }
  90. Procedure AsmWritePChar(p:pchar);
  91. {# Write a string to the assembler file followed by a new line }
  92. Procedure AsmWriteLn(const s:string);
  93. {# Write a new line to the assembler file }
  94. Procedure AsmLn;
  95. procedure AsmCreate(Aplace:tcutplace);
  96. procedure AsmClose;
  97. {# This routine should be 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. objectdata : TAsmObjectData;
  115. objectoutput : tobjectoutput;
  116. private
  117. { the aasmoutput lists that need to be processed }
  118. lists : byte;
  119. list : array[1..maxoutputlists] of TAAsmoutput;
  120. { current processing }
  121. currlistidx : byte;
  122. currlist : TAAsmoutput;
  123. currpass : byte;
  124. {$ifdef GDB}
  125. n_line : byte; { different types of source lines }
  126. linecount,
  127. includecount : longint;
  128. funcname : tasmsymbol;
  129. stabslastfileinfo : tfileposinfo;
  130. procedure convertstabs(p:pchar);
  131. procedure emitlineinfostabs(nidx,line : longint);
  132. procedure emitstabs(s:string);
  133. procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
  134. procedure StartFileLineInfo;
  135. procedure EndFileLineInfo;
  136. {$endif}
  137. function MaybeNextList(var hp:Tai):boolean;
  138. function TreePass0(hp:Tai):Tai;
  139. function TreePass1(hp:Tai):Tai;
  140. function TreePass2(hp:Tai):Tai;
  141. procedure writetree;
  142. procedure writetreesmart;
  143. end;
  144. TAssemblerClass = class of TAssembler;
  145. Procedure GenerateAsm(smart:boolean);
  146. Procedure OnlyAsm;
  147. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  148. procedure InitAssembler;
  149. procedure DoneAssembler;
  150. Implementation
  151. uses
  152. {$ifdef hasunix}
  153. {$ifdef havelinuxrtl10}
  154. linux,
  155. {$else}
  156. unix,
  157. {$endif}
  158. {$endif}
  159. cutils,script,fmodule,verbose,
  160. cpuinfo,
  161. {$ifdef memdebug}
  162. cclasses,
  163. {$endif memdebug}
  164. {$ifdef GDB}
  165. finput,
  166. gdb,
  167. {$endif GDB}
  168. {$ifdef m68k}
  169. cpuinfo,
  170. {$endif m68k}
  171. cpubase,aasmcpu
  172. ;
  173. var
  174. CAssembler : array[tasm] of TAssemblerClass;
  175. {*****************************************************************************
  176. TAssembler
  177. *****************************************************************************}
  178. Constructor TAssembler.Create(smart:boolean);
  179. begin
  180. { load start values }
  181. asmfile:=current_module.get_asmfilename;
  182. objfile:=current_module.objfilename^;
  183. name:=Lower(current_module.modulename^);
  184. path:=current_module.outputpath^;
  185. asmprefix := current_module.asmprefix^;
  186. if not assigned(current_module.outputpath) then
  187. ppufilename := ''
  188. else
  189. ppufilename := current_module.ppufilename^;
  190. SmartAsm:=smart;
  191. SmartFilesCount:=0;
  192. SmartHeaderCount:=0;
  193. SmartLinkOFiles.Clear;
  194. end;
  195. Destructor TAssembler.Destroy;
  196. begin
  197. end;
  198. procedure TAssembler.NextSmartName(place:tcutplace);
  199. var
  200. s : string;
  201. begin
  202. inc(SmartFilesCount);
  203. if SmartFilesCount>999999 then
  204. Message(asmw_f_too_many_asm_files);
  205. case place of
  206. cut_begin :
  207. begin
  208. inc(SmartHeaderCount);
  209. s:=asmprefix+tostr(SmartHeaderCount)+'h';
  210. end;
  211. cut_normal :
  212. s:=asmprefix+tostr(SmartHeaderCount)+'s';
  213. cut_end :
  214. s:=asmprefix+tostr(SmartHeaderCount)+'t';
  215. end;
  216. AsmFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext);
  217. ObjFile:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext);
  218. { insert in container so it can be cleared after the linking }
  219. SmartLinkOFiles.Insert(Objfile);
  220. end;
  221. {*****************************************************************************
  222. TExternalAssembler
  223. *****************************************************************************}
  224. Function DoPipe:boolean;
  225. begin
  226. DoPipe:=(cs_asm_pipe in aktglobalswitches) and
  227. not(cs_asm_leave in aktglobalswitches)
  228. and ((aktoutputformat in [as_gas,as_darwin]));
  229. end;
  230. Constructor TExternalAssembler.Create(smart:boolean);
  231. begin
  232. inherited Create(smart);
  233. if SmartAsm then
  234. begin
  235. path:=FixPath(path+FixFileName(name)+target_info.smartext,false);
  236. CreateSmartLinkPath(path);
  237. end;
  238. Outcnt:=0;
  239. end;
  240. procedure TExternalAssembler.CreateSmartLinkPath(const s:string);
  241. var
  242. {$IFDEF USE_SYSUTILS}
  243. dir : TSearchRec;
  244. {$ELSE USE_SYSUTILS}
  245. dir : searchrec;
  246. {$ENDIF USE_SYSUTILS}
  247. hs : string;
  248. begin
  249. if PathExists(s) then
  250. begin
  251. { the path exists, now we clean only all the .o and .s files }
  252. { .o files }
  253. {$IFDEF USE_SYSUTILS}
  254. if findfirst(s+source_info.dirsep+'*'+target_info.objext,faAnyFile,dir) = 0
  255. then repeat
  256. RemoveFile(s+source_info.dirsep+dir.name);
  257. until findnext(dir) <> 0;
  258. {$ELSE USE_SYSUTILS}
  259. findfirst(s+source_info.dirsep+'*'+target_info.objext,anyfile,dir);
  260. while (doserror=0) do
  261. begin
  262. RemoveFile(s+source_info.dirsep+dir.name);
  263. findnext(dir);
  264. end;
  265. {$ENDIF USE_SYSUTILS}
  266. findclose(dir);
  267. { .s files }
  268. {$IFDEF USE_SYSUTILS}
  269. if findfirst(s+source_info.dirsep+'*'+target_info.asmext,faAnyFile,dir) = 0
  270. then repeat
  271. RemoveFile(s+source_info.dirsep+dir.name);
  272. until findnext(dir) <> 0;
  273. {$ELSE USE_SYSUTILS}
  274. findfirst(s+source_info.dirsep+'*'+target_info.asmext,anyfile,dir);
  275. while (doserror=0) do
  276. begin
  277. RemoveFile(s+source_info.dirsep+dir.name);
  278. findnext(dir);
  279. end;
  280. {$ENDIF USE_SYSUTILS}
  281. findclose(dir);
  282. end
  283. else
  284. begin
  285. hs:=s;
  286. if hs[length(hs)] in ['/','\'] then
  287. delete(hs,length(hs),1);
  288. {$I-}
  289. mkdir(hs);
  290. {$I+}
  291. if ioresult<>0 then;
  292. end;
  293. end;
  294. const
  295. lastas : byte=255;
  296. var
  297. LastASBin : pathstr;
  298. Function TExternalAssembler.FindAssembler:string;
  299. var
  300. asfound : boolean;
  301. UtilExe : string;
  302. begin
  303. asfound:=false;
  304. if cs_link_on_target in aktglobalswitches then
  305. begin
  306. { If linking on target, don't add any path PM }
  307. FindAssembler:=utilsprefix+AddExtension(target_asm.asmbin,target_info.exeext);
  308. exit;
  309. end
  310. else
  311. UtilExe:=utilsprefix+AddExtension(target_asm.asmbin,source_info.exeext);
  312. if lastas<>ord(target_asm.id) then
  313. begin
  314. lastas:=ord(target_asm.id);
  315. { is an assembler passed ? }
  316. if utilsdirectory<>'' then
  317. asfound:=FindFile(UtilExe,utilsdirectory,LastASBin);
  318. if not AsFound then
  319. asfound:=FindExe(UtilExe,LastASBin);
  320. if (not asfound) and not(cs_asm_extern in aktglobalswitches) then
  321. begin
  322. Message1(exec_e_assembler_not_found,LastASBin);
  323. aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
  324. end;
  325. if asfound then
  326. Message1(exec_t_using_assembler,LastASBin);
  327. end;
  328. FindAssembler:=LastASBin;
  329. end;
  330. Function TExternalAssembler.CallAssembler(const command:string; const para:TCmdStr):Boolean;
  331. {$IFDEF USE_SYSUTILS}
  332. var
  333. DosExitCode:Integer;
  334. {$ENDIF USE_SYSUTILS}
  335. begin
  336. callassembler:=true;
  337. if not(cs_asm_extern in aktglobalswitches) then
  338. {$IFDEF USE_SYSUTILS}
  339. try
  340. DosExitCode := ExecuteProcess(command,para);
  341. if DosExitCode <>0
  342. then begin
  343. Message1(exec_e_error_while_assembling,tostr(dosexitcode));
  344. callassembler:=false;
  345. end;
  346. except on E:EOSError do
  347. begin
  348. Message1(exec_e_cant_call_assembler,tostr(E.ErrorCode));
  349. aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
  350. callassembler:=false;
  351. end
  352. end
  353. {$ELSE USE_SYSUTILS}
  354. begin
  355. swapvectors;
  356. exec(command,para);
  357. swapvectors;
  358. if (doserror<>0) then
  359. begin
  360. Message1(exec_e_cant_call_assembler,tostr(doserror));
  361. aktglobalswitches:=aktglobalswitches+[cs_asm_extern];
  362. callassembler:=false;
  363. end
  364. else
  365. if (dosexitcode<>0) then
  366. begin
  367. Message1(exec_e_error_while_assembling,tostr(dosexitcode));
  368. callassembler:=false;
  369. end;
  370. end
  371. {$ENDIF USE_SYSUTILS}
  372. else
  373. AsmRes.AddAsmCommand(command,para,name);
  374. end;
  375. procedure TExternalAssembler.RemoveAsm;
  376. var
  377. g : file;
  378. begin
  379. if cs_asm_leave in aktglobalswitches then
  380. exit;
  381. if cs_asm_extern in aktglobalswitches then
  382. AsmRes.AddDeleteCommand(AsmFile)
  383. else
  384. begin
  385. assign(g,AsmFile);
  386. {$I-}
  387. erase(g);
  388. {$I+}
  389. if ioresult<>0 then;
  390. end;
  391. end;
  392. Function TExternalAssembler.DoAssemble:boolean;
  393. var
  394. s : TCmdStr;
  395. begin
  396. DoAssemble:=true;
  397. if DoPipe then
  398. exit;
  399. if not(cs_asm_extern in aktglobalswitches) then
  400. begin
  401. if SmartAsm then
  402. begin
  403. if (SmartFilesCount<=1) then
  404. Message1(exec_i_assembling_smart,name);
  405. end
  406. else
  407. Message1(exec_i_assembling,name);
  408. end;
  409. s:=target_asm.asmcmd;
  410. {$ifdef m68k}
  411. if aktoptprocessor = MC68020 then
  412. s:='-m68020 '+s
  413. else
  414. s:='-m68000 '+s;
  415. {$endif}
  416. if (cs_link_on_target in aktglobalswitches) then
  417. begin
  418. Replace(s,'$ASM',ScriptFixFileName(AsmFile));
  419. Replace(s,'$OBJ',ScriptFixFileName(ObjFile));
  420. end
  421. else
  422. begin
  423. Replace(s,'$ASM',AsmFile);
  424. Replace(s,'$OBJ',ObjFile);
  425. end;
  426. if CallAssembler(FindAssembler,s) then
  427. RemoveAsm
  428. else
  429. begin
  430. DoAssemble:=false;
  431. GenerateError;
  432. end;
  433. end;
  434. Procedure TExternalAssembler.AsmFlush;
  435. begin
  436. if outcnt>0 then
  437. begin
  438. { suppress i/o error }
  439. {$i-}
  440. BlockWrite(outfile,outbuf,outcnt);
  441. {$i+}
  442. ioerror:=ioerror or (ioresult<>0);
  443. outcnt:=0;
  444. end;
  445. end;
  446. Procedure TExternalAssembler.AsmClear;
  447. begin
  448. outcnt:=0;
  449. end;
  450. Procedure TExternalAssembler.AsmWrite(const s:string);
  451. begin
  452. if OutCnt+length(s)>=AsmOutSize then
  453. AsmFlush;
  454. Move(s[1],OutBuf[OutCnt],length(s));
  455. inc(OutCnt,length(s));
  456. inc(AsmSize,length(s));
  457. end;
  458. Procedure TExternalAssembler.AsmWriteLn(const s:string);
  459. begin
  460. AsmWrite(s);
  461. AsmLn;
  462. end;
  463. Procedure TExternalAssembler.AsmWritePChar(p:pchar);
  464. var
  465. i,j : longint;
  466. begin
  467. i:=StrLen(p);
  468. j:=i;
  469. while j>0 do
  470. begin
  471. i:=min(j,AsmOutSize);
  472. if OutCnt+i>=AsmOutSize then
  473. AsmFlush;
  474. Move(p[0],OutBuf[OutCnt],i);
  475. inc(OutCnt,i);
  476. inc(AsmSize,i);
  477. dec(j,i);
  478. p:=pchar(@p[i]);
  479. end;
  480. end;
  481. Procedure TExternalAssembler.AsmLn;
  482. begin
  483. if OutCnt>=AsmOutSize-2 then
  484. AsmFlush;
  485. if (cs_link_on_target in aktglobalswitches) then
  486. begin
  487. OutBuf[OutCnt]:=target_info.newline[1];
  488. inc(OutCnt);
  489. inc(AsmSize);
  490. if length(target_info.newline)>1 then
  491. begin
  492. OutBuf[OutCnt]:=target_info.newline[2];
  493. inc(OutCnt);
  494. inc(AsmSize);
  495. end;
  496. end
  497. else
  498. begin
  499. OutBuf[OutCnt]:=source_info.newline[1];
  500. inc(OutCnt);
  501. inc(AsmSize);
  502. if length(source_info.newline)>1 then
  503. begin
  504. OutBuf[OutCnt]:=source_info.newline[2];
  505. inc(OutCnt);
  506. inc(AsmSize);
  507. end;
  508. end;
  509. end;
  510. procedure TExternalAssembler.AsmCreate(Aplace:tcutplace);
  511. begin
  512. if SmartAsm then
  513. NextSmartName(Aplace);
  514. {$ifdef hasunix}
  515. if DoPipe then
  516. begin
  517. Message1(exec_i_assembling_pipe,asmfile);
  518. POpen(outfile,'as -o '+objfile,'W');
  519. end
  520. else
  521. {$endif}
  522. begin
  523. Assign(outfile,asmfile);
  524. {$I-}
  525. Rewrite(outfile,1);
  526. {$I+}
  527. if ioresult<>0 then
  528. begin
  529. ioerror:=true;
  530. Message1(exec_d_cant_create_asmfile,asmfile);
  531. end;
  532. end;
  533. outcnt:=0;
  534. AsmSize:=0;
  535. AsmStartSize:=0;
  536. end;
  537. procedure TExternalAssembler.AsmClose;
  538. var
  539. f : file;
  540. FileAge : longint;
  541. begin
  542. AsmFlush;
  543. {$ifdef hasunix}
  544. if DoPipe then
  545. begin
  546. if PClose(outfile) <> 0 then
  547. GenerateError;
  548. end
  549. else
  550. {$endif}
  551. begin
  552. {Touch Assembler time to ppu time is there is a ppufilename}
  553. if ppufilename<>'' then
  554. begin
  555. Assign(f,ppufilename);
  556. {$I-}
  557. reset(f,1);
  558. {$I+}
  559. if ioresult=0 then
  560. begin
  561. {$IFDEF USE_SYSUTILS}
  562. FileAge := FileGetDate(GetFileHandle(f));
  563. {$ELSE USE_SYSUTILS}
  564. GetFTime(f, FileAge);
  565. {$ENDIF USE_SYSUTILS}
  566. close(f);
  567. reset(outfile,1);
  568. {$IFDEF USE_SYSUTILS}
  569. FileSetDate(GetFileHandle(outFile),FileAge);
  570. {$ELSE USE_SYSUTILS}
  571. SetFTime(f, FileAge);
  572. {$ENDIF USE_SYSUTILS}
  573. end;
  574. end;
  575. close(outfile);
  576. end;
  577. end;
  578. procedure TExternalAssembler.WriteTree(p:TAAsmoutput);
  579. begin
  580. end;
  581. procedure TExternalAssembler.WriteAsmList;
  582. begin
  583. end;
  584. procedure TExternalAssembler.MakeObject;
  585. begin
  586. AsmCreate(cut_normal);
  587. WriteAsmList;
  588. AsmClose;
  589. if not(ioerror) then
  590. DoAssemble;
  591. end;
  592. {*****************************************************************************
  593. TInternalAssembler
  594. *****************************************************************************}
  595. constructor TInternalAssembler.create(smart:boolean);
  596. begin
  597. inherited create(smart);
  598. objectoutput:=nil;
  599. objectdata:=nil;
  600. SmartAsm:=smart;
  601. currpass:=0;
  602. end;
  603. destructor TInternalAssembler.destroy;
  604. {$ifdef MEMDEBUG}
  605. var
  606. d : tmemdebug;
  607. {$endif}
  608. begin
  609. {$ifdef MEMDEBUG}
  610. d := tmemdebug.create(name+' - agbin');
  611. {$endif}
  612. objectdata.free;
  613. objectoutput.free;
  614. {$ifdef MEMDEBUG}
  615. d.free;
  616. {$endif}
  617. end;
  618. {$ifdef GDB}
  619. procedure TInternalAssembler.convertstabs(p:pchar);
  620. var
  621. ofs,
  622. nidx,nother,ii,i,line,j : longint;
  623. code : integer;
  624. hp : pchar;
  625. reloc : boolean;
  626. ps : tasmsymbol;
  627. s : string;
  628. begin
  629. ofs:=0;
  630. reloc:=true;
  631. ps:=nil;
  632. if p[0]='"' then
  633. begin
  634. i:=1;
  635. { we can have \" inside the string !! PM }
  636. while not ((p[i]='"') and (p[i-1]<>'\')) do
  637. inc(i);
  638. p[i]:=#0;
  639. ii:=i;
  640. hp:=@p[1];
  641. s:=StrPas(@P[i+2]);
  642. end
  643. else
  644. begin
  645. hp:=nil;
  646. s:=StrPas(P);
  647. i:=-2; {needed below (PM) }
  648. end;
  649. { When in pass 1 then only alloc and leave }
  650. if currpass=1 then
  651. begin
  652. objectdata.allocstabs(hp);
  653. if assigned(hp) then
  654. p[i]:='"';
  655. exit;
  656. end;
  657. { Parse the rest of the stabs }
  658. if s='' then
  659. internalerror(33000);
  660. j:=pos(',',s);
  661. if j=0 then
  662. internalerror(33001);
  663. Val(Copy(s,1,j-1),nidx,code);
  664. if code<>0 then
  665. internalerror(33002);
  666. i:=i+2+j;
  667. Delete(s,1,j);
  668. j:=pos(',',s);
  669. if (j=0) then
  670. internalerror(33003);
  671. Val(Copy(s,1,j-1),nother,code);
  672. if code<>0 then
  673. internalerror(33004);
  674. i:=i+j;
  675. Delete(s,1,j);
  676. j:=pos(',',s);
  677. if j=0 then
  678. begin
  679. j:=256;
  680. ofs:=-1;
  681. end;
  682. Val(Copy(s,1,j-1),line,code);
  683. if code<>0 then
  684. internalerror(33005);
  685. if ofs=0 then
  686. begin
  687. Delete(s,1,j);
  688. i:=i+j;
  689. Val(s,ofs,code);
  690. if code=0 then
  691. reloc:=false
  692. else
  693. begin
  694. ofs:=0;
  695. s:=strpas(@p[i]);
  696. { handle asmsymbol or
  697. asmsymbol - asmsymbol }
  698. j:=pos(' ',s);
  699. if j=0 then
  700. j:=pos('-',s);
  701. { also try to handle
  702. asmsymbol + constant
  703. or
  704. asmsymbol - constant }
  705. if j=0 then
  706. j:=pos('+',s);
  707. if j<>0 then
  708. begin
  709. Val(Copy(s,j+1,255),ofs,code);
  710. if code<>0 then
  711. ofs:=0
  712. else
  713. { constant reading successful,
  714. avoid further treatment by
  715. setting s[j] to '+' }
  716. s[j]:='+';
  717. end
  718. else
  719. { single asmsymbol }
  720. j:=256;
  721. { the symbol can be external
  722. so we must use newasmsymbol and
  723. not getasmsymbol !! PM }
  724. ps:=objectlibrary.newasmsymbol(copy(s,1,j-1),AB_EXTERNAL,AT_NONE);
  725. if not assigned(ps) then
  726. internalerror(33006)
  727. else
  728. begin
  729. ofs:=ofs+ps.address;
  730. reloc:=true;
  731. objectlibrary.UsedAsmSymbolListInsert(ps);
  732. end;
  733. if (j<256) and (s[j]<>'+') then
  734. begin
  735. i:=i+j;
  736. s:=strpas(@p[i]);
  737. if (s<>'') and (s[1]=' ') then
  738. begin
  739. j:=0;
  740. while (s[j+1]=' ') do
  741. inc(j);
  742. i:=i+j;
  743. s:=strpas(@p[i]);
  744. end;
  745. ps:=objectlibrary.getasmsymbol(s);
  746. if not assigned(ps) then
  747. internalerror(33007)
  748. else
  749. begin
  750. if ps.section<>objectdata.currsec then
  751. internalerror(33008);
  752. ofs:=ofs-ps.address;
  753. reloc:=false;
  754. objectlibrary.UsedAsmSymbolListInsert(ps);
  755. end;
  756. end;
  757. end;
  758. end;
  759. { External references (AB_EXTERNAL and AB_COMMON) need a symbol relocation }
  760. if assigned(ps) and (ps.currbind in [AB_EXTERNAL,AB_COMMON]) then
  761. begin
  762. if currpass=2 then
  763. begin
  764. objectdata.writesymbol(ps);
  765. objectoutput.exportsymbol(ps);
  766. end;
  767. objectdata.writeSymStabs(ofs,hp,ps,nidx,nother,line,reloc)
  768. end
  769. else
  770. objectdata.writeStabs(ofs,hp,nidx,nother,line,reloc);
  771. if assigned(hp) then
  772. p[ii]:='"';
  773. end;
  774. procedure TInternalAssembler.emitlineinfostabs(nidx,line : longint);
  775. begin
  776. if currpass=1 then
  777. begin
  778. objectdata.allocstabs(nil);
  779. exit;
  780. end;
  781. if (nidx=n_textline) and assigned(funcname) and
  782. (target_info.use_function_relative_addresses) then
  783. objectdata.writeStabs(objectdata.currsec.datasize-funcname.address,nil,nidx,0,line,false)
  784. else
  785. objectdata.writeStabs(objectdata.currsec.datasize,nil,nidx,0,line,true);
  786. end;
  787. procedure TInternalAssembler.emitstabs(s:string);
  788. begin
  789. s:=s+#0;
  790. ConvertStabs(@s[1]);
  791. end;
  792. procedure TInternalAssembler.WriteFileLineInfo(var fileinfo : tfileposinfo);
  793. var
  794. curr_n : byte;
  795. hp : tasmsymbol;
  796. infile : tinputfile;
  797. begin
  798. if not ((cs_debuginfo in aktmoduleswitches) or
  799. (cs_gdb_lineinfo in aktglobalswitches)) then
  800. exit;
  801. { file changed ? (must be before line info) }
  802. if (fileinfo.fileindex<>0) and
  803. (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
  804. begin
  805. infile:=current_module.sourcefiles.get_file(fileinfo.fileindex);
  806. if assigned(infile) then
  807. begin
  808. if includecount=0 then
  809. curr_n:=n_sourcefile
  810. else
  811. curr_n:=n_includefile;
  812. { get symbol for this includefile }
  813. hp:=objectlibrary.newasmsymbol('Ltext'+ToStr(IncludeCount),AB_LOCAL,AT_FUNCTION);
  814. if currpass=1 then
  815. begin
  816. objectdata.allocsymbol(currpass,hp,0);
  817. objectlibrary.UsedAsmSymbolListInsert(hp);
  818. end
  819. else
  820. objectdata.writesymbol(hp);
  821. { emit stabs }
  822. if (infile.path^<>'') then
  823. EmitStabs('"'+BsToSlash(FixPath(infile.path^,false))+'",'+tostr(curr_n)+
  824. ',0,0,Ltext'+ToStr(IncludeCount));
  825. EmitStabs('"'+FixFileName(infile.name^)+'",'+tostr(curr_n)+
  826. ',0,0,Ltext'+ToStr(IncludeCount));
  827. inc(includecount);
  828. { force new line info }
  829. stabslastfileinfo.line:=-1;
  830. end;
  831. end;
  832. { line changed ? }
  833. if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
  834. emitlineinfostabs(n_line,fileinfo.line);
  835. stabslastfileinfo:=fileinfo;
  836. end;
  837. procedure TInternalAssembler.StartFileLineInfo;
  838. var
  839. fileinfo : tfileposinfo;
  840. begin
  841. FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
  842. n_line:=n_bssline;
  843. funcname:=nil;
  844. linecount:=1;
  845. includecount:=0;
  846. fileinfo.fileindex:=1;
  847. fileinfo.line:=1;
  848. WriteFileLineInfo(fileinfo);
  849. end;
  850. procedure TInternalAssembler.EndFileLineInfo;
  851. var
  852. hp : tasmsymbol;
  853. begin
  854. if not ((cs_debuginfo in aktmoduleswitches) or
  855. (cs_gdb_lineinfo in aktglobalswitches)) then
  856. exit;
  857. objectdata.createsection(sec_code,'',0,[]);
  858. hp:=objectlibrary.newasmsymbol('Letext',AB_LOCAL,AT_FUNCTION);
  859. if currpass=1 then
  860. begin
  861. objectdata.allocsymbol(currpass,hp,0);
  862. objectlibrary.UsedAsmSymbolListInsert(hp);
  863. end
  864. else
  865. objectdata.writesymbol(hp);
  866. EmitStabs('"",'+tostr(n_sourcefile)+',0,0,Letext');
  867. end;
  868. {$endif GDB}
  869. function TInternalAssembler.MaybeNextList(var hp:Tai):boolean;
  870. begin
  871. { maybe end of list }
  872. while not assigned(hp) do
  873. begin
  874. if currlistidx<lists then
  875. begin
  876. inc(currlistidx);
  877. currlist:=list[currlistidx];
  878. hp:=Tai(currList.first);
  879. end
  880. else
  881. begin
  882. MaybeNextList:=false;
  883. exit;
  884. end;
  885. end;
  886. MaybeNextList:=true;
  887. end;
  888. function TInternalAssembler.TreePass0(hp:Tai):Tai;
  889. var
  890. l : longint;
  891. begin
  892. while assigned(hp) do
  893. begin
  894. case hp.typ of
  895. ait_align :
  896. begin
  897. { always use the maximum fillsize in this pass to avoid possible
  898. short jumps to become out of range }
  899. Tai_align(hp).fillsize:=Tai_align(hp).aligntype;
  900. objectdata.alloc(Tai_align(hp).fillsize);
  901. end;
  902. ait_datablock :
  903. begin
  904. l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
  905. if SmartAsm or (not Tai_datablock(hp).is_global) then
  906. begin
  907. objectdata.allocalign(l);
  908. objectdata.alloc(Tai_datablock(hp).size);
  909. end;
  910. end;
  911. ait_real_80bit :
  912. objectdata.alloc(10);
  913. ait_real_64bit :
  914. objectdata.alloc(8);
  915. ait_real_32bit :
  916. objectdata.alloc(4);
  917. ait_comp_64bit :
  918. objectdata.alloc(8);
  919. ait_const_64bit,
  920. ait_const_32bit,
  921. ait_const_16bit,
  922. ait_const_8bit,
  923. ait_const_rva_symbol,
  924. ait_const_indirect_symbol :
  925. objectdata.alloc(tai_const(hp).size);
  926. ait_section:
  927. begin
  928. objectdata.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secalign,[]);
  929. Tai_section(hp).sec:=objectdata.CurrSec;
  930. end;
  931. ait_symbol :
  932. objectdata.allocsymbol(currpass,Tai_symbol(hp).sym,0);
  933. ait_label :
  934. objectdata.allocsymbol(currpass,Tai_label(hp).l,0);
  935. ait_string :
  936. objectdata.alloc(Tai_string(hp).len);
  937. ait_instruction :
  938. begin
  939. {$ifdef i386}
  940. {$ifndef NOAG386BIN}
  941. { reset instructions which could change in pass 2 }
  942. Taicpu(hp).resetpass2;
  943. objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize));
  944. {$endif NOAG386BIN}
  945. {$endif i386}
  946. end;
  947. ait_cutobject :
  948. if SmartAsm then
  949. break;
  950. end;
  951. hp:=Tai(hp.next);
  952. end;
  953. TreePass0:=hp;
  954. end;
  955. function TInternalAssembler.TreePass1(hp:Tai):Tai;
  956. var
  957. InlineLevel,
  958. l : longint;
  959. {$ifdef i386}
  960. {$ifndef NOAG386BIN}
  961. i : longint;
  962. {$endif NOAG386BIN}
  963. {$endif i386}
  964. begin
  965. inlinelevel:=0;
  966. while assigned(hp) do
  967. begin
  968. {$ifdef GDB}
  969. { write stabs, no line info for inlined code }
  970. if (inlinelevel=0) and
  971. ((cs_debuginfo in aktmoduleswitches) or
  972. (cs_gdb_lineinfo in aktglobalswitches)) then
  973. begin
  974. if (objectdata.currsec<>nil) and
  975. not(hp.typ in SkipLineInfo) then
  976. WriteFileLineInfo(tailineinfo(hp).fileinfo);
  977. end;
  978. {$endif GDB}
  979. case hp.typ of
  980. ait_align :
  981. begin
  982. { here we must determine the fillsize which is used in pass2 }
  983. Tai_align(hp).fillsize:=align(objectdata.currsec.datasize,Tai_align(hp).aligntype)-
  984. objectdata.currsec.datasize;
  985. objectdata.alloc(Tai_align(hp).fillsize);
  986. end;
  987. ait_datablock :
  988. begin
  989. if objectdata.currsec.sectype<>sec_bss then
  990. Message(asmw_e_alloc_data_only_in_bss);
  991. l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
  992. if Tai_datablock(hp).is_global and
  993. not SmartAsm then
  994. begin
  995. objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size);
  996. { force to be common/external, must be after setaddress as that would
  997. set it to AB_GLOBAL }
  998. Tai_datablock(hp).sym.currbind:=AB_COMMON;
  999. end
  1000. else
  1001. begin
  1002. objectdata.allocalign(l);
  1003. objectdata.allocsymbol(currpass,Tai_datablock(hp).sym,Tai_datablock(hp).size);
  1004. objectdata.alloc(Tai_datablock(hp).size);
  1005. end;
  1006. objectlibrary.UsedAsmSymbolListInsert(Tai_datablock(hp).sym);
  1007. end;
  1008. ait_real_80bit :
  1009. objectdata.alloc(10);
  1010. ait_real_64bit :
  1011. objectdata.alloc(8);
  1012. ait_real_32bit :
  1013. objectdata.alloc(4);
  1014. ait_comp_64bit :
  1015. objectdata.alloc(8);
  1016. ait_const_64bit,
  1017. ait_const_32bit,
  1018. ait_const_16bit,
  1019. ait_const_8bit,
  1020. ait_const_rva_symbol,
  1021. ait_const_indirect_symbol :
  1022. begin
  1023. objectdata.alloc(tai_const(hp).size);
  1024. if assigned(Tai_const(hp).sym) then
  1025. objectlibrary.UsedAsmSymbolListInsert(Tai_const(hp).sym);
  1026. if assigned(Tai_const(hp).endsym) then
  1027. objectlibrary.UsedAsmSymbolListInsert(Tai_const(hp).endsym);
  1028. end;
  1029. ait_section:
  1030. begin
  1031. { use cached value }
  1032. objectdata.setsection(Tai_section(hp).sec);
  1033. {$ifdef GDB}
  1034. case Tai_section(hp).sectype of
  1035. sec_code :
  1036. n_line:=n_textline;
  1037. sec_data :
  1038. n_line:=n_dataline;
  1039. sec_bss :
  1040. n_line:=n_bssline;
  1041. else
  1042. n_line:=n_dataline;
  1043. end;
  1044. stabslastfileinfo.line:=-1;
  1045. {$endif GDB}
  1046. end;
  1047. {$ifdef GDB}
  1048. ait_stabn :
  1049. begin
  1050. if assigned(Tai_stabn(hp).str) then
  1051. convertstabs(Tai_stabn(hp).str);
  1052. end;
  1053. ait_stabs :
  1054. begin
  1055. if assigned(Tai_stabs(hp).str) then
  1056. convertstabs(Tai_stabs(hp).str);
  1057. end;
  1058. ait_stab_function_name :
  1059. begin
  1060. if assigned(Tai_stab_function_name(hp).str) then
  1061. begin
  1062. funcname:=objectlibrary.getasmsymbol(strpas(Tai_stab_function_name(hp).str));
  1063. objectlibrary.UsedAsmSymbolListInsert(funcname);
  1064. end
  1065. else
  1066. funcname:=nil;
  1067. end;
  1068. ait_force_line :
  1069. stabslastfileinfo.line:=0;
  1070. {$endif}
  1071. ait_symbol :
  1072. begin
  1073. objectdata.allocsymbol(currpass,Tai_symbol(hp).sym,0);
  1074. objectlibrary.UsedAsmSymbolListInsert(Tai_symbol(hp).sym);
  1075. end;
  1076. ait_symbol_end :
  1077. begin
  1078. if target_info.system in [system_i386_linux,system_i386_beos] then
  1079. begin
  1080. Tai_symbol_end(hp).sym.size:=objectdata.currsec.datasize-Tai_symbol_end(hp).sym.address;
  1081. objectlibrary.UsedAsmSymbolListInsert(Tai_symbol_end(hp).sym);
  1082. end;
  1083. end;
  1084. ait_label :
  1085. begin
  1086. objectdata.allocsymbol(currpass,Tai_label(hp).l,0);
  1087. objectlibrary.UsedAsmSymbolListInsert(Tai_label(hp).l);
  1088. end;
  1089. ait_string :
  1090. objectdata.alloc(Tai_string(hp).len);
  1091. ait_instruction :
  1092. begin
  1093. {$ifdef i386}
  1094. {$ifndef NOAG386BIN}
  1095. objectdata.alloc(Taicpu(hp).Pass1(objectdata.currsec.datasize));
  1096. { fixup the references }
  1097. for i:=1 to Taicpu(hp).ops do
  1098. begin
  1099. with Taicpu(hp).oper[i-1]^ do
  1100. begin
  1101. case typ of
  1102. top_ref :
  1103. begin
  1104. if assigned(ref^.symbol) then
  1105. objectlibrary.UsedAsmSymbolListInsert(ref^.symbol);
  1106. if assigned(ref^.relsymbol) then
  1107. objectlibrary.UsedAsmSymbolListInsert(ref^.symbol);
  1108. end;
  1109. end;
  1110. end;
  1111. end;
  1112. {$endif NOAG386BIN}
  1113. {$endif i386}
  1114. end;
  1115. ait_direct :
  1116. Message(asmw_f_direct_not_supported);
  1117. ait_cutobject :
  1118. if SmartAsm then
  1119. break;
  1120. ait_marker :
  1121. if tai_marker(hp).kind=InlineStart then
  1122. inc(InlineLevel)
  1123. else if tai_marker(hp).kind=InlineEnd then
  1124. dec(InlineLevel);
  1125. end;
  1126. hp:=Tai(hp.next);
  1127. end;
  1128. TreePass1:=hp;
  1129. end;
  1130. function TInternalAssembler.TreePass2(hp:Tai):Tai;
  1131. var
  1132. fillbuffer : tfillbuffer;
  1133. InlineLevel,
  1134. l : longint;
  1135. v : int64;
  1136. {$ifdef x86}
  1137. co : comp;
  1138. {$endif x86}
  1139. begin
  1140. inlinelevel:=0;
  1141. { main loop }
  1142. while assigned(hp) do
  1143. begin
  1144. {$ifdef GDB}
  1145. { write stabs, no line info for inlined code }
  1146. if (inlinelevel=0) and
  1147. ((cs_debuginfo in aktmoduleswitches) or
  1148. (cs_gdb_lineinfo in aktglobalswitches)) then
  1149. begin
  1150. if (objectdata.currsec<>nil) and
  1151. not(hp.typ in SkipLineInfo) then
  1152. WriteFileLineInfo(tailineinfo(hp).fileinfo);
  1153. end;
  1154. {$endif GDB}
  1155. case hp.typ of
  1156. ait_align :
  1157. begin
  1158. if objectdata.currsec.sectype=sec_bss then
  1159. objectdata.alloc(Tai_align(hp).fillsize)
  1160. else
  1161. objectdata.writebytes(Tai_align(hp).calculatefillbuf(fillbuffer)^,Tai_align(hp).fillsize);
  1162. end;
  1163. ait_section :
  1164. begin
  1165. { use cached value }
  1166. objectdata.setsection(Tai_section(hp).sec);
  1167. {$ifdef GDB}
  1168. case Tai_section(hp).sectype of
  1169. sec_code : n_line:=n_textline;
  1170. sec_data : n_line:=n_dataline;
  1171. sec_bss : n_line:=n_bssline;
  1172. else
  1173. n_line:=n_dataline;
  1174. end;
  1175. stabslastfileinfo.line:=-1;
  1176. {$endif GDB}
  1177. end;
  1178. ait_symbol :
  1179. begin
  1180. objectdata.writesymbol(Tai_symbol(hp).sym);
  1181. objectoutput.exportsymbol(Tai_symbol(hp).sym);
  1182. end;
  1183. ait_datablock :
  1184. begin
  1185. l:=used_align(size_2_align(Tai_datablock(hp).size),0,objectdata.currsec.addralign);
  1186. objectdata.writesymbol(Tai_datablock(hp).sym);
  1187. objectoutput.exportsymbol(Tai_datablock(hp).sym);
  1188. if SmartAsm or (not Tai_datablock(hp).is_global) then
  1189. begin
  1190. objectdata.allocalign(l);
  1191. objectdata.alloc(Tai_datablock(hp).size);
  1192. end;
  1193. end;
  1194. ait_real_80bit :
  1195. objectdata.writebytes(Tai_real_80bit(hp).value,10);
  1196. ait_real_64bit :
  1197. objectdata.writebytes(Tai_real_64bit(hp).value,8);
  1198. ait_real_32bit :
  1199. objectdata.writebytes(Tai_real_32bit(hp).value,4);
  1200. ait_comp_64bit :
  1201. begin
  1202. {$ifdef x86}
  1203. {$ifdef FPC}
  1204. co:=comp(Tai_comp_64bit(hp).value);
  1205. {$else}
  1206. co:=Tai_comp_64bit(hp).value;
  1207. {$endif}
  1208. objectdata.writebytes(co,8);
  1209. {$endif x86}
  1210. end;
  1211. ait_string :
  1212. objectdata.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
  1213. ait_const_64bit,
  1214. ait_const_32bit,
  1215. ait_const_16bit,
  1216. ait_const_8bit :
  1217. begin
  1218. if assigned(tai_const(hp).sym) then
  1219. begin
  1220. if assigned(tai_const(hp).endsym) then
  1221. begin
  1222. if tai_const(hp).endsym.section<>tai_const(hp).sym.section then
  1223. internalerror(200404124);
  1224. v:=tai_const(hp).endsym.address-tai_const(hp).sym.address+Tai_const(hp).value;
  1225. objectdata.writebytes(v,tai_const(hp).size);
  1226. end
  1227. else
  1228. objectdata.writereloc(Tai_const(hp).value,Tai_const(hp).size,Tai_const(hp).sym,RELOC_ABSOLUTE);
  1229. end
  1230. else
  1231. objectdata.writebytes(Tai_const(hp).value,tai_const(hp).size);
  1232. end;
  1233. ait_const_rva_symbol :
  1234. objectdata.writereloc(Tai_const(hp).value,sizeof(aint),Tai_const(hp).sym,RELOC_RVA);
  1235. ait_label :
  1236. begin
  1237. objectdata.writesymbol(Tai_label(hp).l);
  1238. { exporting shouldn't be necessary as labels are local,
  1239. but it's better to be on the safe side (PFV) }
  1240. objectoutput.exportsymbol(Tai_label(hp).l);
  1241. end;
  1242. {$ifdef i386}
  1243. {$ifndef NOAG386BIN}
  1244. ait_instruction :
  1245. Taicpu(hp).Pass2(objectdata);
  1246. {$endif NOAG386BIN}
  1247. {$endif i386}
  1248. {$ifdef GDB}
  1249. ait_stabn :
  1250. convertstabs(Tai_stabn(hp).str);
  1251. ait_stabs :
  1252. convertstabs(Tai_stabs(hp).str);
  1253. ait_stab_function_name :
  1254. if assigned(Tai_stab_function_name(hp).str) then
  1255. funcname:=objectlibrary.getasmsymbol(strpas(Tai_stab_function_name(hp).str))
  1256. else
  1257. funcname:=nil;
  1258. ait_force_line :
  1259. stabslastfileinfo.line:=0;
  1260. {$endif}
  1261. ait_cutobject :
  1262. if SmartAsm then
  1263. break;
  1264. ait_marker :
  1265. if tai_marker(hp).kind=InlineStart then
  1266. inc(InlineLevel)
  1267. else if tai_marker(hp).kind=InlineEnd then
  1268. dec(InlineLevel);
  1269. end;
  1270. hp:=Tai(hp.next);
  1271. end;
  1272. TreePass2:=hp;
  1273. end;
  1274. procedure TInternalAssembler.writetree;
  1275. var
  1276. hp : Tai;
  1277. label
  1278. doexit;
  1279. begin
  1280. objectdata:=objectoutput.newobjectdata(Objfile);
  1281. { reset the asmsymbol list }
  1282. objectlibrary.CreateUsedAsmsymbolList;
  1283. { Pass 0 }
  1284. currpass:=0;
  1285. objectdata.createsection(sec_code,'',0,[]);
  1286. objectdata.beforealloc;
  1287. { start with list 1 }
  1288. currlistidx:=1;
  1289. currlist:=list[currlistidx];
  1290. hp:=Tai(currList.first);
  1291. while assigned(hp) do
  1292. begin
  1293. hp:=TreePass0(hp);
  1294. MaybeNextList(hp);
  1295. end;
  1296. objectdata.afteralloc;
  1297. { leave if errors have occured }
  1298. if errorcount>0 then
  1299. goto doexit;
  1300. { Pass 1 }
  1301. currpass:=1;
  1302. objectdata.resetsections;
  1303. objectdata.beforealloc;
  1304. objectdata.createsection(sec_code,'',0,[]);
  1305. {$ifdef GDB}
  1306. StartFileLineInfo;
  1307. {$endif GDB}
  1308. { start with list 1 }
  1309. currlistidx:=1;
  1310. currlist:=list[currlistidx];
  1311. hp:=Tai(currList.first);
  1312. while assigned(hp) do
  1313. begin
  1314. hp:=TreePass1(hp);
  1315. MaybeNextList(hp);
  1316. end;
  1317. {$ifdef GDB}
  1318. EndFileLineInfo;
  1319. {$endif GDB}
  1320. objectdata.afteralloc;
  1321. { check for undefined labels and reset }
  1322. objectlibrary.UsedAsmSymbolListCheckUndefined;
  1323. { leave if errors have occured }
  1324. if errorcount>0 then
  1325. goto doexit;
  1326. { Pass 2 }
  1327. currpass:=2;
  1328. objectdata.resetsections;
  1329. objectdata.beforewrite;
  1330. objectdata.createsection(sec_code,'',0,[]);
  1331. {$ifdef GDB}
  1332. StartFileLineInfo;
  1333. {$endif GDB}
  1334. { start with list 1 }
  1335. currlistidx:=1;
  1336. currlist:=list[currlistidx];
  1337. hp:=Tai(currList.first);
  1338. while assigned(hp) do
  1339. begin
  1340. hp:=TreePass2(hp);
  1341. MaybeNextList(hp);
  1342. end;
  1343. {$ifdef GDB}
  1344. EndFileLineInfo;
  1345. {$endif GDB}
  1346. objectdata.afterwrite;
  1347. { don't write the .o file if errors have occured }
  1348. if errorcount=0 then
  1349. begin
  1350. { write objectfile }
  1351. objectoutput.startobjectfile(ObjFile);
  1352. objectoutput.writeobjectfile(objectdata);
  1353. objectdata.free;
  1354. objectdata:=nil;
  1355. end;
  1356. doexit:
  1357. { reset the used symbols back, must be after the .o has been
  1358. written }
  1359. objectlibrary.UsedAsmsymbolListReset;
  1360. objectlibrary.DestroyUsedAsmsymbolList;
  1361. end;
  1362. procedure TInternalAssembler.writetreesmart;
  1363. var
  1364. hp : Tai;
  1365. startsectype : TAsmSectionType;
  1366. place: tcutplace;
  1367. begin
  1368. NextSmartName(cut_normal);
  1369. objectdata:=objectoutput.newobjectdata(Objfile);
  1370. startsectype:=sec_code;
  1371. { start with list 1 }
  1372. currlistidx:=1;
  1373. currlist:=list[currlistidx];
  1374. hp:=Tai(currList.first);
  1375. while assigned(hp) do
  1376. begin
  1377. { reset the asmsymbol list }
  1378. objectlibrary.CreateUsedAsmSymbolList;
  1379. { Pass 0 }
  1380. currpass:=0;
  1381. objectdata.resetsections;
  1382. objectdata.beforealloc;
  1383. objectdata.createsection(startsectype,'',0,[]);
  1384. TreePass0(hp);
  1385. objectdata.afteralloc;
  1386. { leave if errors have occured }
  1387. if errorcount>0 then
  1388. exit;
  1389. { Pass 1 }
  1390. currpass:=1;
  1391. objectdata.resetsections;
  1392. objectdata.beforealloc;
  1393. objectdata.createsection(startsectype,'',0,[]);
  1394. {$ifdef GDB}
  1395. StartFileLineInfo;
  1396. {$endif GDB}
  1397. TreePass1(hp);
  1398. {$ifdef GDB}
  1399. EndFileLineInfo;
  1400. {$endif GDB}
  1401. objectdata.afteralloc;
  1402. { check for undefined labels }
  1403. objectlibrary.UsedAsmSymbolListCheckUndefined;
  1404. { leave if errors have occured }
  1405. if errorcount>0 then
  1406. exit;
  1407. { Pass 2 }
  1408. currpass:=2;
  1409. objectoutput.startobjectfile(Objfile);
  1410. objectdata.resetsections;
  1411. objectdata.beforewrite;
  1412. objectdata.createsection(startsectype,'',0,[]);
  1413. {$ifdef GDB}
  1414. StartFileLineInfo;
  1415. {$endif GDB}
  1416. hp:=TreePass2(hp);
  1417. { save section type for next loop, must be done before EndFileLineInfo
  1418. because that changes the section to sec_code }
  1419. startsectype:=objectdata.currsec.sectype;
  1420. {$ifdef GDB}
  1421. EndFileLineInfo;
  1422. {$endif GDB}
  1423. objectdata.afterwrite;
  1424. { leave if errors have occured }
  1425. if errorcount>0 then
  1426. exit;
  1427. { write the current objectfile }
  1428. objectoutput.writeobjectfile(objectdata);
  1429. objectdata.free;
  1430. objectdata:=nil;
  1431. { reset the used symbols back, must be after the .o has been
  1432. written }
  1433. objectlibrary.UsedAsmsymbolListReset;
  1434. objectlibrary.DestroyUsedAsmsymbolList;
  1435. { end of lists? }
  1436. if not MaybeNextList(hp) then
  1437. break;
  1438. { we will start a new objectfile so reset everything }
  1439. { The place can still change in the next while loop, so don't init }
  1440. { the writer yet (JM) }
  1441. if (hp.typ=ait_cutobject) then
  1442. place := Tai_cutobject(hp).place
  1443. else
  1444. place := cut_normal;
  1445. { avoid empty files }
  1446. while assigned(hp) and
  1447. (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cutobject]) do
  1448. begin
  1449. if Tai(hp).typ=ait_section then
  1450. startsectype:=Tai_section(hp).sectype
  1451. else if (Tai(hp).typ=ait_cutobject) then
  1452. place:=Tai_cutobject(hp).place;
  1453. hp:=Tai(hp.next);
  1454. end;
  1455. { there is a problem if startsectype is sec_none !! PM }
  1456. if startsectype=sec_none then
  1457. startsectype:=sec_code;
  1458. if not MaybeNextList(hp) then
  1459. break;
  1460. { start next objectfile }
  1461. NextSmartName(place);
  1462. objectdata:=objectoutput.newobjectdata(Objfile);
  1463. end;
  1464. end;
  1465. procedure TInternalAssembler.MakeObject;
  1466. procedure addlist(p:TAAsmoutput);
  1467. begin
  1468. inc(lists);
  1469. list[lists]:=p;
  1470. end;
  1471. begin
  1472. if cs_debuginfo in aktmoduleswitches then
  1473. addlist(debuglist);
  1474. addlist(codesegment);
  1475. addlist(datasegment);
  1476. addlist(consts);
  1477. addlist(rttilist);
  1478. addlist(picdata);
  1479. if assigned(resourcestringlist) then
  1480. addlist(resourcestringlist);
  1481. addlist(bsssegment);
  1482. if assigned(importssection) then
  1483. addlist(importssection);
  1484. if assigned(exportssection) and not UseDeffileForExports then
  1485. addlist(exportssection);
  1486. if assigned(resourcesection) then
  1487. addlist(resourcesection);
  1488. {$warning TODO internal writer support for dwarf}
  1489. {if assigned(dwarflist) then
  1490. addlist(dwarflist);}
  1491. if SmartAsm then
  1492. writetreesmart
  1493. else
  1494. writetree;
  1495. end;
  1496. {*****************************************************************************
  1497. Generate Assembler Files Main Procedure
  1498. *****************************************************************************}
  1499. Procedure GenerateAsm(smart:boolean);
  1500. var
  1501. a : TAssembler;
  1502. begin
  1503. if not assigned(CAssembler[target_asm.id]) then
  1504. Message(asmw_f_assembler_output_not_supported);
  1505. a:=CAssembler[target_asm.id].Create(smart);
  1506. a.MakeObject;
  1507. a.Free;
  1508. end;
  1509. Procedure OnlyAsm;
  1510. var
  1511. a : TExternalAssembler;
  1512. begin
  1513. a:=TExternalAssembler.Create(false);
  1514. a.DoAssemble;
  1515. a.Free;
  1516. end;
  1517. {*****************************************************************************
  1518. Init/Done
  1519. *****************************************************************************}
  1520. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  1521. var
  1522. t : tasm;
  1523. begin
  1524. t:=r.id;
  1525. if assigned(asminfos[t]) then
  1526. writeln('Warning: Assembler is already registered!')
  1527. else
  1528. Getmem(asminfos[t],sizeof(tasminfo));
  1529. asminfos[t]^:=r;
  1530. CAssembler[t]:=c;
  1531. end;
  1532. procedure InitAssembler;
  1533. begin
  1534. { target_asm is already set by readarguments }
  1535. initoutputformat:=target_asm.id;
  1536. aktoutputformat:=target_asm.id;
  1537. end;
  1538. procedure DoneAssembler;
  1539. begin
  1540. end;
  1541. end.
  1542. {
  1543. $Log$
  1544. Revision 1.80 2004-10-14 14:47:52 mazen
  1545. * Merge is complete for this file, cycles !
  1546. Revision 1.79 2004/10/13 17:58:54 peter
  1547. * reverted USE_SYSUTILS patch until ll patches are readyt
  1548. Revision 1.77 2004/10/08 15:52:40 florian
  1549. + non writeable unit output directory produces a nice error message now
  1550. Revision 1.76 2004/10/04 18:26:51 peter
  1551. * debuginfo fixes
  1552. Revision 1.75 2004/10/04 15:48:11 peter
  1553. * AB_COMMON symbols need special relocation in stabs
  1554. Revision 1.74 2004/08/27 20:53:52 peter
  1555. don't lowercase filenames in stabs
  1556. Revision 1.73 2004/08/25 15:55:32 peter
  1557. * fixed win32 that was broken by previous fix
  1558. Revision 1.72 2004/08/24 19:31:44 hajny
  1559. * binary writer fix for GO32v2 from Peter
  1560. Revision 1.71 2004/07/01 18:28:54 jonas
  1561. + detect assembler errors when using -ap
  1562. Revision 1.70 2004/07/01 15:42:53 peter
  1563. * fix wrong calculation of .bss section
  1564. Revision 1.69 2004/06/20 08:55:28 florian
  1565. * logs truncated
  1566. Revision 1.68 2004/06/16 20:07:06 florian
  1567. * dwarf branch merged
  1568. Revision 1.67 2004/05/21 22:43:36 peter
  1569. * set correct n_line type when starting new .o file by passing
  1570. the current section type
  1571. Revision 1.66.2.7 2004/05/03 14:59:57 peter
  1572. * no dlltool needed for win32 linking executables
  1573. Revision 1.66.2.6 2004/05/01 16:02:09 peter
  1574. * POINTER_SIZE replaced with sizeof(aint)
  1575. * aint,aword,tconst*int moved to globtype
  1576. Revision 1.66.2.5 2004/04/29 23:30:28 peter
  1577. * fix i386 compiler
  1578. }