ag386bin.pas 29 KB

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