t_msdos.pas 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540
  1. {
  2. Copyright (c) 1998-2002 by Peter Vreman
  3. This unit implements support import,export,link routines
  4. for the (i8086) MS-DOS target
  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. unit t_msdos;
  19. {$i fpcdefs.inc}
  20. {$define USE_LINKER_WLINK}
  21. interface
  22. implementation
  23. uses
  24. SysUtils,
  25. cutils,cfileutl,cclasses,
  26. globtype,globals,systems,verbose,cscript,
  27. fmodule,i_msdos,
  28. link,aasmbase,cpuinfo,
  29. omfbase,ogbase,ogomf,owomflib;
  30. type
  31. { Borland TLINK support }
  32. TExternalLinkerMsDosTLink=class(texternallinker)
  33. private
  34. Function WriteResponseFile(isdll:boolean) : Boolean;
  35. public
  36. constructor Create;override;
  37. procedure SetDefaultInfo;override;
  38. function MakeExecutable:boolean;override;
  39. end;
  40. { the ALINK linker from http://alink.sourceforge.net/ }
  41. TExternalLinkerMsDosALink=class(texternallinker)
  42. private
  43. Function WriteResponseFile(isdll:boolean) : Boolean;
  44. public
  45. constructor Create;override;
  46. procedure SetDefaultInfo;override;
  47. function MakeExecutable:boolean;override;
  48. end;
  49. { the (Open) Watcom linker }
  50. TExternalLinkerMsDosWLink=class(texternallinker)
  51. private
  52. Function WriteResponseFile(isdll:boolean) : Boolean;
  53. Function PostProcessExecutable(const fn:string) : Boolean;
  54. public
  55. constructor Create;override;
  56. procedure SetDefaultInfo;override;
  57. function MakeExecutable:boolean;override;
  58. end;
  59. { TInternalLinkerMsDos }
  60. TInternalLinkerMsDos=class(tinternallinker)
  61. private
  62. function GetTotalSizeForSegmentClass(aExeOutput: TExeOutput; const SegClass: string): QWord;
  63. protected
  64. function GetCodeSize(aExeOutput: TExeOutput): QWord;override;
  65. function GetDataSize(aExeOutput: TExeOutput): QWord;override;
  66. function GetBssSize(aExeOutput: TExeOutput): QWord;override;
  67. procedure DefaultLinkScript;override;
  68. public
  69. constructor create;override;
  70. end;
  71. {****************************************************************************
  72. TExternalLinkerMsDosTLink
  73. ****************************************************************************}
  74. Constructor TExternalLinkerMsDosTLink.Create;
  75. begin
  76. Inherited Create;
  77. { allow duplicated libs (PM) }
  78. SharedLibFiles.doubles:=true;
  79. StaticLibFiles.doubles:=true;
  80. end;
  81. procedure TExternalLinkerMsDosTLink.SetDefaultInfo;
  82. begin
  83. with Info do
  84. begin
  85. ExeCmd[1]:='tlink $OPT $RES';
  86. end;
  87. end;
  88. Function TExternalLinkerMsDosTLink.WriteResponseFile(isdll:boolean) : Boolean;
  89. Var
  90. linkres : TLinkRes;
  91. s : string;
  92. begin
  93. WriteResponseFile:=False;
  94. { Open link.res file }
  95. LinkRes:=TLinkRes.Create(outputexedir+Info.ResName,true);
  96. { Add all options to link.res instead of passing them via command line:
  97. DOS command line is limited to 126 characters! }
  98. { add objectfiles, start with prt0 always }
  99. LinkRes.Add(GetShortName(FindObjectFile('prt0','',false)) + ' +');
  100. while not ObjectFiles.Empty do
  101. begin
  102. s:=ObjectFiles.GetFirst;
  103. if s<>'' then
  104. LinkRes.Add(GetShortName(s) + ' +');
  105. end;
  106. LinkRes.Add(', ' + maybequoted(current_module.exefilename));
  107. { Write and Close response }
  108. linkres.writetodisk;
  109. LinkRes.Free;
  110. WriteResponseFile:=True;
  111. end;
  112. function TExternalLinkerMsDosTLink.MakeExecutable:boolean;
  113. var
  114. binstr,
  115. cmdstr : TCmdStr;
  116. success : boolean;
  117. begin
  118. if not(cs_link_nolink in current_settings.globalswitches) then
  119. Message1(exec_i_linking,current_module.exefilename);
  120. { Write used files and libraries and our own tlink script }
  121. WriteResponsefile(false);
  122. { Call linker }
  123. SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
  124. Replace(cmdstr,'$RES','@'+maybequoted(outputexedir+Info.ResName));
  125. Replace(cmdstr,'$OPT',Info.ExtraOptions);
  126. success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false);
  127. { Remove ReponseFile }
  128. if (success) and not(cs_link_nolink in current_settings.globalswitches) then
  129. DeleteFile(outputexedir+Info.ResName);
  130. MakeExecutable:=success; { otherwise a recursive call to link method }
  131. end;
  132. {****************************************************************************
  133. TExternalLinkerMsDosALink
  134. ****************************************************************************}
  135. { TExternalLinkerMsDosALink }
  136. function TExternalLinkerMsDosALink.WriteResponseFile(isdll: boolean): Boolean;
  137. Var
  138. linkres : TLinkRes;
  139. s : string;
  140. begin
  141. WriteResponseFile:=False;
  142. { Open link.res file }
  143. LinkRes:=TLinkRes.Create(outputexedir+Info.ResName,true);
  144. { Add all options to link.res instead of passing them via command line:
  145. DOS command line is limited to 126 characters! }
  146. { add objectfiles, start with prt0 always }
  147. LinkRes.Add(maybequoted(FindObjectFile('prt0','',false)));
  148. while not ObjectFiles.Empty do
  149. begin
  150. s:=ObjectFiles.GetFirst;
  151. if s<>'' then
  152. LinkRes.Add(maybequoted(s));
  153. end;
  154. LinkRes.Add('-oEXE');
  155. LinkRes.Add('-o ' + maybequoted(current_module.exefilename));
  156. { Write and Close response }
  157. linkres.writetodisk;
  158. LinkRes.Free;
  159. WriteResponseFile:=True;
  160. end;
  161. constructor TExternalLinkerMsDosALink.Create;
  162. begin
  163. Inherited Create;
  164. { allow duplicated libs (PM) }
  165. SharedLibFiles.doubles:=true;
  166. StaticLibFiles.doubles:=true;
  167. end;
  168. procedure TExternalLinkerMsDosALink.SetDefaultInfo;
  169. begin
  170. with Info do
  171. begin
  172. ExeCmd[1]:='alink $OPT $RES';
  173. end;
  174. end;
  175. function TExternalLinkerMsDosALink.MakeExecutable: boolean;
  176. var
  177. binstr,
  178. cmdstr : TCmdStr;
  179. success : boolean;
  180. begin
  181. if not(cs_link_nolink in current_settings.globalswitches) then
  182. Message1(exec_i_linking,current_module.exefilename);
  183. { Write used files and libraries and our own tlink script }
  184. WriteResponsefile(false);
  185. { Call linker }
  186. SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
  187. Replace(cmdstr,'$RES','@'+maybequoted(outputexedir+Info.ResName));
  188. Replace(cmdstr,'$OPT',Info.ExtraOptions);
  189. success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false);
  190. { Remove ReponseFile }
  191. if (success) and not(cs_link_nolink in current_settings.globalswitches) then
  192. DeleteFile(outputexedir+Info.ResName);
  193. MakeExecutable:=success; { otherwise a recursive call to link method }
  194. end;
  195. {****************************************************************************
  196. TExternalLinkerMsDosWLink
  197. ****************************************************************************}
  198. { TExternalLinkerMsDosWLink }
  199. function TExternalLinkerMsDosWLink.WriteResponseFile(isdll: boolean): Boolean;
  200. Var
  201. linkres : TLinkRes;
  202. s : string;
  203. begin
  204. WriteResponseFile:=False;
  205. { Open link.res file }
  206. LinkRes:=TLinkRes.Create(outputexedir+Info.ResName,true);
  207. { Add all options to link.res instead of passing them via command line:
  208. DOS command line is limited to 126 characters! }
  209. LinkRes.Add('option quiet');
  210. if target_dbg.id in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4] then
  211. LinkRes.Add('debug dwarf')
  212. else if target_dbg.id=dbg_codeview then
  213. LinkRes.Add('debug codeview')
  214. else if cs_debuginfo in current_settings.moduleswitches then
  215. LinkRes.Add('debug watcom all');
  216. if cs_link_separate_dbg_file in current_settings.globalswitches then
  217. LinkRes.Add('option symfile');
  218. { add objectfiles, start with prt0 always }
  219. case current_settings.x86memorymodel of
  220. mm_tiny: LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0t','',false)));
  221. mm_small: LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0s','',false)));
  222. mm_medium: LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0m','',false)));
  223. mm_compact: LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0c','',false)));
  224. mm_large: LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0l','',false)));
  225. mm_huge: LinkRes.Add('file ' + maybequoted(FindObjectFile('prt0h','',false)));
  226. end;
  227. while not ObjectFiles.Empty do
  228. begin
  229. s:=ObjectFiles.GetFirst;
  230. if s<>'' then
  231. LinkRes.Add('file ' + maybequoted(s));
  232. end;
  233. while not StaticLibFiles.Empty do
  234. begin
  235. s:=StaticLibFiles.GetFirst;
  236. if s<>'' then
  237. LinkRes.Add('library '+MaybeQuoted(s));
  238. end;
  239. if apptype=app_com then
  240. LinkRes.Add('format dos com')
  241. else
  242. LinkRes.Add('format dos');
  243. if current_settings.x86memorymodel=mm_tiny then
  244. LinkRes.Add('order clname CODE clname DATA clname BSS')
  245. else
  246. LinkRes.Add('order clname CODE clname FAR_DATA clname BEGDATA segment _NULL segment _AFTERNULL clname DATA clname BSS clname STACK clname HEAP');
  247. if (cs_link_map in current_settings.globalswitches) then
  248. LinkRes.Add('option map='+maybequoted(ChangeFileExt(current_module.exefilename,'.map')));
  249. LinkRes.Add('name ' + maybequoted(current_module.exefilename));
  250. { Write and Close response }
  251. linkres.writetodisk;
  252. LinkRes.Free;
  253. WriteResponseFile:=True;
  254. end;
  255. constructor TExternalLinkerMsDosWLink.Create;
  256. begin
  257. Inherited Create;
  258. { allow duplicated libs (PM) }
  259. SharedLibFiles.doubles:=true;
  260. StaticLibFiles.doubles:=true;
  261. end;
  262. procedure TExternalLinkerMsDosWLink.SetDefaultInfo;
  263. begin
  264. with Info do
  265. begin
  266. ExeCmd[1]:='wlink $OPT $RES';
  267. end;
  268. end;
  269. function TExternalLinkerMsDosWLink.MakeExecutable: boolean;
  270. var
  271. binstr,
  272. cmdstr : TCmdStr;
  273. success : boolean;
  274. begin
  275. if not(cs_link_nolink in current_settings.globalswitches) then
  276. Message1(exec_i_linking,current_module.exefilename);
  277. { Write used files and libraries and our own tlink script }
  278. WriteResponsefile(false);
  279. { Call linker }
  280. SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
  281. Replace(cmdstr,'$RES','@'+maybequoted(outputexedir+Info.ResName));
  282. Replace(cmdstr,'$OPT',Info.ExtraOptions);
  283. success:=DoExec(FindUtil(utilsprefix+BinStr),cmdstr,true,false);
  284. { Post process }
  285. if success then
  286. success:=PostProcessExecutable(current_module.exefilename);
  287. { Remove ReponseFile }
  288. if (success) and not(cs_link_nolink in current_settings.globalswitches) then
  289. DeleteFile(outputexedir+Info.ResName);
  290. MakeExecutable:=success; { otherwise a recursive call to link method }
  291. end;
  292. { In far data memory models, this function sets the MaxAlloc value in the DOS MZ
  293. header according to the difference between HeapMin and HeapMax. We have to do
  294. this manually, because WLink sets MaxAlloc to $FFFF and there seems to be no
  295. way to specify a different value with a linker option. }
  296. function TExternalLinkerMsDosWLink.PostProcessExecutable(const fn: string): Boolean;
  297. var
  298. f: file;
  299. minalloc,maxalloc: Word;
  300. heapmin_paragraphs, heapmax_paragraphs: Integer;
  301. begin
  302. { nothing to do in the near data memory models }
  303. if current_settings.x86memorymodel in x86_near_data_models then
  304. exit(true);
  305. { .COM files are not supported in the far data memory models }
  306. if apptype=app_com then
  307. internalerror(2014062501);
  308. { open file }
  309. assign(f,fn);
  310. {$push}{$I-}
  311. reset(f,1);
  312. if ioresult<>0 then
  313. Message1(execinfo_f_cant_open_executable,fn);
  314. { read minalloc }
  315. seek(f,$A);
  316. BlockRead(f,minalloc,2);
  317. if source_info.endian<>target_info.endian then
  318. minalloc:=SwapEndian(minalloc);
  319. { calculate the additional number of paragraphs needed }
  320. heapmin_paragraphs:=(heapsize + 15) div 16;
  321. heapmax_paragraphs:=(maxheapsize + 15) div 16;
  322. maxalloc:=min(minalloc-heapmin_paragraphs+heapmax_paragraphs,$FFFF);
  323. { write maxalloc }
  324. seek(f,$C);
  325. if source_info.endian<>target_info.endian then
  326. maxalloc:=SwapEndian(maxalloc);
  327. BlockWrite(f,maxalloc,2);
  328. close(f);
  329. {$pop}
  330. if ioresult<>0 then;
  331. Result:=true;
  332. end;
  333. {****************************************************************************
  334. TInternalLinkerMsDos
  335. ****************************************************************************}
  336. function TInternalLinkerMsDos.GetTotalSizeForSegmentClass(
  337. aExeOutput: TExeOutput; const SegClass: string): QWord;
  338. var
  339. objseclist: TFPObjectList;
  340. objsec: TOmfObjSection;
  341. i: Integer;
  342. begin
  343. Result:=0;
  344. objseclist:=TMZExeOutput(aExeOutput).MZFlatContentSection.ObjSectionList;
  345. for i:=0 to objseclist.Count-1 do
  346. begin
  347. objsec:=TOmfObjSection(objseclist[i]);
  348. if objsec.ClassName=SegClass then
  349. Inc(Result,objsec.Size);
  350. end;
  351. end;
  352. function TInternalLinkerMsDos.GetCodeSize(aExeOutput: TExeOutput): QWord;
  353. begin
  354. Result:=GetTotalSizeForSegmentClass(aExeOutput,'CODE');
  355. end;
  356. function TInternalLinkerMsDos.GetDataSize(aExeOutput: TExeOutput): QWord;
  357. begin
  358. Result:=GetTotalSizeForSegmentClass(aExeOutput,'DATA')+
  359. GetTotalSizeForSegmentClass(aExeOutput,'FAR_DATA');
  360. end;
  361. function TInternalLinkerMsDos.GetBssSize(aExeOutput: TExeOutput): QWord;
  362. begin
  363. Result:=GetTotalSizeForSegmentClass(aExeOutput,'BSS');
  364. end;
  365. procedure TInternalLinkerMsDos.DefaultLinkScript;
  366. var
  367. s: TCmdStr;
  368. begin
  369. { add objectfiles, start with prt0 always }
  370. case current_settings.x86memorymodel of
  371. mm_tiny: LinkScript.Concat('READOBJECT ' + maybequoted(FindObjectFile('prt0t','',false)));
  372. mm_small: LinkScript.Concat('READOBJECT ' + maybequoted(FindObjectFile('prt0s','',false)));
  373. mm_medium: LinkScript.Concat('READOBJECT ' + maybequoted(FindObjectFile('prt0m','',false)));
  374. mm_compact: LinkScript.Concat('READOBJECT ' + maybequoted(FindObjectFile('prt0c','',false)));
  375. mm_large: LinkScript.Concat('READOBJECT ' + maybequoted(FindObjectFile('prt0l','',false)));
  376. mm_huge: LinkScript.Concat('READOBJECT ' + maybequoted(FindObjectFile('prt0h','',false)));
  377. end;
  378. while not ObjectFiles.Empty do
  379. begin
  380. s:=ObjectFiles.GetFirst;
  381. if s<>'' then
  382. LinkScript.Concat('READOBJECT ' + maybequoted(s));
  383. end;
  384. LinkScript.Concat('GROUP');
  385. while not StaticLibFiles.Empty do
  386. begin
  387. s:=StaticLibFiles.GetFirst;
  388. if s<>'' then
  389. LinkScript.Concat('READSTATICLIBRARY '+MaybeQuoted(s));
  390. end;
  391. LinkScript.Concat('ENDGROUP');
  392. LinkScript.Concat('EXESECTION .MZ_flat_content');
  393. if current_settings.x86memorymodel=mm_tiny then
  394. begin
  395. LinkScript.Concat(' OBJSECTION _TEXT||CODE');
  396. LinkScript.Concat(' OBJSECTION *||CODE');
  397. LinkScript.Concat(' OBJSECTION *||DATA');
  398. LinkScript.Concat(' SYMBOL _edata');
  399. LinkScript.Concat(' OBJSECTION *||BSS');
  400. LinkScript.Concat(' SYMBOL _end');
  401. end
  402. else
  403. begin
  404. LinkScript.Concat(' OBJSECTION _TEXT||CODE');
  405. LinkScript.Concat(' OBJSECTION *||CODE');
  406. LinkScript.Concat(' OBJSECTION *||FAR_DATA');
  407. LinkScript.Concat(' OBJSECTION _NULL||BEGDATA');
  408. LinkScript.Concat(' OBJSECTION _AFTERNULL||BEGDATA');
  409. LinkScript.Concat(' OBJSECTION *||BEGDATA');
  410. LinkScript.Concat(' OBJSECTION *||DATA');
  411. LinkScript.Concat(' SYMBOL _edata');
  412. LinkScript.Concat(' OBJSECTION *||BSS');
  413. LinkScript.Concat(' SYMBOL _end');
  414. LinkScript.Concat(' OBJSECTION *||STACK');
  415. LinkScript.Concat(' OBJSECTION *||HEAP');
  416. end;
  417. LinkScript.Concat('ENDEXESECTION');
  418. if (cs_debuginfo in current_settings.moduleswitches) and
  419. (target_dbg.id in [dbg_dwarf2,dbg_dwarf3,dbg_dwarf4]) then
  420. begin
  421. LinkScript.Concat('EXESECTION .debug_info');
  422. LinkScript.Concat(' OBJSECTION .DEBUG_INFO||DWARF');
  423. LinkScript.Concat('ENDEXESECTION');
  424. LinkScript.Concat('EXESECTION .debug_abbrev');
  425. LinkScript.Concat(' OBJSECTION .DEBUG_ABBREV||DWARF');
  426. LinkScript.Concat('ENDEXESECTION');
  427. LinkScript.Concat('EXESECTION .debug_line');
  428. LinkScript.Concat(' OBJSECTION .DEBUG_LINE||DWARF');
  429. LinkScript.Concat('ENDEXESECTION');
  430. LinkScript.Concat('EXESECTION .debug_aranges');
  431. LinkScript.Concat(' OBJSECTION .DEBUG_ARANGES||DWARF');
  432. LinkScript.Concat('ENDEXESECTION');
  433. end;
  434. LinkScript.Concat('ENTRYNAME ..start');
  435. end;
  436. constructor TInternalLinkerMsDos.create;
  437. begin
  438. inherited create;
  439. CArObjectReader:=TOmfLibObjectReader;
  440. CExeOutput:=TMZExeOutput;
  441. CObjInput:=TOmfObjInput;
  442. end;
  443. {*****************************************************************************
  444. Initialize
  445. *****************************************************************************}
  446. initialization
  447. RegisterLinker(ld_int_msdos,TInternalLinkerMsDos);
  448. {$if defined(USE_LINKER_TLINK)}
  449. RegisterLinker(ld_msdos,TExternalLinkerMsDosTLink);
  450. {$elseif defined(USE_LINKER_ALINK)}
  451. RegisterLinker(ld_msdos,TExternalLinkerMsDosALink);
  452. {$elseif defined(USE_LINKER_WLINK)}
  453. RegisterLinker(ld_msdos,TExternalLinkerMsDosWLink);
  454. {$else}
  455. {$fatal no linker defined}
  456. {$endif}
  457. RegisterTarget(system_i8086_msdos_info);
  458. end.