ognlm.pas 60 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521
  1. {
  2. Copyright (c) 1998-2006 by Peter Vreman
  3. Copyright (c) 2011 by Armin Diehl
  4. Contains the binary netware nlm executable writer
  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 ognlm;
  19. {$i fpcdefs.inc}
  20. interface
  21. uses
  22. { common }
  23. cclasses,globtype,
  24. { target }
  25. systems,
  26. aasmbase,assemble,link,
  27. { output }
  28. ogbase,
  29. owbase,
  30. ogcoff;
  31. {*****************************************************************************
  32. NLM File structures and constants
  33. *****************************************************************************}
  34. {
  35. LString0 -> 1 byte Length, Text, #0
  36. LString -> 1 byte length, Text
  37. Basic NLM File Structure:
  38. FixedHeader
  39. nlm32_i386_external_fixed_header 130 bytes
  40. VarHdr1
  41. NLM Description: LString0 2+n bytes
  42. Stacksize 4 bytes
  43. reserved = 0 4 bytes
  44. ' LONG' 5 bytes
  45. NLM screen name: LString0 2+n bytes
  46. NLM thread name: LString0 2+n bytes
  47. Optional Headers beginning with stamp (without '')
  48. 'VeRsIoN#': nlm32_i386_external_version_header 32 bytes
  49. 'CoPyRiGhT=': LString0 2+n bytes
  50. 'MeSsAgEs': nlm32_i386_external_extended_header 124 bytes
  51. 'CuStHeAd': nlm32_i386_external_custom_header
  52. 'CyGnUsEx': nlm32_i386_external_cygnus_ext_header 16 bytes
  53. .text
  54. .data
  55. .relocs=
  56. addr(32),addr(32),...
  57. addr and $80000000 > 0 -> FixupToSeg=.text else .data
  58. addr and $40000000 > 0 -> FixupInSeg=.text else .data
  59. .importedSymbols
  60. name LString 1+n bytes
  61. number of references r 4 bytes
  62. addresses r*4 bytes
  63. .exportedSymbols
  64. name LString 1+n bytes
  65. addr 4 bytes
  66. addr and $80000000 > 0 -> .text else .data
  67. ...
  68. .modules
  69. .nlmdebugrecs
  70. type (0=.data,1=.code,2,..=????) 1 byte
  71. addr 4 bytes
  72. name LString 1+n bytes
  73. ...
  74. }
  75. const NLM_MAX_DESCRIPTION_LENGTH = 127;
  76. NLM_MAX_SCREEN_NAME_LENGTH = 71;
  77. NLM_MAX_THREAD_NAME_LENGTH = 71; // some netware docs limit this to 12 ?
  78. NLM_OLD_THREAD_NAME_LENGTH = 5;
  79. NLM_HEADER_VERSION = 4;
  80. NLM_DEFAULT_STACKSIZE = (32 * 1024);
  81. NLM_VERSION_STAMP = 'VeRsIoN#';
  82. NLM_COPYRIGHT_STAMP = 'CoPyRiGhT=';
  83. NLM_CYGNUS_STAMP = 'CyGnUsEx';
  84. NLM_MESSAGES_STAMP = 'MeSsAgEs';
  85. NLM_CUSTOM_STAMP = 'CuStHeAd';
  86. NLM_SIGNATURE = 'NetWare Loadable Module'#$1A;
  87. NLM_FLAGS_REENTRANT = 1;
  88. NLM_FLAGS_MULTILOAD = 2;
  89. NLM_FLAGS_SYNCHRONIZE = 4;
  90. NLM_FLAGS_PSEUDOPREEMPTION = 8;
  91. NLM_FLAGS_OSDOMAIN = $10;
  92. NLM_FLAGS_AUTOUNLOAD = $40;
  93. type
  94. uint32 = longword;
  95. nlm32_i386_external_fixed_header = packed record
  96. signature : array[0..23] of char;
  97. version : uint32;
  98. (* The name of the module, which must be a DOS name (1-8 characters followed
  99. by a period and a 1-3 character extension). The first byte is the byte
  100. length of the name and the last byte is a null terminator byte. This
  101. field is fixed length, and any unused bytes should be null bytes. The
  102. value is set by the OUTPUT keyword to NLMLINK. *)
  103. moduleName : string[13]; //array[0..13] of byte;
  104. codeImageOffset : uint32; // The byte offset of the code image from the start of the file.
  105. codeImageSize : uint32; // The size of the code image, in bytes.
  106. dataImageOffset : uint32; // The byte offset of the data image from the start of the file.
  107. dataImageSize : uint32; // The size of the data image, in bytes.
  108. uninitializedDataSize : uint32; // The size of the uninitialized data region that the loader has to be
  109. // allocated at load time. Uninitialized data follows the initialized
  110. // data in the NLM address space.
  111. customDataOffset : uint32; // The byte offset of the custom data from the start of the file. The
  112. // custom data is set by the CUSTOM keyword to NLMLINK. It is possible
  113. // for this to be EOF if there is no custom data.
  114. customDataSize : uint32; // The size of the custom data, in bytes.
  115. moduleDependencyOffset : uint32; // The byte offset of the module dependencies from the start of the file.
  116. // The module dependencies are determined by the MODULE keyword in NLMLINK.
  117. numberOfModuleDependencies : uint32; // he number of module dependencies at the moduleDependencyOffset.
  118. relocationFixupOffset : uint32; // The byte offset of the relocation fixup data from the start of the file
  119. numberOfRelocationFixups : uint32;
  120. externalReferencesOffset : uint32;
  121. numberOfExternalReferences : uint32;
  122. publicsOffset : uint32;
  123. numberOfPublics : uint32;
  124. debugInfoOffset : uint32; // The byte offset of the internal debug info from the start of the file.
  125. // It is possible for this to be EOF if there is no debug info.
  126. numberOfDebugRecords : uint32;
  127. codeStartOffset : uint32;
  128. exitProcedureOffset : uint32;
  129. checkUnloadProcedureOffset : uint32;
  130. moduleType : uint32;
  131. flags : uint32;
  132. end;
  133. { The version header is one of the optional auxiliary headers and
  134. follows the fixed length and variable length NLM headers. }
  135. { The header is recognized by "VeRsIoN#" in the stamp field. }
  136. nlm32_i386_external_version_header = packed record
  137. stamp : array[0..7] of char; // VeRsIoN#
  138. majorVersion,
  139. minorVersion,
  140. revision,
  141. year,
  142. month,
  143. day : uint32;
  144. end;
  145. { The header is recognized by "MeSsAgEs" in the stamp field. }
  146. nlm32_i386_external_extended_header = packed record
  147. stamp : array[0..7] of char; // MeSsAgEs
  148. languageID : uint32;
  149. messageFileOffset : uint32;
  150. messageFileLength : uint32;
  151. messageCount : uint32;
  152. helpFileOffset : uint32;
  153. helpFileLength : uint32;
  154. RPCDataOffset : uint32;
  155. RPCDataLength : uint32;
  156. sharedCodeOffset : uint32;
  157. sharedCodeLength : uint32;
  158. sharedDataOffset : uint32;
  159. sharedDataLength : uint32;
  160. sharedRelocationFixupOffset : uint32;
  161. sharedRelocationFixupCount : uint32;
  162. sharedExternalReferenceOffset: uint32;
  163. sharedExternalReferenceCount : uint32;
  164. sharedPublicsOffset : uint32;
  165. sharedPublicsCount : uint32;
  166. sharedDebugRecordOffset : uint32;
  167. sharedDebugRecordCount : uint32;
  168. SharedInitializationOffset : uint32;
  169. SharedExitProcedureOffset : uint32;
  170. productID : longint;
  171. reserved0 : longint;
  172. reserved1 : longint;
  173. reserved2 : longint;
  174. reserved3 : longint;
  175. reserved4 : longint;
  176. reserved5 : longint;
  177. end;
  178. nlm32_i386_external_custom_header = packed record
  179. stamp : array[0..7] of char; // CuStHeAd
  180. hdrLength : uint32;
  181. dataOffset : uint32;
  182. dataLength : uint32;
  183. //dataStamp : array[0..7] of char;
  184. //hdr : uint32;
  185. end;
  186. { The internal Cygnus header is written out externally as a custom
  187. header. We don't try to replicate that structure here. }
  188. { The header is recognized by "CyGnUsEx" in the stamp field. }
  189. { File location of debugging information. }
  190. { Length of debugging information. }
  191. nlm32_i386_external_cygnus_ext_header = packed record
  192. stamp : array[0..7] of char; // CyGnUsEx
  193. offset : uint32;
  194. length : uint32;
  195. end;
  196. //------------------
  197. TNLMExeSection = class(TExeSection)
  198. public
  199. constructor createnw(AList:TFPHashObjectList;const n:string);
  200. end;
  201. TsecType = (Section_text,Section_data,Section_other);
  202. TNLMexeoutput = class(texeoutput)
  203. private
  204. FRelocsGenerated,FImportsGenerated : boolean;
  205. FNumRelocs : longword;
  206. FNumExternals : longword;
  207. FNumModules : longword;
  208. FNumDebugSymbols : longword;
  209. fSizeWoDebugSyms : longword;
  210. FnumExports : longword;
  211. NlmSymbols : TDynamicArray;
  212. ExeSecsListSize : longint;
  213. nlmImpNames, // name of import. module name as import
  214. nlmImports : TFPHashObjectList; // name of import, list of relocs as object
  215. headerAlignBytes : longint;
  216. FexportFunctionOffsets:TFPList; // offsets in .exports for function addresses, an offset of $80000000 is needed
  217. nlmHeader : nlm32_i386_external_fixed_header;
  218. nlmVersionHeader : nlm32_i386_external_version_header;
  219. nlmExtHeader : nlm32_i386_external_extended_header;
  220. nlmCustHeader : nlm32_i386_external_custom_header;
  221. nlmHelpFileName : TCmdStr;
  222. nlmMessagesFileName: TCmdStr;
  223. nlmXdcFileName : TCmdStr;
  224. nlmCopyright : string;
  225. nlmThreadname : string;
  226. nlmScreenname : string;
  227. nlmDescription : string;
  228. function totalheadersize:longword;
  229. procedure createNlm_symbol(const name:shortstring;value:longword;secType:TSecType);
  230. procedure globalsyms_create_symbol(p:TObject;arg:pointer);
  231. procedure ExeSectionList_write_header(p:TObject;arg:pointer);
  232. procedure ExeSectionList_calc_size(p:TObject;arg:pointer);
  233. procedure ExeSectionList_write_data(p:TObject;arg:pointer);
  234. procedure GenerateImports;
  235. procedure GenerateExports;
  236. procedure GenerateRelocs;
  237. procedure ExeSectionList_pass2_header(p:TObject;arg:pointer);
  238. protected
  239. function writedata:boolean;override;
  240. public
  241. constructor create; override;
  242. destructor destroy; override;
  243. procedure MemPos_Header;override;
  244. procedure DataPos_Header;override;
  245. procedure fillNlmVersionHeader;
  246. procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);override;
  247. procedure Order_End;override;
  248. procedure MemPos_ExeSection(const aname:string);override;
  249. procedure DataPos_ExeSection(const aname:string);override;
  250. procedure NLMwriteString (const s : string; terminateWithZero : boolean);
  251. procedure objNLMwriteString (const s : string; terminateWithZero : boolean);
  252. procedure ParseScript (linkscript:TCmdStrList); override;
  253. end;
  254. var
  255. {for symbols defined in linker script. To generate a fixup we
  256. need to know the segment (.text,.bss or .code) of the symbol
  257. Pointer in list is used as TsecType
  258. Filled by TInternalLinkerNetware.DefaultLinkScript }
  259. nlmSpecialSymbols_Segments : TFPHashList;
  260. type
  261. TNLMCoffObjInput = class(TCoffObjInput)
  262. constructor create;override;
  263. end;
  264. TNLMCoffassembler = class(tinternalassembler)
  265. constructor create(smart:boolean);override;
  266. end;
  267. TNLMCoffObjData = class(TCoffObjData)
  268. constructor create(const n:string);override;
  269. end;
  270. TNLMCoffObjOutput = class(TCoffObjOutput)
  271. constructor create(AWriter:TObjectWriter);override;
  272. end;
  273. TNLMCoffObjSection = class(TCoffObjSection)
  274. constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override;
  275. end;
  276. implementation
  277. uses
  278. {$ifdef win32}
  279. Windows,
  280. {$endif win32}
  281. SysUtils,
  282. cutils,verbose,globals,
  283. fmodule,aasmdata,
  284. ogmap,export
  285. ;
  286. {****************************************************************************
  287. Helpers
  288. ****************************************************************************}
  289. type
  290. TStringObj = class (TObject)
  291. fValue : string;
  292. constructor create (value:string);
  293. property value : string read fValue write fValue;
  294. end;
  295. constructor TStringObj.create(value:string);
  296. begin
  297. inherited create;
  298. fValue := value;
  299. end;
  300. function SectionType (aName : string) : TSecType;
  301. var s : string;
  302. seg: ptruint;
  303. begin
  304. s := copy(aName,1,5);
  305. if s = '.text' then result := Section_text else
  306. if (s = '.data') or (copy(s,1,4)='.bss') then result := Section_data else
  307. if s[1] <> '.' then
  308. begin
  309. seg := ptruint(nlmSpecialSymbols_Segments.Find(aName));
  310. if seg <> 0 then
  311. result := TSecType(seg)
  312. else
  313. result := Section_other;
  314. end else
  315. result := Section_other;
  316. end;
  317. {****************************************************************************
  318. TNLMexesection
  319. ****************************************************************************}
  320. constructor TNLMExeSection.createnw(AList:TFPHashObjectList;const n:string);
  321. begin
  322. inherited create(AList,n);
  323. end;
  324. {****************************************************************************
  325. TNLMexeoutput
  326. ****************************************************************************}
  327. constructor TNLMexeoutput.create;
  328. begin
  329. inherited create;
  330. CExeSection:=TNLMExeSection;
  331. CObjData:=TNLMCoffObjData;
  332. MaxMemPos:=$7FFFFFFF;
  333. SectionMemAlign:=$0;
  334. SectionDataAlign:=0;
  335. RelocSection := true; // always needed for NLM's
  336. nlmImports := TFPHashObjectList.create(true);
  337. nlmImpNames := TFPHashObjectList.create(false);
  338. NlmSymbols := TDynamicArray.create(4096);
  339. FexportFunctionOffsets := TFPList.Create;
  340. end;
  341. destructor TNLMexeoutput.destroy;
  342. begin
  343. if assigned(nlmImports) then
  344. nlmImports.Free;
  345. if assigned(nlmImpNames) then
  346. nlmImpNames.Free;
  347. if assigned(nlmSymbols) then
  348. nlmSymbols.Free;
  349. if assigned(FexportFunctionOffsets) then
  350. FexportFunctionOffsets.Free;
  351. inherited destroy;
  352. end;
  353. procedure TNLMexeoutput.createNlm_symbol(const name:shortstring;value:longword;secType:TSecType);
  354. var
  355. b:byte;
  356. begin
  357. //Comment (V_Debug,'TNLMexeoutput.write_symbol '+name);
  358. { type (0=.data,1=.code,2,..=????) 1 byte
  359. addr 4 bytes
  360. name LString 1+n bytes }
  361. case secType of
  362. Section_Text : b := 1;
  363. Section_Data : b := 0
  364. else
  365. exit;
  366. end;
  367. nlmSymbols.write(b,sizeof(b));
  368. assert (sizeof(value)<>4);
  369. nlmSymbols.write(value,sizeof(value));
  370. nlmSymbols.write(name[0],length(name)+1);
  371. inc(FNumDebugSymbols);
  372. end;
  373. procedure TNLMexeoutput.globalsyms_create_symbol(p:TObject;arg:pointer);
  374. var
  375. value : longword;
  376. exesec : TExeSection;
  377. i : integer;
  378. secType : TsecType;
  379. begin
  380. if not assigned(texesymbol(p).objsymbol) then
  381. internalerror(200603053);
  382. with texesymbol(p).objsymbol do
  383. begin
  384. exesec:=TExeSection(objsection.exesection);
  385. { There is no exesection defined for special internal symbols
  386. like __image_base__ }
  387. if assigned(exesec) then
  388. begin
  389. //secval:=exesec.secsymidx;
  390. value:=address-exesec.mempos;
  391. end
  392. else
  393. begin
  394. value:=address;
  395. end;
  396. { reloctype address to the section in the executable }
  397. secType := SectionType(objsection.Name);
  398. if (secType = Section_Text) or (secType = Section_Data) then
  399. begin
  400. i := nlmImports.FindIndexOf(texesymbol(p).name);
  401. if i < 0 then
  402. createNlm_symbol(name,value,secType);
  403. end;
  404. end;
  405. end;
  406. (*
  407. function SecOpts(SecOptions:TObjSectionOptions):string;
  408. begin
  409. result := '[';
  410. if oso_Data in SecOptions then result := result + 'oso_Data ';
  411. { Is loaded into memory }
  412. if oso_load in SecOptions then result := result + 'oso_load ';
  413. { Not loaded into memory }
  414. if oso_noload in SecOptions then result := result + 'oso_noload ';
  415. { Read only }
  416. if oso_readonly in SecOptions then result := result + 'oso_readonly ';
  417. { Read/Write }
  418. if oso_write in SecOptions then result := result + 'oso_write ';
  419. { Contains executable instructions }
  420. if oso_executable in SecOptions then result := result + 'oso_executable ';
  421. { Never discard section }
  422. if oso_keep in SecOptions then result := result + 'oso_keep ';
  423. { Special common symbols }
  424. if oso_common in SecOptions then result := result + 'oso_common ';
  425. { Contains debug info and can be stripped }
  426. if oso_debug in SecOptions then result := result + 'oso_debug ';
  427. { Contains only strings }
  428. if oso_strings in SecOptions then result := result + 'oso_strings ';
  429. result := result + ']';
  430. end;
  431. *)
  432. procedure TNLMexeoutput.ExeSectionList_calc_size(p:TObject;arg:pointer);
  433. var
  434. objsec : TObjSection;
  435. i : longint;
  436. begin
  437. with texesection(p) do
  438. begin
  439. { don't write normal section if writing only debug info }
  440. if (ExeWriteMode=ewm_dbgonly) and
  441. not(oso_debug in SecOptions) then
  442. exit;
  443. if oso_data in secoptions then
  444. begin
  445. inc (fSizeWoDebugSyms,(Align(fSizeWoDebugSyms,SectionDataAlign)-fSizeWoDebugSyms));
  446. for i:=0 to ObjSectionList.Count-1 do
  447. begin
  448. objsec:=TObjSection(ObjSectionList[i]);
  449. if oso_data in objsec.secoptions then
  450. begin
  451. inc(fSizeWoDebugSyms,objsec.size);
  452. inc(fSizeWoDebugSyms,objsec.dataalignbytes);
  453. end;
  454. end;
  455. end;
  456. end;
  457. end;
  458. procedure TNLMexeoutput.ExeSectionList_write_Data(p:TObject;arg:pointer);
  459. var
  460. objsec : TObjSection;
  461. i,j : longint;
  462. b : byte;
  463. begin
  464. with texesection(p) do
  465. begin
  466. { don't write normal section if writing only debug info }
  467. if (ExeWriteMode=ewm_dbgonly) and
  468. not(oso_debug in SecOptions) then
  469. exit;
  470. if oso_data in secoptions then
  471. begin
  472. //if Align(FWriter.Size,SectionDataAlign)-FWriter.Size>0 then
  473. // writeln (name,' align ',Align(FWriter.Size,SectionDataAlign)-FWriter.Size,' SectionDataAlign:',SectionDataAlign);
  474. FWriter.Writezeros(Align(FWriter.Size,SectionDataAlign)-FWriter.Size);
  475. for i:=0 to ObjSectionList.Count-1 do
  476. begin
  477. objsec:=TObjSection(ObjSectionList[i]);
  478. if oso_data in objsec.secoptions then
  479. begin
  480. if assigned(exemap) then
  481. if objsec.data.size > 0 then
  482. exemap.Add(' 0x'+hexstr(objsec.DataPos,8)+': '+objsec.name);
  483. //writeln (' ',objsec.name,' size:',objsec.size,' relocs:',objsec.ObjRelocations.count,' DataPos:',objsec.DataPos,' MemPos:',objsec.MemPos);
  484. {for j := 0 to objsec.ObjRelocations.count-1 do
  485. begin
  486. objreloc := TObjRelocation(objsec.ObjRelocations[j]);
  487. with objreloc do
  488. begin
  489. write(' reloc DataOffset: ',DataOffset,' OrgSize:',OrgSize,' typ:',typ);
  490. if assigned(symbol) then
  491. write(' Name: '#39,symbol.Name,#39' bind:',symbol.bind,' address:',symbol.address,' Size:',symbol.size);
  492. writeln;
  493. end;
  494. end;}
  495. if not assigned(objsec.data) then
  496. internalerror(200603042);
  497. if copy (objsec.Name,1,5) = '.text' then
  498. begin // write NOP's instead of zero's for .text, makes disassemble possible
  499. b := $90; // NOP
  500. if objsec.DataAlignBytes > 0 then
  501. for j := 1 to objsec.DataAlignBytes do
  502. FWriter.write(b,1);
  503. end else
  504. FWriter.writezeros(objsec.dataalignbytes);
  505. //if objsec.dataalignbytes>0 then
  506. // writeln (' ',name,' alignbytes: ',objsec.dataalignbytes);
  507. if objsec.DataPos<>FWriter.Size then
  508. internalerror(200602251);
  509. FWriter.writearray(objsec.data);
  510. end else
  511. begin
  512. if assigned(exemap) then //TExeMap
  513. exemap.Add(' skipping: '+objsec.name);
  514. end;
  515. end;
  516. end;
  517. end;
  518. end;
  519. function TNLMexeoutput.totalheadersize:longword;
  520. var
  521. varHdrSize,
  522. optHdrSize,
  523. hdrSize: longword;
  524. begin
  525. optHdrSize := 0;
  526. inc(optHdrSize,2+length(nlmDescription));
  527. inc(optHdrSize,8); // Stacksize+reserved
  528. inc(optHdrSize,NLM_OLD_THREAD_NAME_LENGTH);
  529. inc(optHdrSize,2+length(nlmScreenname));
  530. inc(optHdrSize,2+length(nlmThreadname));
  531. varHdrSize := 0;
  532. if nwcopyright <> '' then
  533. inc(varHdrSize,sizeof(NLM_COPYRIGHT_STAMP)+2+length(nlmCopyright));
  534. hdrSize := sizeof(nlm32_i386_external_fixed_header)+
  535. sizeof(nlm32_i386_external_extended_header)+
  536. sizeof(nlm32_i386_external_custom_header)+
  537. sizeof(nlm32_i386_external_version_header)+ // always
  538. sizeof(nlm32_i386_external_cygnus_ext_header)+ // CyGnUsEx
  539. varHdrSize+optHdrSize+
  540. 8; // empty stamp
  541. result := hdrSize;
  542. end;
  543. procedure TNLMexeoutput.MemPos_Header;
  544. begin
  545. { calculate start positions after the headers }
  546. currmempos:=0;
  547. end;
  548. procedure TNLMexeoutput.ExeSectionList_write_header(p:TObject;arg:pointer);
  549. var
  550. nam : string;
  551. u32,al : longword;
  552. alignAmount:longint;
  553. begin
  554. with tExeSection(p) do
  555. begin
  556. //comment (v_debug,'ExeSectionList_write_header: '+name);
  557. nam := name;
  558. alignAmount := 4 - ((length (nam) + 1) MOD 4);
  559. FWriter.write(nam[1],length(nam));
  560. FWriter.WriteZeros(1+alignAmount);
  561. al := 0;
  562. // for .stab we have to ignore leading zeros due to alignment in file
  563. if nam='.stab' then
  564. if assigned(ObjSectionList[0]) then
  565. al := TObjSection(ObjSectionList[0]).dataalignbytes;
  566. u32 := dataPos+al; FWriter.write(u32,sizeof(u32));
  567. u32 := size-al; FWriter.write(u32,sizeof(u32));
  568. end;
  569. end;
  570. procedure TNLMexeoutput.ExeSectionList_pass2_header(p:TObject;arg:pointer);
  571. var len,alignAmount:longint;
  572. begin
  573. {list of sections, extension of binutils,CuStHeAd points to this list
  574. The format of the section information is:
  575. null terminated section name
  576. zeroes to adjust to 4 byte boundary
  577. 4 byte section data file pointer
  578. 4 byte section size }
  579. with TExeSection(p) do
  580. begin
  581. alignAmount := 4 - ((length (Name) + 1) MOD 4);
  582. len := length(name) + 1 + alignAmount + 8;
  583. if ObjSectionList.Count>0 then
  584. inc(len,TObjSection(ObjSectionList[0]).dataalignbytes);
  585. inc(plongint(arg)^,len);
  586. end;
  587. end;
  588. procedure TNLMexeoutput.DataPos_Header;
  589. begin
  590. ExeSecsListSize:=0;
  591. ExeSectionList.ForEachCall(@ExeSectionList_pass2_header,@ExeSecsListSize);
  592. headerAlignBytes := align(totalheadersize+ExeSecsListSize,16)-(totalheadersize+ExeSecsListSize); // align as in TObjData.sectiontype2align
  593. currdatapos:=totalheadersize+ExeSecsListSize+headerAlignBytes;
  594. end;
  595. procedure TNLMexeoutput.fillNlmVersionHeader;
  596. var
  597. hour,min,sec,hsec,Year,Month,Day : word;
  598. begin
  599. DecodeTime(Time,hour,min,sec,hsec);
  600. DecodeDate(Date,year,month,day);
  601. nlmVersionHeader.stamp := NLM_VERSION_STAMP;
  602. if nlmVersionHeader.year = 0 then
  603. begin
  604. nlmVersionHeader.year := Year;
  605. nlmVersionHeader.month := Month;
  606. nlmVersionHeader.day := Day;
  607. end;
  608. end;
  609. function TNLMexeoutput.writedata:boolean;
  610. var
  611. dummyLong : array[0..4] of char;
  612. textExeSec,
  613. dataExeSec,
  614. bssExeSec,
  615. relocsExeSec,
  616. exportsExeSec,
  617. importsExeSec,
  618. xdcExeSec,
  619. messagesExeSec,
  620. helpExeSec,
  621. customExeSec : TExeSection;
  622. hassymbols : boolean;
  623. nlmCygnusHeader : nlm32_i386_external_cygnus_ext_header;
  624. ModuleName : string;
  625. exesym : TExeSymbol;
  626. expOffset : PtrUInt;
  627. expAddr : longword;
  628. i : integer;
  629. begin
  630. result:=false;
  631. textExeSec:=FindExeSection('.text');
  632. dataExeSec:=FindExeSection('.data');
  633. bssExeSec:=FindExeSection('.bss');
  634. relocsExeSec:=FindExeSection('.reloc');
  635. importsExeSec:=FindExeSection('.imports');
  636. exportsExeSec:=FindExeSection('.exports');
  637. xdcExeSec:=FindExeSection('.xdc');
  638. messagesExeSec:=FindExeSection('.messages');
  639. helpExeSec:=FindExeSection('.help');
  640. customExeSec:=FindExeSection('.custom');
  641. // exported function need the upper bit in the address
  642. // to be set (=CODE), do this here to avoid another
  643. // reloc type. The ExportFunctionOffsets list was
  644. // filled in GenerateExports
  645. if FexportFunctionOffsets.Count>0 then
  646. begin
  647. if not assigned(exportsExeSec) then
  648. internalerror(201103201); // we have to have a .export section
  649. if not assigned(exportsExeSec.ObjSectionList[0]) then
  650. internalerror(201103202); // nothing in the .exports section but we have data in FexportFunctionOffsets
  651. for i := 0 to FexportFunctionOffsets.Count-1 do
  652. begin
  653. expOffset := PtrUint(FexportFunctionOffsets[i]);
  654. if TObjSection(exportsExeSec.ObjSectionList[0]).Data.size < expOffset+3 then
  655. internalerror(201103203); // offset in FexportFunctionOffsets out of range
  656. with TObjSection(exportsExeSec.ObjSectionList[0]) do
  657. begin // set the upper bit of address to indicate .text
  658. Data.seek(expOffset);
  659. Data.read(expAddr,4);
  660. Data.seek(expOffset);
  661. expAddr := expAddr or $80000000;
  662. Data.write(expAddr,4);
  663. end;
  664. end;
  665. end;
  666. if not assigned(TextExeSec) or
  667. not assigned(RelocsExeSec) or
  668. not assigned(DataExeSec) then
  669. internalerror(200602231); // we have to have .data, .text and .reloc
  670. { do we need to write symbols? }
  671. hassymbols:=(ExeWriteMode=ewm_dbgonly) or
  672. (
  673. (ExeWriteMode=ewm_exefull) and
  674. not(cs_link_strip in current_settings.globalswitches)
  675. );
  676. { Initial header, will be updated later }
  677. nlmHeader.signature := NLM_SIGNATURE;
  678. nlmHeader.version := NLM_HEADER_VERSION;
  679. moduleName := upperCase(current_module.exefilename^);
  680. nlmHeader.moduleName := moduleName;
  681. nlmHeader.codeImageOffset := TextExeSec.DataPos+TObjSection(TextExeSec.ObjSectionList[0]).dataalignbytes; // ??? may be that align has to be moved to fixups/imports
  682. nlmHeader.codeImageSize := TextExeSec.Size;
  683. nlmHeader.dataImageOffset := DataExeSec.DataPos;
  684. nlmHeader.dataImageSize := DataExeSec.Size;
  685. if assigned(BSSExeSec) then
  686. nlmHeader.uninitializedDataSize:=BSSExeSec.Size;
  687. if assigned(customExeSec) then
  688. begin
  689. nlmHeader.customDataOffset := customExeSec.DataPos;
  690. nlmHeader.customDataSize := customExeSec.Size;
  691. end;
  692. if FNumModules > 0 then
  693. begin
  694. nlmHeader.moduleDependencyOffset := FindExeSection('.modules').DataPos+4; // 4 bytes dummy
  695. nlmHeader.numberOfModuleDependencies := FNumModules;
  696. end;
  697. nlmHeader.relocationFixupOffset := relocsExeSec.DataPos;
  698. nlmHeader.numberOfRelocationFixups := FNumRelocs;
  699. nlmHeader.externalReferencesOffset := importsExeSec.DataPos+4; // 4 bytes dummy
  700. nlmHeader.numberOfExternalReferences := FNumExternals;
  701. if assigned(exportsExeSec) then
  702. if exportsExeSec.Size>0 then
  703. begin
  704. nlmHeader.publicsOffset := exportsExeSec.dataPos;
  705. nlmHeader.numberOfPublics := FnumExports;
  706. end;
  707. nlmHeader.codeStartOffset := EntrySym.Address;
  708. {exit function}
  709. exesym:=texesymbol(ExeSymbolList.Find('_Stop'));
  710. if assigned(exesym) then
  711. nlmHeader.exitProcedureOffset := exesym.ObjSymbol.address;
  712. {check exit function}
  713. exesym:=texesymbol(ExeSymbolList.Find('FPC_NW_CHECKFUNCTION'));
  714. if assigned(exesym) then
  715. nlmHeader.checkUnloadProcedureOffset := exesym.ObjSymbol.address;
  716. // calc file pos after all exesections
  717. fSizeWoDebugSyms := totalheadersize + ExeSecsListSize + headerAlignBytes;
  718. ExeSectionList.ForEachCall(@ExeSectionList_calc_size,nil);
  719. nlmExtHeader.stamp := NLM_MESSAGES_STAMP;
  720. //extHeader.languageID // TODO: where to get this from ?
  721. if assigned(messagesExeSec) then
  722. begin
  723. nlmExtHeader.messageFileOffset := messagesExeSec.DataPos;
  724. nlmExtHeader.messageFileLength := messagesExeSec.Size;
  725. end;
  726. //nlmExtHeader.messageCount // TODO: how is messageCount set ?
  727. if assigned(helpExeSec) then
  728. begin
  729. nlmExtHeader.helpFileOffset := helpExeSec.DataPos;
  730. nlmExtHeader.helpFileLength := helpExeSec.Size;
  731. end;
  732. //nlmExtHeader.productID // TODO: were does this came from ?
  733. if assigned(xdcExeSec) then
  734. begin
  735. nlmExtHeader.RPCDataOffset := xdcExeSec.DataPos;
  736. nlmExtHeader.RPCDataLength := xdcExeSec.Size;
  737. end;
  738. if hassymbols then
  739. begin
  740. nlmHeader.debugInfoOffset := fSizeWoDebugSyms;
  741. ExeSymbolList.ForEachCall(@globalsyms_create_symbol,nil);
  742. nlmHeader.numberOfDebugRecords := FNumDebugSymbols;
  743. end;
  744. fillNlmVersionHeader;
  745. FWriter.write(nlmHeader,sizeof(nlmHeader));
  746. { variable header }
  747. NLMWriteString(nlmDescription,true);
  748. if stacksize < NLM_DEFAULT_STACKSIZE then stacksize := NLM_DEFAULT_STACKSIZE;
  749. FWriter.Write(stacksize,4);
  750. FWriter.writezeros(4);
  751. dummyLong := ' LONG';
  752. FWriter.Write(dummyLong,sizeof(dummyLong)); // old thread name
  753. NLMWriteString(nlmScreenname,true);
  754. NLMWriteString(nlmThreadname,true);
  755. {version}
  756. FWriter.Write(nlmVersionHeader,sizeof(nlmVersionHeader));
  757. {copyright}
  758. if nlmCopyright <> '' then
  759. begin
  760. FWriter.write(NLM_COPYRIGHT_STAMP,sizeof(NLM_COPYRIGHT_STAMP));
  761. NLMWriteString(nlmCopyright,true);
  762. end;
  763. {messages}
  764. FWriter.write(nlmExtHeader,sizeof(nlmExtHeader));
  765. {custhead}
  766. nlmCustHeader.stamp := NLM_CUSTOM_STAMP;
  767. nlmCustHeader.dataLength := ExeSecsListSize;
  768. nlmCustHeader.dataOffset := totalheadersize;
  769. nlmCustHeader.hdrLength := $10; // why 16 ?, this is what binutils write
  770. FWriter.write(nlmCustHeader,sizeof(nlmCustHeader));
  771. {CyGnUsEx}
  772. // bfd has a strange way to read the sections:
  773. // the section directory is written under CuStHeAd
  774. // when bfd finds the neader "CyGnUsEx", it uses the
  775. // offset and size from CuStHeAd to read the section table
  776. nlmCygnusHeader.stamp := NLM_CYGNUS_STAMP; // CyGnUsEx
  777. // ld writes some unknown values here, bfd irgnores the values at all
  778. // lets write the offset and length of the segment table
  779. nlmCygnusHeader.offset := nlmCustHeader.dataLength;
  780. nlmCygnusHeader.length := nlmCustHeader.dataOffset;
  781. FWriter.write(nlmCygnusHeader,sizeof(nlmCygnusHeader));
  782. FWriter.WriteZeros(8); // empty stamp + align next to 16 bytes
  783. if FWriter.Size<>totalheadersize then
  784. internalerror(201103061); // headersize <> header written
  785. { Section headers, CuStHeAd points to this section, not needed by
  786. netware. Can be used to find the section in the nlm file, binutils
  787. will use this section }
  788. ExeSectionList.ForEachCall(@ExeSectionList_write_header,nil);
  789. FWriter.WriteZeros(headerAlignBytes);
  790. if FWriter.Size<>totalheadersize+ExeSecsListSize+headerAlignBytes then
  791. internalerror(201103062);
  792. { Section data }
  793. if assigned(exemap) then
  794. begin
  795. exemap.Add('');
  796. exemap.Add('NLM file offsets:');
  797. end;
  798. ExeSectionList.ForEachCall(@ExeSectionList_write_data,nil);
  799. if hassymbols then
  800. FWriter.writearray(NlmSymbols); // specific symbols for the internal netware debugger
  801. result:=true;
  802. end;
  803. procedure TNLMexeoutput.GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);
  804. var
  805. idata5objsection : TObjSection;
  806. basedllname : string;
  807. function AddImport(const afuncname,amangledname:string; isvar:boolean):TObjSymbol;
  808. var
  809. secname:string;
  810. begin
  811. //Comment (V_Debug,'TNLMexeoutput.GenerateLibraryImports.AddImport '+afuncName);
  812. result:=nil;
  813. if assigned(exemap) then
  814. exemap.Add(' Importing Function '+afuncname);
  815. if not isvar then
  816. with internalobjdata do
  817. begin
  818. secname:=basedllname+'_i_'+amangledname;
  819. idata5objsection:=createsection(sec_idata5, secname);
  820. internalobjdata.SetSection(idata5objsection);
  821. result:=internalobjdata.SymbolDefine('_'+amangledname,AB_IMPORT,AT_FUNCTION);
  822. end;
  823. end;
  824. var
  825. i,j : longint;
  826. ImportLibrary : TImportLibrary;
  827. ImportSymbol : TImportSymbol;
  828. exesym : TExeSymbol;
  829. importAddressList : TFPObjectList;
  830. begin
  831. if ImportLibraryList.Count > 0 then
  832. begin
  833. {objsec:=}internalObjData.createsection('.imports',0,[oso_data,oso_keep]);
  834. i := 0;
  835. internalobjdata.writebytes(i,4); // dummy to avoid deletion
  836. {objsec:=}internalObjData.createsection('.modules',0,[oso_data,oso_keep]);
  837. internalobjdata.writebytes(i,4); // dummy to avoid deletion
  838. end;
  839. for i:=0 to ImportLibraryList.Count-1 do
  840. begin
  841. ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
  842. idata5objsection:=nil;
  843. for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
  844. begin
  845. ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
  846. exesym:=TExeSymbol(ExeSymbolList.Find(ImportSymbol.MangledName));
  847. if assigned(exesym) and
  848. (exesym.State<>symstate_defined) then
  849. begin
  850. basedllname:=ExtractFileName(ImportLibrary.Name);
  851. exesym.objsymbol:=AddImport(ImportSymbol.Name,ImportSymbol.MangledName,ImportSymbol.IsVar);
  852. exesym.State:=symstate_defined;
  853. importAddressList := TFPObjectList.create(false);
  854. nlmImports.Add(ImportSymbol.Name,importAddressList);
  855. if pos('.',basedllname) = 0 then
  856. basedllname := basedllname + '.nlm';
  857. nlmImpNames.Add(ImportSymbol.Name,TStringObj.create(lower(basedllname)));
  858. end;
  859. end;
  860. end;
  861. PackUnresolvedExeSymbols('after DLL imports');
  862. GenerateExports;
  863. end;
  864. procedure TNLMexeoutput.GenerateImports;
  865. var
  866. exesec,
  867. impexesec : TExeSection;
  868. objsec : TObjSection;
  869. objreloc : TObjRelocation;
  870. i,j,k : integer;
  871. importAddressList : TFPObjectList;
  872. name,mName : string;
  873. b : byte;
  874. modules : string;
  875. modName : TStringObj;
  876. begin
  877. if FImportsGenerated then exit;
  878. FImportsGenerated := true;
  879. impexesec:=FindExeSection('.imports');
  880. if impexesec=nil then exit;
  881. for i:=0 to ExeSectionList.Count-1 do
  882. begin
  883. exesec:=TExeSection(ExeSectionList[i]);
  884. for j:=0 to exesec.ObjSectionList.count-1 do
  885. begin
  886. objsec:=TObjSection(exesec.ObjSectionList[j]);
  887. if j=0 then
  888. begin
  889. exesec.DataPos:=objSec.DataPos;
  890. exesec.MemPos:=objSec.MemPos;
  891. end;
  892. if (copy(objsec.name,1,5) <> '.text') and (copy(objsec.name,1,4) <> '.bss') and (copy(objsec.name,1,5) <> '.data') then
  893. continue;
  894. for k:=0 to objsec.ObjRelocations.Count-1 do
  895. begin
  896. objreloc := TObjRelocation(objsec.ObjRelocations[k]);
  897. if assigned(objreloc.symbol) then
  898. begin
  899. //writeln (objreloc.symbol.name,' ',objreloc.symbol.bind);
  900. if objreloc.symbol.bind = AB_IMPORT then
  901. begin
  902. importAddressList := TFPObjectList(nlmImports.Find(objreloc.symbol.name));
  903. if assigned(importAddressList) then
  904. begin
  905. objreloc.objsection := objsec; // points to idata5
  906. importAddressList.Add(objreloc);
  907. end else
  908. begin
  909. comment(v_error,objreloc.symbol.name+' is external but not defined in nlm imports');
  910. end;
  911. end;
  912. end
  913. end;
  914. end;
  915. end;
  916. modules := '';
  917. for i := 0 to nlmImports.count-1 do
  918. begin
  919. importAddressList := TFPObjectList(nlmImports.Items[i]);
  920. if importAddressList.Count > 0 then
  921. begin
  922. name := nlmImports.NameOfIndex(i);
  923. // find the module to be imported and add it to the list
  924. // of modules to be auto loaded
  925. modName := TStringObj(nlmImpNames.Find(name));
  926. if assigned(modName) then
  927. begin
  928. mName := modName.Value;
  929. if mName <> '' then
  930. if copy(mName,1,1) <> '!' then // special, with ! only the imp will be included but no module is autoloaded, needed i.e. for netware.imp
  931. begin
  932. if pos(mName+';',modules) < 1 then
  933. begin
  934. modules := modules + mName + ';';
  935. inc(FNumModules);
  936. end;
  937. end;
  938. end;
  939. internalobjdata.SetSection(TObjSection(impexesec.ObjSectionList[0]));
  940. objNLMwriteString (name,false); // name of symbol
  941. k := importAddressList.Count;
  942. internalobjdata.writebytes(k,sizeof(k)); // number of references
  943. inc(FNumExternals);
  944. for j := 0 to importAddressList.Count-1 do
  945. begin
  946. objreloc := TObjRelocation(importAddressList[j]);
  947. objsec := objreloc.objsection;
  948. if oso_executable in objreloc.objsection.SecOptions then
  949. begin
  950. if objreloc.typ <> RELOC_RELATIVE then comment(v_error,'reference to external symbols must be RELOC_RELATIVE');
  951. // TODO: how to check if size is 4 ????
  952. k := objsec.MemPos + objreloc.DataOffset;
  953. k := k or $40000000;
  954. // TODO: data|code if we support importing data symbols
  955. // i do not know if this is possible with netware
  956. internalobjdata.writebytes(k,sizeof(k)); // address
  957. // the netware loader requires an offset at the import address
  958. // for call = E8 this is -4
  959. // TODO: how can we check the needed offset ??
  960. if objreloc.DataOffset > 0 then
  961. begin
  962. objsec.Data.seek(objreloc.DataOffset-1);
  963. objsec.data.read(b,1);
  964. if b <> $E8 then
  965. comment(v_error,'no rcall (E8) before imported symbol target address');
  966. k := -4;
  967. objsec.Data.write(k,sizeof(k));
  968. end else
  969. begin
  970. objsec.Data.seek(objreloc.DataOffset);
  971. k := 0;
  972. objsec.Data.write(k,sizeof(k));
  973. end;
  974. objreloc.typ := RELOC_NONE; // to avoid that TCoffObjSection.fixuprelocs changes the address again
  975. end else
  976. comment(v_error,'Importing of symbols only supported for .text');
  977. end;
  978. end;
  979. end;
  980. exesec := FindExeSection('.modules');
  981. if not assigned(exesec) then internalerror(201103272); // exe section .modules does not exist ???
  982. internalobjdata.SetSection(TObjSection(exesec.ObjSectionList[0]));
  983. for i := 1 to FNumModules do
  984. begin
  985. name := GetToken(modules,';');
  986. objNLMwriteString (name,false);
  987. end;
  988. end;
  989. procedure TNLMexeoutput.GenerateExports;
  990. var
  991. hp : texported_item; { for exports }
  992. len : byte;
  993. addr: longword;
  994. exesym : texesymbol;
  995. begin
  996. internalObjData.createsection('.exports',0,[oso_data,oso_keep]);
  997. {name LString 1+n bytes
  998. addr 4 bytes
  999. addr and $80000000 > 0 -> .text else .data}
  1000. hp:=texported_item(current_module._exports.first);
  1001. if assigned(hp) then
  1002. if assigned(exemap) then
  1003. exemap.Add('');
  1004. while assigned(hp) do
  1005. begin
  1006. { Export the Symbol }
  1007. if assigned(exemap) then
  1008. exemap.Add(' Exporting Function '+hp.sym.prettyname+' as '+hp.name^);
  1009. len := length(hp.name^);
  1010. internalobjdata.writebytes(len,1);
  1011. internalobjdata.writebytes(hp.name^[1],len);
  1012. exesym:=texesymbol(ExeSymbolList.Find(hp.sym.prettyname));
  1013. if not assigned(exesym) then
  1014. begin
  1015. comment(v_error,'exported symbol '+hp.sym.prettyname+' not found');
  1016. exit;
  1017. end;
  1018. // for exported functions we have to set the upper bit
  1019. // this will be done in .writedata
  1020. if not hp.is_var then
  1021. FexportFunctionOffsets.Add(pointer(PtrUInt(internalobjdata.CurrObjSec.Size)));
  1022. internalobjdata.writereloc(0,4,exesym.ObjSymbol,RELOC_ABSOLUTE32);
  1023. addr := 0;
  1024. internalobjdata.writebytes(addr,4);
  1025. inc(FnumExports);
  1026. hp:=texported_item(hp.next);
  1027. end;
  1028. end;
  1029. procedure TNLMexeoutput.GenerateRelocs;
  1030. var
  1031. exesec : TExeSection;
  1032. objsec : TObjSection;
  1033. objreloc : TObjRelocation;
  1034. i,j,k : longint;
  1035. offset : longword;
  1036. inSec,toSec : TsecType;
  1037. targetSectionName : string;
  1038. begin
  1039. if not RelocSection or FRelocsGenerated then
  1040. exit;
  1041. exesec:=FindExeSection('.reloc');
  1042. if exesec=nil then
  1043. exit;
  1044. objsec:=internalObjData.createsection('.reloc',0,exesec.SecOptions+[oso_data]);
  1045. exesec.AddObjSection(objsec);
  1046. for i:=0 to ExeSectionList.Count-1 do
  1047. begin
  1048. exesec:=TExeSection(ExeSectionList[i]);
  1049. for j:=0 to exesec.ObjSectionList.count-1 do
  1050. begin
  1051. objsec:=TObjSection(exesec.ObjSectionList[j]);
  1052. //writeln ('Relocs for ',exesec.name,' - ',objsec.name);
  1053. { create relocs only for sections which are loaded in memory }
  1054. if not (oso_load in objsec.SecOptions) then
  1055. continue;
  1056. { create relocs only for .text and .data }
  1057. inSec := SectionType (objsec.name);
  1058. if (inSec <> Section_Text) and (inSec <> Section_Data) then
  1059. continue;
  1060. for k:=0 to objsec.ObjRelocations.Count-1 do
  1061. begin
  1062. objreloc:=TObjRelocation(objsec.ObjRelocations[k]);
  1063. if objreloc.typ <> RELOC_ABSOLUTE then
  1064. continue;
  1065. offset:=objsec.MemPos+objreloc.dataoffset;
  1066. targetSectionName := '';
  1067. if objreloc.symbol <> nil then
  1068. begin
  1069. // writeln (' MemPos',objsec.MemPos,
  1070. // ' dataOfs:',objreloc.dataoffset,' ',objsec.name,
  1071. // ' objreloc.symbol: ',objreloc.symbol.name,
  1072. // ' objreloc.symbol.objsection.name: ',objreloc.symbol.objsection.name,
  1073. // ' ',objreloc.symbol.Typ,' ',objrel
  1074. // oc.symbol.bind,' ',objreloc.Typ);
  1075. if objreloc.symbol.objsection.name[1] <> '.' then
  1076. targetSectionName := objreloc.symbol.name // specials like __bss_start__
  1077. else // dont use objsection.name because it begins with *
  1078. targetSectionName := copy(objreloc.symbol.objsection.name,1,5); // all others begin with .segment, we only have to check for .text, .data or .bss
  1079. end else
  1080. internalerror(2011030603);
  1081. toSec := SectionType(targetSectionName);
  1082. if (toSec = Section_Text) or (toSec = Section_Data) then
  1083. begin
  1084. if (inSec = Section_text) then offset := offset or $40000000;
  1085. if (toSec = Section_text) then offset := offset or $80000000;
  1086. internalObjData.writebytes(offset,4);
  1087. inc(FNumRelocs);
  1088. end;
  1089. end;
  1090. end;
  1091. end;
  1092. FRelocsGenerated:=true;
  1093. end;
  1094. procedure TNLMexeoutput.Order_End;
  1095. var
  1096. exesec : TExeSection;
  1097. begin
  1098. inherited;
  1099. exesec:=FindExeSection('.reloc');
  1100. if exesec=nil then
  1101. exit;
  1102. exesec.SecOptions:=exesec.SecOptions + [oso_Data,oso_keep,oso_load];
  1103. end;
  1104. procedure TNLMexeoutput.MemPos_ExeSection(const aname:string);
  1105. begin
  1106. if aname='.reloc' then
  1107. GenerateRelocs;
  1108. if aname='.imports' then
  1109. GenerateImports;
  1110. if aname='.data' then
  1111. currMemPos := 0; // both, data and code in the nlm have a start offset of 0
  1112. inherited;
  1113. end;
  1114. procedure TNLMexeoutput.DataPos_ExeSection(const aname:string);
  1115. begin
  1116. inherited;
  1117. end;
  1118. procedure TNLMexeoutput.NLMwriteString (const s : string; terminateWithZero : boolean);
  1119. var len : byte;
  1120. begin
  1121. if length(s) > 254 then len := 254 else len := length(s);
  1122. FWriter.Write(len,1);
  1123. if len > 0 then
  1124. FWriter.write(s[1],len);
  1125. if terminateWithZero then
  1126. FWriter.writeZeros(1);
  1127. end;
  1128. procedure TNLMexeoutput.objNLMwriteString (const s : string; terminateWithZero : boolean);
  1129. var len : byte;
  1130. begin
  1131. if length(s) > 254 then len := 254 else len := length(s);
  1132. Internalobjdata.writebytes(len,1);
  1133. if len > 0 then
  1134. Internalobjdata.writebytes(s[1],len);
  1135. if terminateWithZero then
  1136. begin
  1137. len := 0;
  1138. Internalobjdata.writebytes(s[1],len);
  1139. end;
  1140. end;
  1141. { parse netware specific linker options }
  1142. procedure TNLMexeoutput.ParseScript (linkscript:TCmdStrList);
  1143. var
  1144. hp : TCmdStrListItem;
  1145. opt,keyword,s : string;
  1146. i : integer;
  1147. function toInteger(s:string; min,max:integer; var res:integer):boolean;
  1148. var
  1149. code:word;
  1150. begin
  1151. result := false;
  1152. val (s,res,code);
  1153. if code<>0 then exit;
  1154. if (res < min) or (res > max) then exit;
  1155. result := true;
  1156. end;
  1157. procedure loadFile (const secName, fileName, Desc : string);
  1158. var
  1159. fileBuf : array [0..4095] of char;
  1160. bytesRead : longint;
  1161. fileH : THandle;
  1162. fn : TCmdStr;
  1163. begin
  1164. fn := fileName;
  1165. if not fileExists(fn) then
  1166. if not unitsearchpath.FindFile(fileName,true,fn) then
  1167. begin
  1168. comment(v_error,'can not find '+desc+' file '+fileName);
  1169. exit;
  1170. end;
  1171. fileH := fileOpen (fn,fmOpenRead);
  1172. if fileH = THandle(-1) then
  1173. begin
  1174. comment(v_error,'can not open '+desc+' file '+fn);
  1175. exit;
  1176. end;
  1177. { load file into section }
  1178. internalObjData.createsection(secName,0,[oso_data,oso_keep]);
  1179. repeat
  1180. bytesRead := fileRead(fileH,fileBuf,sizeof(fileBuf));
  1181. if bytesRead > 0 then
  1182. internalobjdata.writebytes(fileBuf,bytesRead);
  1183. until bytesRead < sizeof(fileBuf);
  1184. fileClose(fileH);
  1185. end;
  1186. begin
  1187. hp:=TCmdStrListItem(linkscript.first);
  1188. while assigned(hp) do
  1189. begin
  1190. opt:=hp.str;
  1191. if (opt='') or (opt[1]='#') then
  1192. continue;
  1193. keyword:=Upper(GetToken(opt,' '));
  1194. if keyword = 'AUTOUNLOAD' then
  1195. begin
  1196. nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_AUTOUNLOAD;
  1197. end else
  1198. if keyword = 'COPYRIGHT' then
  1199. begin
  1200. nlmCopyright := GetToken(opt,' ');
  1201. end else
  1202. if keyword = 'CUSTOM' then
  1203. begin
  1204. loadFile ('.custom',GetToken(opt,' '),'custom data');
  1205. end;
  1206. if keyword = 'DATE' then // month day 4-digit-year
  1207. begin
  1208. if not toInteger(GetToken(opt,' '),1,12,i) then comment(v_error,'DATE: invalid month')
  1209. else nlmVersionHeader.month := i;
  1210. if not toInteger(GetToken(opt,' '),1,31,i) then comment(v_error,'DATE: invalid day')
  1211. else nlmVersionHeader.day := i;
  1212. if not toInteger(GetToken(opt,' '),1900,3000,i) then comment(v_error,'DATE: invalid year')
  1213. else nlmVersionHeader.year := i;
  1214. end else
  1215. if keyword = 'DEBUG' then
  1216. begin
  1217. // ignore
  1218. end else
  1219. if keyword = 'DESCRIPTION' then
  1220. begin
  1221. nlmDescription := GetToken(opt,' ');
  1222. if length (nlmDescription) > NLM_MAX_DESCRIPTION_LENGTH then
  1223. nlmDescription := copy (nlmDescription,1,NLM_MAX_DESCRIPTION_LENGTH);
  1224. end else
  1225. if keyword = 'FLAG' then
  1226. begin
  1227. s := upper(GetToken(opt,' '));
  1228. if (not toInteger(GetToken(opt,' '),1,$FFFFFFF,i)) or ((s <> 'ON') and (S <> 'OFF')) then comment(v_error,'FLAG: invalid') else
  1229. if (s='ON') then
  1230. nlmHeader.flags:=nlmHeader.flags or i else
  1231. nlmHeader.flags:=nlmHeader.flags and ($FFFFFFF-i);
  1232. end else
  1233. if keyword = 'HELP' then
  1234. begin
  1235. loadFile ('.help',GetToken(opt,' '),'help');
  1236. end else
  1237. if keyword = 'MESSAGES' then
  1238. begin
  1239. loadFile ('.messages',GetToken(opt,' '),'message');
  1240. end else
  1241. if keyword = 'MULTIPLE' then
  1242. begin
  1243. nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_MULTILOAD;
  1244. end else
  1245. if keyword = 'OS_DOMAIN' then
  1246. begin
  1247. nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_OSDOMAIN;
  1248. end else
  1249. if keyword = 'PSEUDOPREEMPTION' then
  1250. begin
  1251. nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_PSEUDOPREEMPTION;
  1252. end else
  1253. if keyword = 'REENTRANT' then
  1254. begin
  1255. nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_REENTRANT;
  1256. end else
  1257. if keyword = 'SCREENNAME' then
  1258. begin
  1259. nlmScreenname := GetToken(opt,' ');
  1260. if length(nlmScreenname) > NLM_MAX_SCREEN_NAME_LENGTH then
  1261. nlmScreenName := copy (nlmScreenName,1,NLM_MAX_SCREEN_NAME_LENGTH);
  1262. end else
  1263. if (keyword = 'STACK') or (keyword = 'STACKSIZE') then
  1264. begin
  1265. if (not toInteger(GetToken(opt,' '),1,$FFFFFFF,i)) then comment(v_error,'invalid stacksize') else
  1266. stacksize := i;
  1267. end else
  1268. if keyword = 'SYNCHRONIZE' then
  1269. begin
  1270. nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_SYNCHRONIZE;
  1271. end else
  1272. if keyword = 'THREADNAME' then
  1273. begin
  1274. nlmThreadname := GetToken(opt,' ');
  1275. if length(nlmThreadname) > NLM_MAX_THREAD_NAME_LENGTH then
  1276. nlmThreadname := copy (nlmThreadname,1,NLM_MAX_THREAD_NAME_LENGTH);
  1277. end else
  1278. if keyword = 'TYPE' then
  1279. begin
  1280. if (not toInteger(GetToken(opt,' '),1,16,i)) then comment(v_error,'invalid TYPE') else
  1281. nlmHeader.moduleType := i; // TODO: set executable extension (.DSK, .LAN, ...)
  1282. end else
  1283. if keyword = 'VERSION' then
  1284. begin
  1285. if (not toInteger(GetToken(opt,' '),0,$FFFFFFF,i)) then comment(v_error,'invalid major version') else
  1286. nlmVersionHeader.majorVersion := i;
  1287. if (not toInteger(GetToken(opt,' '),0,99,i)) then comment(v_error,'invalid minor version') else
  1288. nlmVersionHeader.minorVersion := i;
  1289. if (not toInteger(GetToken(opt,' '),0,$FFFFFFF,i)) then comment(v_error,'invalid minor version') else
  1290. if i > 26 then
  1291. nlmVersionHeader.revision := 0 else
  1292. nlmVersionHeader.revision := i;
  1293. end else
  1294. if keyword = 'XDCDATA' then
  1295. begin
  1296. loadFile ('.xdc',GetToken(opt,' '),'xdc');
  1297. end;
  1298. { TODO: check for unknown options. This means all handled option
  1299. (also in link.pas) have to be flagged if processed }
  1300. hp:=TCmdStrListItem(hp.next);
  1301. end;
  1302. end;
  1303. {****************************************************************************
  1304. TNLMCoffObjData
  1305. ****************************************************************************}
  1306. constructor TNLMCoffObjData.create(const n:string);
  1307. begin
  1308. inherited createcoff(n,true,TNLMCoffObjSection);
  1309. end;
  1310. {****************************************************************************
  1311. TNLMoffObjSection
  1312. ****************************************************************************}
  1313. constructor TNLMCoffObjSection.create(AList:TFPHashObjectList;const aname:string;aalign:shortint;aoptions:TObjSectionOptions);
  1314. begin
  1315. inherited create(alist,aname,aalign,aoptions);
  1316. end;
  1317. constructor TNLMCoffObjOutput.create(AWriter:TObjectWriter);
  1318. begin
  1319. // ??????
  1320. // if win32=false, .stabs and .stabstr will be written without oso_debug
  1321. // Without oso_debug the sections will be removed by the linker
  1322. inherited createcoff(AWriter,{win32}true);
  1323. cobjdata:=TNLMCoffObjData;
  1324. end;
  1325. {****************************************************************************
  1326. TDJCoffAssembler
  1327. ****************************************************************************}
  1328. constructor TNLMCoffAssembler.Create(smart:boolean);
  1329. begin
  1330. inherited Create(smart);
  1331. CObjOutput:=TNLMCoffObjOutput;
  1332. end;
  1333. constructor TNLMCoffObjInput.create;
  1334. begin
  1335. inherited createcoff(true);
  1336. cobjdata:=TNLMCoffObjData;
  1337. end;
  1338. {*****************************************************************************
  1339. Initialize
  1340. *****************************************************************************}
  1341. const
  1342. as_i386_nlmcoff_info : tasminfo =
  1343. (
  1344. id : as_i386_nlmcoff;
  1345. idtxt : 'NLMCOFF';
  1346. asmbin : '';
  1347. asmcmd : '';
  1348. supported_targets : [system_i386_Netware,system_i386_netwlibc];
  1349. flags : [af_outputbinary,af_smartlink_sections];
  1350. labelprefix : '.L';
  1351. comment : '';
  1352. );
  1353. initialization
  1354. {$ifdef i386}
  1355. RegisterAssembler(as_i386_nlmcoff_info,TNLMCoffAssembler);
  1356. {$endif i386}
  1357. end.