og386cff.pas 28 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942
  1. {
  2. $Id$
  3. Copyright (c) 1999 by Florian Klaempfl
  4. Contains the 386 binary coff writer
  5. * This code was inspired by the NASM sources
  6. The Netwide Assembler is copyright (C) 1996 Simon Tatham and
  7. Julian Hall. All rights reserved.
  8. This program is free software; you can redistribute it and/or modify
  9. it under the terms of the GNU General Public License as published by
  10. the Free Software Foundation; either version 2 of the License, or
  11. (at your option) any later version.
  12. This program is distributed in the hope that it will be useful,
  13. but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. GNU General Public License for more details.
  16. You should have received a copy of the GNU General Public License
  17. along with this program; if not, write to the Free Software
  18. Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  19. ****************************************************************************
  20. }
  21. unit og386cff;
  22. {
  23. Notes on COFF:
  24. (0) When I say `standard COFF' below, I mean `COFF as output and
  25. used by DJGPP'. I assume DJGPP gets it right.
  26. (1) Win32 appears to interpret the term `relative relocation'
  27. differently from standard COFF. Standard COFF understands a
  28. relative relocation to mean that during relocation you add the
  29. address of the symbol you're referencing, and subtract the base
  30. address of the section you're in. Win32 COFF, by contrast, seems
  31. to add the address of the symbol and then subtract the address
  32. of THE BYTE AFTER THE RELOCATED DWORD. Hence the two formats are
  33. subtly incompatible.
  34. (2) Win32 doesn't bother putting any flags in the header flags
  35. field (at offset 0x12 into the file).
  36. (3) Win32 uses some extra flags into the section header table:
  37. it defines flags 0x80000000 (writable), 0x40000000 (readable)
  38. and 0x20000000 (executable), and uses them in the expected
  39. combinations. It also defines 0x00100000 through 0x00700000 for
  40. section alignments of 1 through 64 bytes.
  41. (4) Both standard COFF and Win32 COFF seem to use the DWORD
  42. field directly after the section name in the section header
  43. table for something strange: they store what the address of the
  44. section start point _would_ be, if you laid all the sections end
  45. to end starting at zero. Dunno why. Microsoft's documentation
  46. lists this field as "Virtual Size of Section", which doesn't
  47. seem to fit at all. In fact, Win32 even includes non-linked
  48. sections such as .drectve in this calculation.
  49. (5) Standard COFF does something very strange to common
  50. variables: the relocation point for a common variable is as far
  51. _before_ the variable as its size stretches out _after_ it. So
  52. we must fix up common variable references. Win32 seems to be
  53. sensible on this one.
  54. }
  55. interface
  56. uses
  57. cobjects,
  58. systems,i386base,aasm,
  59. og386;
  60. type
  61. preloc = ^treloc;
  62. treloc = packed record
  63. next : preloc;
  64. address : longint;
  65. symbol : pasmsymbol;
  66. section : tsection; { only used if symbol=nil }
  67. relative : relative_type;
  68. end;
  69. psymbol = ^tsymbol;
  70. tsymbol = packed record
  71. name : string[8];
  72. strpos : longint;
  73. section : tsection;
  74. value : longint;
  75. typ : TAsmsymtype;
  76. end;
  77. pcoffsection = ^tcoffsection;
  78. tcoffsection = object
  79. index : tsection;
  80. secidx : longint;
  81. data : PDynamicArray;
  82. size,
  83. fillsize,
  84. mempos,
  85. len,
  86. datapos,
  87. relocpos,
  88. nrelocs,
  89. flags : longint;
  90. relochead : PReloc;
  91. reloctail : ^PReloc;
  92. constructor init(sec:TSection;Aflags:longint);
  93. destructor done;
  94. procedure write(var d;l:longint);
  95. procedure alloc(l:longint);
  96. procedure addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
  97. procedure addsectionreloc(ofs:longint;sec:tsection);
  98. end;
  99. pgenericcoffoutput = ^tgenericcoffoutput;
  100. tgenericcoffoutput = object(tobjectoutput)
  101. win32 : boolean;
  102. sects : array[TSection] of PCoffSection;
  103. strs,
  104. syms : Pdynamicarray;
  105. initsym : longint;
  106. constructor init;
  107. destructor done;virtual;
  108. procedure initwriting;virtual;
  109. procedure donewriting;virtual;
  110. procedure setsectionsizes(var s:tsecsize);virtual;
  111. procedure writebytes(var data;len:longint);virtual;
  112. procedure writealloc(len:longint);virtual;
  113. procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);virtual;
  114. procedure writesymbol(p:pasmsymbol);virtual;
  115. procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;
  116. function text_flags : longint;virtual;
  117. function data_flags : longint;virtual;
  118. function bss_flags : longint;virtual;
  119. function info_flags : longint;virtual;
  120. private
  121. procedure createsection(sec:tsection);
  122. procedure write_relocs(s:pcoffsection);
  123. procedure write_symbol(const name:string;strpos,value,section,typ,aux:longint);
  124. procedure write_symbols;
  125. procedure writetodisk;
  126. end;
  127. pdjgppcoffoutput = ^tdjgppcoffoutput;
  128. tdjgppcoffoutput = object(tgenericcoffoutput)
  129. constructor init;
  130. function text_flags : longint;virtual;
  131. function data_flags : longint;virtual;
  132. function bss_flags : longint;virtual;
  133. function info_flags : longint;virtual;
  134. end;
  135. pwin32coffoutput = ^twin32coffoutput;
  136. twin32coffoutput = object(tgenericcoffoutput)
  137. constructor init;
  138. function text_flags : longint;virtual;
  139. function data_flags : longint;virtual;
  140. function bss_flags : longint;virtual;
  141. function info_flags : longint;virtual;
  142. end;
  143. implementation
  144. uses
  145. strings,verbose,
  146. globtype,globals,files;
  147. type
  148. { Structures which are written directly to the output file }
  149. coffheader=packed record
  150. mach : word;
  151. nsects : word;
  152. time : longint;
  153. sympos : longint;
  154. syms : longint;
  155. opthdr : word;
  156. flag : word;
  157. end;
  158. coffsechdr=packed record
  159. name : array[0..7] of char;
  160. vsize : longint;
  161. rvaofs : longint;
  162. datalen : longint;
  163. datapos : longint;
  164. relocpos : longint;
  165. lineno1 : longint;
  166. nrelocs : word;
  167. lineno2 : word;
  168. flags : longint;
  169. end;
  170. coffsectionrec=packed record
  171. len : longint;
  172. nrelocs : word;
  173. empty : array[0..11] of char;
  174. end;
  175. coffreloc=packed record
  176. address : longint;
  177. sym : longint;
  178. relative : word;
  179. end;
  180. coffsymbol=packed record
  181. name : array[0..3] of char; { real is [0..7], which overlaps the strpos ! }
  182. strpos : longint;
  183. value : longint;
  184. section : integer;
  185. empty : integer;
  186. typ : byte;
  187. aux : byte;
  188. end;
  189. pcoffstab=^coffstab;
  190. coffstab=packed record
  191. strpos : longint;
  192. ntype : byte;
  193. nother : byte;
  194. ndesc : word;
  195. nvalue : longint;
  196. end;
  197. {****************************************************************************
  198. TSection
  199. ****************************************************************************}
  200. constructor tcoffsection.init(sec:TSection;Aflags:longint);
  201. begin
  202. index:=sec;
  203. secidx:=0;
  204. flags:=AFlags;
  205. { filled after pass 1 }
  206. size:=0;
  207. fillsize:=0;
  208. mempos:=0;
  209. { pass 2 data }
  210. relocHead:=nil;
  211. relocTail:=@relocHead;
  212. Len:=0;
  213. NRelocs:=0;
  214. if sec=sec_bss then
  215. data:=nil
  216. else
  217. new(Data,Init(1,8192));
  218. end;
  219. destructor tcoffsection.done;
  220. begin
  221. if assigned(Data) then
  222. dispose(Data,done);
  223. end;
  224. procedure tcoffsection.write(var d;l:longint);
  225. begin
  226. if not assigned(Data) then
  227. Internalerror(3334441);
  228. Data^.write(d,l);
  229. inc(len,l);
  230. end;
  231. procedure tcoffsection.alloc(l:longint);
  232. begin
  233. if assigned(Data) then
  234. Internalerror(3334442);
  235. inc(len,l);
  236. end;
  237. procedure tcoffsection.addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
  238. var
  239. r : PReloc;
  240. begin
  241. new(r);
  242. reloctail^:=r;
  243. reloctail:=@r^.next;
  244. r^.next:=nil;
  245. r^.address:=ofs+mempos;
  246. r^.symbol:=p;
  247. r^.section:=sec_none;
  248. r^.relative:=relative;
  249. inc(nrelocs);
  250. end;
  251. procedure tcoffsection.addsectionreloc(ofs:longint;sec:tsection);
  252. var
  253. r : PReloc;
  254. begin
  255. new(r);
  256. reloctail^:=r;
  257. reloctail:=@r^.next;
  258. r^.next:=nil;
  259. r^.address:=ofs+mempos;
  260. r^.symbol:=nil;
  261. r^.section:=sec;
  262. r^.relative:=relative_false;
  263. inc(nrelocs);
  264. end;
  265. {****************************************************************************
  266. Genericcoffoutput
  267. ****************************************************************************}
  268. const
  269. {$ifdef TP}
  270. symbolresize = 50;
  271. strsresize = 200;
  272. {$else}
  273. symbolresize = 200;
  274. strsresize = 8192;
  275. {$endif}
  276. constructor tgenericcoffoutput.init;
  277. begin
  278. inherited init;
  279. end;
  280. destructor tgenericcoffoutput.done;
  281. begin
  282. inherited done;
  283. end;
  284. procedure tgenericcoffoutput.initwriting;
  285. var
  286. s : string;
  287. begin
  288. inherited initwriting;
  289. { reset }
  290. initsym:=0;
  291. new(syms,init(sizeof(TSymbol),symbolresize));
  292. new(strs,init(1,strsresize));
  293. FillChar(Sects,sizeof(Sects),0);
  294. { we need at least the following 3 sections }
  295. createsection(sec_code);
  296. createsection(sec_data);
  297. createsection(sec_bss);
  298. if (cs_debuginfo in aktmoduleswitches) then
  299. begin
  300. createsection(sec_stab);
  301. createsection(sec_stabstr);
  302. writestabs(sec_none,0,nil,0,0,0,false);
  303. { write zero pchar and name together (PM) }
  304. s:=#0+SplitFileName(current_module^.mainsource^)+#0;
  305. sects[sec_stabstr]^.write(s[1],length(s));
  306. end;
  307. end;
  308. procedure tgenericcoffoutput.donewriting;
  309. var
  310. sec : tsection;
  311. begin
  312. writetodisk;
  313. dispose(syms,done);
  314. dispose(strs,done);
  315. for sec:=low(tsection) to high(tsection) do
  316. if assigned(sects[sec]) then
  317. dispose(sects[sec],done);
  318. inherited donewriting;
  319. end;
  320. function tgenericcoffoutput.text_flags : longint;
  321. begin
  322. text_flags:=0;
  323. end;
  324. function tgenericcoffoutput.data_flags : longint;
  325. begin
  326. data_flags:=0;
  327. end;
  328. function tgenericcoffoutput.bss_flags : longint;
  329. begin
  330. bss_flags:=0;
  331. end;
  332. function tgenericcoffoutput.info_flags : longint;
  333. begin
  334. info_flags:=0;
  335. end;
  336. procedure tgenericcoffoutput.createsection(sec:TSection);
  337. var
  338. Aflags : longint;
  339. begin
  340. Aflags:=0;
  341. case sec of
  342. sec_code :
  343. Aflags:=text_flags;
  344. sec_data :
  345. Aflags:=data_flags;
  346. sec_bss :
  347. Aflags:=bss_flags;
  348. else
  349. Aflags:=0;
  350. end;
  351. sects[sec]:=new(PcoffSection,init(Sec,Aflags));
  352. end;
  353. procedure tgenericcoffoutput.writesymbol(p:pasmsymbol);
  354. var
  355. pos : longint;
  356. sym : tsymbol;
  357. c : char;
  358. s : string;
  359. begin
  360. { already written ? }
  361. if p^.idx<>-1 then
  362. exit;
  363. { be sure that the section will exists }
  364. if (p^.section<>sec_none) and not(assigned(sects[p^.section])) then
  365. createsection(p^.section);
  366. { symbolname }
  367. pos:=strs^.usedsize+4;
  368. c:=#0;
  369. s:=p^.name;
  370. if length(s)>8 then
  371. begin
  372. s:=s+#0;
  373. strs^.write(s[1],length(s));
  374. end
  375. else
  376. pos:=-1;
  377. FillChar(sym,sizeof(sym),0);
  378. sym.strpos:=pos;
  379. if pos=-1 then
  380. sym.name:=s;
  381. sym.value:=p^.size;
  382. sym.typ:=p^.typ;
  383. { if local of global then set the section value to the address
  384. of the symbol }
  385. if p^.typ in [AS_LOCAL,AS_GLOBAL] then
  386. begin
  387. sym.section:=p^.section;
  388. sym.value:=p^.address+sects[p^.section]^.mempos;
  389. end;
  390. { update the asmsymbol index }
  391. p^.idx:=syms^.count;
  392. { store the symbol, but not the local ones (PM) }
  393. if (p^.typ<>AS_LOCAL) or ((copy(s,1,2)<>'.L') and
  394. ((copy(s,1,1)<>'L') or not win32)) then
  395. syms^.write(sym,1);
  396. { make the exported syms known to the objectwriter
  397. (needed for .a generation) }
  398. if (p^.typ=AS_GLOBAL) or
  399. ((p^.typ=AS_EXTERNAL) and (sym.value=p^.size) and (sym.value>0)) then
  400. writer^.writesym(p^.name);
  401. end;
  402. procedure tgenericcoffoutput.writebytes(var data;len:longint);
  403. begin
  404. if not assigned(sects[currsec]) then
  405. createsection(currsec);
  406. sects[currsec]^.write(data,len);
  407. end;
  408. procedure tgenericcoffoutput.writealloc(len:longint);
  409. begin
  410. if not assigned(sects[currsec]) then
  411. createsection(currsec);
  412. sects[currsec]^.alloc(len);
  413. end;
  414. procedure tgenericcoffoutput.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
  415. var
  416. symaddr : longint;
  417. begin
  418. if not assigned(sects[currsec]) then
  419. createsection(currsec);
  420. if assigned(p) then
  421. begin
  422. { real address of the symbol }
  423. symaddr:=p^.address;
  424. if p^.section<>sec_none then
  425. inc(symaddr,sects[p^.section]^.mempos);
  426. { no symbol relocation need inside a section }
  427. if p^.section=currsec then
  428. begin
  429. case relative of
  430. relative_false :
  431. begin
  432. sects[currsec]^.addsectionreloc(sects[currsec]^.len,currsec);
  433. inc(data,symaddr);
  434. end;
  435. relative_true :
  436. begin
  437. inc(data,symaddr-len-sects[currsec]^.len);
  438. end;
  439. relative_rva :
  440. begin
  441. { don't know if this can happens !! }
  442. { does this work ?? }
  443. sects[currsec]^.addsectionreloc(sects[currsec]^.len,currsec);
  444. inc(data,symaddr);
  445. end;
  446. end;
  447. end
  448. else
  449. begin
  450. writesymbol(p);
  451. if (p^.section<>sec_none) and (relative=relative_false) then
  452. sects[currsec]^.addsectionreloc(sects[currsec]^.len,p^.section)
  453. else
  454. sects[currsec]^.addsymreloc(sects[currsec]^.len,p,relative);
  455. if not win32 then {seems wrong to me (PM) }
  456. inc(data,symaddr)
  457. else
  458. if (relative<>relative_true) and (p^.section<>sec_none) then
  459. inc(data,symaddr);
  460. if relative=relative_true then
  461. begin
  462. if win32 then
  463. dec(data,len-4)
  464. else
  465. dec(data,len+sects[currsec]^.len);
  466. end;
  467. end;
  468. end;
  469. sects[currsec]^.write(data,len);
  470. end;
  471. procedure tgenericcoffoutput.writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc : boolean);
  472. var
  473. stab : coffstab;
  474. s : tsection;
  475. begin
  476. if section=sec_none then
  477. s:=currsec
  478. else
  479. s:=section;
  480. { local var can be at offset -1 !! PM }
  481. if reloc then
  482. begin
  483. if (offset=-1) then
  484. begin
  485. if s=sec_none then
  486. offset:=0
  487. else
  488. offset:=sects[s]^.len;
  489. end;
  490. if (s<>sec_none) then
  491. inc(offset,sects[s]^.mempos);
  492. end;
  493. fillchar(stab,sizeof(coffstab),0);
  494. if assigned(p) and (p[0]<>#0) then
  495. begin
  496. stab.strpos:=sects[sec_stabstr]^.len;
  497. sects[sec_stabstr]^.write(p^,strlen(p)+1);
  498. end;
  499. stab.ntype:=nidx;
  500. stab.ndesc:=line;
  501. stab.nother:=nother;
  502. stab.nvalue:=offset;
  503. sects[sec_stab]^.write(stab,sizeof(stab));
  504. { when the offset is not 0 then write a relocation, take also the
  505. hdrstab into account with the offset }
  506. if reloc then
  507. sects[sec_stab]^.addsectionreloc(sects[sec_stab]^.len-4,s);
  508. end;
  509. procedure tgenericcoffoutput.write_relocs(s:pcoffsection);
  510. var
  511. rel : coffreloc;
  512. hr,r : preloc;
  513. begin
  514. r:=s^.relochead;
  515. while assigned(r) do
  516. begin
  517. rel.address:=r^.address;
  518. if assigned(r^.symbol) then
  519. begin
  520. if (r^.symbol^.typ=AS_LOCAL) then
  521. rel.sym:=2*sects[r^.symbol^.section]^.secidx
  522. else
  523. rel.sym:=r^.symbol^.idx+initsym;
  524. end
  525. else
  526. rel.sym:=2*sects[r^.section]^.secidx;
  527. case r^.relative of
  528. relative_true : rel.relative:=$14;
  529. relative_false : rel.relative:=$6;
  530. relative_rva : rel.relative:=$7;
  531. end;
  532. writer^.write(rel,sizeof(rel));
  533. { goto next and dispose this reloc }
  534. hr:=r;
  535. r:=r^.next;
  536. dispose(hr);
  537. end;
  538. end;
  539. procedure tgenericcoffoutput.write_symbol(const name:string;strpos,value,section,typ,aux:longint);
  540. var
  541. sym : coffsymbol;
  542. begin
  543. FillChar(sym,sizeof(sym),0);
  544. if strpos=-1 then
  545. move(name[1],sym.name,length(name))
  546. else
  547. sym.strpos:=strpos;
  548. sym.value:=value;
  549. sym.section:=section;
  550. sym.typ:=typ;
  551. sym.aux:=aux;
  552. writer^.write(sym,sizeof(sym));
  553. end;
  554. procedure tgenericcoffoutput.write_symbols;
  555. var
  556. filename : string[18];
  557. sec : tsection;
  558. sectionval,
  559. i : longint;
  560. globalval : byte;
  561. secrec : coffsectionrec;
  562. sym : tsymbol;
  563. begin
  564. { The `.file' record, and the file name auxiliary record. }
  565. write_symbol ('.file', -1, 0, -2, $67, 1);
  566. fillchar(filename,sizeof(filename),0);
  567. filename:=SplitFileName(current_module^.mainsource^);
  568. writer^.write(filename[1],sizeof(filename)-1);
  569. { The section records, with their auxiliaries, also store the
  570. symbol index }
  571. for sec:=low(tsection) to high(tsection) do
  572. if assigned(sects[sec]) then
  573. begin
  574. write_symbol(target_asm.secnames[sec],-1,sects[sec]^.mempos,sects[sec]^.secidx,3,1);
  575. fillchar(secrec,sizeof(secrec),0);
  576. secrec.len:=sects[sec]^.len;
  577. secrec.nrelocs:=sects[sec]^.nrelocs;
  578. writer^.write(secrec,sizeof(secrec));
  579. end;
  580. { The real symbols. }
  581. syms^.seek(0);
  582. for i:=1 to syms^.count do
  583. begin
  584. syms^.read(sym,1);
  585. if sym.typ=AS_LOCAL then
  586. globalval:=3
  587. else
  588. globalval:=2;
  589. if assigned(sects[sym.section]) then
  590. sectionval:=sects[sym.section]^.secidx
  591. else
  592. sectionval:=0;
  593. write_symbol(sym.name,sym.strpos,sym.value,sectionval,globalval,0);
  594. end;
  595. end;
  596. procedure tgenericcoffoutput.setsectionsizes(var s:tsecsize);
  597. var
  598. align,
  599. mempos : longint;
  600. sec : tsection;
  601. begin
  602. { multiply stab with real size }
  603. s[sec_stab]:=s[sec_stab]*sizeof(coffstab);
  604. { if debug then also count header stab }
  605. if (cs_debuginfo in aktmoduleswitches) then
  606. begin
  607. inc(s[sec_stab],sizeof(coffstab));
  608. inc(s[sec_stabstr],length(SplitFileName(current_module^.mainsource^))+2);
  609. end;
  610. { fix all section }
  611. mempos:=0;
  612. for sec:=low(tsection) to high(tsection) do
  613. if s[sec]>0 then
  614. begin
  615. if not assigned(sects[sec]) then
  616. createsection(sec);
  617. sects[sec]^.size:=s[sec];
  618. sects[sec]^.mempos:=mempos;
  619. { calculate the alignment }
  620. if sects[sec]^.flags=0 then
  621. align:=1
  622. else
  623. align:=4;
  624. sects[sec]^.fillsize:=align-(sects[sec]^.size and (align-1));
  625. if sects[sec]^.fillsize=align then
  626. sects[sec]^.fillsize:=0;
  627. { next section position, not for win32 which uses
  628. relative addresses }
  629. if not win32 then
  630. inc(mempos,sects[sec]^.size+sects[sec]^.fillsize);
  631. end;
  632. end;
  633. procedure tgenericcoffoutput.writetodisk;
  634. var
  635. datapos,secidx,
  636. nsects,sympos,i : longint;
  637. sec : tsection;
  638. header : coffheader;
  639. sechdr : coffsechdr;
  640. empty : array[0..15] of byte;
  641. begin
  642. { calc amount of sections we have and align sections at 4 bytes }
  643. fillchar(empty,sizeof(empty),0);
  644. nsects:=0;
  645. for sec:=low(tsection) to high(tsection) do
  646. if assigned(sects[sec]) then
  647. begin
  648. { check if the section is still the same size }
  649. if (sects[sec]^.len<>sects[sec]^.size) then
  650. Comment(V_Warning,'Size of section changed '+tostr(sects[sec]^.size)+'->'+tostr(sects[sec]^.len)+
  651. ' ['+target_asm.secnames[sec]+']');
  652. { fill with zero }
  653. if sects[sec]^.fillsize>0 then
  654. begin
  655. if assigned(sects[sec]^.data) then
  656. sects[sec]^.write(empty,sects[sec]^.fillsize)
  657. else
  658. sects[sec]^.alloc(sects[sec]^.fillsize);
  659. end;
  660. inc(nsects);
  661. end;
  662. { Calculate the filepositions }
  663. datapos:=sizeof(coffheader)+sizeof(coffsechdr)*nsects;
  664. initsym:=2; { 2 for the file }
  665. { sections first }
  666. secidx:=0;
  667. for sec:=low(tsection) to high(tsection) do
  668. if assigned(sects[sec]) then
  669. begin
  670. inc(secidx);
  671. sects[sec]^.secidx:=secidx;
  672. sects[sec]^.datapos:=datapos;
  673. if assigned(sects[sec]^.data) then
  674. inc(datapos,sects[sec]^.len);
  675. inc(initsym,2); { 2 for each section }
  676. end;
  677. { relocs }
  678. for sec:=low(tsection) to high(tsection) do
  679. if assigned(sects[sec]) then
  680. begin
  681. sects[sec]^.relocpos:=datapos;
  682. inc(datapos,10*sects[sec]^.nrelocs);
  683. end;
  684. { symbols }
  685. sympos:=datapos;
  686. { COFF header }
  687. fillchar(header,sizeof(coffheader),0);
  688. header.mach:=$14c;
  689. header.nsects:=nsects;
  690. header.sympos:=sympos;
  691. header.syms:=syms^.count+initsym;
  692. header.flag:=$104;
  693. writer^.write(header,sizeof(header));
  694. { Section headers }
  695. for sec:=low(tsection) to high(tsection) do
  696. if assigned(sects[sec]) then
  697. begin
  698. fillchar(sechdr,sizeof(sechdr),0);
  699. move(target_asm.secnames[sec][1],sechdr.name,length(target_asm.secnames[sec]));
  700. if not win32 then
  701. begin
  702. sechdr.rvaofs:=sects[sec]^.mempos;
  703. sechdr.vsize:=sects[sec]^.mempos;
  704. end
  705. else
  706. begin
  707. if sec=sec_bss then
  708. sechdr.vsize:=sects[sec]^.len;
  709. end;
  710. sechdr.datalen:=sects[sec]^.len;
  711. if (sects[sec]^.len>0) and assigned(sects[sec]^.data) then
  712. sechdr.datapos:=sects[sec]^.datapos;
  713. sechdr.relocpos:=sects[sec]^.relocpos;
  714. sechdr.nrelocs:=sects[sec]^.nrelocs;
  715. sechdr.flags:=sects[sec]^.flags;
  716. writer^.write(sechdr,sizeof(sechdr));
  717. end;
  718. { Sections }
  719. for sec:=low(tsection) to high(tsection) do
  720. if assigned(sects[sec]) and
  721. assigned(sects[sec]^.data) then
  722. begin
  723. { For the stab section we need an HdrSym which can now be
  724. calculated more easily }
  725. if sec=sec_stab then
  726. begin
  727. pcoffstab(sects[sec_stab]^.data^.data)^.nvalue:=sects[sec_stabstr]^.len;
  728. pcoffstab(sects[sec_stab]^.data^.data)^.strpos:=1;
  729. pcoffstab(sects[sec_stab]^.data^.data)^.ndesc:=
  730. (sects[sec_stab]^.len div sizeof(coffstab))-1{+1 according to gas output PM};
  731. end;
  732. writer^.write(sects[sec]^.data^.data^,sects[sec]^.data^.usedsize);
  733. end;
  734. { Relocs }
  735. for sec:=low(tsection) to high(tsection) do
  736. if assigned(sects[sec]) then
  737. write_relocs(sects[sec]);
  738. { Symbols }
  739. write_symbols;
  740. { Strings }
  741. i:=strs^.usedsize+4;
  742. writer^.write(i,4);
  743. writer^.write(strs^.data^,strs^.usedsize);
  744. end;
  745. {****************************************************************************
  746. DJGppcoffoutput
  747. ****************************************************************************}
  748. constructor tdjgppcoffoutput.init;
  749. begin
  750. inherited init;
  751. win32:=false;
  752. end;
  753. function tdjgppcoffoutput.text_flags : longint;
  754. begin
  755. text_flags:=$20;
  756. end;
  757. function tdjgppcoffoutput.data_flags : longint;
  758. begin
  759. data_flags:=$40;
  760. end;
  761. function tdjgppcoffoutput.bss_flags : longint;
  762. begin
  763. bss_flags:=$80;
  764. end;
  765. function tdjgppcoffoutput.info_flags : longint;
  766. begin
  767. writeln('djgpp coff doesn''t support info sections');
  768. info_flags:=$40;
  769. end;
  770. {****************************************************************************
  771. Win32coffoutput
  772. ****************************************************************************}
  773. constructor twin32coffoutput.init;
  774. begin
  775. inherited init;
  776. win32:=true;
  777. end;
  778. function twin32coffoutput.text_flags : longint;
  779. begin
  780. text_flags:=$60000020; { same as as 2.9.1 }
  781. end;
  782. function twin32coffoutput.data_flags : longint;
  783. begin
  784. data_flags:=$c0300040;
  785. end;
  786. function twin32coffoutput.bss_flags : longint;
  787. begin
  788. bss_flags:=$c0300080;
  789. end;
  790. function twin32coffoutput.info_flags : longint;
  791. begin
  792. info_flags:=$100a00;
  793. end;
  794. end.
  795. {
  796. $Log$
  797. Revision 1.3 1999-05-05 17:34:31 peter
  798. * output is more like as 2.9.1
  799. * stabs really working for go32v2
  800. Revision 1.2 1999/05/02 22:36:35 peter
  801. * fixed section index when not all sections are used
  802. Revision 1.1 1999/05/01 13:24:24 peter
  803. * merged nasm compiler
  804. * old asm moved to oldasm/
  805. Revision 1.13 1999/03/18 20:30:49 peter
  806. + .a writer
  807. Revision 1.12 1999/03/12 00:20:06 pierre
  808. + win32 output working !
  809. Revision 1.11 1999/03/11 13:43:08 pierre
  810. * more fixes for win32
  811. Revision 1.10 1999/03/10 13:41:10 pierre
  812. + partial implementation for win32 !
  813. winhello works but pp still does not !
  814. Revision 1.9 1999/03/08 14:51:09 peter
  815. + smartlinking for ag386bin
  816. Revision 1.8 1999/03/05 13:09:52 peter
  817. * first things for tai_cut support for ag386bin
  818. Revision 1.7 1999/03/04 13:44:58 pierre
  819. * win32 pecoff sections datapos allways zero
  820. Revision 1.6 1999/03/03 11:41:54 pierre
  821. + stabs info corrected to give results near to GAS output
  822. * local labels (with .L are not stored in object anymore)
  823. so we get the same number of symbols as from GAS !
  824. Revision 1.5 1999/03/03 01:36:46 pierre
  825. + stabs output working (though not really tested)
  826. for a simple file the only difference to GAS output is due
  827. to the VMA of the different sections
  828. Revision 1.4 1999/03/02 02:56:27 peter
  829. + stabs support for binary writers
  830. * more fixes and missing updates from the previous commit :(
  831. Revision 1.3 1999/03/01 15:46:25 peter
  832. * ag386bin finally make cycles correct
  833. * prefixes are now also normal opcodes
  834. Revision 1.2 1999/02/25 21:03:10 peter
  835. * ag386bin updates
  836. + coff writer
  837. }