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