ag386bin.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847
  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. i386base,
  27. cobjects,aasm,files,assemble;
  28. type
  29. togtype=(og_none,og_dbg,og_coff,og_pecoff);
  30. pi386binasmlist=^ti386binasmlist;
  31. ti386binasmlist=object
  32. constructor init(t:togtype);
  33. destructor done;
  34. procedure WriteBin;
  35. private
  36. currpass : byte;
  37. {$ifdef GDB}
  38. n_line : byte; { different types of source lines }
  39. linecount,
  40. includecount : longint;
  41. funcname : pasmsymbol;
  42. stabslastfileinfo : tfileposinfo;
  43. procedure convertstabs(p:pchar);
  44. {$ifdef unused}
  45. procedure emitsymbolstabs(s : string;nidx,nother,line : longint;firstasm,secondasm : pasmsymbol);
  46. {$endif}
  47. procedure emitlineinfostabs(nidx,line : longint);
  48. procedure emitstabs(s:string);
  49. procedure WriteFileLineInfo(var fileinfo : tfileposinfo);
  50. procedure StartFileLineInfo;
  51. {$endif}
  52. function TreePass0(hp:pai):pai;
  53. function TreePass1(hp:pai):pai;
  54. function TreePass2(hp:pai):pai;
  55. procedure writetree(p:paasmoutput);
  56. end;
  57. implementation
  58. uses
  59. strings,verbose,
  60. globtype,globals,
  61. i386asm,systems,
  62. {$ifdef GDB}
  63. gdb,
  64. {$endif}
  65. og386,og386dbg,og386cff;
  66. {$ifdef GDB}
  67. procedure ti386binasmlist.convertstabs(p:pchar);
  68. var
  69. ofs,
  70. nidx,nother,i,line,j : longint;
  71. code : integer;
  72. hp : pchar;
  73. reloc : boolean;
  74. sec : tsection;
  75. ps : pasmsymbol;
  76. s : string;
  77. begin
  78. ofs:=0;
  79. reloc:=true;
  80. sec:=sec_none;
  81. if p[0]='"' then
  82. begin
  83. i:=1;
  84. { we can have \" inside the string !! PM }
  85. while not ((p[i]='"') and (p[i-1]<>'\')) do
  86. inc(i);
  87. p[i]:=#0;
  88. hp:=@p[1];
  89. s:=StrPas(@P[i+2]);
  90. end
  91. else
  92. begin
  93. hp:=nil;
  94. s:=StrPas(P);
  95. end;
  96. { When in pass 1 then only alloc and leave }
  97. if currpass=1 then
  98. begin
  99. objectalloc^.staballoc(hp);
  100. if assigned(hp) then
  101. p[i]:='"';
  102. exit;
  103. end;
  104. { Parse the rest of the stabs }
  105. if s='' then
  106. internalerror(33000);
  107. j:=pos(',',s);
  108. if j=0 then
  109. internalerror(33001);
  110. Val(Copy(s,1,j-1),nidx,code);
  111. if code<>0 then
  112. internalerror(33002);
  113. Delete(s,1,j);
  114. j:=pos(',',s);
  115. if (j=0) then
  116. internalerror(33003);
  117. Val(Copy(s,1,j-1),nother,code);
  118. if code<>0 then
  119. internalerror(33004);
  120. Delete(s,1,j);
  121. j:=pos(',',s);
  122. if j=0 then
  123. begin
  124. j:=256;
  125. ofs:=-1;
  126. end;
  127. Val(Copy(s,1,j-1),line,code);
  128. if code<>0 then
  129. internalerror(33005);
  130. if ofs=0 then
  131. Delete(s,1,j);
  132. if ofs=0 then
  133. begin
  134. Val(s,ofs,code);
  135. if code=0 then
  136. reloc:=false
  137. else
  138. begin
  139. ofs:=0;
  140. { handle asmsymbol or
  141. asmsymbol - asmsymbol }
  142. j:=pos(' ',s);
  143. if j=0 then
  144. j:=pos('-',s);
  145. { single asmsymbol }
  146. if j=0 then
  147. j:=256;
  148. ps:=getasmsymbol(copy(s,1,j-1));
  149. if not assigned(ps) then
  150. internalerror(33006)
  151. else
  152. begin
  153. sec:=ps^.section;
  154. ofs:=ps^.address;
  155. reloc:=true;
  156. end;
  157. if j<256 then
  158. begin
  159. delete(s,1,j);
  160. while (s<>'') and (s[1]=' ') do
  161. delete(s,1,1);
  162. ps:=getasmsymbol(s);
  163. if not assigned(ps) then
  164. internalerror(33007)
  165. else
  166. begin
  167. if ps^.section<>sec then
  168. internalerror(33008);
  169. ofs:=ofs-ps^.address;
  170. reloc:=false;
  171. end;
  172. end;
  173. end;
  174. end;
  175. objectoutput^.WriteStabs(sec,ofs,hp,nidx,nother,line,reloc);
  176. if assigned(hp) then
  177. p[i]:='"';
  178. end;
  179. {$ifdef unused}
  180. procedure ti386binasmlist.emitsymbolstabs(s : string;nidx,nother,line : longint;
  181. firstasm,secondasm : pasmsymbol);
  182. var
  183. hp : pchar;
  184. begin
  185. if s='' then
  186. hp:=nil
  187. else
  188. begin
  189. s:=s+#0;
  190. hp:=@s[1];
  191. end;
  192. if not assigned(secondasm) then
  193. begin
  194. if not assigned(firstasm) then
  195. internalerror(33009);
  196. objectoutput^.WriteStabs(firstasm^.section,firstasm^.address,hp,nidx,nother,line,true);
  197. end
  198. else
  199. begin
  200. if firstasm^.section<>secondasm^.section then
  201. internalerror(33010);
  202. objectoutput^.WriteStabs(firstasm^.section,firstasm^.address-secondasm^.address,
  203. hp,nidx,nother,line,false);
  204. end;
  205. end;
  206. {$endif}
  207. procedure ti386binasmlist.emitlineinfostabs(nidx,line : longint);
  208. var
  209. sec : tsection;
  210. begin
  211. if currpass=1 then
  212. begin
  213. objectalloc^.staballoc(nil);
  214. exit;
  215. end;
  216. if (nidx=n_textline) and assigned(funcname) and
  217. (target_os.use_function_relative_addresses) then
  218. objectoutput^.WriteStabs(sec_code,pgenericcoffoutput(objectoutput)^.sects[sec_code]^.len-funcname^.address,
  219. nil,nidx,0,line,false)
  220. else
  221. begin
  222. if nidx=n_textline then
  223. sec:=sec_code
  224. else if nidx=n_dataline then
  225. sec:=sec_data
  226. else
  227. sec:=sec_bss;
  228. objectoutput^.WriteStabs(sec,pgenericcoffoutput(objectoutput)^.sects[sec]^.len,
  229. nil,nidx,0,line,true);
  230. end;
  231. end;
  232. procedure ti386binasmlist.emitstabs(s:string);
  233. begin
  234. s:=s+#0;
  235. ConvertStabs(@s[1]);
  236. end;
  237. procedure ti386binasmlist.WriteFileLineInfo(var fileinfo : tfileposinfo);
  238. var
  239. curr_n : byte;
  240. hp : pasmsymbol;
  241. infile : pinputfile;
  242. begin
  243. if not (cs_debuginfo in aktmoduleswitches) then
  244. exit;
  245. { file changed ? (must be before line info) }
  246. if (fileinfo.fileindex<>0) and
  247. (stabslastfileinfo.fileindex<>fileinfo.fileindex) then
  248. begin
  249. infile:=current_module^.sourcefiles^.get_file(fileinfo.fileindex);
  250. if includecount=0 then
  251. curr_n:=n_sourcefile
  252. else
  253. curr_n:=n_includefile;
  254. { get symbol for this includefile }
  255. hp:=newasmsymbol('Ltext'+ToStr(IncludeCount));
  256. if currpass=1 then
  257. begin
  258. hp^.typ:=AS_LOCAL;
  259. hp^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
  260. end
  261. else
  262. objectoutput^.writesymbol(hp);
  263. { emit stabs }
  264. if (infile^.path^<>'') then
  265. EmitStabs('"'+lower(BsToSlash(FixPath(infile^.path^,false)))+'",'+tostr(curr_n)+
  266. ',0,0,Ltext'+ToStr(IncludeCount));
  267. EmitStabs('"'+lower(FixFileName(infile^.name^))+'",'+tostr(curr_n)+
  268. ',0,0,Ltext'+ToStr(IncludeCount));
  269. inc(includecount);
  270. end;
  271. { line changed ? }
  272. if (stabslastfileinfo.line<>fileinfo.line) and (fileinfo.line<>0) then
  273. emitlineinfostabs(n_line,fileinfo.line);
  274. stabslastfileinfo:=fileinfo;
  275. end;
  276. procedure ti386binasmlist.StartFileLineInfo;
  277. var
  278. fileinfo : tfileposinfo;
  279. begin
  280. FillChar(stabslastfileinfo,sizeof(stabslastfileinfo),0);
  281. n_line:=n_textline;
  282. funcname:=nil;
  283. linecount:=1;
  284. includecount:=0;
  285. fileinfo.fileindex:=1;
  286. fileinfo.line:=1;
  287. WriteFileLineInfo(fileinfo);
  288. end;
  289. {$endif GDB}
  290. function ti386binasmlist.TreePass0(hp:pai):pai;
  291. var
  292. lastsec : tsection;
  293. begin
  294. while assigned(hp) do
  295. begin
  296. case hp^.typ of
  297. ait_align :
  298. begin
  299. if objectalloc^.sectionsize mod pai_align(hp)^.aligntype<>0 then
  300. begin
  301. pai_align(hp)^.fillsize:=pai_align(hp)^.aligntype-
  302. (objectalloc^.sectionsize mod pai_align(hp)^.aligntype);
  303. objectalloc^.sectionalloc(pai_align(hp)^.fillsize);
  304. end
  305. else
  306. pai_align(hp)^.fillsize:=0;
  307. end;
  308. ait_datablock :
  309. begin
  310. {$ifdef EXTERNALBSS}
  311. if not pai_datablock(hp)^.is_global then
  312. objectalloc^.sectionalloc(pai_datablock(hp)^.size);
  313. {$else}
  314. objectalloc^.sectionalloc(pai_datablock(hp)^.size);
  315. {$endif}
  316. end;
  317. ait_const_32bit :
  318. objectalloc^.sectionalloc(4);
  319. ait_const_16bit :
  320. objectalloc^.sectionalloc(2);
  321. ait_const_8bit :
  322. objectalloc^.sectionalloc(1);
  323. ait_real_64bit :
  324. objectalloc^.sectionalloc(8);
  325. ait_real_32bit :
  326. objectalloc^.sectionalloc(4);
  327. ait_real_80bit :
  328. objectalloc^.sectionalloc(10);
  329. ait_const_rva,
  330. ait_const_symbol :
  331. objectalloc^.sectionalloc(4);
  332. ait_section:
  333. begin
  334. objectalloc^.setsection(pai_section(hp)^.sec);
  335. lastsec:=pai_section(hp)^.sec;
  336. end;
  337. ait_symbol :
  338. pai_symbol(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
  339. ait_label :
  340. begin
  341. pai_label(hp)^.setaddress(objectalloc^.sectionsize);
  342. if pai_label(hp)^.l^.is_symbol then
  343. begin
  344. pai_label(hp)^.sym:=newasmsymbol(lab2str(pai_label(hp)^.l));
  345. if (pai_label(hp)^.l^.is_data) and (cs_smartlink in aktmoduleswitches) then
  346. pai_label(hp)^.sym^.typ:=AS_GLOBAL
  347. else
  348. pai_label(hp)^.sym^.typ:=AS_LOCAL;
  349. pai_label(hp)^.sym^.setaddress(objectalloc^.currsec,pai_label(hp)^.l^.address,0);
  350. end;
  351. end;
  352. ait_string :
  353. objectalloc^.sectionalloc(pai_string(hp)^.len);
  354. ait_labeled_instruction,
  355. ait_instruction :
  356. objectalloc^.sectionalloc(pai386(hp)^.Pass1(objectalloc^.sectionsize));
  357. ait_cut :
  358. begin
  359. objectalloc^.resetsections;
  360. objectalloc^.setsection(lastsec);
  361. end;
  362. end;
  363. hp:=pai(hp^.next);
  364. end;
  365. TreePass0:=hp;
  366. end;
  367. function ti386binasmlist.TreePass1(hp:pai):pai;
  368. begin
  369. while assigned(hp) do
  370. begin
  371. {$ifdef GDB}
  372. { write stabs }
  373. if (cs_debuginfo in aktmoduleswitches) then
  374. begin
  375. if (objectalloc^.currsec<>sec_none) and
  376. not(hp^.typ in [ait_external,ait_regalloc, ait_tempalloc,
  377. ait_stabn,ait_stabs,ait_section,
  378. ait_label,ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
  379. WriteFileLineInfo(hp^.fileinfo);
  380. end;
  381. {$endif GDB}
  382. case hp^.typ of
  383. ait_align :
  384. begin
  385. if objectalloc^.sectionsize mod pai_align(hp)^.aligntype<>0 then
  386. begin
  387. pai_align(hp)^.fillsize:=pai_align(hp)^.aligntype-
  388. (objectalloc^.sectionsize mod pai_align(hp)^.aligntype);
  389. objectalloc^.sectionalloc(pai_align(hp)^.fillsize);
  390. end
  391. else
  392. pai_align(hp)^.fillsize:=0;
  393. end;
  394. ait_datablock :
  395. begin
  396. if objectalloc^.currsec<>sec_bss then
  397. Message(asmw_e_alloc_data_only_in_bss);
  398. {$ifdef EXTERNALBSS}
  399. if pai_datablock(hp)^.is_global then
  400. begin
  401. pai_datablock(hp)^.sym^.typ:=AS_EXTERNAL;
  402. pai_datablock(hp)^.sym^.setaddress(sec_none,pai_datablock(hp)^.size,pai_datablock(hp)^.size);
  403. end
  404. else
  405. begin
  406. pai_datablock(hp)^.sym^.typ:=AS_LOCAL;
  407. pai_datablock(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,pai_datablock(hp)^.size);
  408. end;
  409. if not pai_datablock(hp)^.is_global then
  410. objectalloc^.sectionalloc(pai_datablock(hp)^.size);
  411. {$else}
  412. if pai_datablock(hp)^.is_global then
  413. pai_datablock(hp)^.sym^.typ:=AS_GLOBAL
  414. else
  415. pai_datablock(hp)^.sym^.typ:=AS_LOCAL;
  416. pai_datablock(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,pai_datablock(hp)^.size);
  417. objectalloc^.sectionalloc(pai_datablock(hp)^.size);
  418. {$endif}
  419. end;
  420. ait_const_32bit :
  421. objectalloc^.sectionalloc(4);
  422. ait_const_16bit :
  423. objectalloc^.sectionalloc(2);
  424. ait_const_8bit :
  425. objectalloc^.sectionalloc(1);
  426. ait_real_64bit :
  427. objectalloc^.sectionalloc(8);
  428. ait_real_32bit :
  429. objectalloc^.sectionalloc(4);
  430. ait_real_80bit :
  431. objectalloc^.sectionalloc(10);
  432. ait_const_rva,
  433. ait_const_symbol :
  434. objectalloc^.sectionalloc(4);
  435. ait_external :
  436. pai_external(hp)^.sym^.typ:=AS_EXTERNAL;
  437. ait_section:
  438. begin
  439. objectalloc^.setsection(pai_section(hp)^.sec);
  440. {$ifdef GDB}
  441. case pai_section(hp)^.sec of
  442. sec_code : n_line:=n_textline;
  443. sec_data : n_line:=n_dataline;
  444. sec_bss : n_line:=n_bssline;
  445. else
  446. n_line:=n_dataline;
  447. end;
  448. stabslastfileinfo.line:=-1;
  449. {$endif GDB}
  450. end;
  451. {$ifdef GDB}
  452. ait_stabn :
  453. convertstabs(pai_stabn(hp)^.str);
  454. ait_stabs :
  455. convertstabs(pai_stabs(hp)^.str);
  456. ait_stab_function_name :
  457. if assigned(pai_stab_function_name(hp)^.str) then
  458. funcname:=getasmsymbol(pai_stab_function_name(hp)^.str)
  459. else
  460. funcname:=nil;
  461. ait_force_line :
  462. stabslastfileinfo.line:=0;
  463. {$endif}
  464. ait_symbol :
  465. begin
  466. if pai_symbol(hp)^.is_global then
  467. pai_symbol(hp)^.sym^.typ:=AS_GLOBAL
  468. else
  469. pai_symbol(hp)^.sym^.typ:=AS_LOCAL;
  470. pai_symbol(hp)^.sym^.setaddress(objectalloc^.currsec,objectalloc^.sectionsize,0);
  471. end;
  472. ait_label :
  473. begin
  474. pai_label(hp)^.setaddress(objectalloc^.sectionsize);
  475. if pai_label(hp)^.l^.is_symbol then
  476. begin
  477. pai_label(hp)^.sym:=newasmsymbol(lab2str(pai_label(hp)^.l));
  478. if (pai_label(hp)^.l^.is_data) and (cs_smartlink in aktmoduleswitches) then
  479. pai_label(hp)^.sym^.typ:=AS_GLOBAL
  480. else
  481. pai_label(hp)^.sym^.typ:=AS_LOCAL;
  482. pai_label(hp)^.sym^.setaddress(objectalloc^.currsec,pai_label(hp)^.l^.address,0);
  483. end;
  484. end;
  485. ait_string :
  486. objectalloc^.sectionalloc(pai_string(hp)^.len);
  487. ait_labeled_instruction,
  488. ait_instruction :
  489. objectalloc^.sectionalloc(pai386(hp)^.Pass1(objectalloc^.sectionsize));
  490. ait_direct :
  491. Message(asmw_f_direct_not_supported);
  492. ait_comp :
  493. Message(asmw_f_comp_not_supported);
  494. ait_cut :
  495. break;
  496. end;
  497. hp:=pai(hp^.next);
  498. end;
  499. TreePass1:=hp;
  500. end;
  501. function ti386binasmlist.TreePass2(hp:pai):pai;
  502. const
  503. alignarray:array[0..5] of string[8]=(
  504. #$8D#$B4#$26#$00#$00#$00#$00,
  505. #$8D#$B6#$00#$00#$00#$00,
  506. #$8D#$74#$26#$00,
  507. #$8D#$76#$00,
  508. #$89#$F6,
  509. #$90
  510. );
  511. var
  512. l,j : longint;
  513. begin
  514. { main loop }
  515. while assigned(hp) do
  516. begin
  517. {$ifdef GDB}
  518. { write stabs }
  519. if cs_debuginfo in aktmoduleswitches then
  520. begin
  521. if (objectoutput^.currsec<>sec_none) and
  522. not(hp^.typ in [ait_external,ait_regalloc, ait_tempalloc,
  523. ait_stabn,ait_stabs,ait_section,
  524. ait_label,ait_cut,ait_marker,ait_align,ait_stab_function_name]) then
  525. WriteFileLineInfo(hp^.fileinfo);
  526. end;
  527. {$endif GDB}
  528. case hp^.typ of
  529. ait_align :
  530. begin
  531. l:=pai_align(hp)^.fillsize;
  532. while (l>0) do
  533. begin
  534. for j:=0to 5 do
  535. if (l>=length(alignarray[j])) then
  536. break;
  537. objectoutput^.writebytes(alignarray[j][1],length(alignarray[j]));
  538. dec(l,length(alignarray[j]));
  539. end;
  540. end;
  541. ait_section :
  542. begin
  543. objectoutput^.defaultsection(pai_section(hp)^.sec);
  544. {$ifdef GDB}
  545. case pai_section(hp)^.sec of
  546. sec_code : n_line:=n_textline;
  547. sec_data : n_line:=n_dataline;
  548. sec_bss : n_line:=n_bssline;
  549. else
  550. n_line:=n_dataline;
  551. end;
  552. stabslastfileinfo.line:=-1;
  553. {$endif GDB}
  554. end;
  555. ait_external :
  556. objectoutput^.writesymbol(pai_external(hp)^.sym);
  557. ait_symbol :
  558. objectoutput^.writesymbol(pai_symbol(hp)^.sym);
  559. ait_datablock :
  560. begin
  561. objectoutput^.writesymbol(pai_datablock(hp)^.sym);
  562. {$ifdef EXTERNALBSS}
  563. if not pai_datablock(hp)^.is_global then
  564. {$endif}
  565. objectoutput^.writealloc(pai_datablock(hp)^.size);
  566. end;
  567. ait_const_32bit :
  568. objectoutput^.writebytes(pai_const(hp)^.value,4);
  569. ait_const_16bit :
  570. objectoutput^.writebytes(pai_const(hp)^.value,2);
  571. ait_const_8bit :
  572. objectoutput^.writebytes(pai_const(hp)^.value,1);
  573. ait_real_64bit :
  574. objectoutput^.writebytes(pai_double(hp)^.value,8);
  575. ait_real_32bit :
  576. objectoutput^.writebytes(pai_single(hp)^.value,4);
  577. ait_real_80bit :
  578. objectoutput^.writebytes(pai_extended(hp)^.value,10);
  579. ait_string :
  580. objectoutput^.writebytes(pai_string(hp)^.str^,pai_string(hp)^.len);
  581. ait_const_rva :
  582. objectoutput^.writereloc(pai_const_symbol(hp)^.offset,4,
  583. pai_const_symbol(hp)^.sym,relative_rva);
  584. ait_const_symbol :
  585. objectoutput^.writereloc(pai_const_symbol(hp)^.offset,4,
  586. pai_const_symbol(hp)^.sym,relative_false);
  587. ait_label :
  588. begin
  589. if assigned(pai_label(hp)^.sym) then
  590. objectoutput^.writesymbol(pai_label(hp)^.sym);
  591. end;
  592. ait_labeled_instruction,
  593. ait_instruction :
  594. pai386(hp)^.Pass2;
  595. {$ifdef GDB}
  596. ait_stabn :
  597. convertstabs(pai_stabn(hp)^.str);
  598. ait_stabs :
  599. convertstabs(pai_stabs(hp)^.str);
  600. ait_stab_function_name :
  601. if assigned(pai_stab_function_name(hp)^.str) then
  602. funcname:=getasmsymbol(pai_stab_function_name(hp)^.str)
  603. else
  604. funcname:=nil;
  605. ait_force_line :
  606. stabslastfileinfo.line:=0;
  607. {$endif}
  608. ait_cut :
  609. break;
  610. end;
  611. hp:=pai(hp^.next);
  612. end;
  613. TreePass2:=hp;
  614. end;
  615. procedure ti386binasmlist.writetree(p:paasmoutput);
  616. var
  617. hp : pai;
  618. begin
  619. if not assigned(p) then
  620. exit;
  621. objectalloc^.setsection(sec_code);
  622. objectoutput^.defaultsection(sec_code);
  623. hp:=pai(p^.first);
  624. while assigned(hp) do
  625. begin
  626. { Pass 1 }
  627. currpass:=1;
  628. {$ifdef GDB}
  629. StartFileLineInfo;
  630. {$endif GDB}
  631. TreePass1(hp);
  632. { set section sizes }
  633. objectoutput^.setsectionsizes(objectalloc^.secsize);
  634. { Pass 2 }
  635. currpass:=2;
  636. {$ifdef GDB}
  637. StartFileLineInfo;
  638. {$endif GDB}
  639. hp:=TreePass2(hp);
  640. { if assigned then we have a ait_cut }
  641. if assigned(hp) then
  642. begin
  643. if hp^.typ<>ait_cut then
  644. internalerror(3334443);
  645. { write the current objectfile }
  646. objectoutput^.donewriting;
  647. { start the writing again }
  648. objectoutput^.initwriting;
  649. { we will start a new objectfile so reset everything }
  650. ResetAsmsymbolList;
  651. objectalloc^.resetsections;
  652. { avoid empty files }
  653. while assigned(hp^.next) and
  654. (pai(hp^.next)^.typ in [ait_marker,ait_comment,ait_section,ait_cut]) do
  655. begin
  656. if pai(hp^.next)^.typ=ait_section then
  657. begin
  658. objectalloc^.setsection(pai_section(hp^.next)^.sec);
  659. objectoutput^.defaultsection(pai_section(hp^.next)^.sec);
  660. end;
  661. hp:=pai(hp^.next);
  662. end;
  663. hp:=pai(hp^.next);
  664. end;
  665. end;
  666. end;
  667. procedure ti386binasmlist.writebin;
  668. var
  669. mylist : paasmoutput;
  670. procedure addlist(p:paasmoutput);
  671. begin
  672. mylist^.concat(new(pai_section,init(sec_code)));
  673. mylist^.concatlist(p);
  674. end;
  675. begin
  676. {$ifdef MULTIPASS}
  677. { Process the codesegment twice so the short jmp instructions can
  678. be optimized }
  679. currpass:=0;
  680. TreePass0(pai(codesegment^.first));
  681. {$endif}
  682. objectalloc^.resetsections;
  683. objectalloc^.setsection(sec_code);
  684. objectoutput^.initwriting;
  685. objectoutput^.defaultsection(sec_code);
  686. new(mylist,init);
  687. if not(cs_compilesystem in aktmoduleswitches) then
  688. addlist(externals);
  689. if cs_debuginfo in aktmoduleswitches then
  690. addlist(debuglist);
  691. addlist(codesegment);
  692. addlist(datasegment);
  693. addlist(consts);
  694. addlist(rttilist);
  695. addlist(bsssegment);
  696. if assigned(importssection) then
  697. addlist(importssection);
  698. if assigned(exportssection) then
  699. addlist(exportssection);
  700. if assigned(resourcesection) then
  701. addlist(resourcesection);
  702. WriteTree(mylist);
  703. dispose(mylist,done);
  704. objectoutput^.donewriting;
  705. end;
  706. constructor ti386binasmlist.init(t:togtype);
  707. begin
  708. case t of
  709. og_none :
  710. Message(asmw_f_no_binary_writer_selected);
  711. og_dbg :
  712. objectoutput:=new(pdbgoutput,init);
  713. og_coff :
  714. objectoutput:=new(pdjgppcoffoutput,init);
  715. og_pecoff :
  716. objectoutput:=new(pwin32coffoutput,init);
  717. end;
  718. objectalloc:=new(pobjectalloc,init);
  719. currpass:=0;
  720. end;
  721. destructor ti386binasmlist.done;
  722. begin
  723. dispose(objectoutput,done);
  724. dispose(objectalloc,done);
  725. end;
  726. end.
  727. {
  728. $Log$
  729. Revision 1.5 1999-05-06 09:05:07 peter
  730. * generic write_float and str_float
  731. * fixed constant float conversions
  732. Revision 1.4 1999/05/05 22:21:47 peter
  733. * updated messages
  734. Revision 1.3 1999/05/05 17:34:29 peter
  735. * output is more like as 2.9.1
  736. * stabs really working for go32v2
  737. Revision 1.2 1999/05/04 21:44:30 florian
  738. * changes to compile it with Delphi 4.0
  739. Revision 1.1 1999/05/01 13:23:57 peter
  740. * merged nasm compiler
  741. * old asm moved to oldasm/
  742. Revision 1.14 1999/04/16 11:49:48 peter
  743. + tempalloc
  744. + -at to show temp alloc info in .s file
  745. Revision 1.13 1999/03/12 00:20:03 pierre
  746. + win32 output working !
  747. Revision 1.12 1999/03/11 17:52:34 peter
  748. * fixed wrong ot_signed generation in insns tab
  749. Revision 1.11 1999/03/10 13:41:07 pierre
  750. + partial implementation for win32 !
  751. winhello works but pp still does not !
  752. Revision 1.10 1999/03/08 14:51:05 peter
  753. + smartlinking for ag386bin
  754. Revision 1.9 1999/03/06 17:24:18 peter
  755. * rewritten intel parser a lot, especially reference reading
  756. * size checking added for asm parsers
  757. Revision 1.8 1999/03/05 13:09:50 peter
  758. * first things for tai_cut support for ag386bin
  759. Revision 1.7 1999/03/03 11:41:53 pierre
  760. + stabs info corrected to give results near to GAS output
  761. * local labels (with .L are not stored in object anymore)
  762. so we get the same number of symbols as from GAS !
  763. Revision 1.6 1999/03/03 01:36:44 pierre
  764. + stabs output working (though not really tested)
  765. for a simple file the only difference to GAS output is due
  766. to the VMA of the different sections
  767. Revision 1.5 1999/03/02 02:56:18 peter
  768. + stabs support for binary writers
  769. * more fixes and missing updates from the previous commit :(
  770. Revision 1.4 1999/03/01 15:46:20 peter
  771. * ag386bin finally make cycles correct
  772. * prefixes are now also normal opcodes
  773. Revision 1.3 1999/02/25 21:03:01 peter
  774. * ag386bin updates
  775. + coff writer
  776. Revision 1.2 1999/02/22 02:16:00 peter
  777. * updates for ag386bin
  778. Revision 1.1 1999/02/16 17:59:37 peter
  779. + initial files
  780. }