assemble.pas 54 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722
  1. {
  2. Copyright (c) 1998-2004 by Peter Vreman
  3. This unit handles the assemblerfile write and assembler calls of FPC
  4. This program is free software; you can redistribute it and/or modify
  5. it under the terms of the GNU General Public License as published by
  6. the Free Software Foundation; either version 2 of the License, or
  7. (at your option) any later version.
  8. This program is distributed in the hope that it will be useful,
  9. but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. GNU General Public License for more details.
  12. You should have received a copy of the GNU General Public License
  13. along with this program; if not, write to the Free Software
  14. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  15. ****************************************************************************
  16. }
  17. {# @abstract(This unit handles the assembler file write and assembler calls of FPC)
  18. Handles the calls to the actual external assemblers, as well as the generation
  19. of object files for smart linking. Also contains the base class for writing
  20. the assembler statements to file.
  21. }
  22. unit assemble;
  23. {$i fpcdefs.inc}
  24. interface
  25. uses
  26. SysUtils,
  27. systems,globtype,globals,aasmbase,aasmtai,aasmdata,ogbase,finput;
  28. const
  29. { maximum of aasmoutput lists there will be }
  30. maxoutputlists = ord(high(tasmlisttype))+1;
  31. { buffer size for writing the .s file }
  32. AsmOutSize=32768*4;
  33. type
  34. TAssembler=class(TAbstractAssembler)
  35. public
  36. {filenames}
  37. path : TPathStr;
  38. name : string;
  39. AsmFileName, { current .s and .o file }
  40. ObjFileName,
  41. ppufilename : TPathStr;
  42. asmprefix : string;
  43. SmartAsm : boolean;
  44. SmartFilesCount,
  45. SmartHeaderCount : longint;
  46. Constructor Create(smart:boolean);virtual;
  47. Destructor Destroy;override;
  48. procedure NextSmartName(place:tcutplace);
  49. procedure MakeObject;virtual;abstract;
  50. end;
  51. {# This is the base class which should be overridden for each each
  52. assembler writer. It is used to actually assembler a file,
  53. and write the output to the assembler file.
  54. }
  55. TExternalAssembler=class(TAssembler)
  56. private
  57. procedure CreateSmartLinkPath(const s:string);
  58. protected
  59. {outfile}
  60. AsmSize,
  61. AsmStartSize,
  62. outcnt : longint;
  63. outbuf : array[0..AsmOutSize-1] of char;
  64. outfile : file;
  65. ioerror : boolean;
  66. {input source info}
  67. lastfileinfo : tfileposinfo;
  68. infile,
  69. lastinfile : tinputfile;
  70. {last section type written}
  71. lastsectype : TAsmSectionType;
  72. procedure WriteSourceLine(hp: tailineinfo);
  73. procedure WriteTempalloc(hp: tai_tempalloc);
  74. public
  75. {# Returns the complete path and executable name of the assembler
  76. program.
  77. It first tries looking in the UTIL directory if specified,
  78. otherwise it searches in the free pascal binary directory, in
  79. the current working directory and then in the directories
  80. in the $PATH environment.}
  81. Function FindAssembler:string;
  82. {# Actually does the call to the assembler file. Returns false
  83. if the assembling of the file failed.}
  84. Function CallAssembler(const command:string; const para:TCmdStr):Boolean;
  85. Function DoAssemble:boolean;virtual;
  86. Procedure RemoveAsm;virtual;
  87. Procedure AsmFlush;
  88. Procedure AsmClear;
  89. {# Write a string to the assembler file }
  90. Procedure AsmWrite(const c:char);
  91. Procedure AsmWrite(const s:string);
  92. Procedure AsmWrite(const s:ansistring);
  93. {# Write a string to the assembler file }
  94. Procedure AsmWritePChar(p:pchar);
  95. {# Write a string to the assembler file followed by a new line }
  96. Procedure AsmWriteLn(const c:char);
  97. Procedure AsmWriteLn(const s:string);
  98. Procedure AsmWriteLn(const s:ansistring);
  99. {# Write a new line to the assembler file }
  100. Procedure AsmLn;
  101. procedure AsmCreate(Aplace:tcutplace);
  102. procedure AsmClose;
  103. {# This routine should be overridden for each assembler, it is used
  104. to actually write the abstract assembler stream to file.}
  105. procedure WriteTree(p:TAsmList);virtual;
  106. {# This routine should be overridden for each assembler, it is used
  107. to actually write all the different abstract assembler streams
  108. by calling for each stream type, the @var(WriteTree) method.}
  109. procedure WriteAsmList;virtual;
  110. {# Constructs the command line for calling the assembler }
  111. function MakeCmdLine: TCmdStr; virtual;
  112. public
  113. Constructor Create(smart:boolean);override;
  114. procedure MakeObject;override;
  115. end;
  116. { TInternalAssembler }
  117. TInternalAssembler=class(TAssembler)
  118. private
  119. FCObjOutput : TObjOutputclass;
  120. { the aasmoutput lists that need to be processed }
  121. lists : byte;
  122. list : array[1..maxoutputlists] of TAsmList;
  123. { current processing }
  124. currlistidx : byte;
  125. currlist : TAsmList;
  126. procedure WriteStab(p:pchar);
  127. function MaybeNextList(var hp:Tai):boolean;
  128. function SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean;
  129. function TreePass0(hp:Tai):Tai;
  130. function TreePass1(hp:Tai):Tai;
  131. function TreePass2(hp:Tai):Tai;
  132. procedure writetree;
  133. procedure writetreesmart;
  134. protected
  135. ObjData : TObjData;
  136. ObjOutput : tObjOutput;
  137. property CObjOutput:TObjOutputclass read FCObjOutput write FCObjOutput;
  138. public
  139. constructor create(smart:boolean);override;
  140. destructor destroy;override;
  141. procedure MakeObject;override;
  142. end;
  143. TAssemblerClass = class of TAssembler;
  144. Procedure GenerateAsm(smart:boolean);
  145. Procedure OnlyAsm;
  146. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  147. Implementation
  148. uses
  149. {$ifdef hasunix}
  150. unix,
  151. {$endif}
  152. cutils,cfileutl,
  153. {$ifdef memdebug}
  154. cclasses,
  155. {$endif memdebug}
  156. script,fmodule,verbose,
  157. {$if defined(m68k) or defined(arm)}
  158. cpuinfo,
  159. {$endif m68k or arm}
  160. aasmcpu,
  161. owbase,owar
  162. ;
  163. var
  164. CAssembler : array[tasm] of TAssemblerClass;
  165. function fixline(s:string):string;
  166. {
  167. return s with all leading and ending spaces and tabs removed
  168. }
  169. var
  170. i,j,k : integer;
  171. begin
  172. i:=length(s);
  173. while (i>0) and (s[i] in [#9,' ']) do
  174. dec(i);
  175. j:=1;
  176. while (j<i) and (s[j] in [#9,' ']) do
  177. inc(j);
  178. for k:=j to i do
  179. if s[k] in [#0..#31,#127..#255] then
  180. s[k]:='.';
  181. fixline:=Copy(s,j,i-j+1);
  182. end;
  183. {*****************************************************************************
  184. TAssembler
  185. *****************************************************************************}
  186. Constructor TAssembler.Create(smart:boolean);
  187. begin
  188. { load start values }
  189. AsmFileName:=current_module.AsmFilename;
  190. ObjFileName:=current_module.ObjFileName;
  191. name:=Lower(current_module.modulename^);
  192. path:=current_module.outputpath;
  193. asmprefix := current_module.asmprefix^;
  194. if current_module.outputpath = '' then
  195. ppufilename := ''
  196. else
  197. ppufilename := current_module.ppufilename;
  198. SmartAsm:=smart;
  199. SmartFilesCount:=0;
  200. SmartHeaderCount:=0;
  201. SmartLinkOFiles.Clear;
  202. end;
  203. Destructor TAssembler.Destroy;
  204. begin
  205. end;
  206. procedure TAssembler.NextSmartName(place:tcutplace);
  207. var
  208. s : string;
  209. begin
  210. inc(SmartFilesCount);
  211. if SmartFilesCount>999999 then
  212. Message(asmw_f_too_many_asm_files);
  213. case place of
  214. cut_begin :
  215. begin
  216. inc(SmartHeaderCount);
  217. s:=asmprefix+tostr(SmartHeaderCount)+'h';
  218. end;
  219. cut_normal :
  220. s:=asmprefix+tostr(SmartHeaderCount)+'s';
  221. cut_end :
  222. s:=asmprefix+tostr(SmartHeaderCount)+'t';
  223. end;
  224. AsmFileName:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.asmext);
  225. ObjFileName:=Path+FixFileName(s+tostr(SmartFilesCount)+target_info.objext);
  226. { insert in container so it can be cleared after the linking }
  227. SmartLinkOFiles.Insert(ObjFileName);
  228. end;
  229. {*****************************************************************************
  230. TExternalAssembler
  231. *****************************************************************************}
  232. Function DoPipe:boolean;
  233. begin
  234. DoPipe:=(cs_asm_pipe in current_settings.globalswitches) and
  235. (([cs_asm_extern,cs_asm_leave,cs_link_on_target] * current_settings.globalswitches) = []) and
  236. ((target_asm.id in [as_gas,as_ggas,as_darwin,as_powerpc_xcoff]));
  237. end;
  238. Constructor TExternalAssembler.Create(smart:boolean);
  239. begin
  240. inherited Create(smart);
  241. if SmartAsm then
  242. begin
  243. path:=FixPath(ChangeFileExt(AsmFileName,target_info.smartext),false);
  244. CreateSmartLinkPath(path);
  245. end;
  246. Outcnt:=0;
  247. end;
  248. procedure TExternalAssembler.CreateSmartLinkPath(const s:string);
  249. procedure DeleteFilesWithExt(const AExt:string);
  250. var
  251. dir : TSearchRec;
  252. begin
  253. if findfirst(s+source_info.dirsep+'*'+AExt,faAnyFile,dir) = 0 then
  254. begin
  255. repeat
  256. DeleteFile(s+source_info.dirsep+dir.name);
  257. until findnext(dir) <> 0;
  258. end;
  259. findclose(dir);
  260. end;
  261. var
  262. hs : string;
  263. begin
  264. if PathExists(s,false) then
  265. begin
  266. { the path exists, now we clean only all the .o and .s files }
  267. DeleteFilesWithExt(target_info.objext);
  268. DeleteFilesWithExt(target_info.asmext);
  269. end
  270. else
  271. begin
  272. hs:=s;
  273. if hs[length(hs)] in ['/','\'] then
  274. delete(hs,length(hs),1);
  275. {$push} {$I-}
  276. mkdir(hs);
  277. {$pop}
  278. if ioresult<>0 then;
  279. end;
  280. end;
  281. const
  282. lastas : byte=255;
  283. var
  284. LastASBin : TCmdStr;
  285. Function TExternalAssembler.FindAssembler:string;
  286. var
  287. asfound : boolean;
  288. UtilExe : string;
  289. begin
  290. asfound:=false;
  291. if cs_link_on_target in current_settings.globalswitches then
  292. begin
  293. { If linking on target, don't add any path PM }
  294. FindAssembler:=utilsprefix+ChangeFileExt(target_asm.asmbin,target_info.exeext);
  295. exit;
  296. end
  297. else
  298. UtilExe:=utilsprefix+ChangeFileExt(target_asm.asmbin,source_info.exeext);
  299. if lastas<>ord(target_asm.id) then
  300. begin
  301. lastas:=ord(target_asm.id);
  302. { is an assembler passed ? }
  303. if utilsdirectory<>'' then
  304. asfound:=FindFile(UtilExe,utilsdirectory,false,LastASBin);
  305. if not AsFound then
  306. asfound:=FindExe(UtilExe,false,LastASBin);
  307. if (not asfound) and not(cs_asm_extern in current_settings.globalswitches) then
  308. begin
  309. Message1(exec_e_assembler_not_found,LastASBin);
  310. current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern];
  311. end;
  312. if asfound then
  313. Message1(exec_t_using_assembler,LastASBin);
  314. end;
  315. FindAssembler:=LastASBin;
  316. end;
  317. Function TExternalAssembler.CallAssembler(const command:string; const para:TCmdStr):Boolean;
  318. var
  319. DosExitCode : Integer;
  320. begin
  321. result:=true;
  322. if (cs_asm_extern in current_settings.globalswitches) then
  323. begin
  324. AsmRes.AddAsmCommand(command,para,name);
  325. exit;
  326. end;
  327. try
  328. FlushOutput;
  329. DosExitCode:=RequotedExecuteProcess(command,para);
  330. if DosExitCode<>0
  331. then begin
  332. Message1(exec_e_error_while_assembling,tostr(dosexitcode));
  333. result:=false;
  334. end;
  335. except on E:EOSError do
  336. begin
  337. Message1(exec_e_cant_call_assembler,tostr(E.ErrorCode));
  338. current_settings.globalswitches:=current_settings.globalswitches+[cs_asm_extern];
  339. result:=false;
  340. end;
  341. end;
  342. end;
  343. procedure TExternalAssembler.RemoveAsm;
  344. var
  345. g : file;
  346. begin
  347. if cs_asm_leave in current_settings.globalswitches then
  348. exit;
  349. if cs_asm_extern in current_settings.globalswitches then
  350. AsmRes.AddDeleteCommand(AsmFileName)
  351. else
  352. begin
  353. assign(g,AsmFileName);
  354. {$push} {$I-}
  355. erase(g);
  356. {$pop}
  357. if ioresult<>0 then;
  358. end;
  359. end;
  360. Function TExternalAssembler.DoAssemble:boolean;
  361. begin
  362. DoAssemble:=true;
  363. if DoPipe then
  364. exit;
  365. if not(cs_asm_extern in current_settings.globalswitches) then
  366. begin
  367. if SmartAsm then
  368. begin
  369. if (SmartFilesCount<=1) then
  370. Message1(exec_i_assembling_smart,name);
  371. end
  372. else
  373. Message1(exec_i_assembling,name);
  374. end;
  375. if CallAssembler(FindAssembler,MakeCmdLine) then
  376. RemoveAsm
  377. else
  378. begin
  379. DoAssemble:=false;
  380. GenerateError;
  381. end;
  382. end;
  383. Procedure TExternalAssembler.AsmFlush;
  384. begin
  385. if outcnt>0 then
  386. begin
  387. { suppress i/o error }
  388. {$push} {$I-}
  389. BlockWrite(outfile,outbuf,outcnt);
  390. {$pop}
  391. ioerror:=ioerror or (ioresult<>0);
  392. outcnt:=0;
  393. end;
  394. end;
  395. Procedure TExternalAssembler.AsmClear;
  396. begin
  397. outcnt:=0;
  398. end;
  399. Procedure TExternalAssembler.AsmWrite(const c: char);
  400. begin
  401. if OutCnt+1>=AsmOutSize then
  402. AsmFlush;
  403. OutBuf[OutCnt]:=c;
  404. inc(OutCnt);
  405. inc(AsmSize);
  406. end;
  407. Procedure TExternalAssembler.AsmWrite(const s:string);
  408. begin
  409. if OutCnt+length(s)>=AsmOutSize then
  410. AsmFlush;
  411. Move(s[1],OutBuf[OutCnt],length(s));
  412. inc(OutCnt,length(s));
  413. inc(AsmSize,length(s));
  414. end;
  415. Procedure TExternalAssembler.AsmWrite(const s:ansistring);
  416. var
  417. StartIndex, ToWrite: longint;
  418. begin
  419. if s='' then
  420. exit;
  421. if OutCnt+length(s)>=AsmOutSize then
  422. AsmFlush;
  423. StartIndex:=1;
  424. ToWrite:=length(s);
  425. while ToWrite>AsmOutSize do
  426. begin
  427. Move(s[StartIndex],OutBuf[OutCnt],AsmOutSize);
  428. inc(OutCnt,AsmOutSize);
  429. inc(AsmSize,AsmOutSize);
  430. AsmFlush;
  431. inc(StartIndex,AsmOutSize);
  432. dec(ToWrite,AsmOutSize);
  433. end;
  434. Move(s[StartIndex],OutBuf[OutCnt],ToWrite);
  435. inc(OutCnt,ToWrite);
  436. inc(AsmSize,ToWrite);
  437. end;
  438. procedure TExternalAssembler.AsmWriteLn(const c: char);
  439. begin
  440. AsmWrite(c);
  441. AsmLn;
  442. end;
  443. Procedure TExternalAssembler.AsmWriteLn(const s:string);
  444. begin
  445. AsmWrite(s);
  446. AsmLn;
  447. end;
  448. Procedure TExternalAssembler.AsmWriteLn(const s: ansistring);
  449. begin
  450. AsmWrite(s);
  451. AsmLn;
  452. end;
  453. Procedure TExternalAssembler.AsmWritePChar(p:pchar);
  454. var
  455. i,j : longint;
  456. begin
  457. i:=StrLen(p);
  458. j:=i;
  459. while j>0 do
  460. begin
  461. i:=min(j,AsmOutSize);
  462. if OutCnt+i>=AsmOutSize then
  463. AsmFlush;
  464. Move(p[0],OutBuf[OutCnt],i);
  465. inc(OutCnt,i);
  466. inc(AsmSize,i);
  467. dec(j,i);
  468. p:=pchar(@p[i]);
  469. end;
  470. end;
  471. Procedure TExternalAssembler.AsmLn;
  472. begin
  473. if OutCnt>=AsmOutSize-2 then
  474. AsmFlush;
  475. if (cs_link_on_target in current_settings.globalswitches) then
  476. begin
  477. OutBuf[OutCnt]:=target_info.newline[1];
  478. inc(OutCnt);
  479. inc(AsmSize);
  480. if length(target_info.newline)>1 then
  481. begin
  482. OutBuf[OutCnt]:=target_info.newline[2];
  483. inc(OutCnt);
  484. inc(AsmSize);
  485. end;
  486. end
  487. else
  488. begin
  489. OutBuf[OutCnt]:=source_info.newline[1];
  490. inc(OutCnt);
  491. inc(AsmSize);
  492. if length(source_info.newline)>1 then
  493. begin
  494. OutBuf[OutCnt]:=source_info.newline[2];
  495. inc(OutCnt);
  496. inc(AsmSize);
  497. end;
  498. end;
  499. end;
  500. function TExternalAssembler.MakeCmdLine: TCmdStr;
  501. begin
  502. result:=target_asm.asmcmd;
  503. {$ifdef m68k}
  504. if current_settings.cputype = cpu_MC68020 then
  505. result:='-m68020 '+result
  506. else
  507. result:='-m68000 '+result;
  508. {$endif}
  509. {$ifdef arm}
  510. if (target_info.system=system_arm_darwin) then
  511. Replace(result,'$ARCH',lower(cputypestr[current_settings.cputype]));
  512. {$endif arm}
  513. if (cs_link_on_target in current_settings.globalswitches) then
  514. begin
  515. Replace(result,'$ASM',maybequoted(ScriptFixFileName(AsmFileName)));
  516. Replace(result,'$OBJ',maybequoted(ScriptFixFileName(ObjFileName)));
  517. end
  518. else
  519. begin
  520. {$ifdef hasunix}
  521. if DoPipe then
  522. Replace(result,'$ASM','')
  523. else
  524. {$endif}
  525. Replace(result,'$ASM',maybequoted(AsmFileName));
  526. Replace(result,'$OBJ',maybequoted(ObjFileName));
  527. end;
  528. end;
  529. procedure TExternalAssembler.AsmCreate(Aplace:tcutplace);
  530. begin
  531. if SmartAsm then
  532. NextSmartName(Aplace);
  533. {$ifdef hasunix}
  534. if DoPipe then
  535. begin
  536. if SmartAsm then
  537. begin
  538. if (SmartFilesCount<=1) then
  539. Message1(exec_i_assembling_smart,name);
  540. end
  541. else
  542. Message1(exec_i_assembling_pipe,AsmFileName);
  543. POpen(outfile,maybequoted(FindAssembler)+' '+MakeCmdLine,'W');
  544. end
  545. else
  546. {$endif}
  547. begin
  548. Assign(outfile,AsmFileName);
  549. {$push} {$I-}
  550. Rewrite(outfile,1);
  551. {$pop}
  552. if ioresult<>0 then
  553. begin
  554. ioerror:=true;
  555. Message1(exec_d_cant_create_asmfile,AsmFileName);
  556. end;
  557. end;
  558. outcnt:=0;
  559. AsmSize:=0;
  560. AsmStartSize:=0;
  561. end;
  562. procedure TExternalAssembler.AsmClose;
  563. var
  564. f : file;
  565. FileAge : longint;
  566. begin
  567. AsmFlush;
  568. {$ifdef hasunix}
  569. if DoPipe then
  570. begin
  571. if PClose(outfile) <> 0 then
  572. GenerateError;
  573. end
  574. else
  575. {$endif}
  576. begin
  577. {Touch Assembler time to ppu time is there is a ppufilename}
  578. if ppufilename<>'' then
  579. begin
  580. Assign(f,ppufilename);
  581. {$push} {$I-}
  582. reset(f,1);
  583. {$pop}
  584. if ioresult=0 then
  585. begin
  586. FileAge := FileGetDate(GetFileHandle(f));
  587. close(f);
  588. reset(outfile,1);
  589. FileSetDate(GetFileHandle(outFile),FileAge);
  590. end;
  591. end;
  592. close(outfile);
  593. end;
  594. end;
  595. procedure TExternalAssembler.WriteSourceLine(hp: tailineinfo);
  596. begin
  597. { load infile }
  598. if lastfileinfo.fileindex<>hp.fileinfo.fileindex then
  599. begin
  600. infile:=current_module.sourcefiles.get_file(hp.fileinfo.fileindex);
  601. if assigned(infile) then
  602. begin
  603. { open only if needed !! }
  604. if (cs_asm_source in current_settings.globalswitches) then
  605. infile.open;
  606. end;
  607. { avoid unnecessary reopens of the same file !! }
  608. lastfileinfo.fileindex:=hp.fileinfo.fileindex;
  609. { be sure to change line !! }
  610. lastfileinfo.line:=-1;
  611. end;
  612. { write source }
  613. if (cs_asm_source in current_settings.globalswitches) and
  614. assigned(infile) then
  615. begin
  616. if (infile<>lastinfile) then
  617. begin
  618. AsmWriteLn(target_asm.comment+'['+infile.name+']');
  619. if assigned(lastinfile) then
  620. lastinfile.close;
  621. end;
  622. if (hp.fileinfo.line<>lastfileinfo.line) and
  623. (hp.fileinfo.line<infile.maxlinebuf) then
  624. begin
  625. if (hp.fileinfo.line<>0) and
  626. (infile.linebuf^[hp.fileinfo.line]>=0) then
  627. AsmWriteLn(target_asm.comment+'['+tostr(hp.fileinfo.line)+'] '+
  628. fixline(infile.GetLineStr(hp.fileinfo.line)));
  629. { set it to a negative value !
  630. to make that is has been read already !! PM }
  631. if (infile.linebuf^[hp.fileinfo.line]>=0) then
  632. infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1;
  633. end;
  634. end;
  635. lastfileinfo:=hp.fileinfo;
  636. lastinfile:=infile;
  637. end;
  638. procedure TExternalAssembler.WriteTempalloc(hp: tai_tempalloc);
  639. begin
  640. {$ifdef EXTDEBUG}
  641. if assigned(hp.problem) then
  642. AsmWriteLn(target_asm.comment+'Temp '+tostr(hp.temppos)+','+
  643. tostr(hp.tempsize)+' '+hp.problem^)
  644. else
  645. {$endif EXTDEBUG}
  646. AsmWriteLn(target_asm.comment+'Temp '+tostr(hp.temppos)+','+
  647. tostr(hp.tempsize)+' '+tempallocstr[hp.allocation]);
  648. end;
  649. procedure TExternalAssembler.WriteTree(p:TAsmList);
  650. begin
  651. end;
  652. procedure TExternalAssembler.WriteAsmList;
  653. begin
  654. end;
  655. procedure TExternalAssembler.MakeObject;
  656. begin
  657. AsmCreate(cut_normal);
  658. FillChar(lastfileinfo, sizeof(lastfileinfo), 0);
  659. lastfileinfo.line := -1;
  660. lastinfile := nil;
  661. lastsectype := sec_none;
  662. WriteAsmList;
  663. AsmClose;
  664. if not(ioerror) then
  665. DoAssemble;
  666. end;
  667. {*****************************************************************************
  668. TInternalAssembler
  669. *****************************************************************************}
  670. constructor TInternalAssembler.create(smart:boolean);
  671. begin
  672. inherited create(smart);
  673. ObjOutput:=nil;
  674. ObjData:=nil;
  675. SmartAsm:=smart;
  676. end;
  677. destructor TInternalAssembler.destroy;
  678. begin
  679. if assigned(ObjData) then
  680. ObjData.free;
  681. if assigned(ObjOutput) then
  682. ObjOutput.free;
  683. end;
  684. procedure TInternalAssembler.WriteStab(p:pchar);
  685. function consumecomma(var p:pchar):boolean;
  686. begin
  687. while (p^=' ') do
  688. inc(p);
  689. result:=(p^=',');
  690. inc(p);
  691. end;
  692. function consumenumber(var p:pchar;out value:longint):boolean;
  693. var
  694. hs : string;
  695. len,
  696. code : integer;
  697. begin
  698. value:=0;
  699. while (p^=' ') do
  700. inc(p);
  701. len:=0;
  702. while (p^ in ['0'..'9']) do
  703. begin
  704. inc(len);
  705. hs[len]:=p^;
  706. inc(p);
  707. end;
  708. if len>0 then
  709. begin
  710. hs[0]:=chr(len);
  711. val(hs,value,code);
  712. end
  713. else
  714. code:=-1;
  715. result:=(code=0);
  716. end;
  717. function consumeoffset(var p:pchar;out relocsym:tobjsymbol;out value:longint):boolean;
  718. var
  719. hs : string;
  720. len,
  721. code : integer;
  722. pstart : pchar;
  723. sym : tobjsymbol;
  724. exprvalue : longint;
  725. gotmin,
  726. have_first_symbol,
  727. have_second_symbol,
  728. dosub : boolean;
  729. begin
  730. result:=false;
  731. value:=0;
  732. relocsym:=nil;
  733. gotmin:=false;
  734. have_first_symbol:=false;
  735. have_second_symbol:=false;
  736. repeat
  737. dosub:=false;
  738. exprvalue:=0;
  739. if gotmin then
  740. begin
  741. dosub:=true;
  742. gotmin:=false;
  743. end;
  744. while (p^=' ') do
  745. inc(p);
  746. case p^ of
  747. #0 :
  748. break;
  749. ' ' :
  750. inc(p);
  751. '0'..'9' :
  752. begin
  753. len:=0;
  754. while (p^ in ['0'..'9']) do
  755. begin
  756. inc(len);
  757. hs[len]:=p^;
  758. inc(p);
  759. end;
  760. hs[0]:=chr(len);
  761. val(hs,exprvalue,code);
  762. if code<>0 then
  763. internalerror(200702251);
  764. end;
  765. '.','_',
  766. 'A'..'Z',
  767. 'a'..'z' :
  768. begin
  769. pstart:=p;
  770. while not(p^ in [#0,' ','-','+']) do
  771. inc(p);
  772. len:=p-pstart;
  773. if len>255 then
  774. internalerror(200509187);
  775. move(pstart^,hs[1],len);
  776. hs[0]:=chr(len);
  777. sym:=objdata.symbolref(hs);
  778. have_first_symbol:=true;
  779. { Second symbol? }
  780. if assigned(relocsym) then
  781. begin
  782. if have_second_symbol then
  783. internalerror(2007032201);
  784. have_second_symbol:=true;
  785. if not have_first_symbol then
  786. internalerror(2007032202);
  787. { second symbol should substracted to first }
  788. if not dosub then
  789. internalerror(2007032203);
  790. if (relocsym.objsection<>sym.objsection) then
  791. internalerror(2005091810);
  792. exprvalue:=relocsym.address-sym.address;
  793. relocsym:=nil;
  794. dosub:=false;
  795. end
  796. else
  797. begin
  798. relocsym:=sym;
  799. if assigned(sym.objsection) then
  800. begin
  801. { first symbol should be + }
  802. if not have_first_symbol and dosub then
  803. internalerror(2007032204);
  804. have_first_symbol:=true;
  805. end;
  806. end;
  807. end;
  808. '+' :
  809. begin
  810. { nothing, by default addition is done }
  811. inc(p);
  812. end;
  813. '-' :
  814. begin
  815. gotmin:=true;
  816. inc(p);
  817. end;
  818. else
  819. internalerror(200509189);
  820. end;
  821. if dosub then
  822. dec(value,exprvalue)
  823. else
  824. inc(value,exprvalue);
  825. until false;
  826. result:=true;
  827. end;
  828. var
  829. stabstrlen,
  830. ofs,
  831. nline,
  832. nidx,
  833. nother,
  834. i : longint;
  835. stab : TObjStabEntry;
  836. relocsym : TObjSymbol;
  837. pstr,
  838. pcurr,
  839. pendquote : pchar;
  840. oldsec : TObjSection;
  841. begin
  842. pcurr:=nil;
  843. pstr:=nil;
  844. pendquote:=nil;
  845. relocsym:=nil;
  846. ofs:=0;
  847. { Parse string part }
  848. if (p[0]='"') then
  849. begin
  850. pstr:=@p[1];
  851. { Ignore \" inside the string }
  852. i:=1;
  853. while not((p[i]='"') and (p[i-1]<>'\')) and
  854. (p[i]<>#0) do
  855. inc(i);
  856. pendquote:=@p[i];
  857. pendquote^:=#0;
  858. pcurr:=@p[i+1];
  859. if not consumecomma(pcurr) then
  860. internalerror(200509181);
  861. end
  862. else
  863. pcurr:=p;
  864. { When in pass 1 then only alloc and leave }
  865. if ObjData.currpass=1 then
  866. begin
  867. ObjData.StabsSec.Alloc(sizeof(TObjStabEntry));
  868. if assigned(pstr) and (pstr[0]<>#0) then
  869. ObjData.StabStrSec.Alloc(strlen(pstr)+1);
  870. end
  871. else
  872. begin
  873. { Stabs format: nidx,nother,nline[,offset] }
  874. if not consumenumber(pcurr,nidx) then
  875. internalerror(200509182);
  876. if not consumecomma(pcurr) then
  877. internalerror(200509183);
  878. if not consumenumber(pcurr,nother) then
  879. internalerror(200509184);
  880. if not consumecomma(pcurr) then
  881. internalerror(200509185);
  882. if not consumenumber(pcurr,nline) then
  883. internalerror(200509186);
  884. if consumecomma(pcurr) then
  885. consumeoffset(pcurr,relocsym,ofs);
  886. { Generate stab entry }
  887. if assigned(pstr) and (pstr[0]<>#0) then
  888. begin
  889. stabstrlen:=strlen(pstr);
  890. {$ifdef optimizestabs}
  891. StabStrEntry:=nil;
  892. if (nidx=N_SourceFile) or (nidx=N_IncludeFile) then
  893. begin
  894. hs:=strpas(pstr);
  895. StabstrEntry:=StabStrDict.Find(hs);
  896. if not assigned(StabstrEntry) then
  897. begin
  898. StabstrEntry:=TStabStrEntry.Create(hs);
  899. StabstrEntry:=StabStrSec.Size;
  900. StabStrDict.Insert(StabstrEntry);
  901. { generate new stab }
  902. StabstrEntry:=nil;
  903. end;
  904. end;
  905. if assigned(StabstrEntry) then
  906. stab.strpos:=StabstrEntry.strpos
  907. else
  908. {$endif optimizestabs}
  909. begin
  910. stab.strpos:=ObjData.StabStrSec.Size;
  911. ObjData.StabStrSec.write(pstr^,stabstrlen+1);
  912. end;
  913. end
  914. else
  915. stab.strpos:=0;
  916. stab.ntype:=byte(nidx);
  917. stab.ndesc:=word(nline);
  918. stab.nother:=byte(nother);
  919. stab.nvalue:=ofs;
  920. { Write the stab first without the value field. Then
  921. write a the value field with relocation }
  922. oldsec:=ObjData.CurrObjSec;
  923. ObjData.SetSection(ObjData.StabsSec);
  924. ObjData.Writebytes(stab,sizeof(TObjStabEntry)-4);
  925. ObjData.Writereloc(stab.nvalue,4,relocsym,RELOC_ABSOLUTE32);
  926. ObjData.setsection(oldsec);
  927. end;
  928. if assigned(pendquote) then
  929. pendquote^:='"';
  930. end;
  931. function TInternalAssembler.MaybeNextList(var hp:Tai):boolean;
  932. begin
  933. { maybe end of list }
  934. while not assigned(hp) do
  935. begin
  936. if currlistidx<lists then
  937. begin
  938. inc(currlistidx);
  939. currlist:=list[currlistidx];
  940. hp:=Tai(currList.first);
  941. end
  942. else
  943. begin
  944. MaybeNextList:=false;
  945. exit;
  946. end;
  947. end;
  948. MaybeNextList:=true;
  949. end;
  950. function TInternalAssembler.SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean;
  951. var
  952. objsym : TObjSymbol;
  953. indsym : TObjSymbol;
  954. begin
  955. Result:=
  956. Assigned(hp) and
  957. (hp.typ=ait_symbol);
  958. if not Result then
  959. Exit;
  960. objsym:=Objdata.SymbolRef(tai_symbol(hp).sym);
  961. objsym.size:=0;
  962. indsym := TObjSymbol(ObjData.ObjSymbolList.Find(indirectname));
  963. if not Assigned(indsym) then
  964. begin
  965. { it's possible that indirect symbol is not present in the list,
  966. so we must create it as undefined }
  967. indsym:=TObjSymbol.Create(ObjData.ObjSymbolList, indirectname);
  968. indsym.typ:=AT_NONE;
  969. indsym.bind:=AB_NONE;
  970. end;
  971. objsym.indsymbol:=indsym;
  972. Result:=true;
  973. end;
  974. function TInternalAssembler.TreePass0(hp:Tai):Tai;
  975. var
  976. objsym,
  977. objsymend : TObjSymbol;
  978. begin
  979. while assigned(hp) do
  980. begin
  981. case hp.typ of
  982. ait_align :
  983. begin
  984. if tai_align_abstract(hp).aligntype>1 then
  985. begin
  986. { always use the maximum fillsize in this pass to avoid possible
  987. short jumps to become out of range }
  988. Tai_align_abstract(hp).fillsize:=Tai_align_abstract(hp).aligntype;
  989. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  990. end
  991. else
  992. Tai_align_abstract(hp).fillsize:=0;
  993. end;
  994. ait_datablock :
  995. begin
  996. {$ifdef USE_COMM_IN_BSS}
  997. if writingpackages and
  998. Tai_datablock(hp).is_global then
  999. ObjData.SymbolDefine(Tai_datablock(hp).sym)
  1000. else
  1001. {$endif USE_COMM_IN_BSS}
  1002. begin
  1003. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1004. ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1005. ObjData.alloc(Tai_datablock(hp).size);
  1006. end;
  1007. end;
  1008. ait_real_80bit :
  1009. ObjData.alloc(tai_real_80bit(hp).savesize);
  1010. ait_real_64bit :
  1011. ObjData.alloc(8);
  1012. ait_real_32bit :
  1013. ObjData.alloc(4);
  1014. ait_comp_64bit :
  1015. ObjData.alloc(8);
  1016. ait_const:
  1017. begin
  1018. { if symbols are provided we can calculate the value for relative symbols.
  1019. This is required for length calculation of leb128 constants }
  1020. if assigned(tai_const(hp).sym) then
  1021. begin
  1022. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1023. { objsym already defined and there is endsym? }
  1024. if assigned(objsym.objsection) and assigned(tai_const(hp).endsym) then
  1025. begin
  1026. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1027. { objsymend already defined? }
  1028. if assigned(objsymend.objsection) then
  1029. begin
  1030. if objsymend.objsection<>objsym.objsection then
  1031. internalerror(200404124);
  1032. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1033. end;
  1034. end;
  1035. end;
  1036. ObjData.alloc(tai_const(hp).size);
  1037. end;
  1038. ait_directive:
  1039. begin
  1040. case tai_directive(hp).directive of
  1041. asd_indirect_symbol:
  1042. { handled in TreePass1 }
  1043. ;
  1044. asd_lazy_reference:
  1045. begin
  1046. if tai_directive(hp).name='' then
  1047. Internalerror(2009112101);
  1048. objsym:=ObjData.symbolref(tai_directive(hp).name);
  1049. objsym.bind:=AB_LAZY;
  1050. end;
  1051. asd_reference:
  1052. { ignore for now, but should be added}
  1053. ;
  1054. else
  1055. internalerror(2010011101);
  1056. end;
  1057. end;
  1058. ait_section:
  1059. begin
  1060. ObjData.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secorder);
  1061. Tai_section(hp).sec:=ObjData.CurrObjSec;
  1062. end;
  1063. ait_symbol :
  1064. begin
  1065. { needs extra support in the internal assembler }
  1066. { the value is just ignored }
  1067. {if tai_symbol(hp).has_value then
  1068. internalerror(2009090804); ;}
  1069. ObjData.SymbolDefine(Tai_symbol(hp).sym);
  1070. end;
  1071. ait_label :
  1072. ObjData.SymbolDefine(Tai_label(hp).labsym);
  1073. ait_string :
  1074. ObjData.alloc(Tai_string(hp).len);
  1075. ait_instruction :
  1076. begin
  1077. { reset instructions which could change in pass 2 }
  1078. Taicpu(hp).resetpass2;
  1079. ObjData.alloc(Taicpu(hp).Pass1(ObjData));
  1080. end;
  1081. ait_cutobject :
  1082. if SmartAsm then
  1083. break;
  1084. end;
  1085. hp:=Tai(hp.next);
  1086. end;
  1087. TreePass0:=hp;
  1088. end;
  1089. function TInternalAssembler.TreePass1(hp:Tai):Tai;
  1090. var
  1091. objsym,
  1092. objsymend : TObjSymbol;
  1093. begin
  1094. while assigned(hp) do
  1095. begin
  1096. case hp.typ of
  1097. ait_align :
  1098. begin
  1099. if tai_align_abstract(hp).aligntype>1 then
  1100. begin
  1101. { here we must determine the fillsize which is used in pass2 }
  1102. Tai_align_abstract(hp).fillsize:=align(ObjData.CurrObjSec.Size,Tai_align_abstract(hp).aligntype)-
  1103. ObjData.CurrObjSec.Size;
  1104. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  1105. end;
  1106. end;
  1107. ait_datablock :
  1108. begin
  1109. if (oso_data in ObjData.CurrObjSec.secoptions) then
  1110. Message(asmw_e_alloc_data_only_in_bss);
  1111. {$ifdef USE_COMM_IN_BSS}
  1112. if writingpackages and
  1113. Tai_datablock(hp).is_global then
  1114. begin
  1115. objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1116. objsym.size:=Tai_datablock(hp).size;
  1117. objsym.bind:=AB_COMMON;
  1118. objsym.alignment:=needtowritealignmentalsoforELF;
  1119. end
  1120. else
  1121. {$endif USE_COMM_IN_BSS}
  1122. begin
  1123. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1124. objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1125. objsym.size:=Tai_datablock(hp).size;
  1126. ObjData.alloc(Tai_datablock(hp).size);
  1127. end;
  1128. end;
  1129. ait_real_80bit :
  1130. ObjData.alloc(tai_real_80bit(hp).savesize);
  1131. ait_real_64bit :
  1132. ObjData.alloc(8);
  1133. ait_real_32bit :
  1134. ObjData.alloc(4);
  1135. ait_comp_64bit :
  1136. ObjData.alloc(8);
  1137. ait_const:
  1138. begin
  1139. { Recalculate relative symbols }
  1140. if assigned(tai_const(hp).sym) and
  1141. assigned(tai_const(hp).endsym) then
  1142. begin
  1143. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1144. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1145. if objsymend.objsection<>objsym.objsection then
  1146. internalerror(200905042);
  1147. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1148. end;
  1149. ObjData.alloc(tai_const(hp).size);
  1150. end;
  1151. ait_section:
  1152. begin
  1153. { use cached value }
  1154. ObjData.setsection(Tai_section(hp).sec);
  1155. end;
  1156. ait_stab :
  1157. begin
  1158. if assigned(Tai_stab(hp).str) then
  1159. WriteStab(Tai_stab(hp).str);
  1160. end;
  1161. ait_symbol :
  1162. ObjData.SymbolDefine(Tai_symbol(hp).sym);
  1163. ait_symbol_end :
  1164. begin
  1165. objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
  1166. objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
  1167. end;
  1168. ait_label :
  1169. ObjData.SymbolDefine(Tai_label(hp).labsym);
  1170. ait_string :
  1171. ObjData.alloc(Tai_string(hp).len);
  1172. ait_instruction :
  1173. ObjData.alloc(Taicpu(hp).Pass1(ObjData));
  1174. ait_cutobject :
  1175. if SmartAsm then
  1176. break;
  1177. ait_directive :
  1178. begin
  1179. case tai_directive(hp).directive of
  1180. asd_indirect_symbol:
  1181. if tai_directive(hp).name='' then
  1182. Internalerror(2009101103)
  1183. else if not SetIndirectToSymbol(Tai(hp.Previous), tai_directive(hp).name) then
  1184. Internalerror(2009101102);
  1185. asd_lazy_reference:
  1186. { handled in TreePass0 }
  1187. ;
  1188. asd_reference:
  1189. { ignore for now, but should be added}
  1190. ;
  1191. else
  1192. internalerror(2010011102);
  1193. end;
  1194. end;
  1195. end;
  1196. hp:=Tai(hp.next);
  1197. end;
  1198. TreePass1:=hp;
  1199. end;
  1200. function TInternalAssembler.TreePass2(hp:Tai):Tai;
  1201. var
  1202. fillbuffer : tfillbuffer;
  1203. {$ifdef x86}
  1204. co : comp;
  1205. {$endif x86}
  1206. leblen : byte;
  1207. lebbuf : array[0..63] of byte;
  1208. objsym,
  1209. objsymend : TObjSymbol;
  1210. zerobuf : array[0..63] of byte;
  1211. begin
  1212. fillchar(zerobuf,sizeof(zerobuf),0);
  1213. { main loop }
  1214. while assigned(hp) do
  1215. begin
  1216. case hp.typ of
  1217. ait_align :
  1218. begin
  1219. if oso_data in ObjData.CurrObjSec.secoptions then
  1220. ObjData.writebytes(Tai_align_abstract(hp).calculatefillbuf(fillbuffer,oso_executable in ObjData.CurrObjSec.secoptions)^,
  1221. Tai_align_abstract(hp).fillsize)
  1222. else
  1223. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  1224. end;
  1225. ait_section :
  1226. begin
  1227. { use cached value }
  1228. ObjData.setsection(Tai_section(hp).sec);
  1229. end;
  1230. ait_symbol :
  1231. begin
  1232. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_symbol(hp).sym));
  1233. end;
  1234. ait_symbol_end :
  1235. begin
  1236. { recalculate size, as some preceding instructions
  1237. could have been changed to smaller size }
  1238. objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
  1239. objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
  1240. end;
  1241. ait_datablock :
  1242. begin
  1243. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_datablock(hp).sym));
  1244. {$ifdef USE_COMM_IN_BSS}
  1245. if not(writingpackages and
  1246. Tai_datablock(hp).is_global) then
  1247. {$endif USE_COMM_IN_BSS}
  1248. begin
  1249. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1250. ObjData.alloc(Tai_datablock(hp).size);
  1251. end;
  1252. end;
  1253. ait_real_80bit :
  1254. begin
  1255. ObjData.writebytes(Tai_real_80bit(hp).value,10);
  1256. ObjData.writebytes(zerobuf,Tai_real_80bit(hp).savesize-10);
  1257. end;
  1258. ait_real_64bit :
  1259. ObjData.writebytes(Tai_real_64bit(hp).value,8);
  1260. ait_real_32bit :
  1261. ObjData.writebytes(Tai_real_32bit(hp).value,4);
  1262. ait_comp_64bit :
  1263. begin
  1264. {$ifdef x86}
  1265. co:=comp(Tai_comp_64bit(hp).value);
  1266. ObjData.writebytes(co,8);
  1267. {$endif x86}
  1268. end;
  1269. ait_string :
  1270. ObjData.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
  1271. ait_const :
  1272. begin
  1273. { Recalculate relative symbols, addresses of forward references
  1274. can be changed in treepass1 }
  1275. if assigned(tai_const(hp).sym) and
  1276. assigned(tai_const(hp).endsym) then
  1277. begin
  1278. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1279. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1280. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1281. end;
  1282. case tai_const(hp).consttype of
  1283. aitconst_64bit,
  1284. aitconst_32bit,
  1285. aitconst_16bit,
  1286. aitconst_8bit :
  1287. begin
  1288. if assigned(tai_const(hp).sym) and
  1289. not assigned(tai_const(hp).endsym) then
  1290. ObjData.writereloc(Tai_const(hp).symofs,tai_const(hp).size,Objdata.SymbolRef(tai_const(hp).sym),RELOC_ABSOLUTE)
  1291. else
  1292. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  1293. end;
  1294. aitconst_rva_symbol :
  1295. begin
  1296. { PE32+? }
  1297. if target_info.system=system_x86_64_win64 then
  1298. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA)
  1299. else
  1300. ObjData.writereloc(Tai_const(hp).symofs,sizeof(pint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA);
  1301. end;
  1302. aitconst_secrel32_symbol :
  1303. begin
  1304. { Required for DWARF2 support under Windows }
  1305. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_SECREL32);
  1306. end;
  1307. aitconst_uleb128bit,
  1308. aitconst_sleb128bit :
  1309. begin
  1310. if tai_const(hp).consttype=aitconst_uleb128bit then
  1311. leblen:=EncodeUleb128(qword(Tai_const(hp).value),lebbuf)
  1312. else
  1313. leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf);
  1314. if leblen<>tai_const(hp).size then
  1315. internalerror(200709271);
  1316. ObjData.writebytes(lebbuf,leblen);
  1317. end;
  1318. aitconst_darwin_dwarf_delta32,
  1319. aitconst_darwin_dwarf_delta64:
  1320. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  1321. else
  1322. internalerror(200603254);
  1323. end;
  1324. end;
  1325. ait_label :
  1326. begin
  1327. { exporting shouldn't be necessary as labels are local,
  1328. but it's better to be on the safe side (PFV) }
  1329. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_label(hp).labsym));
  1330. end;
  1331. ait_instruction :
  1332. Taicpu(hp).Pass2(ObjData);
  1333. ait_stab :
  1334. WriteStab(Tai_stab(hp).str);
  1335. ait_function_name,
  1336. ait_force_line : ;
  1337. ait_cutobject :
  1338. if SmartAsm then
  1339. break;
  1340. {$ifdef TEST_WIN64_SEH}
  1341. ait_seh_directive :
  1342. tai_seh_directive(hp).generate_code(objdata);
  1343. {$endif TEST_WIN64_SEH}
  1344. end;
  1345. hp:=Tai(hp.next);
  1346. end;
  1347. TreePass2:=hp;
  1348. end;
  1349. procedure TInternalAssembler.writetree;
  1350. label
  1351. doexit;
  1352. var
  1353. hp : Tai;
  1354. ObjWriter : TObjectWriter;
  1355. begin
  1356. ObjWriter:=TObjectwriter.create;
  1357. ObjOutput:=CObjOutput.Create(ObjWriter);
  1358. ObjData:=ObjOutput.newObjData(ObjFileName);
  1359. { Pass 0 }
  1360. ObjData.currpass:=0;
  1361. ObjData.createsection(sec_code);
  1362. ObjData.beforealloc;
  1363. { start with list 1 }
  1364. currlistidx:=1;
  1365. currlist:=list[currlistidx];
  1366. hp:=Tai(currList.first);
  1367. while assigned(hp) do
  1368. begin
  1369. hp:=TreePass0(hp);
  1370. MaybeNextList(hp);
  1371. end;
  1372. ObjData.afteralloc;
  1373. { leave if errors have occured }
  1374. if errorcount>0 then
  1375. goto doexit;
  1376. { Pass 1 }
  1377. ObjData.currpass:=1;
  1378. ObjData.resetsections;
  1379. ObjData.beforealloc;
  1380. ObjData.createsection(sec_code);
  1381. { start with list 1 }
  1382. currlistidx:=1;
  1383. currlist:=list[currlistidx];
  1384. hp:=Tai(currList.first);
  1385. while assigned(hp) do
  1386. begin
  1387. hp:=TreePass1(hp);
  1388. MaybeNextList(hp);
  1389. end;
  1390. ObjData.createsection(sec_code);
  1391. ObjData.afteralloc;
  1392. { leave if errors have occured }
  1393. if errorcount>0 then
  1394. goto doexit;
  1395. { Pass 2 }
  1396. ObjData.currpass:=2;
  1397. ObjData.resetsections;
  1398. ObjData.beforewrite;
  1399. ObjData.createsection(sec_code);
  1400. { start with list 1 }
  1401. currlistidx:=1;
  1402. currlist:=list[currlistidx];
  1403. hp:=Tai(currList.first);
  1404. while assigned(hp) do
  1405. begin
  1406. hp:=TreePass2(hp);
  1407. MaybeNextList(hp);
  1408. end;
  1409. ObjData.createsection(sec_code);
  1410. ObjData.afterwrite;
  1411. { don't write the .o file if errors have occured }
  1412. if errorcount=0 then
  1413. begin
  1414. { write objectfile }
  1415. ObjOutput.startobjectfile(ObjFileName);
  1416. ObjOutput.writeobjectfile(ObjData);
  1417. end;
  1418. doexit:
  1419. { Cleanup }
  1420. ObjData.free;
  1421. ObjData:=nil;
  1422. ObjWriter.free;
  1423. end;
  1424. procedure TInternalAssembler.writetreesmart;
  1425. var
  1426. hp : Tai;
  1427. startsectype : TAsmSectiontype;
  1428. place: tcutplace;
  1429. ObjWriter : TObjectWriter;
  1430. begin
  1431. if not(cs_asm_leave in current_settings.globalswitches) then
  1432. ObjWriter:=TARObjectWriter.create(current_module.staticlibfilename)
  1433. else
  1434. ObjWriter:=TObjectwriter.create;
  1435. NextSmartName(cut_normal);
  1436. ObjOutput:=CObjOutput.Create(ObjWriter);
  1437. startsectype:=sec_code;
  1438. { start with list 1 }
  1439. currlistidx:=1;
  1440. currlist:=list[currlistidx];
  1441. hp:=Tai(currList.first);
  1442. while assigned(hp) do
  1443. begin
  1444. ObjData:=ObjOutput.newObjData(ObjFileName);
  1445. { Pass 0 }
  1446. ObjData.currpass:=0;
  1447. ObjData.resetsections;
  1448. ObjData.beforealloc;
  1449. ObjData.createsection(startsectype);
  1450. TreePass0(hp);
  1451. ObjData.afteralloc;
  1452. { leave if errors have occured }
  1453. if errorcount>0 then
  1454. break;
  1455. { Pass 1 }
  1456. ObjData.currpass:=1;
  1457. ObjData.resetsections;
  1458. ObjData.beforealloc;
  1459. ObjData.createsection(startsectype);
  1460. TreePass1(hp);
  1461. ObjData.afteralloc;
  1462. { leave if errors have occured }
  1463. if errorcount>0 then
  1464. break;
  1465. { Pass 2 }
  1466. ObjData.currpass:=2;
  1467. ObjOutput.startobjectfile(ObjFileName);
  1468. ObjData.resetsections;
  1469. ObjData.beforewrite;
  1470. ObjData.createsection(startsectype);
  1471. hp:=TreePass2(hp);
  1472. ObjData.afterwrite;
  1473. { leave if errors have occured }
  1474. if errorcount>0 then
  1475. break;
  1476. { write the current objectfile }
  1477. ObjOutput.writeobjectfile(ObjData);
  1478. ObjData.free;
  1479. ObjData:=nil;
  1480. { end of lists? }
  1481. if not MaybeNextList(hp) then
  1482. break;
  1483. { we will start a new objectfile so reset everything }
  1484. { The place can still change in the next while loop, so don't init }
  1485. { the writer yet (JM) }
  1486. if (hp.typ=ait_cutobject) then
  1487. place := Tai_cutobject(hp).place
  1488. else
  1489. place := cut_normal;
  1490. { avoid empty files }
  1491. startsectype:=sec_code;
  1492. while assigned(hp) and
  1493. (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cutobject]) do
  1494. begin
  1495. if Tai(hp).typ=ait_section then
  1496. startsectype:=Tai_section(hp).sectype;
  1497. if (Tai(hp).typ=ait_cutobject) then
  1498. place:=Tai_cutobject(hp).place;
  1499. hp:=Tai(hp.next);
  1500. end;
  1501. if not MaybeNextList(hp) then
  1502. break;
  1503. { start next objectfile }
  1504. NextSmartName(place);
  1505. end;
  1506. ObjData.free;
  1507. ObjData:=nil;
  1508. ObjWriter.free;
  1509. end;
  1510. procedure TInternalAssembler.MakeObject;
  1511. var to_do:set of TasmlistType;
  1512. i:TasmlistType;
  1513. procedure addlist(p:TAsmList);
  1514. begin
  1515. inc(lists);
  1516. list[lists]:=p;
  1517. end;
  1518. begin
  1519. to_do:=[low(Tasmlisttype)..high(Tasmlisttype)];
  1520. if usedeffileforexports then
  1521. exclude(to_do,al_exports);
  1522. if not(tf_section_threadvars in target_info.flags) then
  1523. exclude(to_do,al_threadvars);
  1524. for i:=low(TasmlistType) to high(TasmlistType) do
  1525. if (i in to_do) and (current_asmdata.asmlists[i]<>nil) then
  1526. addlist(current_asmdata.asmlists[i]);
  1527. if SmartAsm then
  1528. writetreesmart
  1529. else
  1530. writetree;
  1531. end;
  1532. {*****************************************************************************
  1533. Generate Assembler Files Main Procedure
  1534. *****************************************************************************}
  1535. Procedure GenerateAsm(smart:boolean);
  1536. var
  1537. a : TAssembler;
  1538. begin
  1539. if not assigned(CAssembler[target_asm.id]) then
  1540. Message(asmw_f_assembler_output_not_supported);
  1541. a:=CAssembler[target_asm.id].Create(smart);
  1542. a.MakeObject;
  1543. a.Free;
  1544. end;
  1545. Procedure OnlyAsm;
  1546. var
  1547. a : TExternalAssembler;
  1548. begin
  1549. a:=TExternalAssembler.Create(false);
  1550. a.DoAssemble;
  1551. a.Free;
  1552. end;
  1553. {*****************************************************************************
  1554. Init/Done
  1555. *****************************************************************************}
  1556. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  1557. var
  1558. t : tasm;
  1559. begin
  1560. t:=r.id;
  1561. if assigned(asminfos[t]) then
  1562. writeln('Warning: Assembler is already registered!')
  1563. else
  1564. Getmem(asminfos[t],sizeof(tasminfo));
  1565. asminfos[t]^:=r;
  1566. CAssembler[t]:=c;
  1567. end;
  1568. end.