assemble.pas 55 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747
  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. end
  999. else
  1000. Tai_align_abstract(hp).fillsize:=0;
  1001. end;
  1002. ait_datablock :
  1003. begin
  1004. {$ifdef USE_COMM_IN_BSS}
  1005. if writingpackages and
  1006. Tai_datablock(hp).is_global then
  1007. ObjData.SymbolDefine(Tai_datablock(hp).sym)
  1008. else
  1009. {$endif USE_COMM_IN_BSS}
  1010. begin
  1011. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1012. ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1013. ObjData.alloc(Tai_datablock(hp).size);
  1014. end;
  1015. end;
  1016. ait_real_80bit :
  1017. ObjData.alloc(tai_real_80bit(hp).savesize);
  1018. ait_real_64bit :
  1019. ObjData.alloc(8);
  1020. ait_real_32bit :
  1021. ObjData.alloc(4);
  1022. ait_comp_64bit :
  1023. ObjData.alloc(8);
  1024. ait_const:
  1025. begin
  1026. { if symbols are provided we can calculate the value for relative symbols.
  1027. This is required for length calculation of leb128 constants }
  1028. if assigned(tai_const(hp).sym) then
  1029. begin
  1030. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1031. { objsym already defined and there is endsym? }
  1032. if assigned(objsym.objsection) and assigned(tai_const(hp).endsym) then
  1033. begin
  1034. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1035. { objsymend already defined? }
  1036. if assigned(objsymend.objsection) then
  1037. begin
  1038. if objsymend.objsection<>objsym.objsection then
  1039. begin
  1040. { leb128 relative constants are not relocatable, but other types are,
  1041. given that objsym belongs to the current section. }
  1042. if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or
  1043. (objsym.objsection<>ObjData.CurrObjSec) then
  1044. InternalError(200404124);
  1045. end
  1046. else
  1047. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1048. end;
  1049. end;
  1050. end;
  1051. ObjData.alloc(tai_const(hp).size);
  1052. end;
  1053. ait_directive:
  1054. begin
  1055. case tai_directive(hp).directive of
  1056. asd_indirect_symbol:
  1057. { handled in TreePass1 }
  1058. ;
  1059. asd_lazy_reference:
  1060. begin
  1061. if tai_directive(hp).name='' then
  1062. Internalerror(2009112101);
  1063. objsym:=ObjData.symbolref(tai_directive(hp).name);
  1064. objsym.bind:=AB_LAZY;
  1065. end;
  1066. asd_reference:
  1067. { ignore for now, but should be added}
  1068. ;
  1069. else
  1070. internalerror(2010011101);
  1071. end;
  1072. end;
  1073. ait_section:
  1074. begin
  1075. ObjData.CreateSection(Tai_section(hp).sectype,Tai_section(hp).name^,Tai_section(hp).secorder);
  1076. Tai_section(hp).sec:=ObjData.CurrObjSec;
  1077. end;
  1078. ait_symbol :
  1079. begin
  1080. { needs extra support in the internal assembler }
  1081. { the value is just ignored }
  1082. {if tai_symbol(hp).has_value then
  1083. internalerror(2009090804); ;}
  1084. ObjData.SymbolDefine(Tai_symbol(hp).sym);
  1085. end;
  1086. ait_label :
  1087. ObjData.SymbolDefine(Tai_label(hp).labsym);
  1088. ait_string :
  1089. ObjData.alloc(Tai_string(hp).len);
  1090. ait_instruction :
  1091. begin
  1092. { reset instructions which could change in pass 2 }
  1093. Taicpu(hp).resetpass2;
  1094. ObjData.alloc(Taicpu(hp).Pass1(ObjData));
  1095. end;
  1096. ait_cutobject :
  1097. if SmartAsm then
  1098. break;
  1099. end;
  1100. hp:=Tai(hp.next);
  1101. end;
  1102. TreePass0:=hp;
  1103. end;
  1104. function TInternalAssembler.TreePass1(hp:Tai):Tai;
  1105. var
  1106. objsym,
  1107. objsymend : TObjSymbol;
  1108. begin
  1109. while assigned(hp) do
  1110. begin
  1111. case hp.typ of
  1112. ait_align :
  1113. begin
  1114. if tai_align_abstract(hp).aligntype>1 then
  1115. begin
  1116. { here we must determine the fillsize which is used in pass2 }
  1117. Tai_align_abstract(hp).fillsize:=align(ObjData.CurrObjSec.Size,Tai_align_abstract(hp).aligntype)-
  1118. ObjData.CurrObjSec.Size;
  1119. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  1120. end;
  1121. end;
  1122. ait_datablock :
  1123. begin
  1124. if (oso_data in ObjData.CurrObjSec.secoptions) then
  1125. Message(asmw_e_alloc_data_only_in_bss);
  1126. {$ifdef USE_COMM_IN_BSS}
  1127. if writingpackages and
  1128. Tai_datablock(hp).is_global then
  1129. begin
  1130. objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1131. objsym.size:=Tai_datablock(hp).size;
  1132. objsym.bind:=AB_COMMON;
  1133. objsym.alignment:=needtowritealignmentalsoforELF;
  1134. end
  1135. else
  1136. {$endif USE_COMM_IN_BSS}
  1137. begin
  1138. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1139. objsym:=ObjData.SymbolDefine(Tai_datablock(hp).sym);
  1140. objsym.size:=Tai_datablock(hp).size;
  1141. ObjData.alloc(Tai_datablock(hp).size);
  1142. end;
  1143. end;
  1144. ait_real_80bit :
  1145. ObjData.alloc(tai_real_80bit(hp).savesize);
  1146. ait_real_64bit :
  1147. ObjData.alloc(8);
  1148. ait_real_32bit :
  1149. ObjData.alloc(4);
  1150. ait_comp_64bit :
  1151. ObjData.alloc(8);
  1152. ait_const:
  1153. begin
  1154. { Recalculate relative symbols }
  1155. if assigned(tai_const(hp).sym) and
  1156. assigned(tai_const(hp).endsym) then
  1157. begin
  1158. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1159. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1160. if objsymend.objsection<>objsym.objsection then
  1161. begin
  1162. if (Tai_const(hp).consttype in [aitconst_uleb128bit,aitconst_sleb128bit]) or
  1163. (objsym.objsection<>ObjData.CurrObjSec) then
  1164. internalerror(200905042);
  1165. end
  1166. else
  1167. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1168. end;
  1169. ObjData.alloc(tai_const(hp).size);
  1170. end;
  1171. ait_section:
  1172. begin
  1173. { use cached value }
  1174. ObjData.setsection(Tai_section(hp).sec);
  1175. end;
  1176. ait_stab :
  1177. begin
  1178. if assigned(Tai_stab(hp).str) then
  1179. WriteStab(Tai_stab(hp).str);
  1180. end;
  1181. ait_symbol :
  1182. ObjData.SymbolDefine(Tai_symbol(hp).sym);
  1183. ait_symbol_end :
  1184. begin
  1185. objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
  1186. objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
  1187. end;
  1188. ait_label :
  1189. ObjData.SymbolDefine(Tai_label(hp).labsym);
  1190. ait_string :
  1191. ObjData.alloc(Tai_string(hp).len);
  1192. ait_instruction :
  1193. ObjData.alloc(Taicpu(hp).Pass1(ObjData));
  1194. ait_cutobject :
  1195. if SmartAsm then
  1196. break;
  1197. ait_directive :
  1198. begin
  1199. case tai_directive(hp).directive of
  1200. asd_indirect_symbol:
  1201. if tai_directive(hp).name='' then
  1202. Internalerror(2009101103)
  1203. else if not SetIndirectToSymbol(Tai(hp.Previous), tai_directive(hp).name) then
  1204. Internalerror(2009101102);
  1205. asd_lazy_reference:
  1206. { handled in TreePass0 }
  1207. ;
  1208. asd_reference:
  1209. { ignore for now, but should be added}
  1210. ;
  1211. else
  1212. internalerror(2010011102);
  1213. end;
  1214. end;
  1215. end;
  1216. hp:=Tai(hp.next);
  1217. end;
  1218. TreePass1:=hp;
  1219. end;
  1220. function TInternalAssembler.TreePass2(hp:Tai):Tai;
  1221. var
  1222. fillbuffer : tfillbuffer;
  1223. {$ifdef x86}
  1224. co : comp;
  1225. {$endif x86}
  1226. leblen : byte;
  1227. lebbuf : array[0..63] of byte;
  1228. objsym,
  1229. objsymend : TObjSymbol;
  1230. zerobuf : array[0..63] of byte;
  1231. relative_reloc: boolean;
  1232. begin
  1233. fillchar(zerobuf,sizeof(zerobuf),0);
  1234. { main loop }
  1235. while assigned(hp) do
  1236. begin
  1237. case hp.typ of
  1238. ait_align :
  1239. begin
  1240. if oso_data in ObjData.CurrObjSec.secoptions then
  1241. ObjData.writebytes(Tai_align_abstract(hp).calculatefillbuf(fillbuffer,oso_executable in ObjData.CurrObjSec.secoptions)^,
  1242. Tai_align_abstract(hp).fillsize)
  1243. else
  1244. ObjData.alloc(Tai_align_abstract(hp).fillsize);
  1245. end;
  1246. ait_section :
  1247. begin
  1248. { use cached value }
  1249. ObjData.setsection(Tai_section(hp).sec);
  1250. end;
  1251. ait_symbol :
  1252. begin
  1253. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_symbol(hp).sym));
  1254. end;
  1255. ait_symbol_end :
  1256. begin
  1257. { recalculate size, as some preceding instructions
  1258. could have been changed to smaller size }
  1259. objsym:=ObjData.SymbolRef(Tai_symbol_end(hp).sym);
  1260. objsym.size:=ObjData.CurrObjSec.Size-objsym.offset;
  1261. end;
  1262. ait_datablock :
  1263. begin
  1264. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_datablock(hp).sym));
  1265. {$ifdef USE_COMM_IN_BSS}
  1266. if not(writingpackages and
  1267. Tai_datablock(hp).is_global) then
  1268. {$endif USE_COMM_IN_BSS}
  1269. begin
  1270. ObjData.allocalign(used_align(size_2_align(Tai_datablock(hp).size),0,ObjData.CurrObjSec.secalign));
  1271. ObjData.alloc(Tai_datablock(hp).size);
  1272. end;
  1273. end;
  1274. ait_real_80bit :
  1275. begin
  1276. ObjData.writebytes(Tai_real_80bit(hp).value,10);
  1277. ObjData.writebytes(zerobuf,Tai_real_80bit(hp).savesize-10);
  1278. end;
  1279. ait_real_64bit :
  1280. ObjData.writebytes(Tai_real_64bit(hp).value,8);
  1281. ait_real_32bit :
  1282. ObjData.writebytes(Tai_real_32bit(hp).value,4);
  1283. ait_comp_64bit :
  1284. begin
  1285. {$ifdef x86}
  1286. co:=comp(Tai_comp_64bit(hp).value);
  1287. ObjData.writebytes(co,8);
  1288. {$endif x86}
  1289. end;
  1290. ait_string :
  1291. ObjData.writebytes(Tai_string(hp).str^,Tai_string(hp).len);
  1292. ait_const :
  1293. begin
  1294. { Recalculate relative symbols, addresses of forward references
  1295. can be changed in treepass1 }
  1296. relative_reloc:=false;
  1297. if assigned(tai_const(hp).sym) and
  1298. assigned(tai_const(hp).endsym) then
  1299. begin
  1300. objsym:=Objdata.SymbolRef(tai_const(hp).sym);
  1301. objsymend:=Objdata.SymbolRef(tai_const(hp).endsym);
  1302. relative_reloc:=(objsym.objsection<>objsymend.objsection);
  1303. Tai_const(hp).value:=objsymend.address-objsym.address+Tai_const(hp).symofs;
  1304. end;
  1305. case tai_const(hp).consttype of
  1306. aitconst_64bit,
  1307. aitconst_32bit,
  1308. aitconst_16bit,
  1309. aitconst_8bit :
  1310. begin
  1311. if assigned(tai_const(hp).sym) and
  1312. not assigned(tai_const(hp).endsym) then
  1313. ObjData.writereloc(Tai_const(hp).symofs,tai_const(hp).size,Objdata.SymbolRef(tai_const(hp).sym),RELOC_ABSOLUTE)
  1314. else if relative_reloc then
  1315. ObjData.writereloc(ObjData.CurrObjSec.size+tai_const(hp).size-objsym.address+tai_const(hp).symofs,tai_const(hp).size,objsymend,RELOC_RELATIVE)
  1316. else
  1317. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  1318. end;
  1319. aitconst_rva_symbol :
  1320. begin
  1321. { PE32+? }
  1322. if target_info.system=system_x86_64_win64 then
  1323. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA)
  1324. else
  1325. ObjData.writereloc(Tai_const(hp).symofs,sizeof(pint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_RVA);
  1326. end;
  1327. aitconst_secrel32_symbol :
  1328. begin
  1329. { Required for DWARF2 support under Windows }
  1330. ObjData.writereloc(Tai_const(hp).symofs,sizeof(longint),Objdata.SymbolRef(tai_const(hp).sym),RELOC_SECREL32);
  1331. end;
  1332. aitconst_uleb128bit,
  1333. aitconst_sleb128bit :
  1334. begin
  1335. if tai_const(hp).consttype=aitconst_uleb128bit then
  1336. leblen:=EncodeUleb128(qword(Tai_const(hp).value),lebbuf)
  1337. else
  1338. leblen:=EncodeSleb128(Tai_const(hp).value,lebbuf);
  1339. if leblen<>tai_const(hp).size then
  1340. internalerror(200709271);
  1341. ObjData.writebytes(lebbuf,leblen);
  1342. end;
  1343. aitconst_darwin_dwarf_delta32,
  1344. aitconst_darwin_dwarf_delta64:
  1345. ObjData.writebytes(Tai_const(hp).value,tai_const(hp).size);
  1346. else
  1347. internalerror(200603254);
  1348. end;
  1349. end;
  1350. ait_label :
  1351. begin
  1352. { exporting shouldn't be necessary as labels are local,
  1353. but it's better to be on the safe side (PFV) }
  1354. ObjOutput.exportsymbol(ObjData.SymbolRef(Tai_label(hp).labsym));
  1355. end;
  1356. ait_instruction :
  1357. Taicpu(hp).Pass2(ObjData);
  1358. ait_stab :
  1359. WriteStab(Tai_stab(hp).str);
  1360. ait_function_name,
  1361. ait_force_line : ;
  1362. ait_cutobject :
  1363. if SmartAsm then
  1364. break;
  1365. {$ifdef TEST_WIN64_SEH}
  1366. ait_seh_directive :
  1367. tai_seh_directive(hp).generate_code(objdata);
  1368. {$endif TEST_WIN64_SEH}
  1369. end;
  1370. hp:=Tai(hp.next);
  1371. end;
  1372. TreePass2:=hp;
  1373. end;
  1374. procedure TInternalAssembler.writetree;
  1375. label
  1376. doexit;
  1377. var
  1378. hp : Tai;
  1379. ObjWriter : TObjectWriter;
  1380. begin
  1381. ObjWriter:=TObjectwriter.create;
  1382. ObjOutput:=CObjOutput.Create(ObjWriter);
  1383. ObjData:=ObjOutput.newObjData(ObjFileName);
  1384. { Pass 0 }
  1385. ObjData.currpass:=0;
  1386. ObjData.createsection(sec_code);
  1387. ObjData.beforealloc;
  1388. { start with list 1 }
  1389. currlistidx:=1;
  1390. currlist:=list[currlistidx];
  1391. hp:=Tai(currList.first);
  1392. while assigned(hp) do
  1393. begin
  1394. hp:=TreePass0(hp);
  1395. MaybeNextList(hp);
  1396. end;
  1397. ObjData.afteralloc;
  1398. { leave if errors have occured }
  1399. if errorcount>0 then
  1400. goto doexit;
  1401. { Pass 1 }
  1402. ObjData.currpass:=1;
  1403. ObjData.resetsections;
  1404. ObjData.beforealloc;
  1405. ObjData.createsection(sec_code);
  1406. { start with list 1 }
  1407. currlistidx:=1;
  1408. currlist:=list[currlistidx];
  1409. hp:=Tai(currList.first);
  1410. while assigned(hp) do
  1411. begin
  1412. hp:=TreePass1(hp);
  1413. MaybeNextList(hp);
  1414. end;
  1415. ObjData.createsection(sec_code);
  1416. ObjData.afteralloc;
  1417. { leave if errors have occured }
  1418. if errorcount>0 then
  1419. goto doexit;
  1420. { Pass 2 }
  1421. ObjData.currpass:=2;
  1422. ObjData.resetsections;
  1423. ObjData.beforewrite;
  1424. ObjData.createsection(sec_code);
  1425. { start with list 1 }
  1426. currlistidx:=1;
  1427. currlist:=list[currlistidx];
  1428. hp:=Tai(currList.first);
  1429. while assigned(hp) do
  1430. begin
  1431. hp:=TreePass2(hp);
  1432. MaybeNextList(hp);
  1433. end;
  1434. ObjData.createsection(sec_code);
  1435. ObjData.afterwrite;
  1436. { don't write the .o file if errors have occured }
  1437. if errorcount=0 then
  1438. begin
  1439. { write objectfile }
  1440. ObjOutput.startobjectfile(ObjFileName);
  1441. ObjOutput.writeobjectfile(ObjData);
  1442. end;
  1443. doexit:
  1444. { Cleanup }
  1445. ObjData.free;
  1446. ObjData:=nil;
  1447. ObjWriter.free;
  1448. end;
  1449. procedure TInternalAssembler.writetreesmart;
  1450. var
  1451. hp : Tai;
  1452. startsectype : TAsmSectiontype;
  1453. place: tcutplace;
  1454. ObjWriter : TObjectWriter;
  1455. begin
  1456. if not(cs_asm_leave in current_settings.globalswitches) then
  1457. ObjWriter:=TARObjectWriter.create(current_module.staticlibfilename)
  1458. else
  1459. ObjWriter:=TObjectwriter.create;
  1460. NextSmartName(cut_normal);
  1461. ObjOutput:=CObjOutput.Create(ObjWriter);
  1462. startsectype:=sec_code;
  1463. { start with list 1 }
  1464. currlistidx:=1;
  1465. currlist:=list[currlistidx];
  1466. hp:=Tai(currList.first);
  1467. while assigned(hp) do
  1468. begin
  1469. ObjData:=ObjOutput.newObjData(ObjFileName);
  1470. { Pass 0 }
  1471. ObjData.currpass:=0;
  1472. ObjData.resetsections;
  1473. ObjData.beforealloc;
  1474. ObjData.createsection(startsectype);
  1475. TreePass0(hp);
  1476. ObjData.afteralloc;
  1477. { leave if errors have occured }
  1478. if errorcount>0 then
  1479. break;
  1480. { Pass 1 }
  1481. ObjData.currpass:=1;
  1482. ObjData.resetsections;
  1483. ObjData.beforealloc;
  1484. ObjData.createsection(startsectype);
  1485. TreePass1(hp);
  1486. ObjData.afteralloc;
  1487. { leave if errors have occured }
  1488. if errorcount>0 then
  1489. break;
  1490. { Pass 2 }
  1491. ObjData.currpass:=2;
  1492. ObjOutput.startobjectfile(ObjFileName);
  1493. ObjData.resetsections;
  1494. ObjData.beforewrite;
  1495. ObjData.createsection(startsectype);
  1496. hp:=TreePass2(hp);
  1497. ObjData.afterwrite;
  1498. { leave if errors have occured }
  1499. if errorcount>0 then
  1500. break;
  1501. { write the current objectfile }
  1502. ObjOutput.writeobjectfile(ObjData);
  1503. ObjData.free;
  1504. ObjData:=nil;
  1505. { end of lists? }
  1506. if not MaybeNextList(hp) then
  1507. break;
  1508. { we will start a new objectfile so reset everything }
  1509. { The place can still change in the next while loop, so don't init }
  1510. { the writer yet (JM) }
  1511. if (hp.typ=ait_cutobject) then
  1512. place := Tai_cutobject(hp).place
  1513. else
  1514. place := cut_normal;
  1515. { avoid empty files }
  1516. startsectype:=sec_code;
  1517. while assigned(hp) and
  1518. (Tai(hp).typ in [ait_marker,ait_comment,ait_section,ait_cutobject]) do
  1519. begin
  1520. if Tai(hp).typ=ait_section then
  1521. startsectype:=Tai_section(hp).sectype;
  1522. if (Tai(hp).typ=ait_cutobject) then
  1523. place:=Tai_cutobject(hp).place;
  1524. hp:=Tai(hp.next);
  1525. end;
  1526. if not MaybeNextList(hp) then
  1527. break;
  1528. { start next objectfile }
  1529. NextSmartName(place);
  1530. end;
  1531. ObjData.free;
  1532. ObjData:=nil;
  1533. ObjWriter.free;
  1534. end;
  1535. procedure TInternalAssembler.MakeObject;
  1536. var to_do:set of TasmlistType;
  1537. i:TasmlistType;
  1538. procedure addlist(p:TAsmList);
  1539. begin
  1540. inc(lists);
  1541. list[lists]:=p;
  1542. end;
  1543. begin
  1544. to_do:=[low(Tasmlisttype)..high(Tasmlisttype)];
  1545. if usedeffileforexports then
  1546. exclude(to_do,al_exports);
  1547. if not(tf_section_threadvars in target_info.flags) then
  1548. exclude(to_do,al_threadvars);
  1549. for i:=low(TasmlistType) to high(TasmlistType) do
  1550. if (i in to_do) and (current_asmdata.asmlists[i]<>nil) then
  1551. addlist(current_asmdata.asmlists[i]);
  1552. if SmartAsm then
  1553. writetreesmart
  1554. else
  1555. writetree;
  1556. end;
  1557. {*****************************************************************************
  1558. Generate Assembler Files Main Procedure
  1559. *****************************************************************************}
  1560. Procedure GenerateAsm(smart:boolean);
  1561. var
  1562. a : TAssembler;
  1563. begin
  1564. if not assigned(CAssembler[target_asm.id]) then
  1565. Message(asmw_f_assembler_output_not_supported);
  1566. a:=CAssembler[target_asm.id].Create(smart);
  1567. a.MakeObject;
  1568. a.Free;
  1569. end;
  1570. Procedure OnlyAsm;
  1571. var
  1572. a : TExternalAssembler;
  1573. begin
  1574. a:=TExternalAssembler.Create(false);
  1575. a.DoAssemble;
  1576. a.Free;
  1577. end;
  1578. {*****************************************************************************
  1579. Init/Done
  1580. *****************************************************************************}
  1581. procedure RegisterAssembler(const r:tasminfo;c:TAssemblerClass);
  1582. var
  1583. t : tasm;
  1584. begin
  1585. t:=r.id;
  1586. if assigned(asminfos[t]) then
  1587. writeln('Warning: Assembler is already registered!')
  1588. else
  1589. Getmem(asminfos[t],sizeof(tasminfo));
  1590. asminfos[t]^:=r;
  1591. CAssembler[t]:=c;
  1592. end;
  1593. end.