assemble.pas 56 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698169917001701170217031704170517061707170817091710171117121713171417151716171717181719172017211722172317241725172617271728172917301731173217331734173517361737173817391740174117421743174417451746174717481749175017511752175317541755
  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. if (cs_create_pic in current_settings.moduleswitches) then
  529. Replace(result,'$PIC','-KPIC')
  530. else
  531. Replace(result,'$PIC','');
  532. if (cs_asm_source in current_settings.globalswitches) then
  533. Replace(result,'$NOWARN','')
  534. else
  535. Replace(result,'$NOWARN','-W');
  536. end;
  537. procedure TExternalAssembler.AsmCreate(Aplace:tcutplace);
  538. begin
  539. if SmartAsm then
  540. NextSmartName(Aplace);
  541. {$ifdef hasunix}
  542. if DoPipe then
  543. begin
  544. if SmartAsm then
  545. begin
  546. if (SmartFilesCount<=1) then
  547. Message1(exec_i_assembling_smart,name);
  548. end
  549. else
  550. Message1(exec_i_assembling_pipe,AsmFileName);
  551. POpen(outfile,maybequoted(FindAssembler)+' '+MakeCmdLine,'W');
  552. end
  553. else
  554. {$endif}
  555. begin
  556. Assign(outfile,AsmFileName);
  557. {$push} {$I-}
  558. Rewrite(outfile,1);
  559. {$pop}
  560. if ioresult<>0 then
  561. begin
  562. ioerror:=true;
  563. Message1(exec_d_cant_create_asmfile,AsmFileName);
  564. end;
  565. end;
  566. outcnt:=0;
  567. AsmSize:=0;
  568. AsmStartSize:=0;
  569. end;
  570. procedure TExternalAssembler.AsmClose;
  571. var
  572. f : file;
  573. FileAge : longint;
  574. begin
  575. AsmFlush;
  576. {$ifdef hasunix}
  577. if DoPipe then
  578. begin
  579. if PClose(outfile) <> 0 then
  580. GenerateError;
  581. end
  582. else
  583. {$endif}
  584. begin
  585. {Touch Assembler time to ppu time is there is a ppufilename}
  586. if ppufilename<>'' then
  587. begin
  588. Assign(f,ppufilename);
  589. {$push} {$I-}
  590. reset(f,1);
  591. {$pop}
  592. if ioresult=0 then
  593. begin
  594. FileAge := FileGetDate(GetFileHandle(f));
  595. close(f);
  596. reset(outfile,1);
  597. FileSetDate(GetFileHandle(outFile),FileAge);
  598. end;
  599. end;
  600. close(outfile);
  601. end;
  602. end;
  603. procedure TExternalAssembler.WriteSourceLine(hp: tailineinfo);
  604. begin
  605. { load infile }
  606. if lastfileinfo.fileindex<>hp.fileinfo.fileindex then
  607. begin
  608. infile:=current_module.sourcefiles.get_file(hp.fileinfo.fileindex);
  609. if assigned(infile) then
  610. begin
  611. { open only if needed !! }
  612. if (cs_asm_source in current_settings.globalswitches) then
  613. infile.open;
  614. end;
  615. { avoid unnecessary reopens of the same file !! }
  616. lastfileinfo.fileindex:=hp.fileinfo.fileindex;
  617. { be sure to change line !! }
  618. lastfileinfo.line:=-1;
  619. end;
  620. { write source }
  621. if (cs_asm_source in current_settings.globalswitches) and
  622. assigned(infile) then
  623. begin
  624. if (infile<>lastinfile) then
  625. begin
  626. AsmWriteLn(target_asm.comment+'['+infile.name+']');
  627. if assigned(lastinfile) then
  628. lastinfile.close;
  629. end;
  630. if (hp.fileinfo.line<>lastfileinfo.line) and
  631. (hp.fileinfo.line<infile.maxlinebuf) then
  632. begin
  633. if (hp.fileinfo.line<>0) and
  634. (infile.linebuf^[hp.fileinfo.line]>=0) then
  635. AsmWriteLn(target_asm.comment+'['+tostr(hp.fileinfo.line)+'] '+
  636. fixline(infile.GetLineStr(hp.fileinfo.line)));
  637. { set it to a negative value !
  638. to make that is has been read already !! PM }
  639. if (infile.linebuf^[hp.fileinfo.line]>=0) then
  640. infile.linebuf^[hp.fileinfo.line]:=-infile.linebuf^[hp.fileinfo.line]-1;
  641. end;
  642. end;
  643. lastfileinfo:=hp.fileinfo;
  644. lastinfile:=infile;
  645. end;
  646. procedure TExternalAssembler.WriteTempalloc(hp: tai_tempalloc);
  647. begin
  648. {$ifdef EXTDEBUG}
  649. if assigned(hp.problem) then
  650. AsmWriteLn(target_asm.comment+'Temp '+tostr(hp.temppos)+','+
  651. tostr(hp.tempsize)+' '+hp.problem^)
  652. else
  653. {$endif EXTDEBUG}
  654. AsmWriteLn(target_asm.comment+'Temp '+tostr(hp.temppos)+','+
  655. tostr(hp.tempsize)+' '+tempallocstr[hp.allocation]);
  656. end;
  657. procedure TExternalAssembler.WriteTree(p:TAsmList);
  658. begin
  659. end;
  660. procedure TExternalAssembler.WriteAsmList;
  661. begin
  662. end;
  663. procedure TExternalAssembler.MakeObject;
  664. begin
  665. AsmCreate(cut_normal);
  666. FillChar(lastfileinfo, sizeof(lastfileinfo), 0);
  667. lastfileinfo.line := -1;
  668. lastinfile := nil;
  669. lastsectype := sec_none;
  670. WriteAsmList;
  671. AsmClose;
  672. if not(ioerror) then
  673. DoAssemble;
  674. end;
  675. {*****************************************************************************
  676. TInternalAssembler
  677. *****************************************************************************}
  678. constructor TInternalAssembler.create(smart:boolean);
  679. begin
  680. inherited create(smart);
  681. ObjOutput:=nil;
  682. ObjData:=nil;
  683. SmartAsm:=smart;
  684. end;
  685. destructor TInternalAssembler.destroy;
  686. begin
  687. if assigned(ObjData) then
  688. ObjData.free;
  689. if assigned(ObjOutput) then
  690. ObjOutput.free;
  691. end;
  692. procedure TInternalAssembler.WriteStab(p:pchar);
  693. function consumecomma(var p:pchar):boolean;
  694. begin
  695. while (p^=' ') do
  696. inc(p);
  697. result:=(p^=',');
  698. inc(p);
  699. end;
  700. function consumenumber(var p:pchar;out value:longint):boolean;
  701. var
  702. hs : string;
  703. len,
  704. code : integer;
  705. begin
  706. value:=0;
  707. while (p^=' ') do
  708. inc(p);
  709. len:=0;
  710. while (p^ in ['0'..'9']) do
  711. begin
  712. inc(len);
  713. hs[len]:=p^;
  714. inc(p);
  715. end;
  716. if len>0 then
  717. begin
  718. hs[0]:=chr(len);
  719. val(hs,value,code);
  720. end
  721. else
  722. code:=-1;
  723. result:=(code=0);
  724. end;
  725. function consumeoffset(var p:pchar;out relocsym:tobjsymbol;out value:longint):boolean;
  726. var
  727. hs : string;
  728. len,
  729. code : integer;
  730. pstart : pchar;
  731. sym : tobjsymbol;
  732. exprvalue : longint;
  733. gotmin,
  734. have_first_symbol,
  735. have_second_symbol,
  736. dosub : boolean;
  737. begin
  738. result:=false;
  739. value:=0;
  740. relocsym:=nil;
  741. gotmin:=false;
  742. have_first_symbol:=false;
  743. have_second_symbol:=false;
  744. repeat
  745. dosub:=false;
  746. exprvalue:=0;
  747. if gotmin then
  748. begin
  749. dosub:=true;
  750. gotmin:=false;
  751. end;
  752. while (p^=' ') do
  753. inc(p);
  754. case p^ of
  755. #0 :
  756. break;
  757. ' ' :
  758. inc(p);
  759. '0'..'9' :
  760. begin
  761. len:=0;
  762. while (p^ in ['0'..'9']) do
  763. begin
  764. inc(len);
  765. hs[len]:=p^;
  766. inc(p);
  767. end;
  768. hs[0]:=chr(len);
  769. val(hs,exprvalue,code);
  770. if code<>0 then
  771. internalerror(200702251);
  772. end;
  773. '.','_',
  774. 'A'..'Z',
  775. 'a'..'z' :
  776. begin
  777. pstart:=p;
  778. while not(p^ in [#0,' ','-','+']) do
  779. inc(p);
  780. len:=p-pstart;
  781. if len>255 then
  782. internalerror(200509187);
  783. move(pstart^,hs[1],len);
  784. hs[0]:=chr(len);
  785. sym:=objdata.symbolref(hs);
  786. have_first_symbol:=true;
  787. { Second symbol? }
  788. if assigned(relocsym) then
  789. begin
  790. if have_second_symbol then
  791. internalerror(2007032201);
  792. have_second_symbol:=true;
  793. if not have_first_symbol then
  794. internalerror(2007032202);
  795. { second symbol should substracted to first }
  796. if not dosub then
  797. internalerror(2007032203);
  798. if (relocsym.objsection<>sym.objsection) then
  799. internalerror(2005091810);
  800. exprvalue:=relocsym.address-sym.address;
  801. relocsym:=nil;
  802. dosub:=false;
  803. end
  804. else
  805. begin
  806. relocsym:=sym;
  807. if assigned(sym.objsection) then
  808. begin
  809. { first symbol should be + }
  810. if not have_first_symbol and dosub then
  811. internalerror(2007032204);
  812. have_first_symbol:=true;
  813. end;
  814. end;
  815. end;
  816. '+' :
  817. begin
  818. { nothing, by default addition is done }
  819. inc(p);
  820. end;
  821. '-' :
  822. begin
  823. gotmin:=true;
  824. inc(p);
  825. end;
  826. else
  827. internalerror(200509189);
  828. end;
  829. if dosub then
  830. dec(value,exprvalue)
  831. else
  832. inc(value,exprvalue);
  833. until false;
  834. result:=true;
  835. end;
  836. var
  837. stabstrlen,
  838. ofs,
  839. nline,
  840. nidx,
  841. nother,
  842. i : longint;
  843. stab : TObjStabEntry;
  844. relocsym : TObjSymbol;
  845. pstr,
  846. pcurr,
  847. pendquote : pchar;
  848. oldsec : TObjSection;
  849. begin
  850. pcurr:=nil;
  851. pstr:=nil;
  852. pendquote:=nil;
  853. relocsym:=nil;
  854. ofs:=0;
  855. { Parse string part }
  856. if (p[0]='"') then
  857. begin
  858. pstr:=@p[1];
  859. { Ignore \" inside the string }
  860. i:=1;
  861. while not((p[i]='"') and (p[i-1]<>'\')) and
  862. (p[i]<>#0) do
  863. inc(i);
  864. pendquote:=@p[i];
  865. pendquote^:=#0;
  866. pcurr:=@p[i+1];
  867. if not consumecomma(pcurr) then
  868. internalerror(200509181);
  869. end
  870. else
  871. pcurr:=p;
  872. { When in pass 1 then only alloc and leave }
  873. if ObjData.currpass=1 then
  874. begin
  875. ObjData.StabsSec.Alloc(sizeof(TObjStabEntry));
  876. if assigned(pstr) and (pstr[0]<>#0) then
  877. ObjData.StabStrSec.Alloc(strlen(pstr)+1);
  878. end
  879. else
  880. begin
  881. { Stabs format: nidx,nother,nline[,offset] }
  882. if not consumenumber(pcurr,nidx) then
  883. internalerror(200509182);
  884. if not consumecomma(pcurr) then
  885. internalerror(200509183);
  886. if not consumenumber(pcurr,nother) then
  887. internalerror(200509184);
  888. if not consumecomma(pcurr) then
  889. internalerror(200509185);
  890. if not consumenumber(pcurr,nline) then
  891. internalerror(200509186);
  892. if consumecomma(pcurr) then
  893. consumeoffset(pcurr,relocsym,ofs);
  894. { Generate stab entry }
  895. if assigned(pstr) and (pstr[0]<>#0) then
  896. begin
  897. stabstrlen:=strlen(pstr);
  898. {$ifdef optimizestabs}
  899. StabStrEntry:=nil;
  900. if (nidx=N_SourceFile) or (nidx=N_IncludeFile) then
  901. begin
  902. hs:=strpas(pstr);
  903. StabstrEntry:=StabStrDict.Find(hs);
  904. if not assigned(StabstrEntry) then
  905. begin
  906. StabstrEntry:=TStabStrEntry.Create(hs);
  907. StabstrEntry:=StabStrSec.Size;
  908. StabStrDict.Insert(StabstrEntry);
  909. { generate new stab }
  910. StabstrEntry:=nil;
  911. end;
  912. end;
  913. if assigned(StabstrEntry) then
  914. stab.strpos:=StabstrEntry.strpos
  915. else
  916. {$endif optimizestabs}
  917. begin
  918. stab.strpos:=ObjData.StabStrSec.Size;
  919. ObjData.StabStrSec.write(pstr^,stabstrlen+1);
  920. end;
  921. end
  922. else
  923. stab.strpos:=0;
  924. stab.ntype:=byte(nidx);
  925. stab.ndesc:=word(nline);
  926. stab.nother:=byte(nother);
  927. stab.nvalue:=ofs;
  928. { Write the stab first without the value field. Then
  929. write a the value field with relocation }
  930. oldsec:=ObjData.CurrObjSec;
  931. ObjData.SetSection(ObjData.StabsSec);
  932. ObjData.Writebytes(stab,sizeof(TObjStabEntry)-4);
  933. ObjData.Writereloc(stab.nvalue,4,relocsym,RELOC_ABSOLUTE32);
  934. ObjData.setsection(oldsec);
  935. end;
  936. if assigned(pendquote) then
  937. pendquote^:='"';
  938. end;
  939. function TInternalAssembler.MaybeNextList(var hp:Tai):boolean;
  940. begin
  941. { maybe end of list }
  942. while not assigned(hp) do
  943. begin
  944. if currlistidx<lists then
  945. begin
  946. inc(currlistidx);
  947. currlist:=list[currlistidx];
  948. hp:=Tai(currList.first);
  949. end
  950. else
  951. begin
  952. MaybeNextList:=false;
  953. exit;
  954. end;
  955. end;
  956. MaybeNextList:=true;
  957. end;
  958. function TInternalAssembler.SetIndirectToSymbol(hp: Tai; const indirectname: string): Boolean;
  959. var
  960. objsym : TObjSymbol;
  961. indsym : TObjSymbol;
  962. begin
  963. Result:=
  964. Assigned(hp) and
  965. (hp.typ=ait_symbol);
  966. if not Result then
  967. Exit;
  968. objsym:=Objdata.SymbolRef(tai_symbol(hp).sym);
  969. objsym.size:=0;
  970. indsym := TObjSymbol(ObjData.ObjSymbolList.Find(indirectname));
  971. if not Assigned(indsym) then
  972. begin
  973. { it's possible that indirect symbol is not present in the list,
  974. so we must create it as undefined }
  975. indsym:=TObjSymbol.Create(ObjData.ObjSymbolList, indirectname);
  976. indsym.typ:=AT_NONE;
  977. indsym.bind:=AB_NONE;
  978. end;
  979. objsym.indsymbol:=indsym;
  980. Result:=true;
  981. end;
  982. function TInternalAssembler.TreePass0(hp:Tai):Tai;
  983. var
  984. objsym,
  985. objsymend : TObjSymbol;
  986. begin
  987. while assigned(hp) do
  988. begin
  989. case hp.typ of
  990. ait_align :
  991. begin
  992. if tai_align_abstract(hp).aligntype>1 then
  993. begin
  994. { always use the maximum fillsize in this pass to avoid possible
  995. short jumps to become out of range }
  996. Tai_align_abstract(hp).fillsize:=Tai_align_abstract(hp).aligntype;
  997. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  998. { may need to increase alignment of section }
  999. if tai_align_abstract(hp).aligntype>ObjData.CurrObjSec.secalign then
  1000. ObjData.CurrObjSec.secalign:=tai_align_abstract(hp).aligntype;
  1001. end
  1002. else
  1003. Tai_align_abstract(hp).fillsize:=0;
  1004. end;
  1005. ait_datablock :
  1006. begin
  1007. {$ifdef USE_COMM_IN_BSS}
  1008. if writingpackages and
  1009. Tai_datablock(hp).is_global then
  1010. ObjData.SymbolDefine(Tai_datablock(hp).sym)
  1011. else
  1012. {$endif USE_COMM_IN_BSS}
  1013. begin
  1014. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1015. ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1016. ObjData.alloc(Tai_datablock(hp).size);
  1017. end;
  1018. end;
  1019. ait_real_80bit :
  1020. ObjData.alloc(tai_real_80bit(hp).savesize);
  1021. ait_real_64bit :
  1022. ObjData.alloc(8);
  1023. ait_real_32bit :
  1024. ObjData.alloc(4);
  1025. ait_comp_64bit :
  1026. ObjData.alloc(8);
  1027. ait_const:
  1028. begin
  1029. { if symbols are provided we can calculate the value for relative symbols.
  1030. This is required for length calculation of leb128 constants }
  1031. if assigned(tai_const(hp).sym) then
  1032. begin
  1033. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1034. { objsym already defined and there is endsym? }
  1035. if assigned(objsym.objsection) and assigned(tai_const(hp).endsym) then
  1036. begin
  1037. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1038. { objsymend already defined? }
  1039. if assigned(objsymend.objsection) then
  1040. begin
  1041. if objsymend.objsection<>objsym.objsection then
  1042. begin
  1043. { leb128 relative constants are not relocatable, but other types are,
  1044. given that objsym belongs to the current section. }
  1045. if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or
  1046. (objsym.objsection<>ObjData.CurrObjSec) then
  1047. InternalError(200404124);
  1048. end
  1049. else
  1050. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1051. end;
  1052. end;
  1053. end;
  1054. ObjData.alloc(tai_const(hp).size);
  1055. end;
  1056. ait_directive:
  1057. begin
  1058. case tai_directive(hp).directive of
  1059. asd_indirect_symbol:
  1060. { handled in TreePass1 }
  1061. ;
  1062. asd_lazy_reference:
  1063. begin
  1064. if tai_directive(hp).name='' then
  1065. Internalerror(2009112101);
  1066. objsym:=ObjData.symbolref(tai_directive(hp).name);
  1067. objsym.bind:=AB_LAZY;
  1068. end;
  1069. asd_reference:
  1070. { ignore for now, but should be added}
  1071. ;
  1072. else
  1073. internalerror(2010011101);
  1074. end;
  1075. end;
  1076. ait_section:
  1077. begin
  1078. ObjData.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secorder);
  1079. Tai_section(hp).sec:=ObjData.CurrObjSec;
  1080. end;
  1081. ait_symbol :
  1082. begin
  1083. { needs extra support in the internal assembler }
  1084. { the value is just ignored }
  1085. {if tai_symbol(hp).has_value then
  1086. internalerror(2009090804); ;}
  1087. ObjData.SymbolDefine(Tai_symbol(hp).sym);
  1088. end;
  1089. ait_label :
  1090. ObjData.SymbolDefine(Tai_label(hp).labsym);
  1091. ait_string :
  1092. ObjData.alloc(Tai_string(hp).len);
  1093. ait_instruction :
  1094. begin
  1095. { reset instructions which could change in pass 2 }
  1096. Taicpu(hp).resetpass2;
  1097. ObjData.alloc(Taicpu(hp).Pass1(ObjData));
  1098. end;
  1099. ait_cutobject :
  1100. if SmartAsm then
  1101. break;
  1102. end;
  1103. hp:=Tai(hp.next);
  1104. end;
  1105. TreePass0:=hp;
  1106. end;
  1107. function TInternalAssembler.TreePass1(hp:Tai):Tai;
  1108. var
  1109. objsym,
  1110. objsymend : TObjSymbol;
  1111. begin
  1112. while assigned(hp) do
  1113. begin
  1114. case hp.typ of
  1115. ait_align :
  1116. begin
  1117. if tai_align_abstract(hp).aligntype>1 then
  1118. begin
  1119. { here we must determine the fillsize which is used in pass2 }
  1120. Tai_align_abstract(hp).fillsize:=align(ObjData.CurrObjSec.Size,Tai_align_abstract(hp).aligntype)-
  1121. ObjData.CurrObjSec.Size;
  1122. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  1123. end;
  1124. end;
  1125. ait_datablock :
  1126. begin
  1127. if (oso_data in ObjData.CurrObjSec.secoptions) then
  1128. Message(asmw_e_alloc_data_only_in_bss);
  1129. {$ifdef USE_COMM_IN_BSS}
  1130. if writingpackages and
  1131. Tai_datablock(hp).is_global then
  1132. begin
  1133. objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1134. objsym.size:=Tai_datablock(hp).size;
  1135. objsym.bind:=AB_COMMON;
  1136. objsym.alignment:=needtowritealignmentalsoforELF;
  1137. end
  1138. else
  1139. {$endif USE_COMM_IN_BSS}
  1140. begin
  1141. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1142. objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1143. objsym.size:=Tai_datablock(hp).size;
  1144. ObjData.alloc(Tai_datablock(hp).size);
  1145. end;
  1146. end;
  1147. ait_real_80bit :
  1148. ObjData.alloc(tai_real_80bit(hp).savesize);
  1149. ait_real_64bit :
  1150. ObjData.alloc(8);
  1151. ait_real_32bit :
  1152. ObjData.alloc(4);
  1153. ait_comp_64bit :
  1154. ObjData.alloc(8);
  1155. ait_const:
  1156. begin
  1157. { Recalculate relative symbols }
  1158. if assigned(tai_const(hp).sym) and
  1159. assigned(tai_const(hp).endsym) then
  1160. begin
  1161. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1162. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1163. if objsymend.objsection<>objsym.objsection then
  1164. begin
  1165. if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or
  1166. (objsym.objsection<>ObjData.CurrObjSec) then
  1167. internalerror(200905042);
  1168. end
  1169. else
  1170. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1171. end;
  1172. ObjData.alloc(tai_const(hp).size);
  1173. end;
  1174. ait_section:
  1175. begin
  1176. { use cached value }
  1177. ObjData.setsection(Tai_section(hp).sec);
  1178. end;
  1179. ait_stab :
  1180. begin
  1181. if assigned(Tai_stab(hp).str) then
  1182. WriteStab(Tai_stab(hp).str);
  1183. end;
  1184. ait_symbol :
  1185. ObjData.SymbolDefine(Tai_symbol(hp).sym);
  1186. ait_symbol_end :
  1187. begin
  1188. objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
  1189. objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
  1190. end;
  1191. ait_label :
  1192. ObjData.SymbolDefine(Tai_label(hp).labsym);
  1193. ait_string :
  1194. ObjData.alloc(Tai_string(hp).len);
  1195. ait_instruction :
  1196. ObjData.alloc(Taicpu(hp).Pass1(ObjData));
  1197. ait_cutobject :
  1198. if SmartAsm then
  1199. break;
  1200. ait_directive :
  1201. begin
  1202. case tai_directive(hp).directive of
  1203. asd_indirect_symbol:
  1204. if tai_directive(hp).name='' then
  1205. Internalerror(2009101103)
  1206. else if not SetIndirectToSymbol(Tai(hp.Previous), tai_directive(hp).name) then
  1207. Internalerror(2009101102);
  1208. asd_lazy_reference:
  1209. { handled in TreePass0 }
  1210. ;
  1211. asd_reference:
  1212. { ignore for now, but should be added}
  1213. ;
  1214. else
  1215. internalerror(2010011102);
  1216. end;
  1217. end;
  1218. end;
  1219. hp:=Tai(hp.next);
  1220. end;
  1221. TreePass1:=hp;
  1222. end;
  1223. function TInternalAssembler.TreePass2(hp:Tai):Tai;
  1224. var
  1225. fillbuffer : tfillbuffer;
  1226. {$ifdef x86}
  1227. co : comp;
  1228. {$endif x86}
  1229. leblen : byte;
  1230. lebbuf : array[0..63] of byte;
  1231. objsym,
  1232. objsymend : TObjSymbol;
  1233. zerobuf : array[0..63] of byte;
  1234. relative_reloc: boolean;
  1235. begin
  1236. fillchar(zerobuf,sizeof(zerobuf),0);
  1237. { main loop }
  1238. while assigned(hp) do
  1239. begin
  1240. case hp.typ of
  1241. ait_align :
  1242. begin
  1243. if tai_align_abstract(hp).aligntype>ObjData.CurrObjSec.secalign then
  1244. InternalError(2012072301);
  1245. if oso_data in ObjData.CurrObjSec.secoptions then
  1246. ObjData.writebytes(Tai_align_abstract(hp).calculatefillbuf(fillbuffer,oso_executable in ObjData.CurrObjSec.secoptions)^,
  1247. Tai_align_abstract(hp).fillsize)
  1248. else
  1249. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  1250. end;
  1251. ait_section :
  1252. begin
  1253. { use cached value }
  1254. ObjData.setsection(Tai_section(hp).sec);
  1255. end;
  1256. ait_symbol :
  1257. begin
  1258. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_symbol(hp).sym));
  1259. end;
  1260. ait_symbol_end :
  1261. begin
  1262. { recalculate size, as some preceding instructions
  1263. could have been changed to smaller size }
  1264. objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
  1265. objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
  1266. end;
  1267. ait_datablock :
  1268. begin
  1269. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_datablock(hp).sym));
  1270. {$ifdef USE_COMM_IN_BSS}
  1271. if not(writingpackages and
  1272. Tai_datablock(hp).is_global) then
  1273. {$endif USE_COMM_IN_BSS}
  1274. begin
  1275. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1276. ObjData.alloc(Tai_datablock(hp).size);
  1277. end;
  1278. end;
  1279. ait_real_80bit :
  1280. begin
  1281. ObjData.writebytes(Tai_real_80bit(hp).value,10);
  1282. ObjData.writebytes(zerobuf,Tai_real_80bit(hp).savesize-10);
  1283. end;
  1284. ait_real_64bit :
  1285. ObjData.writebytes(Tai_real_64bit(hp).value,8);
  1286. ait_real_32bit :
  1287. ObjData.writebytes(Tai_real_32bit(hp).value,4);
  1288. ait_comp_64bit :
  1289. begin
  1290. {$ifdef x86}
  1291. co:=comp(Tai_comp_64bit(hp).value);
  1292. ObjData.writebytes(co,8);
  1293. {$endif x86}
  1294. end;
  1295. ait_string :
  1296. ObjData.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
  1297. ait_const :
  1298. begin
  1299. { Recalculate relative symbols, addresses of forward references
  1300. can be changed in treepass1 }
  1301. relative_reloc:=false;
  1302. if assigned(tai_const(hp).sym) and
  1303. assigned(tai_const(hp).endsym) then
  1304. begin
  1305. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1306. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1307. relative_reloc:=(objsym.objsection<>objsymend.objsection);
  1308. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1309. end;
  1310. case tai_const(hp).consttype of
  1311. aitconst_64bit,
  1312. aitconst_32bit,
  1313. aitconst_16bit,
  1314. aitconst_64bit_unaligned,
  1315. aitconst_32bit_unaligned,
  1316. aitconst_16bit_unaligned,
  1317. aitconst_8bit :
  1318. begin
  1319. if assigned(tai_const(hp).sym) and
  1320. not assigned(tai_const(hp).endsym) then
  1321. ObjData.writereloc(Tai_const(hp).symofs,tai_const(hp).size,Objdata.SymbolRef(tai_const(hp).sym),RELOC_ABSOLUTE)
  1322. else if relative_reloc then
  1323. ObjData.writereloc(ObjData.CurrObjSec.size+tai_const(hp).size-objsym.address+tai_const(hp).symofs,tai_const(hp).size,objsymend,RELOC_RELATIVE)
  1324. else
  1325. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  1326. end;
  1327. aitconst_rva_symbol :
  1328. begin
  1329. { PE32+? }
  1330. if target_info.system=system_x86_64_win64 then
  1331. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA)
  1332. else
  1333. ObjData.writereloc(Tai_const(hp).symofs,sizeof(pint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA);
  1334. end;
  1335. aitconst_secrel32_symbol :
  1336. begin
  1337. { Required for DWARF2 support under Windows }
  1338. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_SECREL32);
  1339. end;
  1340. aitconst_uleb128bit,
  1341. aitconst_sleb128bit :
  1342. begin
  1343. if tai_const(hp).consttype=aitconst_uleb128bit then
  1344. leblen:=EncodeUleb128(qword(Tai_const(hp).value),lebbuf)
  1345. else
  1346. leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf);
  1347. if leblen<>tai_const(hp).size then
  1348. internalerror(200709271);
  1349. ObjData.writebytes(lebbuf,leblen);
  1350. end;
  1351. aitconst_darwin_dwarf_delta32,
  1352. aitconst_darwin_dwarf_delta64:
  1353. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  1354. else
  1355. internalerror(200603254);
  1356. end;
  1357. end;
  1358. ait_label :
  1359. begin
  1360. { exporting shouldn't be necessary as labels are local,
  1361. but it's better to be on the safe side (PFV) }
  1362. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_label(hp).labsym));
  1363. end;
  1364. ait_instruction :
  1365. Taicpu(hp).Pass2(ObjData);
  1366. ait_stab :
  1367. WriteStab(Tai_stab(hp).str);
  1368. ait_function_name,
  1369. ait_force_line : ;
  1370. ait_cutobject :
  1371. if SmartAsm then
  1372. break;
  1373. {$ifdef TEST_WIN64_SEH}
  1374. ait_seh_directive :
  1375. tai_seh_directive(hp).generate_code(objdata);
  1376. {$endif TEST_WIN64_SEH}
  1377. end;
  1378. hp:=Tai(hp.next);
  1379. end;
  1380. TreePass2:=hp;
  1381. end;
  1382. procedure TInternalAssembler.writetree;
  1383. label
  1384. doexit;
  1385. var
  1386. hp : Tai;
  1387. ObjWriter : TObjectWriter;
  1388. begin
  1389. ObjWriter:=TObjectwriter.create;
  1390. ObjOutput:=CObjOutput.Create(ObjWriter);
  1391. ObjData:=ObjOutput.newObjData(ObjFileName);
  1392. { Pass 0 }
  1393. ObjData.currpass:=0;
  1394. ObjData.createsection(sec_code);
  1395. ObjData.beforealloc;
  1396. { start with list 1 }
  1397. currlistidx:=1;
  1398. currlist:=list[currlistidx];
  1399. hp:=Tai(currList.first);
  1400. while assigned(hp) do
  1401. begin
  1402. hp:=TreePass0(hp);
  1403. MaybeNextList(hp);
  1404. end;
  1405. ObjData.afteralloc;
  1406. { leave if errors have occured }
  1407. if errorcount>0 then
  1408. goto doexit;
  1409. { Pass 1 }
  1410. ObjData.currpass:=1;
  1411. ObjData.resetsections;
  1412. ObjData.beforealloc;
  1413. ObjData.createsection(sec_code);
  1414. { start with list 1 }
  1415. currlistidx:=1;
  1416. currlist:=list[currlistidx];
  1417. hp:=Tai(currList.first);
  1418. while assigned(hp) do
  1419. begin
  1420. hp:=TreePass1(hp);
  1421. MaybeNextList(hp);
  1422. end;
  1423. ObjData.createsection(sec_code);
  1424. ObjData.afteralloc;
  1425. { leave if errors have occured }
  1426. if errorcount>0 then
  1427. goto doexit;
  1428. { Pass 2 }
  1429. ObjData.currpass:=2;
  1430. ObjData.resetsections;
  1431. ObjData.beforewrite;
  1432. ObjData.createsection(sec_code);
  1433. { start with list 1 }
  1434. currlistidx:=1;
  1435. currlist:=list[currlistidx];
  1436. hp:=Tai(currList.first);
  1437. while assigned(hp) do
  1438. begin
  1439. hp:=TreePass2(hp);
  1440. MaybeNextList(hp);
  1441. end;
  1442. ObjData.createsection(sec_code);
  1443. ObjData.afterwrite;
  1444. { don't write the .o file if errors have occured }
  1445. if errorcount=0 then
  1446. begin
  1447. { write objectfile }
  1448. ObjOutput.startobjectfile(ObjFileName);
  1449. ObjOutput.writeobjectfile(ObjData);
  1450. end;
  1451. doexit:
  1452. { Cleanup }
  1453. ObjData.free;
  1454. ObjData:=nil;
  1455. ObjWriter.free;
  1456. end;
  1457. procedure TInternalAssembler.writetreesmart;
  1458. var
  1459. hp : Tai;
  1460. startsectype : TAsmSectiontype;
  1461. place: tcutplace;
  1462. ObjWriter : TObjectWriter;
  1463. begin
  1464. if not(cs_asm_leave in current_settings.globalswitches) then
  1465. ObjWriter:=TARObjectWriter.create(current_module.staticlibfilename)
  1466. else
  1467. ObjWriter:=TObjectwriter.create;
  1468. NextSmartName(cut_normal);
  1469. ObjOutput:=CObjOutput.Create(ObjWriter);
  1470. startsectype:=sec_code;
  1471. { start with list 1 }
  1472. currlistidx:=1;
  1473. currlist:=list[currlistidx];
  1474. hp:=Tai(currList.first);
  1475. while assigned(hp) do
  1476. begin
  1477. ObjData:=ObjOutput.newObjData(ObjFileName);
  1478. { Pass 0 }
  1479. ObjData.currpass:=0;
  1480. ObjData.resetsections;
  1481. ObjData.beforealloc;
  1482. ObjData.createsection(startsectype);
  1483. TreePass0(hp);
  1484. ObjData.afteralloc;
  1485. { leave if errors have occured }
  1486. if errorcount>0 then
  1487. break;
  1488. { Pass 1 }
  1489. ObjData.currpass:=1;
  1490. ObjData.resetsections;
  1491. ObjData.beforealloc;
  1492. ObjData.createsection(startsectype);
  1493. TreePass1(hp);
  1494. ObjData.afteralloc;
  1495. { leave if errors have occured }
  1496. if errorcount>0 then
  1497. break;
  1498. { Pass 2 }
  1499. ObjData.currpass:=2;
  1500. ObjOutput.startobjectfile(ObjFileName);
  1501. ObjData.resetsections;
  1502. ObjData.beforewrite;
  1503. ObjData.createsection(startsectype);
  1504. hp:=TreePass2(hp);
  1505. ObjData.afterwrite;
  1506. { leave if errors have occured }
  1507. if errorcount>0 then
  1508. break;
  1509. { write the current objectfile }
  1510. ObjOutput.writeobjectfile(ObjData);
  1511. ObjData.free;
  1512. ObjData:=nil;
  1513. { end of lists? }
  1514. if not MaybeNextList(hp) then
  1515. break;
  1516. { we will start a new objectfile so reset everything }
  1517. { The place can still change in the next while loop, so don't init }
  1518. { the writer yet (JM) }
  1519. if (hp.typ=ait_cutobject) then
  1520. place := Tai_cutobject(hp).place
  1521. else
  1522. place := cut_normal;
  1523. { avoid empty files }
  1524. startsectype:=sec_code;
  1525. while assigned(hp) and
  1526. (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cutobject]) do
  1527. begin
  1528. if Tai(hp).typ=ait_section then
  1529. startsectype:=Tai_section(hp).sectype;
  1530. if (Tai(hp).typ=ait_cutobject) then
  1531. place:=Tai_cutobject(hp).place;
  1532. hp:=Tai(hp.next);
  1533. end;
  1534. if not MaybeNextList(hp) then
  1535. break;
  1536. { start next objectfile }
  1537. NextSmartName(place);
  1538. end;
  1539. ObjData.free;
  1540. ObjData:=nil;
  1541. ObjWriter.free;
  1542. end;
  1543. procedure TInternalAssembler.MakeObject;
  1544. var to_do:set of TasmlistType;
  1545. i:TasmlistType;
  1546. procedure addlist(p:TAsmList);
  1547. begin
  1548. inc(lists);
  1549. list[lists]:=p;
  1550. end;
  1551. begin
  1552. to_do:=[low(Tasmlisttype)..high(Tasmlisttype)];
  1553. if usedeffileforexports then
  1554. exclude(to_do,al_exports);
  1555. if not(tf_section_threadvars in target_info.flags) then
  1556. exclude(to_do,al_threadvars);
  1557. for i:=low(TasmlistType) to high(TasmlistType) do
  1558. if (i in to_do) and (current_asmdata.asmlists[i]<>nil) then
  1559. addlist(current_asmdata.asmlists[i]);
  1560. if SmartAsm then
  1561. writetreesmart
  1562. else
  1563. writetree;
  1564. end;
  1565. {*****************************************************************************
  1566. Generate Assembler Files Main Procedure
  1567. *****************************************************************************}
  1568. Procedure GenerateAsm(smart:boolean);
  1569. var
  1570. a : TAssembler;
  1571. begin
  1572. if not assigned(CAssembler[target_asm.id]) then
  1573. Message(asmw_f_assembler_output_not_supported);
  1574. a:=CAssembler[target_asm.id].Create(smart);
  1575. a.MakeObject;
  1576. a.Free;
  1577. end;
  1578. Procedure OnlyAsm;
  1579. var
  1580. a : TExternalAssembler;
  1581. begin
  1582. a:=TExternalAssembler.Create(false);
  1583. a.DoAssemble;
  1584. a.Free;
  1585. end;
  1586. {*****************************************************************************
  1587. Init/Done
  1588. *****************************************************************************}
  1589. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  1590. var
  1591. t : tasm;
  1592. begin
  1593. t:=r.id;
  1594. if assigned(asminfos[t]) then
  1595. writeln('Warning: Assembler is already registered!')
  1596. else
  1597. Getmem(asminfos[t],sizeof(tasminfo));
  1598. asminfos[t]^:=r;
  1599. CAssembler[t]:=c;
  1600. end;
  1601. end.