assemble.pas 52 KB

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