t_nwm.pas 30 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945
  1. {
  2. Copyright (c) 1998-2002 by Peter Vreman
  3. This unit implements support import,export,link routines
  4. for the (i386) Netware 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. Currently generating NetWare-NLM's only work under Linux and win32.
  17. (see http://home.arcor.de/armin.diehl/fpcnw for binutils working
  18. with win32) while not included in fpc-releases.
  19. The following compiler-swiches are supported for NetWare:
  20. $DESCRIPTION : NLM-Description, will be displayed at load-time
  21. $M : For Stack-Size, Heap-Size will be ignored
  22. 32K is the accepted minimum
  23. $VERSION x.x.x : Sets Major, Minor and Revision
  24. $SCREENNAME : Sets the ScreenName
  25. $THREADNAME : Sets current threadname
  26. Displaying copyright does not work with nlmconv from gnu bunutils
  27. version less that 2.13
  28. Additional parameters for the nlmvonv-inputfile can be passed with
  29. -k, i.e. -kREENTRANT will add the option REENTRANT to the nlmconv
  30. inputfile. A ; will be converted into a newline
  31. Exports will be handled like in win32:
  32. procedure bla;
  33. begin
  34. end;
  35. exports foo name 'Bar';
  36. The path to the import-Files must be specified by the library-path.
  37. All external modules are defined as autoload. (Note: the import-files have
  38. to be in unix-format for exe2nlm)
  39. By default, the most import files are included in freepascal.
  40. i.e. Procedure ConsolePrintf (p:pchar); cdecl; external 'clib.nlm';
  41. sets IMPORT @clib.imp and MODULE clib.
  42. Function simply defined as external work without generating autoload but
  43. you will get a warnung from nlmconv.
  44. If you dont have nlmconv, compile gnu-binutils with
  45. ./configure --enable-targets=i386-linux,i386-netware
  46. make all
  47. Debugging is possible with gdb and a converter from gdb to ndi available
  48. at http://home.arcor.de/armin.diehl/gdbnw
  49. A sample program:
  50. Program Hello;
  51. (*$DESCRIPTION HelloWorldNlm*)
  52. (*$VERSION 1.2.3*)
  53. (*$ScreenName Hello*)
  54. (*$M 60000,60000*)
  55. begin
  56. writeLn ('hello world');
  57. end.
  58. compile with:
  59. ppc386 -Tnetware hello
  60. ToDo:
  61. - No duplicate imports and autoloads
  62. - libc support (needs new target)
  63. ****************************************************************************
  64. }
  65. unit t_nwm;
  66. {$i fpcdefs.inc}
  67. interface
  68. implementation
  69. uses
  70. SysUtils,
  71. cutils,cfileutl,
  72. verbose,systems,globtype,globals,
  73. symconst,script,
  74. fmodule,aasmbase,aasmtai,aasmdata,aasmcpu,cpubase,symsym,symdef,
  75. import,export,link,i_nwm,ogbase, ogcoff, ognlm
  76. {$ifdef netware} ,dos {$endif}
  77. ;
  78. type
  79. timportlibnetware=class(timportlib)
  80. procedure generatelib;override;
  81. end;
  82. texportlibnetware=class(texportlib)
  83. procedure preparelib(const s : string);override;
  84. procedure exportprocedure(hp : texported_item);override;
  85. procedure exportvar(hp : texported_item);override;
  86. procedure generatelib;override;
  87. end;
  88. tlinkernetware=class(texternallinker)
  89. private
  90. NLMConvLinkFile: TLinkRes; {for second pass, fist pass is ld}
  91. Function WriteResponseFile(isdll:boolean) : Boolean;
  92. public
  93. constructor Create;override;
  94. procedure SetDefaultInfo;override;
  95. function MakeExecutable:boolean;override;
  96. end;
  97. TInternalLinkerNetware = class(TInternalLinker)
  98. prelude : string;
  99. constructor create;override;
  100. procedure DefaultLinkScript;override;
  101. procedure InitSysInitUnitName;override;
  102. procedure ConcatEntryName; virtual;
  103. Function MakeSharedLibrary:boolean;override;
  104. end;
  105. Const tmpLinkFileName = 'link~tmp._o_';
  106. minStackSize = 32768;
  107. {*****************************************************************************
  108. TIMPORTLIBNETWARE
  109. *****************************************************************************}
  110. procedure timportlibnetware.generatelib;
  111. var
  112. i : longint;
  113. ImportLibrary : TImportLibrary;
  114. begin
  115. for i:=0 to current_module.ImportLibraryList.Count-1 do
  116. begin
  117. ImportLibrary:=TImportLibrary(current_module.ImportLibraryList[i]);
  118. current_module.linkothersharedlibs.add(ImportLibrary.Name,link_always);
  119. end;
  120. end;
  121. {*****************************************************************************
  122. TEXPORTLIBNETWARE
  123. *****************************************************************************}
  124. procedure texportlibnetware.preparelib(const s:string);
  125. begin
  126. end;
  127. procedure texportlibnetware.exportprocedure(hp : texported_item);
  128. var
  129. hp2 : texported_item;
  130. begin
  131. { first test the index value }
  132. if (hp.options and eo_index)<>0 then
  133. begin
  134. Comment(V_Error,'can''t export with index under netware');
  135. exit;
  136. end;
  137. { use pascal name is none specified }
  138. if (hp.options and eo_name)=0 then
  139. begin
  140. hp.name:=stringdup(hp.sym.name);
  141. hp.options:=hp.options or eo_name;
  142. end;
  143. { now place in correct order }
  144. hp2:=texported_item(current_module._exports.first);
  145. while assigned(hp2) and
  146. (hp.name^>hp2.name^) do
  147. hp2:=texported_item(hp2.next);
  148. { insert hp there !! }
  149. if assigned(hp2) and (hp2.name^=hp.name^) then
  150. begin
  151. { this is not allowed !! }
  152. Message1(parser_e_export_name_double,hp.name^);
  153. exit;
  154. end;
  155. if hp2=texported_item(current_module._exports.first) then
  156. current_module._exports.insert(hp)
  157. else if assigned(hp2) then
  158. begin
  159. hp.next:=hp2;
  160. hp.previous:=hp2.previous;
  161. if assigned(hp2.previous) then
  162. hp2.previous.next:=hp;
  163. hp2.previous:=hp;
  164. end
  165. else
  166. current_module._exports.concat(hp);
  167. end;
  168. procedure texportlibnetware.exportvar(hp : texported_item);
  169. begin
  170. hp.is_var:=true;
  171. exportprocedure(hp);
  172. end;
  173. procedure texportlibnetware.generatelib;
  174. var
  175. hp2 : texported_item;
  176. pd : tprocdef;
  177. begin
  178. hp2:=texported_item(current_module._exports.first);
  179. while assigned(hp2) do
  180. begin
  181. if (not hp2.is_var) and
  182. (hp2.sym.typ=procsym) then
  183. begin
  184. { the manglednames can already be the same when the procedure
  185. is declared with cdecl }
  186. pd:=tprocdef(tprocsym(hp2.sym).ProcdefList[0]);
  187. if pd.mangledname<>hp2.name^ then
  188. begin
  189. {$ifdef i386}
  190. { place jump in al_procedures }
  191. current_asmdata.asmlists[al_procedures].concat(Tai_align.Create_op(4,$90));
  192. current_asmdata.asmlists[al_procedures].concat(Tai_symbol.Createname_global(hp2.name^,AT_FUNCTION,0));
  193. current_asmdata.asmlists[al_procedures].concat(Taicpu.Op_sym(A_JMP,S_NO,current_asmdata.RefAsmSymbol(pd.mangledname)));
  194. current_asmdata.asmlists[al_procedures].concat(Tai_symbol_end.Createname(hp2.name^));
  195. {$endif i386}
  196. end;
  197. end
  198. else
  199. //Comment(V_Error,'Exporting of variables is not supported under netware');
  200. Message1(parser_e_no_export_of_variables_for_target,'netware');
  201. hp2:=texported_item(hp2.next);
  202. end;
  203. end;
  204. {*****************************************************************************
  205. TLINKERNETWARE
  206. *****************************************************************************}
  207. Constructor TLinkerNetware.Create;
  208. begin
  209. Inherited Create;
  210. end;
  211. procedure TLinkerNetware.SetDefaultInfo;
  212. begin
  213. with Info do
  214. begin
  215. {$ifndef netware}
  216. ExeCmd[1]:= FindUtil(utilsprefix+'ld') + ' -Ur -T $RES $STRIP -o $TMPOBJ';
  217. ExeCmd[2]:= FindUtil(utilsprefix+'nlmconv') + ' -T$RES';
  218. {$else}
  219. {for running on netware we need absolute pathes since ld has another working directory}
  220. ExeCmd[1]:= FindUtil(utilsprefix+'ld') + ' -Ur -T '+FExpand(outputexedir+Info.ResName)+' $STRIP -o '+Fexpand(outputexedir+tmpLinkFileName);
  221. ExeCmd[2]:= FindUtil(utilsprefix+'nlmconv') + ' -T'+FExpand(outputexedir+'n'+Info.ResName);
  222. {$endif}
  223. end;
  224. end;
  225. Function TLinkerNetware.WriteResponseFile(isdll:boolean) : Boolean;
  226. Var
  227. linkres : TLinkRes;
  228. i : longint;
  229. s,s2,s3 : TCmdStr;
  230. ProgNam : string [80];
  231. NlmNam : string [80];
  232. hp2 : texported_item; { for exports }
  233. p : byte;
  234. begin
  235. WriteResponseFile:=False;
  236. ProgNam := current_module.exefilename^;
  237. i:=Pos(target_info.exeext,ProgNam);
  238. if i>0 then
  239. Delete(ProgNam,i,255);
  240. NlmNam := ProgNam + target_info.exeext;
  241. { Open link.res file }
  242. LinkRes:=TLinkRes.Create(outputexedir+Info.ResName); {for ld}
  243. NLMConvLinkFile:=TLinkRes.Create(outputexedir+'n'+Info.ResName); {for nlmconv, written in CreateExeFile}
  244. p := Pos ('"', Description);
  245. while (p > 0) do
  246. begin
  247. delete (Description,p,1);
  248. p := Pos ('"', Description);
  249. end;
  250. if Description <> '' then
  251. NLMConvLinkFile.Add('DESCRIPTION "' + Description + '"');
  252. NLMConvLinkFile.Add('VERSION '+tostr(dllmajor)+','+tostr(dllminor)+','+tostr(dllrevision));
  253. p := Pos ('"', nwscreenname);
  254. while (p > 0) do
  255. begin
  256. delete (nwscreenname,p,1);
  257. p := Pos ('"', nwscreenname);
  258. end;
  259. p := Pos ('"', nwthreadname);
  260. while (p > 0) do
  261. begin
  262. delete (nwthreadname,p,1);
  263. p := Pos ('"', nwthreadname);
  264. end;
  265. p := Pos ('"', nwcopyright);
  266. while (p > 0) do
  267. begin
  268. delete (nwcopyright,p,1);
  269. p := Pos ('"', nwcopyright);
  270. end;
  271. if nwscreenname <> '' then
  272. NLMConvLinkFile.Add('SCREENNAME "' + nwscreenname + '"');
  273. if nwthreadname <> '' then
  274. NLMConvLinkFile.Add('THREADNAME "' + nwthreadname + '"');
  275. if nwcopyright <> '' then
  276. NLMConvLinkFile.Add('COPYRIGHT "' + nwcopyright + '"');
  277. if stacksize < minStackSize then stacksize := minStackSize;
  278. str (stacksize, s);
  279. NLMConvLinkFile.Add ('STACKSIZE '+s);
  280. {$ifndef netware}
  281. NLMConvLinkFile.Add ('INPUT '+outputexedir+tmpLinkFileName);
  282. {$else}
  283. NLMConvLinkFile.Add ('INPUT '+FExpand(outputexedir+tmpLinkFileName));
  284. {$endif}
  285. { add objectfiles, start with nwpre always }
  286. LinkRes.Add ('INPUT(');
  287. s2 := FindObjectFile('nwpre','',false);
  288. Comment (V_Debug,'adding Object File '+s2);
  289. {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif}
  290. { main objectfiles, add to linker input }
  291. while not ObjectFiles.Empty do
  292. begin
  293. s:=ObjectFiles.GetFirst;
  294. if s<>'' then
  295. begin
  296. s2 := FindObjectFile (s,'',false);
  297. Comment (V_Debug,'adding Object File '+s2);
  298. {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif}
  299. end;
  300. end;
  301. LinkRes.Add (')');
  302. { output file (nlm), add to nlmconv }
  303. {$ifndef netware}
  304. NLMConvLinkFile.Add ('OUTPUT ' + NlmNam);
  305. {$else}
  306. NLMConvLinkFile.Add ('OUTPUT ' + FExpand(NlmNam));
  307. {$endif}
  308. { start and stop-procedures }
  309. NLMConvLinkFile.Add ('START _Prelude'); { defined in rtl/netware/nwpre.as }
  310. NLMConvLinkFile.Add ('EXIT _Stop'); { nwpre.as }
  311. NLMConvLinkFile.Add ('CHECK FPC_NW_CHECKFUNCTION'); { system.pp }
  312. if not (cs_link_strip in current_settings.globalswitches) then
  313. begin
  314. NLMConvLinkFile.Add ('DEBUG');
  315. Comment(V_Debug,'DEBUG');
  316. end;
  317. { Write staticlibraries }
  318. if not StaticLibFiles.Empty then
  319. begin
  320. LinkRes.Add ('GROUP(');
  321. While not StaticLibFiles.Empty do
  322. begin
  323. S:=lower (StaticLibFiles.GetFirst);
  324. if s<>'' then
  325. begin
  326. {ad: that's a hack !
  327. whith -XX we get the .a files as static libs (in addition to the
  328. imported libraries}
  329. if (pos ('.a',s) <> 0) OR (pos ('.A', s) <> 0) then
  330. begin
  331. S2 := FindObjectFile(s,'',false);
  332. {$ifndef netware} LinkRes.Add (s2); {$else} LinkRes.Add (FExpand(s2)); {$endif}
  333. Comment(V_Debug,'adding Object File (StaticLibFiles) '+S2);
  334. end else
  335. begin
  336. i:=Pos(target_info.staticlibext,S);
  337. if i>0 then
  338. Delete(S,i,255);
  339. S := S + '.imp'; S2 := '';
  340. librarysearchpath.FindFile(S,false,S2);
  341. {$ifdef netware}
  342. Comment(V_Debug,'IMPORT @'+s2);
  343. s2 := FExpand (S2);
  344. {$endif}
  345. NLMConvLinkFile.Add('IMPORT @'+S2);
  346. Comment(V_Debug,'IMPORT @'+s2);
  347. end;
  348. end
  349. end;
  350. LinkRes.Add (')');
  351. end;
  352. if not SharedLibFiles.Empty then
  353. begin
  354. While not SharedLibFiles.Empty do
  355. begin
  356. {because of upper/lower case mix, we may get duplicate
  357. names but nlmconv ignores that.
  358. Here we are setting the import-files for nlmconv. I.e. for
  359. the module clib or clib.nlm we add IMPORT @clib.imp and also
  360. the module clib.nlm (autoload)
  361. ? may it be better to set autoload's via StaticLibFiles ? }
  362. S:=lower (SharedLibFiles.GetFirst);
  363. if s<>'' then
  364. begin
  365. s2:=s;
  366. i:=Pos(target_info.sharedlibext,S);
  367. if i>0 then
  368. Delete(S,i,255);
  369. if s[1] = '!' then
  370. begin // special, with ! only the imp will be included but no module is autoloaded, needed i.e. for netware.imp
  371. S := copy(S,2,255) + '.imp';
  372. librarysearchpath.FindFile(S,false,S3);
  373. {$ifdef netware}
  374. Comment(V_Debug,'IMPORT @'+S3);
  375. S3 := FExpand (S3);
  376. {$endif}
  377. NLMConvLinkFile.Add('IMPORT @'+S3);
  378. Comment(V_Debug,'IMPORT @'+S3);
  379. end else
  380. begin
  381. S := S + '.imp';
  382. librarysearchpath.FindFile(S,false,S3);
  383. {$ifdef netware}
  384. Comment(V_Debug,'IMPORT @'+S3);
  385. S3 := FExpand (S3);
  386. {$endif}
  387. NLMConvLinkFile.Add('IMPORT @'+S3);
  388. NLMConvLinkFile.Add('MODULE '+s2);
  389. Comment(V_Debug,'MODULE '+S2);
  390. Comment(V_Debug,'IMPORT @'+S3);
  391. end;
  392. end;
  393. end;
  394. end;
  395. { write exports }
  396. hp2:=texported_item(current_module._exports.first);
  397. while assigned(hp2) do
  398. begin
  399. if not hp2.is_var then
  400. begin
  401. { Export the Symbol }
  402. Comment(V_Debug,'EXPORT '+hp2.name^);
  403. NLMConvLinkFile.Add ('EXPORT '+hp2.name^);
  404. end
  405. else
  406. { really, i think it is possible }
  407. Message1(parser_e_no_export_of_variables_for_target,'netware');
  408. hp2:=texported_item(hp2.next);
  409. end;
  410. { Write and Close response for ld, response for nlmconv is in NLMConvLinkFile(not written) }
  411. linkres.writetodisk;
  412. LinkRes.Free;
  413. { pass options from -k to nlmconv, ; is interpreted as newline }
  414. s := ParaLinkOptions;
  415. while(Length(s) > 0) and (s[1] = ' ') do
  416. delete (s,1,1);
  417. p := pos ('"',s);
  418. while p > 0 do
  419. begin
  420. delete (s,p,1);
  421. p := pos ('"',s);
  422. end;
  423. p := pos (';',s);
  424. while p > 0 do
  425. begin
  426. s2 := copy(s,1,p-1);
  427. comment (V_Debug,'adding "'+s2+'" to nlmvonv input');
  428. NLMConvLinkFile.Add(s2);
  429. delete (s,1,p);
  430. p := pos (';',s);
  431. end;
  432. if s <> '' then
  433. begin
  434. comment (V_Debug,'adding "'+s+'" to nlmvonv input');
  435. NLMConvLinkFile.Add(s);
  436. end;
  437. WriteResponseFile:=True;
  438. end;
  439. function TLinkerNetware.MakeExecutable:boolean;
  440. var
  441. binstr,
  442. cmdstr : TCmdStr;
  443. success : boolean;
  444. StripStr : string[2];
  445. begin
  446. if not(cs_link_nolink in current_settings.globalswitches) then
  447. Message1(exec_i_linking,current_module.exefilename^);
  448. { Create some replacements }
  449. StripStr:='';
  450. if (cs_link_strip in current_settings.globalswitches) then
  451. StripStr:='-s';
  452. { Write used files and libraries and create Headerfile for
  453. nlmconv in NLMConvLinkFile }
  454. WriteResponseFile(false);
  455. { Call linker, this will generate a new object file that will be passed
  456. to nlmconv. Otherwise we could not create nlms without debug info }
  457. SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
  458. Replace(cmdstr,'$EXE',maybequoted(current_module.exefilename^));
  459. Replace(cmdstr,'$RES',maybequoted(outputexedir+Info.ResName));
  460. Replace(cmdstr,'$STRIP',StripStr);
  461. Replace(cmdstr,'$TMPOBJ',maybequoted(outputexedir+tmpLinkFileName));
  462. Comment (v_debug,'Executing '+BinStr+' '+cmdstr);
  463. success:=DoExec(BinStr,CmdStr,true,false);
  464. { Remove ReponseFile }
  465. if (success) and not(cs_link_nolink in current_settings.globalswitches) then
  466. DeleteFile(outputexedir+Info.ResName);
  467. { Call nlmconv }
  468. if success then
  469. begin
  470. NLMConvLinkFile.writetodisk;
  471. NLMConvLinkFile.Free;
  472. SplitBinCmd(Info.ExeCmd[2],binstr,cmdstr);
  473. Replace(cmdstr,'$RES',maybequoted(outputexedir+'n'+Info.ResName));
  474. Comment (v_debug,'Executing '+BinStr+' '+cmdstr);
  475. success:=DoExec(BinStr,CmdStr,true,false);
  476. if (success) and not(cs_link_nolink in current_settings.globalswitches) then
  477. begin
  478. DeleteFile(outputexedir+'n'+Info.ResName);
  479. DeleteFile(outputexedir+tmpLinkFileName);
  480. end;
  481. end;
  482. MakeExecutable:=success; { otherwise a recursive call to link method }
  483. end;
  484. {****************************************************************************
  485. TInternalLinkerNetware
  486. ****************************************************************************}
  487. constructor TInternalLinkerNetware.Create;
  488. begin
  489. inherited Create;
  490. CExeoutput:=TNLMexeoutput;
  491. CObjInput:=TNLMCoffObjInput;
  492. end;
  493. procedure TInternalLinkerNetware.DefaultLinkScript;
  494. var
  495. s,s2 : TCmdStr;
  496. secname,
  497. secnames : string;
  498. hasCopyright,
  499. hasScreenname,
  500. hasThreadname,
  501. hasVersion,
  502. hasDescription,
  503. hasStacksize: boolean;
  504. t : text;
  505. procedure addLinkerOption(s : string);
  506. var op : string;
  507. begin
  508. if s = '' then exit;
  509. if s[1] = '#' then exit;
  510. LinkScript.Concat(s);
  511. op := upper(GetToken(s,' '));
  512. {check for options via -k that can also be specified vie
  513. compiler directives in source, -k options will override
  514. options in source}
  515. if op = 'COPYRIGHT' then hasCopyright := true else
  516. if op = 'SCREENNAME' then hasScreenname := true else
  517. if op = 'THREADNAME' then hasThreadname := true else
  518. if op = 'VERSION' then hasVersion := true else
  519. if op = 'DESCRIPTION' then hasDescription := true else
  520. if (op = 'STACK') or (op = 'STACKSIZE') then hasStacksize := true;
  521. end;
  522. { add linker scropt specified by -k@FileName }
  523. procedure addLinkerOptionsFile (fileName : string);
  524. var
  525. t : text;
  526. option : string;
  527. fn : TCmdStr;
  528. begin
  529. fn := fileName;
  530. if not sysutils.fileExists(fn) then
  531. if not includesearchpath.FindFile(fileName,true,fn) then
  532. begin
  533. comment(v_error,'linker options file "'+fileName+'" not found');
  534. exit;
  535. end;
  536. assign(t,fn); reset(t);
  537. while not eof(t) do
  538. begin
  539. readln(t,option);
  540. addLinkerOption(option);
  541. end;
  542. close(t);
  543. end;
  544. { add linker options specified by command line parameter -k }
  545. procedure addLinkerOptions;
  546. var
  547. s,option : string;
  548. p : integer;
  549. begin
  550. s := ParaLinkOptions;
  551. option := GetToken(s,';');
  552. while option <> '' do
  553. begin
  554. if copy(option,1,1)='@' then
  555. begin
  556. delete(option,1,1);
  557. addLinkerOptionsFile(option);
  558. end else
  559. addLinkerOption(option);
  560. option := GetToken(s,';');
  561. end;
  562. end;
  563. { default: nwpre but can be specified via linker options
  564. bacuse this has to be the first object, we have to scan
  565. linker options before adding other options }
  566. function findPreludeInFile (fileName : string):string;
  567. var
  568. t : text;
  569. option,s : string;
  570. fn : TCmdStr;
  571. begin
  572. result := '';
  573. fn := fileName;
  574. if not sysutils.fileExists(fn) then
  575. if not includesearchpath.FindFile(fileName,true,fn) then
  576. begin
  577. comment(v_error,'linker options file "'+fileName+'" not found');
  578. exit;
  579. end;
  580. assign(t,fn); reset(t);
  581. while not eof(t) do
  582. begin
  583. readln(t,option);
  584. option := upper(GetToken(s,' '));
  585. if option='PRELUDE' then
  586. begin
  587. result := getToken(s,' ');
  588. close(t);
  589. exit;
  590. end;
  591. end;
  592. close(t);
  593. end;
  594. function findPrelude : string;
  595. var
  596. s,option,keyword : string;
  597. p : integer;
  598. begin
  599. s := ParaLinkOptions;
  600. option := GetToken(s,';');
  601. while option <> '' do
  602. begin
  603. if copy(option,1,1)='@' then
  604. begin
  605. delete(option,1,1);
  606. result := findPreludeInFile(option);
  607. if result <> '' then exit;
  608. end else
  609. begin
  610. keyword := GetToken(option,' ');
  611. if keyword = 'PRELUDE' then
  612. begin
  613. result := GetToken(option,' ');
  614. exit;
  615. end;
  616. end;
  617. option := GetToken(s,';');
  618. end;
  619. result := 'nwpre';
  620. end;
  621. begin
  622. with LinkScript do
  623. begin
  624. prelude := findPrelude; // needs to be first object, can be specified by -k"PRELUDE ObjFileName"
  625. if prelude = '' then internalerror(201103271);
  626. if pos ('.',prelude) = 0 then prelude := prelude + '.o';
  627. s2 := FindObjectFile(prelude,'',false);
  628. Comment (V_Debug,'adding init Object File '+s2);
  629. Concat('READOBJECT '+MaybeQuoted(s2));
  630. while not ObjectFiles.Empty do
  631. begin
  632. s:=ObjectFiles.GetFirst;
  633. if s<>'' then
  634. begin
  635. Concat('READOBJECT '+MaybeQuoted(s));
  636. Comment (V_Debug,'adding Object File '+s);
  637. end;
  638. end;
  639. while not StaticLibFiles.Empty do
  640. begin
  641. s:=StaticLibFiles.GetFirst;
  642. if s<>'' then
  643. begin
  644. Comment (V_Debug,'adding StaticLibFile '+s);
  645. Concat('READSTATICLIBRARY '+MaybeQuoted(s));
  646. end;
  647. end;
  648. { While not SharedLibFiles.Empty do
  649. begin
  650. S:=SharedLibFiles.GetFirst;
  651. if FindLibraryFile(s,target_info.staticClibprefix,target_info.importlibext,s2) then
  652. begin
  653. Comment (V_Debug,'adding LibraryFile '+s);
  654. Concat('READSTATICLIBRARY '+MaybeQuoted(s2));
  655. end else
  656. Comment(V_Error,'Import library not found for '+S);
  657. end;}
  658. if IsSharedLibrary then
  659. Concat('ISSHAREDLIBRARY');
  660. ConcatEntryName;
  661. Concat('IMAGEBASE $' + hexStr(0, SizeOf(imagebase)*2));
  662. Concat('HEADER');
  663. Concat('EXESECTION .text');
  664. Concat(' SYMBOL __text_start__');
  665. Concat(' OBJSECTION .text*');
  666. Concat(' SYMBOL ___CTOR_LIST__');
  667. Concat(' SYMBOL __CTOR_LIST__');
  668. Concat(' LONG -1');
  669. Concat(' OBJSECTION .ctor*');
  670. Concat(' LONG 0');
  671. Concat(' SYMBOL ___DTOR_LIST__');
  672. Concat(' SYMBOL __DTOR_LIST__');
  673. Concat(' LONG -1');
  674. Concat(' OBJSECTION .dtor*');
  675. Concat(' LONG 0');
  676. Concat(' SYMBOL etext');
  677. Concat('ENDEXESECTION');
  678. Concat('EXESECTION .data');
  679. Concat(' SYMBOL __data_start__');
  680. Concat(' OBJSECTION .data*');
  681. Concat(' OBJSECTION .fpc*');
  682. Concat(' SYMBOL edata');
  683. Concat(' SYMBOL __data_end__');
  684. Concat('ENDEXESECTION');
  685. Concat('EXESECTION .bss');
  686. Concat(' SYMBOL __bss_start__');
  687. Concat(' OBJSECTION .bss*');
  688. Concat(' SYMBOL __bss_end__');
  689. Concat('ENDEXESECTION');
  690. Concat('EXESECTION .imports');
  691. Concat(' SYMBOL __imports_start__');
  692. Concat(' OBJSECTION .imports*');
  693. Concat(' SYMBOL __imports_end__');
  694. Concat('ENDEXESECTION');
  695. Concat('EXESECTION .modules');
  696. Concat(' SYMBOL __modules_start__');
  697. Concat(' OBJSECTION .modules*');
  698. Concat(' SYMBOL __modules_end__');
  699. Concat('ENDEXESECTION');
  700. Concat('EXESECTION .exports');
  701. Concat(' SYMBOL __exports_start__');
  702. Concat(' OBJSECTION .exports*');
  703. Concat(' SYMBOL __exports_end__');
  704. Concat('ENDEXESECTION');
  705. Concat('EXESECTION .reloc');
  706. Concat(' SYMBOL __reloc_start__');
  707. Concat(' OBJSECTION .reloc*');
  708. Concat(' SYMBOL __reloc_end__');
  709. Concat('ENDEXESECTION');
  710. Concat('EXESECTION .xdc');
  711. Concat(' OBJSECTION .xdc*');
  712. Concat('ENDEXESECTION');
  713. Concat('EXESECTION .custom');
  714. Concat(' OBJSECTION .custom*');
  715. Concat('ENDEXESECTION');
  716. Concat('EXESECTION .messages');
  717. Concat(' OBJSECTION .messages*');
  718. Concat('ENDEXESECTION');
  719. Concat('EXESECTION .help');
  720. Concat(' OBJSECTION .help*');
  721. Concat('ENDEXESECTION');
  722. Concat('EXESECTION .rdata');
  723. Concat(' SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST__');
  724. Concat(' SYMBOL __RUNTIME_PSEUDO_RELOC_LIST__');
  725. Concat(' OBJSECTION .rdata_runtime_pseudo_reloc');
  726. Concat(' SYMBOL ___RUNTIME_PSEUDO_RELOC_LIST_END__');
  727. Concat(' SYMBOL __RUNTIME_PSEUDO_RELOC_LIST_END__');
  728. Concat(' OBJSECTION .rdata*');
  729. Concat(' OBJSECTION .rodata*');
  730. Concat('ENDEXESECTION');
  731. Concat('EXESECTION .pdata');
  732. Concat(' OBJSECTION .pdata');
  733. Concat('ENDEXESECTION');
  734. secnames:='.edata,.rsrc,.gnu_debuglink,'+
  735. '.debug_aranges,.debug_pubnames,.debug_info,.debug_abbrev,.debug_line,.debug_frame,.debug_str,.debug_loc,'+
  736. '.debug_macinfo,.debug_weaknames,.debug_funcnames,.debug_typenames,.debug_varnames,.debug_ranges';
  737. repeat
  738. secname:=gettoken(secnames,',');
  739. if secname='' then
  740. break;
  741. Concat('EXESECTION '+secname);
  742. Concat(' OBJSECTION '+secname+'*');
  743. Concat('ENDEXESECTION');
  744. until false;
  745. { Can't use the generic rules, because that will add also .stabstr to .stab }
  746. Concat('EXESECTION .stab');
  747. Concat(' OBJSECTION .stab');
  748. Concat('ENDEXESECTION');
  749. Concat('EXESECTION .stabstr');
  750. Concat(' OBJSECTION .stabstr');
  751. Concat('ENDEXESECTION');
  752. Concat('STABS');
  753. Concat('SYMBOLS');
  754. Concat('');
  755. hasCopyright := false;
  756. hasScreenname := false;
  757. hasThreadname := false;
  758. hasVersion := false;
  759. hasDescription := false;
  760. hasStacksize := false;
  761. addLinkerOptions;
  762. if not hasCopyright then
  763. if nwcopyright <> '' then
  764. Concat('COPYRIGHT "'+nwCopyright+'"');
  765. if not hasScreenname then
  766. if nwscreenname <> '' then
  767. Concat('SCREENNAME "'+nwscreenname+'"');
  768. if not hasThreadname then
  769. if nwthreadname <> '' then
  770. Concat('THREADNAME "'+nwthreadname+'"');
  771. if not hasVersion then
  772. Concat('VERSION '+tostr(dllmajor)+' '+tostr(dllminor)+' '+tostr(dllrevision));
  773. if not hasDescription then
  774. if description <> '' then
  775. Concat ('DESCRIPTION "'+description+'"');
  776. if not hasStacksize then
  777. if MaxStackSizeSetExplicity then
  778. begin
  779. if stacksize < minStackSize then stacksize := minStackSize;
  780. Concat ('STACKSIZE '+tostr(stacksize));
  781. end else
  782. Concat ('STACKSIZE '+tostr(minStackSize));
  783. end;
  784. // add symbols needed by nwpre. We have not loaded the ppu,
  785. // therefore we do not know the externals so read it from nwpre.imp
  786. s := ChangeFileExt(prelude,'.imp'); // nwpre.imp
  787. if not librarysearchpath.FindFile(s,true,s2) then
  788. begin
  789. comment(v_error,s+' not found');
  790. exit;
  791. end;
  792. assign(t,s2); reset(t);
  793. while not eof(t) do
  794. begin
  795. readln(t,s);
  796. s := trimspace(s);
  797. if (length(s) > 0) then
  798. if copy(s,1,1) <> '#' then
  799. AddImportSymbol('!clib',s,0,false);
  800. end;
  801. close(t);
  802. end;
  803. procedure TInternalLinkerNetware.InitSysInitUnitName;
  804. begin
  805. //if target_info.system=system_i386_netware then
  806. // GlobalInitSysInitUnitName(self);
  807. end;
  808. procedure TInternalLinkerNetware.ConcatEntryName;
  809. begin
  810. with LinkScript do
  811. begin
  812. if IsSharedLibrary then
  813. begin
  814. Concat('ISSHAREDLIBRARY');
  815. Concat('ENTRYNAME _Prelude')
  816. end
  817. else
  818. begin
  819. Concat('ENTRYNAME _Prelude')
  820. end;
  821. end;
  822. end;
  823. Function TInternalLinkerNetware.MakeSharedLibrary:boolean;
  824. begin
  825. Comment(V_Error,'Make shared library not supported for netware');
  826. end;
  827. {*****************************************************************************
  828. Initialize
  829. *****************************************************************************}
  830. initialization
  831. RegisterExternalLinker(system_i386_netware_info,TLinkerNetware);
  832. RegisterInternalLinker(system_i386_netware_info,TInternalLinkerNetware);
  833. RegisterImport(system_i386_netware,TImportLibNetware);
  834. RegisterExport(system_i386_netware,TExportLibNetware);
  835. RegisterTarget(system_i386_netware_info);
  836. end.