ag386bin.pas 31 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997
  1. {
  2. $Id$
  3. Copyright (c) 1996-98 by the FPC development team
  4. This unit implements an binary assembler output class
  5. This program is free software; you can redistribute it and/or modify
  6. it under the terms of the GNU General Public License as published by
  7. the Free Software Foundation; either version 2 of the License, or
  8. (at your option) any later version.
  9. This program is distributed in the hope that it will be useful,
  10. but WITHOUT ANY WARRANTY; without even the implied warranty of
  11. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  12. GNU General Public License for more details.
  13. You should have received a copy of the GNU General Public License
  14. along with this program; if not, write to the Free Software
  15. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  16. ****************************************************************************
  17. }
  18. {$ifdef TP}
  19. {$N+,E+}
  20. {$endif}
  21. unit ag386bin;
  22. {$define MULTIPASS}
  23. {$define EXTERNALBSS}
  24. interface
  25. uses
  26. cpubase,cobjects,aasm,files,assemble;
  27. type
  28. togtype=(og_none,og_dbg,og_coff,og_pecoff);
  29. pi386binasmlist=^ti386binasmlist;
  30. ti386binasmlist=object
  31. SmartAsm : boolean;
  32. constructor init(t:togtype;smart:boolean);
  33. destructor done;
  34. procedure WriteBin;
  35. private
  36. { the aasmoutput lists that need to be processed }
  37. lists : byte;
  38. list : array[1..maxoutputlists] of paasmoutput;
  39. { current processing }
  40. currlistidx : byte;
  41. currlist : paasmoutput;
  42. currpass : byte;
  43. {$ifdef GDB}
  44. n_line : byte; { different types of source lines }
  45. linecount,
  46. includecount : longint;
  47. funcname : pasmsymbol;
  48. stabslastfileinfo : tfileposinfo;
  49. procedure convertstabs(p:pchar);
  50. {$ifdef unused}
  51. procedure emitsymbolstabs(s : string;nidx,nother,line : longint;firstasm,secondasm : pasmsymbol);
  52. {$endif}
  53. procedure emitlineinfostabs(nidx,line : longint);
  54. procedure emitstabs(s:string);
  55. procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
  56. procedure StartFileLineInfo;
  57. {$endif}
  58. function MaybeNextList(var hp:pai):boolean;
  59. function TreePass0(hp:pai):pai;
  60. function TreePass1(hp:pai):pai;
  61. function TreePass2(hp:pai):pai;
  62. procedure writetree;
  63. procedure writetreesmart;
  64. end;
  65. implementation
  66. uses
  67. strings,
  68. globtype,globals,systems,verbose,
  69. cpuasm,
  70. {$ifdef GDB}
  71. gdb,
  72. {$endif}
  73. og386,og386dbg,og386cff;
  74. {$ifdef GDB}
  75. procedure ti386binasmlist.convertstabs(p:pchar);
  76. var
  77. ofs,
  78. nidx,nother,ii,i,line,j : longint;
  79. code : integer;
  80. hp : pchar;
  81. reloc : boolean;
  82. sec : tsection;
  83. ps : pasmsymbol;
  84. s : string;
  85. begin
  86. ofs:=0;
  87. reloc:=true;
  88. ps:=nil;
  89. sec:=sec_none;
  90. if p[0]='"' then
  91. begin
  92. i:=1;
  93. { we can have \" inside the string !! PM }
  94. while not ((p[i]='"') and (p[i-1]<>'\')) do
  95. inc(i);
  96. p[i]:=#0;
  97. ii:=i;
  98. hp:=@p[1];
  99. s:=StrPas(@P[i+2]);
  100. end
  101. else
  102. begin
  103. hp:=nil;
  104. s:=StrPas(P);
  105. i:=-2; {needed below (PM) }
  106. end;
  107. { When in pass 1 then only alloc and leave }
  108. if currpass=1 then
  109. begin
  110. objectalloc^.staballoc(hp);
  111. if assigned(hp) then
  112. p[i]:='"';
  113. exit;
  114. end;
  115. { Parse the rest of the stabs }
  116. if s='' then
  117. internalerror(33000);
  118. j:=pos(',',s);
  119. if j=0 then
  120. internalerror(33001);
  121. Val(Copy(s,1,j-1),nidx,code);
  122. if code<>0 then
  123. internalerror(33002);
  124. i:=i+2+j;
  125. Delete(s,1,j);
  126. j:=pos(',',s);
  127. if (j=0) then
  128. internalerror(33003);
  129. Val(Copy(s,1,j-1),nother,code);
  130. if code<>0 then
  131. internalerror(33004);
  132. i:=i+j;
  133. Delete(s,1,j);
  134. j:=pos(',',s);
  135. if j=0 then
  136. begin
  137. j:=256;
  138. ofs:=-1;
  139. end;
  140. Val(Copy(s,1,j-1),line,code);
  141. if code<>0 then
  142. internalerror(33005);
  143. if ofs=0 then
  144. begin
  145. Delete(s,1,j);
  146. i:=i+j;
  147. Val(s,ofs,code);
  148. if code=0 then
  149. reloc:=false
  150. else
  151. begin
  152. ofs:=0;
  153. s:=strpas(@p[i]);
  154. { handle asmsymbol or
  155. asmsymbol - asmsymbol }
  156. j:=pos(' ',s);
  157. if j=0 then
  158. j:=pos('-',s);
  159. { single asmsymbol }
  160. if j=0 then
  161. j:=256;
  162. { the symbol can be external
  163. so we must use newasmsymbol and
  164. not getasmsymbol !! PM }
  165. ps:=newasmsymbol(copy(s,1,j-1));
  166. if not assigned(ps) then
  167. internalerror(33006)
  168. else
  169. begin
  170. sec:=ps^.section;
  171. ofs:=ps^.address;
  172. reloc:=true;
  173. end;
  174. if j<256 then
  175. begin
  176. i:=i+j;
  177. s:=strpas(@p[i]);
  178. if (s<>'') and (s[1]=' ') then
  179. begin
  180. j:=0;
  181. while (s[j+1]=' ') do
  182. inc(j);
  183. i:=i+j;
  184. s:=strpas(@p[i]);
  185. end;
  186. ps:=getasmsymbol(s);
  187. if not assigned(ps) then
  188. internalerror(33007)
  189. else
  190. begin
  191. if ps^.section<>sec then
  192. internalerror(33008);
  193. ofs:=ofs-ps^.address;
  194. reloc:=false;
  195. end;
  196. end;
  197. end;
  198. end;
  199. { external bss need speical handling (PM) }
  200. if assigned(ps) and (ps^.section=sec_none) then
  201. objectoutput^.WriteSymStabs(sec,ofs,hp,ps,nidx,nother,line,reloc)
  202. else
  203. objectoutput^.WriteStabs(sec,ofs,hp,nidx,nother,line,reloc);
  204. if assigned(hp) then
  205. p[ii]:='"';
  206. end;
  207. {$ifdef unused}
  208. procedure ti386binasmlist.emitsymbolstabs(s : string;nidx,nother,line : longint;
  209. firstasm,secondasm : pasmsymbol);
  210. var
  211. hp : pchar;
  212. begin
  213. if s='' then
  214. hp:=nil
  215. else
  216. begin
  217. s:=s+#0;
  218. hp:=@s[1];
  219. end;
  220. if not assigned(secondasm) then
  221. begin
  222. if not assigned(firstasm) then
  223. internalerror(33009);
  224. objectoutput^.WriteStabs(firstasm^.section,firstasm^.address,hp,nidx,nother,line,true);
  225. end
  226. else
  227. begin
  228. if firstasm^.section<>secondasm^.section then
  229. internalerror(33010);
  230. objectoutput^.WriteStabs(firstasm^.section,firstasm^.address-secondasm^.address,
  231. hp,nidx,nother,line,false);
  232. end;
  233. end;
  234. {$endif}
  235. procedure ti386binasmlist.emitlineinfostabs(nidx,line : longint);
  236. var
  237. sec : tsection;
  238. begin
  239. if currpass=1 then
  240. begin
  241. objectalloc^.staballoc(nil);
  242. exit;
  243. end;
  244. if (nidx=n_textline) and assigned(funcname) and
  245. (target_os.use_function_relative_addresses) then
  246. objectoutput^.WriteStabs(sec_code,pgenericcoffoutput(objectoutput)^.sects[sec_code]^.len-funcname^.address,
  247. nil,nidx,0,line,false)
  248. else
  249. begin
  250. if nidx=n_textline then
  251. sec:=sec_code
  252. else if nidx=n_dataline then
  253. sec:=sec_data
  254. else
  255. sec:=sec_bss;
  256. objectoutput^.WriteStabs(sec,pgenericcoffoutput(objectoutput)^.sects[sec]^.len,
  257. nil,nidx,0,line,true);
  258. end;
  259. end;
  260. procedure ti386binasmlist.emitstabs(s:string);
  261. begin
  262. s:=s+#0;
  263. ConvertStabs(@s[1]);
  264. end;
  265. procedure ti386binasmlist.WriteFileLineInfo(var fileinfo : tfileposinfo);
  266. var
  267. curr_n : byte;
  268. hp : pasmsymbol;
  269. infile : pinputfile;
  270. begin
  271. if not (cs_debuginfo in aktmoduleswitches) then
  272. exit;
  273. { file changed ? (must be before line info) }
  274. if (fileinfo.fileindex<>0) and
  275. (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
  276. begin
  277. infile:=current_module^.sourcefiles^.get_file(fileinfo.fileindex);
  278. if includecount=0 then
  279. curr_n:=n_sourcefile
  280. else
  281. curr_n:=n_includefile;
  282. { get symbol for this includefile }
  283. hp:=newasmsymbol('Ltext'+ToStr(IncludeCount));
  284. if currpass=1 then
  285. begin
  286. hp^.typ:=AS_LOCAL;
  287. hp^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
  288. end
  289. else
  290. objectoutput^.writesymbol(hp);
  291. { emit stabs }
  292. if (infile^.path^<>'') then
  293. EmitStabs('"'+lower(BsToSlash(FixPath(infile^.path^,false)))+'",'+tostr(curr_n)+
  294. ',0,0,Ltext'+ToStr(IncludeCount));
  295. EmitStabs('"'+lower(FixFileName(infile^.name^))+'",'+tostr(curr_n)+
  296. ',0,0,Ltext'+ToStr(IncludeCount));
  297. inc(includecount);
  298. end;
  299. { line changed ? }
  300. if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
  301. emitlineinfostabs(n_line,fileinfo.line);
  302. stabslastfileinfo:=fileinfo;
  303. end;
  304. procedure ti386binasmlist.StartFileLineInfo;
  305. var
  306. fileinfo : tfileposinfo;
  307. begin
  308. FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
  309. n_line:=n_textline;
  310. funcname:=nil;
  311. linecount:=1;
  312. includecount:=0;
  313. fileinfo.fileindex:=1;
  314. fileinfo.line:=1;
  315. WriteFileLineInfo(fileinfo);
  316. end;
  317. {$endif GDB}
  318. function ti386binasmlist.MaybeNextList(var hp:pai):boolean;
  319. begin
  320. { maybe end of list }
  321. while not assigned(hp) do
  322. begin
  323. if currlistidx<lists then
  324. begin
  325. inc(currlistidx);
  326. currlist:=list[currlistidx];
  327. hp:=pai(currlist^.first);
  328. end
  329. else
  330. begin
  331. MaybeNextList:=false;
  332. exit;
  333. end;
  334. end;
  335. MaybeNextList:=true;
  336. end;
  337. function ti386binasmlist.TreePass0(hp:pai):pai;
  338. var
  339. lastsec : tsection;
  340. l : longint;
  341. begin
  342. while assigned(hp) do
  343. begin
  344. case hp^.typ of
  345. ait_align :
  346. begin
  347. { always use the maximum fillsize in this pass to avoid possible
  348. short jumps to become out of range }
  349. pai_align(hp)^.fillsize:=pai_align(hp)^.aligntype;
  350. objectalloc^.sectionalloc(pai_align(hp)^.fillsize);
  351. end;
  352. ait_datablock :
  353. begin
  354. {$ifdef EXTERNALBSS}
  355. if not SmartAsm then
  356. begin
  357. if not pai_datablock(hp)^.is_global then
  358. begin
  359. l:=pai_datablock(hp)^.size;
  360. if l>2 then
  361. objectalloc^.sectionalign(4)
  362. else if l>1 then
  363. objectalloc^.sectionalign(2);
  364. objectalloc^.sectionalloc(pai_datablock(hp)^.size);
  365. end;
  366. end
  367. else
  368. begin
  369. {$endif}
  370. l:=pai_datablock(hp)^.size;
  371. if l>2 then
  372. objectalloc^.sectionalign(4)
  373. else if l>1 then
  374. objectalloc^.sectionalign(2);
  375. objectalloc^.sectionalloc(pai_datablock(hp)^.size);
  376. end;
  377. end;
  378. ait_const_32bit :
  379. objectalloc^.sectionalloc(4);
  380. ait_const_16bit :
  381. objectalloc^.sectionalloc(2);
  382. ait_const_8bit :
  383. objectalloc^.sectionalloc(1);
  384. ait_real_80bit :
  385. objectalloc^.sectionalloc(10);
  386. ait_real_64bit :
  387. objectalloc^.sectionalloc(8);
  388. ait_real_32bit :
  389. objectalloc^.sectionalloc(4);
  390. ait_comp_64bit :
  391. objectalloc^.sectionalloc(8);
  392. ait_const_rva,
  393. ait_const_symbol :
  394. objectalloc^.sectionalloc(4);
  395. ait_section:
  396. begin
  397. objectalloc^.setsection(pai_section(hp)^.sec);
  398. lastsec:=pai_section(hp)^.sec;
  399. end;
  400. ait_symbol :
  401. pai_symbol(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
  402. ait_label :
  403. pai_label(hp)^.l^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
  404. ait_string :
  405. objectalloc^.sectionalloc(pai_string(hp)^.len);
  406. ait_instruction :
  407. objectalloc^.sectionalloc(paicpu(hp)^.Pass1(objectalloc^.sectionsize));
  408. ait_cut :
  409. if SmartAsm then
  410. begin
  411. objectalloc^.resetsections;
  412. objectalloc^.setsection(lastsec);
  413. end;
  414. end;
  415. hp:=pai(hp^.next);
  416. end;
  417. TreePass0:=hp;
  418. end;
  419. function ti386binasmlist.TreePass1(hp:pai):pai;
  420. var
  421. l : longint;
  422. begin
  423. while assigned(hp) do
  424. begin
  425. {$ifdef GDB}
  426. { write stabs }
  427. if (cs_debuginfo in aktmoduleswitches) then
  428. begin
  429. if (objectalloc^.currsec<>sec_none) and
  430. not(hp^.typ in [
  431. ait_label,
  432. ait_regalloc,ait_tempalloc,
  433. ait_stabn,ait_stabs,ait_section,
  434. ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
  435. WriteFileLineInfo(hp^.fileinfo);
  436. end;
  437. {$endif GDB}
  438. case hp^.typ of
  439. ait_align :
  440. begin
  441. { here we must determine the fillsize which is used in pass2 }
  442. pai_align(hp)^.fillsize:=align(objectalloc^.sectionsize,pai_align(hp)^.aligntype)-
  443. objectalloc^.sectionsize;
  444. objectalloc^.sectionalloc(pai_align(hp)^.fillsize);
  445. end;
  446. ait_datablock :
  447. begin
  448. if objectalloc^.currsec<>sec_bss then
  449. Message(asmw_e_alloc_data_only_in_bss);
  450. {$ifdef EXTERNALBSS}
  451. if not SmartAsm then
  452. begin
  453. if pai_datablock(hp)^.is_global then
  454. begin
  455. pai_datablock(hp)^.sym^.typ:=AS_EXTERNAL;
  456. pai_datablock(hp)^.sym^.setaddress(sec_none,pai_datablock(hp)^.size,pai_datablock(hp)^.size);
  457. end
  458. else
  459. begin
  460. l:=pai_datablock(hp)^.size;
  461. if l>2 then
  462. objectalloc^.sectionalign(4)
  463. else if l>1 then
  464. objectalloc^.sectionalign(2);
  465. pai_datablock(hp)^.sym^.typ:=AS_LOCAL;
  466. pai_datablock(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,
  467. pai_datablock(hp)^.size);
  468. objectalloc^.sectionalloc(pai_datablock(hp)^.size);
  469. end;
  470. end
  471. else
  472. {$endif}
  473. begin
  474. if pai_datablock(hp)^.is_global then
  475. pai_datablock(hp)^.sym^.typ:=AS_GLOBAL
  476. else
  477. pai_datablock(hp)^.sym^.typ:=AS_LOCAL;
  478. l:=pai_datablock(hp)^.size;
  479. if l>2 then
  480. objectalloc^.sectionalign(4)
  481. else if l>1 then
  482. objectalloc^.sectionalign(2);
  483. pai_datablock(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,pai_datablock(hp)^.size);
  484. objectalloc^.sectionalloc(pai_datablock(hp)^.size);
  485. end;
  486. end;
  487. ait_const_32bit :
  488. objectalloc^.sectionalloc(4);
  489. ait_const_16bit :
  490. objectalloc^.sectionalloc(2);
  491. ait_const_8bit :
  492. objectalloc^.sectionalloc(1);
  493. ait_real_80bit :
  494. objectalloc^.sectionalloc(10);
  495. ait_real_64bit :
  496. objectalloc^.sectionalloc(8);
  497. ait_real_32bit :
  498. objectalloc^.sectionalloc(4);
  499. ait_comp_64bit :
  500. objectalloc^.sectionalloc(8);
  501. ait_const_rva,
  502. ait_const_symbol :
  503. objectalloc^.sectionalloc(4);
  504. ait_section:
  505. begin
  506. objectalloc^.setsection(pai_section(hp)^.sec);
  507. {$ifdef GDB}
  508. case pai_section(hp)^.sec of
  509. sec_code : n_line:=n_textline;
  510. sec_data : n_line:=n_dataline;
  511. sec_bss : n_line:=n_bssline;
  512. else
  513. n_line:=n_dataline;
  514. end;
  515. stabslastfileinfo.line:=-1;
  516. {$endif GDB}
  517. end;
  518. {$ifdef GDB}
  519. ait_stabn :
  520. convertstabs(pai_stabn(hp)^.str);
  521. ait_stabs :
  522. convertstabs(pai_stabs(hp)^.str);
  523. ait_stab_function_name :
  524. if assigned(pai_stab_function_name(hp)^.str) then
  525. funcname:=getasmsymbol(strpas(pai_stab_function_name(hp)^.str))
  526. else
  527. funcname:=nil;
  528. ait_force_line :
  529. stabslastfileinfo.line:=0;
  530. {$endif}
  531. ait_symbol :
  532. begin
  533. if pai_symbol(hp)^.is_global then
  534. pai_symbol(hp)^.sym^.typ:=AS_GLOBAL
  535. else
  536. pai_symbol(hp)^.sym^.typ:=AS_LOCAL;
  537. pai_symbol(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
  538. end;
  539. ait_label :
  540. begin
  541. if pai_label(hp)^.is_global then
  542. pai_label(hp)^.l^.typ:=AS_GLOBAL
  543. else
  544. pai_label(hp)^.l^.typ:=AS_LOCAL;
  545. pai_label(hp)^.l^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
  546. end;
  547. ait_string :
  548. objectalloc^.sectionalloc(pai_string(hp)^.len);
  549. ait_instruction :
  550. objectalloc^.sectionalloc(paicpu(hp)^.Pass1(objectalloc^.sectionsize));
  551. ait_direct :
  552. Message(asmw_f_direct_not_supported);
  553. ait_cut :
  554. if SmartAsm then
  555. break;
  556. end;
  557. hp:=pai(hp^.next);
  558. end;
  559. TreePass1:=hp;
  560. end;
  561. function ti386binasmlist.TreePass2(hp:pai):pai;
  562. const
  563. alignarray:array[0..5] of string[8]=(
  564. #$8D#$B4#$26#$00#$00#$00#$00,
  565. #$8D#$B6#$00#$00#$00#$00,
  566. #$8D#$74#$26#$00,
  567. #$8D#$76#$00,
  568. #$89#$F6,
  569. #$90
  570. );
  571. var
  572. l,j : longint;
  573. alignoparray:array[0..63] of byte;
  574. {$ifdef I386}
  575. co : comp;
  576. {$endif I386}
  577. begin
  578. { main loop }
  579. while assigned(hp) do
  580. begin
  581. {$ifdef GDB}
  582. { write stabs }
  583. if cs_debuginfo in aktmoduleswitches then
  584. begin
  585. if (objectoutput^.currsec<>sec_none) and
  586. not(hp^.typ in [
  587. ait_label,
  588. ait_regalloc,ait_tempalloc,
  589. ait_stabn,ait_stabs,ait_section,
  590. ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
  591. WriteFileLineInfo(hp^.fileinfo);
  592. end;
  593. {$endif GDB}
  594. case hp^.typ of
  595. ait_align :
  596. begin
  597. if not pai_align(hp)^.use_op then
  598. begin
  599. l:=pai_align(hp)^.fillsize;
  600. while (l>0) do
  601. begin
  602. for j:=0to 5 do
  603. if (l>=length(alignarray[j])) then
  604. break;
  605. objectoutput^.writebytes(alignarray[j][1],length(alignarray[j]));
  606. dec(l,length(alignarray[j]));
  607. end;
  608. end
  609. else
  610. begin
  611. fillchar(alignoparray,pai_align(hp)^.fillsize,pai_align(hp)^.fillop);
  612. objectoutput^.writebytes(alignoparray,pai_align(hp)^.fillsize);
  613. end;
  614. end;
  615. ait_section :
  616. begin
  617. objectoutput^.defaultsection(pai_section(hp)^.sec);
  618. {$ifdef GDB}
  619. case pai_section(hp)^.sec of
  620. sec_code : n_line:=n_textline;
  621. sec_data : n_line:=n_dataline;
  622. sec_bss : n_line:=n_bssline;
  623. else
  624. n_line:=n_dataline;
  625. end;
  626. stabslastfileinfo.line:=-1;
  627. {$endif GDB}
  628. end;
  629. ait_symbol :
  630. objectoutput^.writesymbol(pai_symbol(hp)^.sym);
  631. ait_datablock :
  632. begin
  633. objectoutput^.writesymbol(pai_datablock(hp)^.sym);
  634. if SmartAsm
  635. {$ifdef EXTERNALBSS}
  636. or (not pai_datablock(hp)^.is_global)
  637. {$endif}
  638. then
  639. begin
  640. l:=pai_datablock(hp)^.size;
  641. if l>2 then
  642. objectoutput^.writealign(4)
  643. else if l>1 then
  644. objectoutput^.writealign(2);
  645. objectoutput^.writealloc(pai_datablock(hp)^.size);
  646. end;
  647. end;
  648. ait_const_32bit :
  649. objectoutput^.writebytes(pai_const(hp)^.value,4);
  650. ait_const_16bit :
  651. objectoutput^.writebytes(pai_const(hp)^.value,2);
  652. ait_const_8bit :
  653. objectoutput^.writebytes(pai_const(hp)^.value,1);
  654. ait_real_80bit :
  655. objectoutput^.writebytes(pai_real_80bit(hp)^.value,10);
  656. ait_real_64bit :
  657. objectoutput^.writebytes(pai_real_64bit(hp)^.value,8);
  658. ait_real_32bit :
  659. objectoutput^.writebytes(pai_real_32bit(hp)^.value,4);
  660. ait_comp_64bit :
  661. begin
  662. {$ifdef FPC}
  663. co:=comp(pai_comp_64bit(hp)^.value);
  664. {$else}
  665. co:=pai_comp_64bit(hp)^.value;
  666. {$endif}
  667. objectoutput^.writebytes(co,8);
  668. end;
  669. ait_string :
  670. objectoutput^.writebytes(pai_string(hp)^.str^,pai_string(hp)^.len);
  671. ait_const_rva :
  672. objectoutput^.writereloc(pai_const_symbol(hp)^.offset,4,
  673. pai_const_symbol(hp)^.sym,relative_rva);
  674. ait_const_symbol :
  675. objectoutput^.writereloc(pai_const_symbol(hp)^.offset,4,
  676. pai_const_symbol(hp)^.sym,relative_false);
  677. ait_label :
  678. objectoutput^.writesymbol(pai_label(hp)^.l);
  679. ait_instruction :
  680. paicpu(hp)^.Pass2;
  681. {$ifdef GDB}
  682. ait_stabn :
  683. convertstabs(pai_stabn(hp)^.str);
  684. ait_stabs :
  685. convertstabs(pai_stabs(hp)^.str);
  686. ait_stab_function_name :
  687. if assigned(pai_stab_function_name(hp)^.str) then
  688. funcname:=getasmsymbol(strpas(pai_stab_function_name(hp)^.str))
  689. else
  690. funcname:=nil;
  691. ait_force_line :
  692. stabslastfileinfo.line:=0;
  693. {$endif}
  694. ait_cut :
  695. if SmartAsm then
  696. break;
  697. end;
  698. hp:=pai(hp^.next);
  699. end;
  700. TreePass2:=hp;
  701. end;
  702. procedure ti386binasmlist.writetree;
  703. var
  704. hp : pai;
  705. begin
  706. objectalloc^.setsection(sec_code);
  707. objectoutput^.defaultsection(sec_code);
  708. { Pass 1 }
  709. currpass:=1;
  710. {$ifdef GDB}
  711. StartFileLineInfo;
  712. {$endif GDB}
  713. { start with list 1 }
  714. currlistidx:=1;
  715. currlist:=list[currlistidx];
  716. hp:=pai(currlist^.first);
  717. while assigned(hp) do
  718. begin
  719. hp:=TreePass1(hp);
  720. MaybeNextList(hp);
  721. end;
  722. { set section sizes }
  723. objectoutput^.setsectionsizes(objectalloc^.secsize);
  724. { Pass 2 }
  725. currpass:=2;
  726. {$ifdef GDB}
  727. StartFileLineInfo;
  728. {$endif GDB}
  729. { start with list 1 }
  730. currlistidx:=1;
  731. currlist:=list[currlistidx];
  732. hp:=pai(currlist^.first);
  733. while assigned(hp) do
  734. begin
  735. hp:=TreePass2(hp);
  736. MaybeNextList(hp);
  737. end;
  738. end;
  739. procedure ti386binasmlist.writetreesmart;
  740. var
  741. hp : pai;
  742. begin
  743. objectalloc^.setsection(sec_code);
  744. objectoutput^.defaultsection(sec_code);
  745. { start with list 1 }
  746. currlistidx:=1;
  747. currlist:=list[currlistidx];
  748. hp:=pai(currlist^.first);
  749. while assigned(hp) do
  750. begin
  751. { Pass 1 }
  752. currpass:=1;
  753. {$ifdef GDB}
  754. StartFileLineInfo;
  755. {$endif GDB}
  756. TreePass1(hp);
  757. { set section sizes }
  758. objectoutput^.setsectionsizes(objectalloc^.secsize);
  759. { Pass 2 }
  760. currpass:=2;
  761. {$ifdef GDB}
  762. StartFileLineInfo;
  763. {$endif GDB}
  764. hp:=TreePass2(hp);
  765. if not MaybeNextList(hp) then
  766. break;
  767. { write the current objectfile }
  768. objectoutput^.donewriting;
  769. { we will start a new objectfile so reset everything }
  770. if (hp^.typ=ait_cut) then
  771. objectoutput^.initwriting(pai_cut(hp)^.place)
  772. else
  773. objectoutput^.initwriting(cut_normal);
  774. objectalloc^.resetsections;
  775. ResetAsmsymbolList;
  776. { avoid empty files }
  777. while assigned(hp^.next) and
  778. (pai(hp^.next)^.typ in [ait_marker,ait_comment,ait_section,ait_cut]) do
  779. begin
  780. if pai(hp^.next)^.typ=ait_section then
  781. begin
  782. objectalloc^.setsection(pai_section(hp^.next)^.sec);
  783. objectoutput^.defaultsection(pai_section(hp^.next)^.sec);
  784. end;
  785. hp:=pai(hp^.next);
  786. end;
  787. hp:=pai(hp^.next);
  788. if not MaybeNextList(hp) then
  789. break;
  790. end;
  791. end;
  792. procedure ti386binasmlist.writebin;
  793. procedure addlist(p:paasmoutput);
  794. begin
  795. inc(lists);
  796. list[lists]:=p;
  797. end;
  798. begin
  799. {$ifdef MULTIPASS}
  800. { Process the codesegment twice so the short jmp instructions can
  801. be optimized }
  802. currpass:=0;
  803. TreePass0(pai(codesegment^.first));
  804. {$endif}
  805. objectalloc^.resetsections;
  806. objectalloc^.setsection(sec_code);
  807. objectoutput^.initwriting(cut_normal);
  808. objectoutput^.defaultsection(sec_code);
  809. if cs_debuginfo in aktmoduleswitches then
  810. addlist(debuglist);
  811. addlist(codesegment);
  812. addlist(datasegment);
  813. addlist(consts);
  814. addlist(rttilist);
  815. if assigned(resourcestringlist) then
  816. addlist(resourcestringlist);
  817. addlist(bsssegment);
  818. if assigned(importssection) then
  819. addlist(importssection);
  820. if assigned(exportssection) and not UseDeffileForExport then
  821. addlist(exportssection);
  822. if assigned(resourcesection) then
  823. addlist(resourcesection);
  824. if SmartAsm then
  825. writetreesmart
  826. else
  827. writetree;
  828. objectoutput^.donewriting;
  829. end;
  830. constructor ti386binasmlist.init(t:togtype;smart:boolean);
  831. begin
  832. case t of
  833. og_none :
  834. Message(asmw_f_no_binary_writer_selected);
  835. og_dbg :
  836. objectoutput:=new(pdbgoutput,init(smart));
  837. og_coff :
  838. objectoutput:=new(pdjgppcoffoutput,init(smart));
  839. og_pecoff :
  840. objectoutput:=new(pwin32coffoutput,init(smart));
  841. end;
  842. objectalloc:=new(pobjectalloc,init);
  843. SmartAsm:=smart;
  844. currpass:=0;
  845. end;
  846. destructor ti386binasmlist.done;
  847. begin
  848. dispose(objectoutput,done);
  849. dispose(objectalloc,done);
  850. end;
  851. end.
  852. {
  853. $Log$
  854. Revision 1.30 1999-12-08 10:39:59 pierre
  855. + allow use of unit var in exports of DLL for win32
  856. by using direct export writing by default instead of use of DEFFILE
  857. that does not allow assembler labels that do not
  858. start with an underscore.
  859. Use -WD to force use of Deffile for Win32 DLL
  860. Revision 1.29 1999/12/01 22:05:13 pierre
  861. * problem with unused external symbol in stabs solved
  862. Revision 1.28 1999/11/30 10:40:42 peter
  863. + ttype, tsymlist
  864. Revision 1.27 1999/11/06 14:34:16 peter
  865. * truncated log to 20 revs
  866. Revision 1.26 1999/11/02 15:06:56 peter
  867. * import library fixes for win32
  868. * alignment works again
  869. Revision 1.25 1999/09/26 21:13:40 peter
  870. * short jmp with alignment problems fixed
  871. Revision 1.24 1999/08/25 11:59:33 jonas
  872. * changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
  873. Revision 1.23 1999/08/10 12:26:21 pierre
  874. * avoid double .edata section if using DLLTOOL
  875. Revision 1.22 1999/08/04 00:22:35 florian
  876. * renamed i386asm and i386base to cpuasm and cpubase
  877. Revision 1.21 1999/08/01 18:28:09 florian
  878. * modifications for the new code generator
  879. Revision 1.20 1999/07/31 12:33:11 peter
  880. * fixed smartlinking
  881. Revision 1.19 1999/07/22 09:37:30 florian
  882. + resourcestring implemented
  883. + start of longstring support
  884. Revision 1.18 1999/07/03 00:26:02 peter
  885. * ag386bin doesn't destroy the aasmoutput lists anymore
  886. Revision 1.17 1999/06/10 23:52:34 pierre
  887. * merged from fixes branch
  888. Revision 1.16.2.1 1999/06/10 23:33:35 pierre
  889. * pchar memory loss and .bss size problem solved
  890. Revision 1.16 1999/06/03 16:39:10 pierre
  891. * EXTERNALBSS fixed for stabs and default again
  892. Revision 1.15 1999/06/02 22:43:59 pierre
  893. * previous wrong log corrected
  894. Revision 1.14 1999/06/02 22:25:25 pierre
  895. * changed $ifdef FPC @ into $ifndef TP
  896. Revision 1.13 1999/06/01 10:24:09 pierre
  897. * ts010021.pp problem solved for ag386bin !
  898. Revision 1.12 1999/05/27 19:43:59 peter
  899. * removed oldasm
  900. * plabel -> pasmlabel
  901. * -a switches to source writing automaticly
  902. * assembler readers OOPed
  903. * asmsymbol automaticly external
  904. * jumptables and other label fixes for asm readers
  905. Revision 1.11 1999/05/21 13:54:41 peter
  906. * NEWLAB for label as symbol
  907. Revision 1.10 1999/05/19 11:54:17 pierre
  908. + experimental code for externalbss and stabs problem
  909. Revision 1.9 1999/05/12 00:19:37 peter
  910. * removed R_DEFAULT_SEG
  911. * uniform float names
  912. Revision 1.8 1999/05/09 11:38:04 peter
  913. * don't write .o and link if errors occure during assembling
  914. }