ag386bin.pas 28 KB

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