og386cff.pas 27 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890
  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. og386,i386base,aasm;
  59. type
  60. preloc = ^treloc;
  61. treloc = packed record
  62. next : preloc;
  63. address : longint;
  64. symbol : pasmsymbol;
  65. section : tsection; { only used if symbol=nil }
  66. relative : relative_type;
  67. end;
  68. psymbol = ^tsymbol;
  69. tsymbol = packed record
  70. name : string[8];
  71. strpos : longint;
  72. section : longint;
  73. value : longint;
  74. typ : TAsmsymtype;
  75. end;
  76. pcoffsection = ^tcoffsection;
  77. tcoffsection = object
  78. index : tsection;
  79. data : PDynamicArray;
  80. len,
  81. pos,
  82. datapos,
  83. relocpos,
  84. nrelocs,
  85. flags : longint;
  86. relochead : PReloc;
  87. reloctail : ^PReloc;
  88. constructor init(sec:TSection;Aflags:longint);
  89. destructor done;
  90. procedure write(var d;l:longint);
  91. procedure alloc(l:longint);
  92. procedure addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
  93. procedure addsectionreloc(ofs:longint;sec:tsection);
  94. end;
  95. pgenericcoffoutput = ^tgenericcoffoutput;
  96. tgenericcoffoutput = object(tobjectoutput)
  97. win32 : boolean;
  98. sects : array[TSection] of PCoffSection;
  99. strs,
  100. syms : Pdynamicarray;
  101. initsym : longint;
  102. constructor init;
  103. destructor done;virtual;
  104. procedure initwriting;virtual;
  105. procedure donewriting;virtual;
  106. procedure writebytes(var data;len:longint);virtual;
  107. procedure writealloc(len:longint);virtual;
  108. procedure writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);virtual;
  109. procedure writesymbol(p:pasmsymbol);virtual;
  110. procedure writestabs(section:tsection;offset:longint;p:pchar;nidx,nother,line:longint;reloc:boolean);virtual;
  111. function text_flags : longint;virtual;
  112. function data_flags : longint;virtual;
  113. function bss_flags : longint;virtual;
  114. function info_flags : longint;virtual;
  115. private
  116. procedure createsection(sec:tsection);
  117. procedure write_relocs(s:pcoffsection);
  118. procedure write_symbol(const name:string;strpos,value,section,typ,aux:longint);
  119. procedure write_symbols;
  120. procedure writetodisk;
  121. end;
  122. pdjgppcoffoutput = ^tdjgppcoffoutput;
  123. tdjgppcoffoutput = object(tgenericcoffoutput)
  124. constructor init;
  125. function text_flags : longint;virtual;
  126. function data_flags : longint;virtual;
  127. function bss_flags : longint;virtual;
  128. function info_flags : longint;virtual;
  129. end;
  130. pwin32coffoutput = ^twin32coffoutput;
  131. twin32coffoutput = object(tgenericcoffoutput)
  132. constructor init;
  133. function text_flags : longint;virtual;
  134. function data_flags : longint;virtual;
  135. function bss_flags : longint;virtual;
  136. function info_flags : longint;virtual;
  137. end;
  138. implementation
  139. uses
  140. strings,verbose,
  141. globtype,globals,files;
  142. type
  143. { Structures which are written directly to the output file }
  144. coffheader=packed record
  145. mach : word;
  146. nsects : word;
  147. time : longint;
  148. sympos : longint;
  149. syms : longint;
  150. opthdr : word;
  151. flag : word;
  152. end;
  153. coffsechdr=packed record
  154. name : array[0..7] of char;
  155. vsize : longint;
  156. rvaofs : longint;
  157. datalen : longint;
  158. datapos : longint;
  159. relocpos : longint;
  160. lineno1 : longint;
  161. nrelocs : word;
  162. lineno2 : word;
  163. flags : longint;
  164. end;
  165. coffsectionrec=packed record
  166. len : longint;
  167. nrelocs : word;
  168. empty : array[0..11] of char;
  169. end;
  170. coffreloc=packed record
  171. address : longint;
  172. sym : longint;
  173. relative : word;
  174. end;
  175. coffsymbol=packed record
  176. name : array[0..3] of char; { real is [0..7], which overlaps the strpos ! }
  177. strpos : longint;
  178. value : longint;
  179. section : integer;
  180. empty : integer;
  181. typ : byte;
  182. aux : byte;
  183. end;
  184. pcoffstab=^coffstab;
  185. coffstab=packed record
  186. strpos : longint;
  187. ntype : byte;
  188. nother : byte;
  189. ndesc : word;
  190. nvalue : longint;
  191. end;
  192. const
  193. sec_2_str : array[tsection] of string[8]=('',
  194. '.text','.data','.bss',
  195. '.stab','.stabstr',
  196. '.idata$2','.idata$4','.idata$5','.idata$6','.idata$7','.edata',
  197. ''
  198. );
  199. {****************************************************************************
  200. TSection
  201. ****************************************************************************}
  202. constructor tcoffsection.init(sec:TSection;Aflags:longint);
  203. begin
  204. index:=sec;
  205. flags:=AFlags;
  206. relocHead:=nil;
  207. relocTail:=@relocHead;
  208. Len:=0;
  209. NRelocs:=0;
  210. if sec=sec_bss then
  211. data:=nil
  212. else
  213. new(Data,Init(1,8192));
  214. end;
  215. destructor tcoffsection.done;
  216. begin
  217. if assigned(Data) then
  218. dispose(Data,done);
  219. end;
  220. procedure tcoffsection.write(var d;l:longint);
  221. begin
  222. if not assigned(Data) then
  223. Internalerror(3334441);
  224. Data^.write(d,l);
  225. inc(len,l);
  226. end;
  227. procedure tcoffsection.alloc(l:longint);
  228. begin
  229. if assigned(Data) then
  230. Internalerror(3334442);
  231. inc(len,l);
  232. end;
  233. procedure tcoffsection.addsymreloc(ofs:longint;p:pasmsymbol;relative:relative_type);
  234. var
  235. r : PReloc;
  236. begin
  237. new(r);
  238. reloctail^:=r;
  239. reloctail:=@r^.next;
  240. r^.next:=nil;
  241. r^.address:=ofs;
  242. r^.symbol:=p;
  243. r^.section:=sec_none;
  244. r^.relative:=relative;
  245. inc(nrelocs);
  246. end;
  247. procedure tcoffsection.addsectionreloc(ofs:longint;sec:tsection);
  248. var
  249. r : PReloc;
  250. begin
  251. new(r);
  252. reloctail^:=r;
  253. reloctail:=@r^.next;
  254. r^.next:=nil;
  255. r^.address:=ofs;
  256. r^.symbol:=nil;
  257. r^.section:=sec;
  258. r^.relative:=relative_false;
  259. inc(nrelocs);
  260. end;
  261. {****************************************************************************
  262. Genericcoffoutput
  263. ****************************************************************************}
  264. const
  265. {$ifdef TP}
  266. symbolresize = 50;
  267. strsresize = 200;
  268. {$else}
  269. symbolresize = 200;
  270. strsresize = 8192;
  271. {$endif}
  272. constructor tgenericcoffoutput.init;
  273. begin
  274. inherited init;
  275. end;
  276. destructor tgenericcoffoutput.done;
  277. begin
  278. inherited done;
  279. end;
  280. procedure tgenericcoffoutput.initwriting;
  281. var
  282. s : string;
  283. begin
  284. inherited initwriting;
  285. { reset }
  286. initsym:=0;
  287. new(syms,init(sizeof(TSymbol),symbolresize));
  288. new(strs,init(1,strsresize));
  289. FillChar(Sects,sizeof(Sects),0);
  290. { we need at least the following 3 sections }
  291. createsection(sec_code);
  292. createsection(sec_data);
  293. createsection(sec_bss);
  294. if (cs_debuginfo in aktmoduleswitches) then
  295. begin
  296. createsection(sec_stab);
  297. createsection(sec_stabstr);
  298. writestabs(sec_none,0,nil,0,0,0,false);
  299. { write zero pchar and name together (PM) }
  300. s:=#0+SplitFileName(current_module^.mainsource^)+#0;
  301. sects[sec_stabstr]^.write(s[1],length(s));
  302. end;
  303. end;
  304. procedure tgenericcoffoutput.donewriting;
  305. var
  306. sec : tsection;
  307. begin
  308. writetodisk;
  309. dispose(syms,done);
  310. dispose(strs,done);
  311. for sec:=low(tsection) to high(tsection) do
  312. if assigned(sects[sec]) then
  313. dispose(sects[sec],done);
  314. inherited donewriting;
  315. end;
  316. function tgenericcoffoutput.text_flags : longint;
  317. begin
  318. text_flags:=0;
  319. end;
  320. function tgenericcoffoutput.data_flags : longint;
  321. begin
  322. data_flags:=0;
  323. end;
  324. function tgenericcoffoutput.bss_flags : longint;
  325. begin
  326. bss_flags:=0;
  327. end;
  328. function tgenericcoffoutput.info_flags : longint;
  329. begin
  330. info_flags:=0;
  331. end;
  332. procedure tgenericcoffoutput.createsection(sec:TSection);
  333. var
  334. Aflags : longint;
  335. begin
  336. Aflags:=0;
  337. case sec of
  338. sec_code :
  339. Aflags:=text_flags;
  340. sec_data :
  341. Aflags:=data_flags;
  342. sec_bss :
  343. Aflags:=bss_flags;
  344. { sec_info :
  345. Aflags:=info_flags; }
  346. else
  347. Aflags:=0;
  348. end;
  349. sects[sec]:=new(PcoffSection,init(Sec,Aflags));
  350. end;
  351. procedure tgenericcoffoutput.writesymbol(p:pasmsymbol);
  352. var
  353. pos : longint;
  354. sym : tsymbol;
  355. c : char;
  356. s : string;
  357. begin
  358. { already written ? }
  359. if p^.idx<>-1 then
  360. exit;
  361. { be sure that the section will exists }
  362. if (p^.section<>sec_none) and not(assigned(sects[p^.section])) then
  363. createsection(p^.section);
  364. { symbolname }
  365. pos:=strs^.usedsize+4;
  366. c:=#0;
  367. s:=p^.name;
  368. if length(s)>8 then
  369. begin
  370. s:=s+#0;
  371. strs^.write(s[1],length(s));
  372. end
  373. else
  374. pos:=-1;
  375. FillChar(sym,sizeof(sym),0);
  376. sym.strpos:=pos;
  377. if pos=-1 then
  378. sym.name:=s;
  379. sym.value:=p^.size;
  380. sym.typ:=p^.typ;
  381. { if local of global then set the section value to the address
  382. of the symbol }
  383. if p^.typ in [AS_LOCAL,AS_GLOBAL] then
  384. begin
  385. sym.section:=ord(p^.section);
  386. sym.value:=p^.address;
  387. end;
  388. { update the asmsymbol index }
  389. p^.idx:=syms^.count;
  390. { store the symbol, but not the local ones (PM) }
  391. if (p^.typ<>AS_LOCAL) or ((copy(s,1,2)<>'.L') and
  392. ((copy(s,1,1)<>'L') or not win32)) then
  393. syms^.write(sym,1);
  394. { make the exported syms known to the objectwriter
  395. (needed for .a generation) }
  396. if (p^.typ=AS_GLOBAL) or
  397. ((p^.typ=AS_EXTERNAL) and (sym.value=p^.size) and (sym.value>0)) then
  398. writer^.writesym(p^.name);
  399. end;
  400. procedure tgenericcoffoutput.writebytes(var data;len:longint);
  401. begin
  402. if not assigned(sects[currsec]) then
  403. createsection(currsec);
  404. sects[currsec]^.write(data,len);
  405. end;
  406. procedure tgenericcoffoutput.writealloc(len:longint);
  407. begin
  408. if not assigned(sects[currsec]) then
  409. createsection(currsec);
  410. sects[currsec]^.alloc(len);
  411. end;
  412. procedure tgenericcoffoutput.writereloc(data,len:longint;p:pasmsymbol;relative:relative_type);
  413. begin
  414. if not assigned(sects[currsec]) then
  415. createsection(currsec);
  416. if assigned(p) then
  417. begin
  418. { no symbol relocation need inside a section }
  419. if p^.section=currsec then
  420. begin
  421. if relative=relative_false then
  422. begin
  423. sects[currsec]^.addsectionreloc(sects[currsec]^.len,currsec);
  424. inc(data,p^.address);
  425. end
  426. else if relative=relative_true then
  427. begin
  428. inc(data,p^.address-len-sects[currsec]^.len);
  429. end
  430. else if relative=relative_rva then
  431. begin
  432. { don't know if this can happens !! }
  433. { does this work ?? }
  434. sects[currsec]^.addsectionreloc(sects[currsec]^.len,currsec);
  435. inc(data,p^.address);
  436. end;
  437. end
  438. else
  439. begin
  440. writesymbol(p);
  441. if (p^.section<>sec_none) and (relative=relative_false) then
  442. begin
  443. sects[currsec]^.addsectionreloc(sects[currsec]^.len,p^.section);
  444. end
  445. else
  446. sects[currsec]^.addsymreloc(sects[currsec]^.len,p,relative);
  447. if not win32 then {seems wrong to me (PM) }
  448. begin
  449. {if p^.section<>sec_none then
  450. this is the cause of the strange
  451. feature see Note (5) before
  452. address contains the size for
  453. global vars switched to common }
  454. inc(data,p^.address);
  455. end
  456. else
  457. if (relative<>relative_true) and (p^.section<>sec_none) then
  458. inc(data,p^.address);
  459. if relative=relative_true then
  460. begin
  461. if win32 then
  462. {inc(data,4-len)}
  463. dec(data,len-4{+p^.address})
  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 (offset=-1) and reloc then
  482. begin
  483. if s=sec_none then
  484. offset:=0
  485. else
  486. offset:=sects[s]^.len;
  487. end;
  488. fillchar(stab,sizeof(coffstab),0);
  489. if assigned(p) and (p[0]<>#0) then
  490. begin
  491. stab.strpos:=sects[sec_stabstr]^.len;
  492. sects[sec_stabstr]^.write(p^,strlen(p)+1);
  493. end;
  494. stab.ntype:=nidx;
  495. stab.ndesc:=line;
  496. stab.nother:=nother;
  497. stab.nvalue:=offset;
  498. sects[sec_stab]^.write(stab,sizeof(stab));
  499. { when the offset is not 0 then write a relocation, take also the
  500. hdrstab into account with the offset }
  501. if reloc then
  502. sects[sec_stab]^.addsectionreloc(sects[sec_stab]^.len-4,s);
  503. end;
  504. procedure tgenericcoffoutput.write_relocs(s:pcoffsection);
  505. var
  506. rel : coffreloc;
  507. hr,r : preloc;
  508. begin
  509. r:=s^.relochead;
  510. while assigned(r) do
  511. begin
  512. rel.address:=r^.address;
  513. if assigned(r^.symbol) then
  514. begin
  515. if (r^.symbol^.typ=AS_LOCAL) then
  516. rel.sym:=2*ord(r^.symbol^.section)
  517. else
  518. rel.sym:=r^.symbol^.idx+initsym;
  519. end
  520. else
  521. rel.sym:=2*ord(r^.section);
  522. case r^.relative of
  523. relative_true : rel.relative:=$14;
  524. relative_false : rel.relative:=$6;
  525. relative_rva : rel.relative:=$7;
  526. end;
  527. writer^.write(rel,sizeof(rel));
  528. { goto next and dispose this reloc }
  529. hr:=r;
  530. r:=r^.next;
  531. dispose(hr);
  532. end;
  533. end;
  534. procedure tgenericcoffoutput.write_symbol(const name:string;strpos,value,section,typ,aux:longint);
  535. var
  536. sym : coffsymbol;
  537. begin
  538. FillChar(sym,sizeof(sym),0);
  539. if strpos=-1 then
  540. move(name[1],sym.name,length(name))
  541. else
  542. sym.strpos:=strpos;
  543. sym.value:=value;
  544. sym.section:=section;
  545. sym.typ:=typ;
  546. sym.aux:=aux;
  547. writer^.write(sym,sizeof(sym));
  548. end;
  549. procedure tgenericcoffoutput.write_symbols;
  550. var
  551. filename : string[18];
  552. sec : tsection;
  553. i : longint;
  554. globalval : byte;
  555. secrec : coffsectionrec;
  556. sym : tsymbol;
  557. begin
  558. { The `.file' record, and the file name auxiliary record. }
  559. write_symbol ('.file', -1, 0, -2, $67, 1);
  560. fillchar(filename,sizeof(filename),0);
  561. filename:=SplitFileName(current_module^.mainsource^);
  562. writer^.write(filename[1],sizeof(filename)-1);
  563. { The section records, with their auxiliaries }
  564. i:=0;
  565. for sec:=low(tsection) to high(tsection) do
  566. if assigned(sects[sec]) then
  567. begin
  568. inc(i);
  569. write_symbol(sec_2_str[sec],-1,{sects[sec]^.pos}0,i,3,1);
  570. fillchar(secrec,sizeof(secrec),0);
  571. secrec.len:=sects[sec]^.len;
  572. secrec.nrelocs:=sects[sec]^.nrelocs;
  573. writer^.write(secrec,sizeof(secrec));
  574. end;
  575. { The real symbols. }
  576. syms^.seek(0);
  577. for i:=1 to syms^.count do
  578. begin
  579. syms^.read(sym,1);
  580. if sym.typ=AS_LOCAL then
  581. globalval:=3
  582. else
  583. globalval:=2;
  584. write_symbol(sym.name,sym.strpos,sym.value,sym.section,globalval,0);
  585. end;
  586. end;
  587. procedure tgenericcoffoutput.writetodisk;
  588. var
  589. datapos,
  590. nsects,pos,sympos,i,fillsize : longint;
  591. sec : tsection;
  592. header : coffheader;
  593. sechdr : coffsechdr;
  594. empty : array[0..15] of byte;
  595. begin
  596. { calc amount of sections we have and align sections at 4 bytes }
  597. fillchar(empty,sizeof(empty),0);
  598. nsects:=0;
  599. for sec:=low(tsection) to high(tsection) do
  600. { .stabstr section length must be without alignment !! }
  601. if assigned(sects[sec]) then
  602. begin
  603. { fill with zero }
  604. fillsize:=4-(sects[sec]^.len and 3);
  605. if fillsize<>4 then
  606. begin
  607. if assigned(sects[sec]^.data) then
  608. sects[sec]^.write(empty,fillsize)
  609. else
  610. sects[sec]^.alloc(fillsize);
  611. { .stabstr section length must be without alignment !! }
  612. if (sec=sec_stabstr) then
  613. dec(sects[sec]^.len,fillsize);
  614. end;
  615. inc(nsects);
  616. end;
  617. { Calculate the filepositions }
  618. datapos:=sizeof(coffheader)+sizeof(coffsechdr)*nsects;
  619. pos:=0;
  620. initsym:=2; { 2 for the file }
  621. { sections first }
  622. for sec:=low(tsection) to high(tsection) do
  623. if assigned(sects[sec]) then
  624. begin
  625. sects[sec]^.pos:=pos;
  626. sects[sec]^.datapos:=datapos;
  627. inc(pos,sects[sec]^.len);
  628. if assigned(sects[sec]^.data) then
  629. inc(datapos,sects[sec]^.len);
  630. { align after stabstr section !! }
  631. if (sec=sec_stabstr) and ((sects[sec]^.len and 3)<>0) then
  632. inc(datapos,4-(sects[sec]^.len and 3));
  633. inc(initsym,2); { 2 for each section }
  634. end;
  635. { relocs }
  636. for sec:=low(tsection) to high(tsection) do
  637. if assigned(sects[sec]) then
  638. begin
  639. sects[sec]^.relocpos:=datapos;
  640. inc(datapos,10*sects[sec]^.nrelocs);
  641. end;
  642. { symbols }
  643. sympos:=datapos;
  644. { COFF header }
  645. fillchar(header,sizeof(coffheader),0);
  646. header.mach:=$14c;
  647. header.nsects:=nsects;
  648. header.sympos:=sympos;
  649. header.syms:=syms^.count+initsym;
  650. if not win32 then
  651. header.flag:=$104;
  652. writer^.write(header,sizeof(header));
  653. { Section headers }
  654. for sec:=low(tsection) to high(tsection) do
  655. if assigned(sects[sec]) then
  656. begin
  657. fillchar(sechdr,sizeof(sechdr),0);
  658. move(sec_2_str[sec][1],sechdr.name,length(sec_2_str[sec]));
  659. if not win32 then
  660. sechdr.vsize:=sects[sec]^.pos
  661. else if sec=sec_bss then
  662. sechdr.vsize:=sects[sec]^.len;
  663. sechdr.datalen:=sects[sec]^.len;
  664. { apparently win32 asw leaves section at datapos zero }
  665. { this was an error by me (PM) }
  666. if (sects[sec]^.len>0) and assigned(sects[sec]^.data) then
  667. sechdr.datapos:=sects[sec]^.datapos;
  668. sechdr.relocpos:=sects[sec]^.relocpos;
  669. sechdr.nrelocs:=sects[sec]^.nrelocs;
  670. sechdr.flags:=sects[sec]^.flags;
  671. writer^.write(sechdr,sizeof(sechdr));
  672. end;
  673. { Sections }
  674. for sec:=low(tsection) to high(tsection) do
  675. if assigned(sects[sec]) and
  676. assigned(sects[sec]^.data) then
  677. begin
  678. { For the stab section we need an HdrSym which can now be
  679. calculated more easily }
  680. if sec=sec_stab then
  681. begin
  682. pcoffstab(sects[sec_stab]^.data^.data)^.nvalue:=sects[sec_stabstr]^.len;
  683. pcoffstab(sects[sec_stab]^.data^.data)^.strpos:=1;
  684. pcoffstab(sects[sec_stab]^.data^.data)^.ndesc:=
  685. (sects[sec_stab]^.len div sizeof(coffstab))-1{+1 according to gas output PM};
  686. end;
  687. writer^.write(sects[sec]^.data^.data^,sects[sec]^.data^.usedsize);
  688. end;
  689. { Relocs }
  690. for sec:=low(tsection) to high(tsection) do
  691. if assigned(sects[sec]) then
  692. write_relocs(sects[sec]);
  693. { Symbols }
  694. write_symbols;
  695. { Strings }
  696. i:=strs^.usedsize+4;
  697. writer^.write(i,4);
  698. writer^.write(strs^.data^,strs^.usedsize);
  699. end;
  700. {****************************************************************************
  701. DJGppcoffoutput
  702. ****************************************************************************}
  703. constructor tdjgppcoffoutput.init;
  704. begin
  705. inherited init;
  706. win32:=false;
  707. end;
  708. function tdjgppcoffoutput.text_flags : longint;
  709. begin
  710. text_flags:=$20;
  711. end;
  712. function tdjgppcoffoutput.data_flags : longint;
  713. begin
  714. data_flags:=$40;
  715. end;
  716. function tdjgppcoffoutput.bss_flags : longint;
  717. begin
  718. bss_flags:=$80;
  719. end;
  720. function tdjgppcoffoutput.info_flags : longint;
  721. begin
  722. writeln('djgpp coff doesn''t support info sections');
  723. info_flags:=$40;
  724. end;
  725. {****************************************************************************
  726. Win32coffoutput
  727. ****************************************************************************}
  728. constructor twin32coffoutput.init;
  729. begin
  730. inherited init;
  731. win32:=true;
  732. end;
  733. function twin32coffoutput.text_flags : longint;
  734. begin
  735. text_flags:={ $60500020}$60300020{changed to get same as asw.exe (PM)};
  736. end;
  737. function twin32coffoutput.data_flags : longint;
  738. begin
  739. data_flags:=$c0300040;
  740. end;
  741. function twin32coffoutput.bss_flags : longint;
  742. begin
  743. bss_flags:=$c0300080;
  744. end;
  745. function twin32coffoutput.info_flags : longint;
  746. begin
  747. info_flags:=$100a00;
  748. end;
  749. end.
  750. {
  751. $Log$
  752. Revision 1.1 1999-05-01 13:24:24 peter
  753. * merged nasm compiler
  754. * old asm moved to oldasm/
  755. Revision 1.13 1999/03/18 20:30:49 peter
  756. + .a writer
  757. Revision 1.12 1999/03/12 00:20:06 pierre
  758. + win32 output working !
  759. Revision 1.11 1999/03/11 13:43:08 pierre
  760. * more fixes for win32
  761. Revision 1.10 1999/03/10 13:41:10 pierre
  762. + partial implementation for win32 !
  763. winhello works but pp still does not !
  764. Revision 1.9 1999/03/08 14:51:09 peter
  765. + smartlinking for ag386bin
  766. Revision 1.8 1999/03/05 13:09:52 peter
  767. * first things for tai_cut support for ag386bin
  768. Revision 1.7 1999/03/04 13:44:58 pierre
  769. * win32 pecoff sections datapos allways zero
  770. Revision 1.6 1999/03/03 11:41:54 pierre
  771. + stabs info corrected to give results near to GAS output
  772. * local labels (with .L are not stored in object anymore)
  773. so we get the same number of symbols as from GAS !
  774. Revision 1.5 1999/03/03 01:36:46 pierre
  775. + stabs output working (though not really tested)
  776. for a simple file the only difference to GAS output is due
  777. to the VMA of the different sections
  778. Revision 1.4 1999/03/02 02:56:27 peter
  779. + stabs support for binary writers
  780. * more fixes and missing updates from the previous commit :(
  781. Revision 1.3 1999/03/01 15:46:25 peter
  782. * ag386bin finally make cycles correct
  783. * prefixes are now also normal opcodes
  784. Revision 1.2 1999/02/25 21:03:10 peter
  785. * ag386bin updates
  786. + coff writer
  787. }