t_nwm.pas 33 KB

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