123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521 |
- {
- Copyright (c) 1998-2006 by Peter Vreman
- Copyright (c) 2011 by Armin Diehl
- Contains the binary netware nlm executable writer
- This program is free software; you can redistribute it and/or modify
- it under the terms of the GNU General Public License as published by
- the Free Software Foundation; either version 2 of the License, or
- (at your option) any later version.
- This program is distributed in the hope that it will be useful,
- but WITHOUT ANY WARRANTY; without even the implied warranty of
- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- GNU General Public License for more details.
- You should have received a copy of the GNU General Public License
- along with this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************
- }
- unit ognlm;
- {$i fpcdefs.inc}
- interface
- uses
- { common }
- cclasses,globtype,
- { target }
- systems,
- aasmbase,assemble,link,
- { output }
- ogbase,
- owbase,
- ogcoff;
- {*****************************************************************************
- NLM File structures and constants
- *****************************************************************************}
- {
- LString0 -> 1 byte Length, Text, #0
- LString -> 1 byte length, Text
- Basic NLM File Structure:
- FixedHeader
- nlm32_i386_external_fixed_header 130 bytes
- VarHdr1
- NLM Description: LString0 2+n bytes
- Stacksize 4 bytes
- reserved = 0 4 bytes
- ' LONG' 5 bytes
- NLM screen name: LString0 2+n bytes
- NLM thread name: LString0 2+n bytes
- Optional Headers beginning with stamp (without '')
- 'VeRsIoN#': nlm32_i386_external_version_header 32 bytes
- 'CoPyRiGhT=': LString0 2+n bytes
- 'MeSsAgEs': nlm32_i386_external_extended_header 124 bytes
- 'CuStHeAd': nlm32_i386_external_custom_header
- 'CyGnUsEx': nlm32_i386_external_cygnus_ext_header 16 bytes
- .text
- .data
- .relocs=
- addr(32),addr(32),...
- addr and $80000000 > 0 -> FixupToSeg=.text else .data
- addr and $40000000 > 0 -> FixupInSeg=.text else .data
- .importedSymbols
- name LString 1+n bytes
- number of references r 4 bytes
- addresses r*4 bytes
- .exportedSymbols
- name LString 1+n bytes
- addr 4 bytes
- addr and $80000000 > 0 -> .text else .data
- ...
- .modules
- .nlmdebugrecs
- type (0=.data,1=.code,2,..=????) 1 byte
- addr 4 bytes
- name LString 1+n bytes
- ...
- }
- const NLM_MAX_DESCRIPTION_LENGTH = 127;
- NLM_MAX_SCREEN_NAME_LENGTH = 71;
- NLM_MAX_THREAD_NAME_LENGTH = 71; // some netware docs limit this to 12 ?
- NLM_OLD_THREAD_NAME_LENGTH = 5;
- NLM_HEADER_VERSION = 4;
- NLM_DEFAULT_STACKSIZE = (32 * 1024);
- NLM_VERSION_STAMP = 'VeRsIoN#';
- NLM_COPYRIGHT_STAMP = 'CoPyRiGhT=';
- NLM_CYGNUS_STAMP = 'CyGnUsEx';
- NLM_MESSAGES_STAMP = 'MeSsAgEs';
- NLM_CUSTOM_STAMP = 'CuStHeAd';
- NLM_SIGNATURE = 'NetWare Loadable Module'#$1A;
- NLM_FLAGS_REENTRANT = 1;
- NLM_FLAGS_MULTILOAD = 2;
- NLM_FLAGS_SYNCHRONIZE = 4;
- NLM_FLAGS_PSEUDOPREEMPTION = 8;
- NLM_FLAGS_OSDOMAIN = $10;
- NLM_FLAGS_AUTOUNLOAD = $40;
- type
- uint32 = longword;
- nlm32_i386_external_fixed_header = packed record
- signature : array[0..23] of char;
- version : uint32;
- (* The name of the module, which must be a DOS name (1-8 characters followed
- by a period and a 1-3 character extension). The first byte is the byte
- length of the name and the last byte is a null terminator byte. This
- field is fixed length, and any unused bytes should be null bytes. The
- value is set by the OUTPUT keyword to NLMLINK. *)
- moduleName : string[13]; //array[0..13] of byte;
- codeImageOffset : uint32; // The byte offset of the code image from the start of the file.
- codeImageSize : uint32; // The size of the code image, in bytes.
- dataImageOffset : uint32; // The byte offset of the data image from the start of the file.
- dataImageSize : uint32; // The size of the data image, in bytes.
- uninitializedDataSize : uint32; // The size of the uninitialized data region that the loader has to be
- // allocated at load time. Uninitialized data follows the initialized
- // data in the NLM address space.
- customDataOffset : uint32; // The byte offset of the custom data from the start of the file. The
- // custom data is set by the CUSTOM keyword to NLMLINK. It is possible
- // for this to be EOF if there is no custom data.
- customDataSize : uint32; // The size of the custom data, in bytes.
- moduleDependencyOffset : uint32; // The byte offset of the module dependencies from the start of the file.
- // The module dependencies are determined by the MODULE keyword in NLMLINK.
- numberOfModuleDependencies : uint32; // he number of module dependencies at the moduleDependencyOffset.
- relocationFixupOffset : uint32; // The byte offset of the relocation fixup data from the start of the file
- numberOfRelocationFixups : uint32;
- externalReferencesOffset : uint32;
- numberOfExternalReferences : uint32;
- publicsOffset : uint32;
- numberOfPublics : uint32;
- debugInfoOffset : uint32; // The byte offset of the internal debug info from the start of the file.
- // It is possible for this to be EOF if there is no debug info.
- numberOfDebugRecords : uint32;
- codeStartOffset : uint32;
- exitProcedureOffset : uint32;
- checkUnloadProcedureOffset : uint32;
- moduleType : uint32;
- flags : uint32;
- end;
- { The version header is one of the optional auxiliary headers and
- follows the fixed length and variable length NLM headers. }
- { The header is recognized by "VeRsIoN#" in the stamp field. }
- nlm32_i386_external_version_header = packed record
- stamp : array[0..7] of char; // VeRsIoN#
- majorVersion,
- minorVersion,
- revision,
- year,
- month,
- day : uint32;
- end;
- { The header is recognized by "MeSsAgEs" in the stamp field. }
- nlm32_i386_external_extended_header = packed record
- stamp : array[0..7] of char; // MeSsAgEs
- languageID : uint32;
- messageFileOffset : uint32;
- messageFileLength : uint32;
- messageCount : uint32;
- helpFileOffset : uint32;
- helpFileLength : uint32;
- RPCDataOffset : uint32;
- RPCDataLength : uint32;
- sharedCodeOffset : uint32;
- sharedCodeLength : uint32;
- sharedDataOffset : uint32;
- sharedDataLength : uint32;
- sharedRelocationFixupOffset : uint32;
- sharedRelocationFixupCount : uint32;
- sharedExternalReferenceOffset: uint32;
- sharedExternalReferenceCount : uint32;
- sharedPublicsOffset : uint32;
- sharedPublicsCount : uint32;
- sharedDebugRecordOffset : uint32;
- sharedDebugRecordCount : uint32;
- SharedInitializationOffset : uint32;
- SharedExitProcedureOffset : uint32;
- productID : longint;
- reserved0 : longint;
- reserved1 : longint;
- reserved2 : longint;
- reserved3 : longint;
- reserved4 : longint;
- reserved5 : longint;
- end;
- nlm32_i386_external_custom_header = packed record
- stamp : array[0..7] of char; // CuStHeAd
- hdrLength : uint32;
- dataOffset : uint32;
- dataLength : uint32;
- //dataStamp : array[0..7] of char;
- //hdr : uint32;
- end;
- { The internal Cygnus header is written out externally as a custom
- header. We don't try to replicate that structure here. }
- { The header is recognized by "CyGnUsEx" in the stamp field. }
- { File location of debugging information. }
- { Length of debugging information. }
- nlm32_i386_external_cygnus_ext_header = packed record
- stamp : array[0..7] of char; // CyGnUsEx
- offset : uint32;
- length : uint32;
- end;
- //------------------
- TNLMExeSection = class(TExeSection)
- public
- constructor createnw(AList:TFPHashObjectList;const n:string);
- end;
- TsecType = (Section_text,Section_data,Section_other);
- TNLMexeoutput = class(texeoutput)
- private
- FRelocsGenerated,FImportsGenerated : boolean;
- FNumRelocs : longword;
- FNumExternals : longword;
- FNumModules : longword;
- FNumDebugSymbols : longword;
- fSizeWoDebugSyms : longword;
- FnumExports : longword;
- NlmSymbols : TDynamicArray;
- ExeSecsListSize : longint;
- nlmImpNames, // name of import. module name as import
- nlmImports : TFPHashObjectList; // name of import, list of relocs as object
- headerAlignBytes : longint;
- FexportFunctionOffsets:TFPList; // offsets in .exports for function addresses, an offset of $80000000 is needed
- nlmHeader : nlm32_i386_external_fixed_header;
- nlmVersionHeader : nlm32_i386_external_version_header;
- nlmExtHeader : nlm32_i386_external_extended_header;
- nlmCustHeader : nlm32_i386_external_custom_header;
- nlmHelpFileName : TCmdStr;
- nlmMessagesFileName: TCmdStr;
- nlmXdcFileName : TCmdStr;
- nlmCopyright : string;
- nlmThreadname : string;
- nlmScreenname : string;
- nlmDescription : string;
- function totalheadersize:longword;
- procedure createNlm_symbol(const name:shortstring;value:longword;secType:TSecType);
- procedure globalsyms_create_symbol(p:TObject;arg:pointer);
- procedure ExeSectionList_write_header(p:TObject;arg:pointer);
- procedure ExeSectionList_calc_size(p:TObject;arg:pointer);
- procedure ExeSectionList_write_data(p:TObject;arg:pointer);
- procedure GenerateImports;
- procedure GenerateExports;
- procedure GenerateRelocs;
- procedure ExeSectionList_pass2_header(p:TObject;arg:pointer);
- protected
- function writedata:boolean;override;
- public
- constructor create; override;
- destructor destroy; override;
- procedure MemPos_Header;override;
- procedure DataPos_Header;override;
- procedure fillNlmVersionHeader;
- procedure GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);override;
- procedure Order_End;override;
- procedure MemPos_ExeSection(const aname:string);override;
- procedure DataPos_ExeSection(const aname:string);override;
- procedure NLMwriteString (const s : string; terminateWithZero : boolean);
- procedure objNLMwriteString (const s : string; terminateWithZero : boolean);
- procedure ParseScript (linkscript:TCmdStrList); override;
- end;
- var
- {for symbols defined in linker script. To generate a fixup we
- need to know the segment (.text,.bss or .code) of the symbol
- Pointer in list is used as TsecType
- Filled by TInternalLinkerNetware.DefaultLinkScript }
- nlmSpecialSymbols_Segments : TFPHashList;
- type
- TNLMCoffObjInput = class(TCoffObjInput)
- constructor create;override;
- end;
- TNLMCoffassembler = class(tinternalassembler)
- constructor create(smart:boolean);override;
- end;
- TNLMCoffObjData = class(TCoffObjData)
- constructor create(const n:string);override;
- end;
- TNLMCoffObjOutput = class(TCoffObjOutput)
- constructor create(AWriter:TObjectWriter);override;
- end;
- TNLMCoffObjSection = class(TCoffObjSection)
- constructor create(AList:TFPHashObjectList;const Aname:string;Aalign:shortint;Aoptions:TObjSectionOptions);override;
- end;
- implementation
- uses
- {$ifdef win32}
- Windows,
- {$endif win32}
- SysUtils,
- cutils,verbose,globals,
- fmodule,aasmdata,
- ogmap,export
- ;
- {****************************************************************************
- Helpers
- ****************************************************************************}
- type
- TStringObj = class (TObject)
- fValue : string;
- constructor create (value:string);
- property value : string read fValue write fValue;
- end;
- constructor TStringObj.create(value:string);
- begin
- inherited create;
- fValue := value;
- end;
- function SectionType (aName : string) : TSecType;
- var s : string;
- seg: ptruint;
- begin
- s := copy(aName,1,5);
- if s = '.text' then result := Section_text else
- if (s = '.data') or (copy(s,1,4)='.bss') then result := Section_data else
- if s[1] <> '.' then
- begin
- seg := ptruint(nlmSpecialSymbols_Segments.Find(aName));
- if seg <> 0 then
- result := TSecType(seg)
- else
- result := Section_other;
- end else
- result := Section_other;
- end;
- {****************************************************************************
- TNLMexesection
- ****************************************************************************}
- constructor TNLMExeSection.createnw(AList:TFPHashObjectList;const n:string);
- begin
- inherited create(AList,n);
- end;
- {****************************************************************************
- TNLMexeoutput
- ****************************************************************************}
- constructor TNLMexeoutput.create;
- begin
- inherited create;
- CExeSection:=TNLMExeSection;
- CObjData:=TNLMCoffObjData;
- MaxMemPos:=$7FFFFFFF;
- SectionMemAlign:=$0;
- SectionDataAlign:=0;
- RelocSection := true; // always needed for NLM's
- nlmImports := TFPHashObjectList.create(true);
- nlmImpNames := TFPHashObjectList.create(false);
- NlmSymbols := TDynamicArray.create(4096);
- FexportFunctionOffsets := TFPList.Create;
- end;
- destructor TNLMexeoutput.destroy;
- begin
- if assigned(nlmImports) then
- nlmImports.Free;
- if assigned(nlmImpNames) then
- nlmImpNames.Free;
- if assigned(nlmSymbols) then
- nlmSymbols.Free;
- if assigned(FexportFunctionOffsets) then
- FexportFunctionOffsets.Free;
- inherited destroy;
- end;
- procedure TNLMexeoutput.createNlm_symbol(const name:shortstring;value:longword;secType:TSecType);
- var
- b:byte;
- begin
- //Comment (V_Debug,'TNLMexeoutput.write_symbol '+name);
- { type (0=.data,1=.code,2,..=????) 1 byte
- addr 4 bytes
- name LString 1+n bytes }
- case secType of
- Section_Text : b := 1;
- Section_Data : b := 0
- else
- exit;
- end;
- nlmSymbols.write(b,sizeof(b));
- assert (sizeof(value)<>4);
- nlmSymbols.write(value,sizeof(value));
- nlmSymbols.write(name[0],length(name)+1);
- inc(FNumDebugSymbols);
- end;
- procedure TNLMexeoutput.globalsyms_create_symbol(p:TObject;arg:pointer);
- var
- value : longword;
- exesec : TExeSection;
- i : integer;
- secType : TsecType;
- begin
- if not assigned(texesymbol(p).objsymbol) then
- internalerror(200603053);
- with texesymbol(p).objsymbol do
- begin
- exesec:=TExeSection(objsection.exesection);
- { There is no exesection defined for special internal symbols
- like __image_base__ }
- if assigned(exesec) then
- begin
- //secval:=exesec.secsymidx;
- value:=address-exesec.mempos;
- end
- else
- begin
- value:=address;
- end;
- { reloctype address to the section in the executable }
- secType := SectionType(objsection.Name);
- if (secType = Section_Text) or (secType = Section_Data) then
- begin
- i := nlmImports.FindIndexOf(texesymbol(p).name);
- if i < 0 then
- createNlm_symbol(name,value,secType);
- end;
- end;
- end;
- (*
- function SecOpts(SecOptions:TObjSectionOptions):string;
- begin
- result := '[';
- if oso_Data in SecOptions then result := result + 'oso_Data ';
- { Is loaded into memory }
- if oso_load in SecOptions then result := result + 'oso_load ';
- { Not loaded into memory }
- if oso_noload in SecOptions then result := result + 'oso_noload ';
- { Read only }
- if oso_readonly in SecOptions then result := result + 'oso_readonly ';
- { Read/Write }
- if oso_write in SecOptions then result := result + 'oso_write ';
- { Contains executable instructions }
- if oso_executable in SecOptions then result := result + 'oso_executable ';
- { Never discard section }
- if oso_keep in SecOptions then result := result + 'oso_keep ';
- { Special common symbols }
- if oso_common in SecOptions then result := result + 'oso_common ';
- { Contains debug info and can be stripped }
- if oso_debug in SecOptions then result := result + 'oso_debug ';
- { Contains only strings }
- if oso_strings in SecOptions then result := result + 'oso_strings ';
- result := result + ']';
- end;
- *)
- procedure TNLMexeoutput.ExeSectionList_calc_size(p:TObject;arg:pointer);
- var
- objsec : TObjSection;
- i : longint;
- begin
- with texesection(p) do
- begin
- { don't write normal section if writing only debug info }
- if (ExeWriteMode=ewm_dbgonly) and
- not(oso_debug in SecOptions) then
- exit;
- if oso_data in secoptions then
- begin
- inc (fSizeWoDebugSyms,(Align(fSizeWoDebugSyms,SectionDataAlign)-fSizeWoDebugSyms));
- for i:=0 to ObjSectionList.Count-1 do
- begin
- objsec:=TObjSection(ObjSectionList[i]);
- if oso_data in objsec.secoptions then
- begin
- inc(fSizeWoDebugSyms,objsec.size);
- inc(fSizeWoDebugSyms,objsec.dataalignbytes);
- end;
- end;
- end;
- end;
- end;
- procedure TNLMexeoutput.ExeSectionList_write_Data(p:TObject;arg:pointer);
- var
- objsec : TObjSection;
- i,j : longint;
- b : byte;
- begin
- with texesection(p) do
- begin
- { don't write normal section if writing only debug info }
- if (ExeWriteMode=ewm_dbgonly) and
- not(oso_debug in SecOptions) then
- exit;
- if oso_data in secoptions then
- begin
- //if Align(FWriter.Size,SectionDataAlign)-FWriter.Size>0 then
- // writeln (name,' align ',Align(FWriter.Size,SectionDataAlign)-FWriter.Size,' SectionDataAlign:',SectionDataAlign);
- FWriter.Writezeros(Align(FWriter.Size,SectionDataAlign)-FWriter.Size);
- for i:=0 to ObjSectionList.Count-1 do
- begin
- objsec:=TObjSection(ObjSectionList[i]);
- if oso_data in objsec.secoptions then
- begin
- if assigned(exemap) then
- if objsec.data.size > 0 then
- exemap.Add(' 0x'+hexstr(objsec.DataPos,8)+': '+objsec.name);
- //writeln (' ',objsec.name,' size:',objsec.size,' relocs:',objsec.ObjRelocations.count,' DataPos:',objsec.DataPos,' MemPos:',objsec.MemPos);
- {for j := 0 to objsec.ObjRelocations.count-1 do
- begin
- objreloc := TObjRelocation(objsec.ObjRelocations[j]);
- with objreloc do
- begin
- write(' reloc DataOffset: ',DataOffset,' OrgSize:',OrgSize,' typ:',typ);
- if assigned(symbol) then
- write(' Name: '#39,symbol.Name,#39' bind:',symbol.bind,' address:',symbol.address,' Size:',symbol.size);
- writeln;
- end;
- end;}
- if not assigned(objsec.data) then
- internalerror(200603042);
- if copy (objsec.Name,1,5) = '.text' then
- begin // write NOP's instead of zero's for .text, makes disassemble possible
- b := $90; // NOP
- if objsec.DataAlignBytes > 0 then
- for j := 1 to objsec.DataAlignBytes do
- FWriter.write(b,1);
- end else
- FWriter.writezeros(objsec.dataalignbytes);
- //if objsec.dataalignbytes>0 then
- // writeln (' ',name,' alignbytes: ',objsec.dataalignbytes);
- if objsec.DataPos<>FWriter.Size then
- internalerror(200602251);
- FWriter.writearray(objsec.data);
- end else
- begin
- if assigned(exemap) then //TExeMap
- exemap.Add(' skipping: '+objsec.name);
- end;
- end;
- end;
- end;
- end;
- function TNLMexeoutput.totalheadersize:longword;
- var
- varHdrSize,
- optHdrSize,
- hdrSize: longword;
- begin
- optHdrSize := 0;
- inc(optHdrSize,2+length(nlmDescription));
- inc(optHdrSize,8); // Stacksize+reserved
- inc(optHdrSize,NLM_OLD_THREAD_NAME_LENGTH);
- inc(optHdrSize,2+length(nlmScreenname));
- inc(optHdrSize,2+length(nlmThreadname));
- varHdrSize := 0;
- if nwcopyright <> '' then
- inc(varHdrSize,sizeof(NLM_COPYRIGHT_STAMP)+2+length(nlmCopyright));
- hdrSize := sizeof(nlm32_i386_external_fixed_header)+
- sizeof(nlm32_i386_external_extended_header)+
- sizeof(nlm32_i386_external_custom_header)+
- sizeof(nlm32_i386_external_version_header)+ // always
- sizeof(nlm32_i386_external_cygnus_ext_header)+ // CyGnUsEx
- varHdrSize+optHdrSize+
- 8; // empty stamp
- result := hdrSize;
- end;
- procedure TNLMexeoutput.MemPos_Header;
- begin
- { calculate start positions after the headers }
- currmempos:=0;
- end;
- procedure TNLMexeoutput.ExeSectionList_write_header(p:TObject;arg:pointer);
- var
- nam : string;
- u32,al : longword;
- alignAmount:longint;
- begin
- with tExeSection(p) do
- begin
- //comment (v_debug,'ExeSectionList_write_header: '+name);
- nam := name;
- alignAmount := 4 - ((length (nam) + 1) MOD 4);
- FWriter.write(nam[1],length(nam));
- FWriter.WriteZeros(1+alignAmount);
- al := 0;
- // for .stab we have to ignore leading zeros due to alignment in file
- if nam='.stab' then
- if assigned(ObjSectionList[0]) then
- al := TObjSection(ObjSectionList[0]).dataalignbytes;
- u32 := dataPos+al; FWriter.write(u32,sizeof(u32));
- u32 := size-al; FWriter.write(u32,sizeof(u32));
- end;
- end;
- procedure TNLMexeoutput.ExeSectionList_pass2_header(p:TObject;arg:pointer);
- var len,alignAmount:longint;
- begin
- {list of sections, extension of binutils,CuStHeAd points to this list
- The format of the section information is:
- null terminated section name
- zeroes to adjust to 4 byte boundary
- 4 byte section data file pointer
- 4 byte section size }
- with TExeSection(p) do
- begin
- alignAmount := 4 - ((length (Name) + 1) MOD 4);
- len := length(name) + 1 + alignAmount + 8;
- if ObjSectionList.Count>0 then
- inc(len,TObjSection(ObjSectionList[0]).dataalignbytes);
- inc(plongint(arg)^,len);
- end;
- end;
- procedure TNLMexeoutput.DataPos_Header;
- begin
- ExeSecsListSize:=0;
- ExeSectionList.ForEachCall(@ExeSectionList_pass2_header,@ExeSecsListSize);
- headerAlignBytes := align(totalheadersize+ExeSecsListSize,16)-(totalheadersize+ExeSecsListSize); // align as in TObjData.sectiontype2align
- currdatapos:=totalheadersize+ExeSecsListSize+headerAlignBytes;
- end;
- procedure TNLMexeoutput.fillNlmVersionHeader;
- var
- hour,min,sec,hsec,Year,Month,Day : word;
- begin
- DecodeTime(Time,hour,min,sec,hsec);
- DecodeDate(Date,year,month,day);
- nlmVersionHeader.stamp := NLM_VERSION_STAMP;
- if nlmVersionHeader.year = 0 then
- begin
- nlmVersionHeader.year := Year;
- nlmVersionHeader.month := Month;
- nlmVersionHeader.day := Day;
- end;
- end;
- function TNLMexeoutput.writedata:boolean;
- var
- dummyLong : array[0..4] of char;
- textExeSec,
- dataExeSec,
- bssExeSec,
- relocsExeSec,
- exportsExeSec,
- importsExeSec,
- xdcExeSec,
- messagesExeSec,
- helpExeSec,
- customExeSec : TExeSection;
- hassymbols : boolean;
- nlmCygnusHeader : nlm32_i386_external_cygnus_ext_header;
- ModuleName : string;
- exesym : TExeSymbol;
- expOffset : PtrUInt;
- expAddr : longword;
- i : integer;
- begin
- result:=false;
- textExeSec:=FindExeSection('.text');
- dataExeSec:=FindExeSection('.data');
- bssExeSec:=FindExeSection('.bss');
- relocsExeSec:=FindExeSection('.reloc');
- importsExeSec:=FindExeSection('.imports');
- exportsExeSec:=FindExeSection('.exports');
- xdcExeSec:=FindExeSection('.xdc');
- messagesExeSec:=FindExeSection('.messages');
- helpExeSec:=FindExeSection('.help');
- customExeSec:=FindExeSection('.custom');
- // exported function need the upper bit in the address
- // to be set (=CODE), do this here to avoid another
- // reloc type. The ExportFunctionOffsets list was
- // filled in GenerateExports
- if FexportFunctionOffsets.Count>0 then
- begin
- if not assigned(exportsExeSec) then
- internalerror(201103201); // we have to have a .export section
- if not assigned(exportsExeSec.ObjSectionList[0]) then
- internalerror(201103202); // nothing in the .exports section but we have data in FexportFunctionOffsets
- for i := 0 to FexportFunctionOffsets.Count-1 do
- begin
- expOffset := PtrUint(FexportFunctionOffsets[i]);
- if TObjSection(exportsExeSec.ObjSectionList[0]).Data.size < expOffset+3 then
- internalerror(201103203); // offset in FexportFunctionOffsets out of range
- with TObjSection(exportsExeSec.ObjSectionList[0]) do
- begin // set the upper bit of address to indicate .text
- Data.seek(expOffset);
- Data.read(expAddr,4);
- Data.seek(expOffset);
- expAddr := expAddr or $80000000;
- Data.write(expAddr,4);
- end;
- end;
- end;
- if not assigned(TextExeSec) or
- not assigned(RelocsExeSec) or
- not assigned(DataExeSec) then
- internalerror(200602231); // we have to have .data, .text and .reloc
- { do we need to write symbols? }
- hassymbols:=(ExeWriteMode=ewm_dbgonly) or
- (
- (ExeWriteMode=ewm_exefull) and
- not(cs_link_strip in current_settings.globalswitches)
- );
- { Initial header, will be updated later }
- nlmHeader.signature := NLM_SIGNATURE;
- nlmHeader.version := NLM_HEADER_VERSION;
- moduleName := upperCase(current_module.exefilename^);
- nlmHeader.moduleName := moduleName;
- nlmHeader.codeImageOffset := TextExeSec.DataPos+TObjSection(TextExeSec.ObjSectionList[0]).dataalignbytes; // ??? may be that align has to be moved to fixups/imports
- nlmHeader.codeImageSize := TextExeSec.Size;
- nlmHeader.dataImageOffset := DataExeSec.DataPos;
- nlmHeader.dataImageSize := DataExeSec.Size;
- if assigned(BSSExeSec) then
- nlmHeader.uninitializedDataSize:=BSSExeSec.Size;
- if assigned(customExeSec) then
- begin
- nlmHeader.customDataOffset := customExeSec.DataPos;
- nlmHeader.customDataSize := customExeSec.Size;
- end;
- if FNumModules > 0 then
- begin
- nlmHeader.moduleDependencyOffset := FindExeSection('.modules').DataPos+4; // 4 bytes dummy
- nlmHeader.numberOfModuleDependencies := FNumModules;
- end;
- nlmHeader.relocationFixupOffset := relocsExeSec.DataPos;
- nlmHeader.numberOfRelocationFixups := FNumRelocs;
- nlmHeader.externalReferencesOffset := importsExeSec.DataPos+4; // 4 bytes dummy
- nlmHeader.numberOfExternalReferences := FNumExternals;
- if assigned(exportsExeSec) then
- if exportsExeSec.Size>0 then
- begin
- nlmHeader.publicsOffset := exportsExeSec.dataPos;
- nlmHeader.numberOfPublics := FnumExports;
- end;
- nlmHeader.codeStartOffset := EntrySym.Address;
- {exit function}
- exesym:=texesymbol(ExeSymbolList.Find('_Stop'));
- if assigned(exesym) then
- nlmHeader.exitProcedureOffset := exesym.ObjSymbol.address;
- {check exit function}
- exesym:=texesymbol(ExeSymbolList.Find('FPC_NW_CHECKFUNCTION'));
- if assigned(exesym) then
- nlmHeader.checkUnloadProcedureOffset := exesym.ObjSymbol.address;
- // calc file pos after all exesections
- fSizeWoDebugSyms := totalheadersize + ExeSecsListSize + headerAlignBytes;
- ExeSectionList.ForEachCall(@ExeSectionList_calc_size,nil);
- nlmExtHeader.stamp := NLM_MESSAGES_STAMP;
- //extHeader.languageID // TODO: where to get this from ?
- if assigned(messagesExeSec) then
- begin
- nlmExtHeader.messageFileOffset := messagesExeSec.DataPos;
- nlmExtHeader.messageFileLength := messagesExeSec.Size;
- end;
- //nlmExtHeader.messageCount // TODO: how is messageCount set ?
- if assigned(helpExeSec) then
- begin
- nlmExtHeader.helpFileOffset := helpExeSec.DataPos;
- nlmExtHeader.helpFileLength := helpExeSec.Size;
- end;
- //nlmExtHeader.productID // TODO: were does this came from ?
- if assigned(xdcExeSec) then
- begin
- nlmExtHeader.RPCDataOffset := xdcExeSec.DataPos;
- nlmExtHeader.RPCDataLength := xdcExeSec.Size;
- end;
- if hassymbols then
- begin
- nlmHeader.debugInfoOffset := fSizeWoDebugSyms;
- ExeSymbolList.ForEachCall(@globalsyms_create_symbol,nil);
- nlmHeader.numberOfDebugRecords := FNumDebugSymbols;
- end;
- fillNlmVersionHeader;
- FWriter.write(nlmHeader,sizeof(nlmHeader));
- { variable header }
- NLMWriteString(nlmDescription,true);
- if stacksize < NLM_DEFAULT_STACKSIZE then stacksize := NLM_DEFAULT_STACKSIZE;
- FWriter.Write(stacksize,4);
- FWriter.writezeros(4);
- dummyLong := ' LONG';
- FWriter.Write(dummyLong,sizeof(dummyLong)); // old thread name
- NLMWriteString(nlmScreenname,true);
- NLMWriteString(nlmThreadname,true);
- {version}
- FWriter.Write(nlmVersionHeader,sizeof(nlmVersionHeader));
- {copyright}
- if nlmCopyright <> '' then
- begin
- FWriter.write(NLM_COPYRIGHT_STAMP,sizeof(NLM_COPYRIGHT_STAMP));
- NLMWriteString(nlmCopyright,true);
- end;
- {messages}
- FWriter.write(nlmExtHeader,sizeof(nlmExtHeader));
- {custhead}
- nlmCustHeader.stamp := NLM_CUSTOM_STAMP;
- nlmCustHeader.dataLength := ExeSecsListSize;
- nlmCustHeader.dataOffset := totalheadersize;
- nlmCustHeader.hdrLength := $10; // why 16 ?, this is what binutils write
- FWriter.write(nlmCustHeader,sizeof(nlmCustHeader));
- {CyGnUsEx}
- // bfd has a strange way to read the sections:
- // the section directory is written under CuStHeAd
- // when bfd finds the neader "CyGnUsEx", it uses the
- // offset and size from CuStHeAd to read the section table
- nlmCygnusHeader.stamp := NLM_CYGNUS_STAMP; // CyGnUsEx
- // ld writes some unknown values here, bfd irgnores the values at all
- // lets write the offset and length of the segment table
- nlmCygnusHeader.offset := nlmCustHeader.dataLength;
- nlmCygnusHeader.length := nlmCustHeader.dataOffset;
- FWriter.write(nlmCygnusHeader,sizeof(nlmCygnusHeader));
- FWriter.WriteZeros(8); // empty stamp + align next to 16 bytes
- if FWriter.Size<>totalheadersize then
- internalerror(201103061); // headersize <> header written
- { Section headers, CuStHeAd points to this section, not needed by
- netware. Can be used to find the section in the nlm file, binutils
- will use this section }
- ExeSectionList.ForEachCall(@ExeSectionList_write_header,nil);
- FWriter.WriteZeros(headerAlignBytes);
- if FWriter.Size<>totalheadersize+ExeSecsListSize+headerAlignBytes then
- internalerror(201103062);
- { Section data }
- if assigned(exemap) then
- begin
- exemap.Add('');
- exemap.Add('NLM file offsets:');
- end;
- ExeSectionList.ForEachCall(@ExeSectionList_write_data,nil);
- if hassymbols then
- FWriter.writearray(NlmSymbols); // specific symbols for the internal netware debugger
- result:=true;
- end;
- procedure TNLMexeoutput.GenerateLibraryImports(ImportLibraryList:TFPHashObjectList);
- var
- idata5objsection : TObjSection;
- basedllname : string;
- function AddImport(const afuncname,amangledname:string; isvar:boolean):TObjSymbol;
- var
- secname:string;
- begin
- //Comment (V_Debug,'TNLMexeoutput.GenerateLibraryImports.AddImport '+afuncName);
- result:=nil;
- if assigned(exemap) then
- exemap.Add(' Importing Function '+afuncname);
- if not isvar then
- with internalobjdata do
- begin
- secname:=basedllname+'_i_'+amangledname;
- idata5objsection:=createsection(sec_idata5, secname);
- internalobjdata.SetSection(idata5objsection);
- result:=internalobjdata.SymbolDefine('_'+amangledname,AB_IMPORT,AT_FUNCTION);
- end;
- end;
- var
- i,j : longint;
- ImportLibrary : TImportLibrary;
- ImportSymbol : TImportSymbol;
- exesym : TExeSymbol;
- importAddressList : TFPObjectList;
- begin
- if ImportLibraryList.Count > 0 then
- begin
- {objsec:=}internalObjData.createsection('.imports',0,[oso_data,oso_keep]);
- i := 0;
- internalobjdata.writebytes(i,4); // dummy to avoid deletion
- {objsec:=}internalObjData.createsection('.modules',0,[oso_data,oso_keep]);
- internalobjdata.writebytes(i,4); // dummy to avoid deletion
- end;
- for i:=0 to ImportLibraryList.Count-1 do
- begin
- ImportLibrary:=TImportLibrary(ImportLibraryList[i]);
- idata5objsection:=nil;
- for j:=0 to ImportLibrary.ImportSymbolList.Count-1 do
- begin
- ImportSymbol:=TImportSymbol(ImportLibrary.ImportSymbolList[j]);
- exesym:=TExeSymbol(ExeSymbolList.Find(ImportSymbol.MangledName));
- if assigned(exesym) and
- (exesym.State<>symstate_defined) then
- begin
- basedllname:=ExtractFileName(ImportLibrary.Name);
- exesym.objsymbol:=AddImport(ImportSymbol.Name,ImportSymbol.MangledName,ImportSymbol.IsVar);
- exesym.State:=symstate_defined;
- importAddressList := TFPObjectList.create(false);
- nlmImports.Add(ImportSymbol.Name,importAddressList);
- if pos('.',basedllname) = 0 then
- basedllname := basedllname + '.nlm';
- nlmImpNames.Add(ImportSymbol.Name,TStringObj.create(lower(basedllname)));
- end;
- end;
- end;
- PackUnresolvedExeSymbols('after DLL imports');
- GenerateExports;
- end;
- procedure TNLMexeoutput.GenerateImports;
- var
- exesec,
- impexesec : TExeSection;
- objsec : TObjSection;
- objreloc : TObjRelocation;
- i,j,k : integer;
- importAddressList : TFPObjectList;
- name,mName : string;
- b : byte;
- modules : string;
- modName : TStringObj;
- begin
- if FImportsGenerated then exit;
- FImportsGenerated := true;
- impexesec:=FindExeSection('.imports');
- if impexesec=nil then exit;
- for i:=0 to ExeSectionList.Count-1 do
- begin
- exesec:=TExeSection(ExeSectionList[i]);
- for j:=0 to exesec.ObjSectionList.count-1 do
- begin
- objsec:=TObjSection(exesec.ObjSectionList[j]);
- if j=0 then
- begin
- exesec.DataPos:=objSec.DataPos;
- exesec.MemPos:=objSec.MemPos;
- end;
- if (copy(objsec.name,1,5) <> '.text') and (copy(objsec.name,1,4) <> '.bss') and (copy(objsec.name,1,5) <> '.data') then
- continue;
- for k:=0 to objsec.ObjRelocations.Count-1 do
- begin
- objreloc := TObjRelocation(objsec.ObjRelocations[k]);
- if assigned(objreloc.symbol) then
- begin
- //writeln (objreloc.symbol.name,' ',objreloc.symbol.bind);
- if objreloc.symbol.bind = AB_IMPORT then
- begin
- importAddressList := TFPObjectList(nlmImports.Find(objreloc.symbol.name));
- if assigned(importAddressList) then
- begin
- objreloc.objsection := objsec; // points to idata5
- importAddressList.Add(objreloc);
- end else
- begin
- comment(v_error,objreloc.symbol.name+' is external but not defined in nlm imports');
- end;
- end;
- end
- end;
- end;
- end;
- modules := '';
- for i := 0 to nlmImports.count-1 do
- begin
- importAddressList := TFPObjectList(nlmImports.Items[i]);
- if importAddressList.Count > 0 then
- begin
- name := nlmImports.NameOfIndex(i);
- // find the module to be imported and add it to the list
- // of modules to be auto loaded
- modName := TStringObj(nlmImpNames.Find(name));
- if assigned(modName) then
- begin
- mName := modName.Value;
- if mName <> '' then
- 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
- begin
- if pos(mName+';',modules) < 1 then
- begin
- modules := modules + mName + ';';
- inc(FNumModules);
- end;
- end;
- end;
- internalobjdata.SetSection(TObjSection(impexesec.ObjSectionList[0]));
- objNLMwriteString (name,false); // name of symbol
- k := importAddressList.Count;
- internalobjdata.writebytes(k,sizeof(k)); // number of references
- inc(FNumExternals);
- for j := 0 to importAddressList.Count-1 do
- begin
- objreloc := TObjRelocation(importAddressList[j]);
- objsec := objreloc.objsection;
- if oso_executable in objreloc.objsection.SecOptions then
- begin
- if objreloc.typ <> RELOC_RELATIVE then comment(v_error,'reference to external symbols must be RELOC_RELATIVE');
- // TODO: how to check if size is 4 ????
- k := objsec.MemPos + objreloc.DataOffset;
- k := k or $40000000;
- // TODO: data|code if we support importing data symbols
- // i do not know if this is possible with netware
- internalobjdata.writebytes(k,sizeof(k)); // address
- // the netware loader requires an offset at the import address
- // for call = E8 this is -4
- // TODO: how can we check the needed offset ??
- if objreloc.DataOffset > 0 then
- begin
- objsec.Data.seek(objreloc.DataOffset-1);
- objsec.data.read(b,1);
- if b <> $E8 then
- comment(v_error,'no rcall (E8) before imported symbol target address');
- k := -4;
- objsec.Data.write(k,sizeof(k));
- end else
- begin
- objsec.Data.seek(objreloc.DataOffset);
- k := 0;
- objsec.Data.write(k,sizeof(k));
- end;
- objreloc.typ := RELOC_NONE; // to avoid that TCoffObjSection.fixuprelocs changes the address again
- end else
- comment(v_error,'Importing of symbols only supported for .text');
- end;
- end;
- end;
- exesec := FindExeSection('.modules');
- if not assigned(exesec) then internalerror(201103272); // exe section .modules does not exist ???
- internalobjdata.SetSection(TObjSection(exesec.ObjSectionList[0]));
- for i := 1 to FNumModules do
- begin
- name := GetToken(modules,';');
- objNLMwriteString (name,false);
- end;
- end;
- procedure TNLMexeoutput.GenerateExports;
- var
- hp : texported_item; { for exports }
- len : byte;
- addr: longword;
- exesym : texesymbol;
- begin
- internalObjData.createsection('.exports',0,[oso_data,oso_keep]);
- {name LString 1+n bytes
- addr 4 bytes
- addr and $80000000 > 0 -> .text else .data}
- hp:=texported_item(current_module._exports.first);
- if assigned(hp) then
- if assigned(exemap) then
- exemap.Add('');
- while assigned(hp) do
- begin
- { Export the Symbol }
- if assigned(exemap) then
- exemap.Add(' Exporting Function '+hp.sym.prettyname+' as '+hp.name^);
- len := length(hp.name^);
- internalobjdata.writebytes(len,1);
- internalobjdata.writebytes(hp.name^[1],len);
- exesym:=texesymbol(ExeSymbolList.Find(hp.sym.prettyname));
- if not assigned(exesym) then
- begin
- comment(v_error,'exported symbol '+hp.sym.prettyname+' not found');
- exit;
- end;
- // for exported functions we have to set the upper bit
- // this will be done in .writedata
- if not hp.is_var then
- FexportFunctionOffsets.Add(pointer(PtrUInt(internalobjdata.CurrObjSec.Size)));
- internalobjdata.writereloc(0,4,exesym.ObjSymbol,RELOC_ABSOLUTE32);
- addr := 0;
- internalobjdata.writebytes(addr,4);
- inc(FnumExports);
- hp:=texported_item(hp.next);
- end;
- end;
- procedure TNLMexeoutput.GenerateRelocs;
- var
- exesec : TExeSection;
- objsec : TObjSection;
- objreloc : TObjRelocation;
- i,j,k : longint;
- offset : longword;
- inSec,toSec : TsecType;
- targetSectionName : string;
- begin
- if not RelocSection or FRelocsGenerated then
- exit;
- exesec:=FindExeSection('.reloc');
- if exesec=nil then
- exit;
- objsec:=internalObjData.createsection('.reloc',0,exesec.SecOptions+[oso_data]);
- exesec.AddObjSection(objsec);
- for i:=0 to ExeSectionList.Count-1 do
- begin
- exesec:=TExeSection(ExeSectionList[i]);
- for j:=0 to exesec.ObjSectionList.count-1 do
- begin
- objsec:=TObjSection(exesec.ObjSectionList[j]);
- //writeln ('Relocs for ',exesec.name,' - ',objsec.name);
- { create relocs only for sections which are loaded in memory }
- if not (oso_load in objsec.SecOptions) then
- continue;
- { create relocs only for .text and .data }
- inSec := SectionType (objsec.name);
- if (inSec <> Section_Text) and (inSec <> Section_Data) then
- continue;
- for k:=0 to objsec.ObjRelocations.Count-1 do
- begin
- objreloc:=TObjRelocation(objsec.ObjRelocations[k]);
- if objreloc.typ <> RELOC_ABSOLUTE then
- continue;
- offset:=objsec.MemPos+objreloc.dataoffset;
- targetSectionName := '';
- if objreloc.symbol <> nil then
- begin
- // writeln (' MemPos',objsec.MemPos,
- // ' dataOfs:',objreloc.dataoffset,' ',objsec.name,
- // ' objreloc.symbol: ',objreloc.symbol.name,
- // ' objreloc.symbol.objsection.name: ',objreloc.symbol.objsection.name,
- // ' ',objreloc.symbol.Typ,' ',objrel
- // oc.symbol.bind,' ',objreloc.Typ);
- if objreloc.symbol.objsection.name[1] <> '.' then
- targetSectionName := objreloc.symbol.name // specials like __bss_start__
- else // dont use objsection.name because it begins with *
- targetSectionName := copy(objreloc.symbol.objsection.name,1,5); // all others begin with .segment, we only have to check for .text, .data or .bss
- end else
- internalerror(2011030603);
- toSec := SectionType(targetSectionName);
- if (toSec = Section_Text) or (toSec = Section_Data) then
- begin
- if (inSec = Section_text) then offset := offset or $40000000;
- if (toSec = Section_text) then offset := offset or $80000000;
- internalObjData.writebytes(offset,4);
- inc(FNumRelocs);
- end;
- end;
- end;
- end;
- FRelocsGenerated:=true;
- end;
- procedure TNLMexeoutput.Order_End;
- var
- exesec : TExeSection;
- begin
- inherited;
- exesec:=FindExeSection('.reloc');
- if exesec=nil then
- exit;
- exesec.SecOptions:=exesec.SecOptions + [oso_Data,oso_keep,oso_load];
- end;
- procedure TNLMexeoutput.MemPos_ExeSection(const aname:string);
- begin
- if aname='.reloc' then
- GenerateRelocs;
- if aname='.imports' then
- GenerateImports;
- if aname='.data' then
- currMemPos := 0; // both, data and code in the nlm have a start offset of 0
- inherited;
- end;
- procedure TNLMexeoutput.DataPos_ExeSection(const aname:string);
- begin
- inherited;
- end;
- procedure TNLMexeoutput.NLMwriteString (const s : string; terminateWithZero : boolean);
- var len : byte;
- begin
- if length(s) > 254 then len := 254 else len := length(s);
- FWriter.Write(len,1);
- if len > 0 then
- FWriter.write(s[1],len);
- if terminateWithZero then
- FWriter.writeZeros(1);
- end;
- procedure TNLMexeoutput.objNLMwriteString (const s : string; terminateWithZero : boolean);
- var len : byte;
- begin
- if length(s) > 254 then len := 254 else len := length(s);
- Internalobjdata.writebytes(len,1);
- if len > 0 then
- Internalobjdata.writebytes(s[1],len);
- if terminateWithZero then
- begin
- len := 0;
- Internalobjdata.writebytes(s[1],len);
- end;
- end;
- { parse netware specific linker options }
- procedure TNLMexeoutput.ParseScript (linkscript:TCmdStrList);
- var
- hp : TCmdStrListItem;
- opt,keyword,s : string;
- i : integer;
- function toInteger(s:string; min,max:integer; var res:integer):boolean;
- var
- code:word;
- begin
- result := false;
- val (s,res,code);
- if code<>0 then exit;
- if (res < min) or (res > max) then exit;
- result := true;
- end;
- procedure loadFile (const secName, fileName, Desc : string);
- var
- fileBuf : array [0..4095] of char;
- bytesRead : longint;
- fileH : THandle;
- fn : TCmdStr;
- begin
- fn := fileName;
- if not fileExists(fn) then
- if not unitsearchpath.FindFile(fileName,true,fn) then
- begin
- comment(v_error,'can not find '+desc+' file '+fileName);
- exit;
- end;
- fileH := fileOpen (fn,fmOpenRead);
- if fileH = THandle(-1) then
- begin
- comment(v_error,'can not open '+desc+' file '+fn);
- exit;
- end;
- { load file into section }
- internalObjData.createsection(secName,0,[oso_data,oso_keep]);
- repeat
- bytesRead := fileRead(fileH,fileBuf,sizeof(fileBuf));
- if bytesRead > 0 then
- internalobjdata.writebytes(fileBuf,bytesRead);
- until bytesRead < sizeof(fileBuf);
- fileClose(fileH);
- end;
- begin
- hp:=TCmdStrListItem(linkscript.first);
- while assigned(hp) do
- begin
- opt:=hp.str;
- if (opt='') or (opt[1]='#') then
- continue;
- keyword:=Upper(GetToken(opt,' '));
- if keyword = 'AUTOUNLOAD' then
- begin
- nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_AUTOUNLOAD;
- end else
- if keyword = 'COPYRIGHT' then
- begin
- nlmCopyright := GetToken(opt,' ');
- end else
- if keyword = 'CUSTOM' then
- begin
- loadFile ('.custom',GetToken(opt,' '),'custom data');
- end;
- if keyword = 'DATE' then // month day 4-digit-year
- begin
- if not toInteger(GetToken(opt,' '),1,12,i) then comment(v_error,'DATE: invalid month')
- else nlmVersionHeader.month := i;
- if not toInteger(GetToken(opt,' '),1,31,i) then comment(v_error,'DATE: invalid day')
- else nlmVersionHeader.day := i;
- if not toInteger(GetToken(opt,' '),1900,3000,i) then comment(v_error,'DATE: invalid year')
- else nlmVersionHeader.year := i;
- end else
- if keyword = 'DEBUG' then
- begin
- // ignore
- end else
- if keyword = 'DESCRIPTION' then
- begin
- nlmDescription := GetToken(opt,' ');
- if length (nlmDescription) > NLM_MAX_DESCRIPTION_LENGTH then
- nlmDescription := copy (nlmDescription,1,NLM_MAX_DESCRIPTION_LENGTH);
- end else
- if keyword = 'FLAG' then
- begin
- s := upper(GetToken(opt,' '));
- if (not toInteger(GetToken(opt,' '),1,$FFFFFFF,i)) or ((s <> 'ON') and (S <> 'OFF')) then comment(v_error,'FLAG: invalid') else
- if (s='ON') then
- nlmHeader.flags:=nlmHeader.flags or i else
- nlmHeader.flags:=nlmHeader.flags and ($FFFFFFF-i);
- end else
- if keyword = 'HELP' then
- begin
- loadFile ('.help',GetToken(opt,' '),'help');
- end else
- if keyword = 'MESSAGES' then
- begin
- loadFile ('.messages',GetToken(opt,' '),'message');
- end else
- if keyword = 'MULTIPLE' then
- begin
- nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_MULTILOAD;
- end else
- if keyword = 'OS_DOMAIN' then
- begin
- nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_OSDOMAIN;
- end else
- if keyword = 'PSEUDOPREEMPTION' then
- begin
- nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_PSEUDOPREEMPTION;
- end else
- if keyword = 'REENTRANT' then
- begin
- nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_REENTRANT;
- end else
- if keyword = 'SCREENNAME' then
- begin
- nlmScreenname := GetToken(opt,' ');
- if length(nlmScreenname) > NLM_MAX_SCREEN_NAME_LENGTH then
- nlmScreenName := copy (nlmScreenName,1,NLM_MAX_SCREEN_NAME_LENGTH);
- end else
- if (keyword = 'STACK') or (keyword = 'STACKSIZE') then
- begin
- if (not toInteger(GetToken(opt,' '),1,$FFFFFFF,i)) then comment(v_error,'invalid stacksize') else
- stacksize := i;
- end else
- if keyword = 'SYNCHRONIZE' then
- begin
- nlmHeader.flags:=nlmHeader.flags or NLM_FLAGS_SYNCHRONIZE;
- end else
- if keyword = 'THREADNAME' then
- begin
- nlmThreadname := GetToken(opt,' ');
- if length(nlmThreadname) > NLM_MAX_THREAD_NAME_LENGTH then
- nlmThreadname := copy (nlmThreadname,1,NLM_MAX_THREAD_NAME_LENGTH);
- end else
- if keyword = 'TYPE' then
- begin
- if (not toInteger(GetToken(opt,' '),1,16,i)) then comment(v_error,'invalid TYPE') else
- nlmHeader.moduleType := i; // TODO: set executable extension (.DSK, .LAN, ...)
- end else
- if keyword = 'VERSION' then
- begin
- if (not toInteger(GetToken(opt,' '),0,$FFFFFFF,i)) then comment(v_error,'invalid major version') else
- nlmVersionHeader.majorVersion := i;
- if (not toInteger(GetToken(opt,' '),0,99,i)) then comment(v_error,'invalid minor version') else
- nlmVersionHeader.minorVersion := i;
- if (not toInteger(GetToken(opt,' '),0,$FFFFFFF,i)) then comment(v_error,'invalid minor version') else
- if i > 26 then
- nlmVersionHeader.revision := 0 else
- nlmVersionHeader.revision := i;
- end else
- if keyword = 'XDCDATA' then
- begin
- loadFile ('.xdc',GetToken(opt,' '),'xdc');
- end;
- { TODO: check for unknown options. This means all handled option
- (also in link.pas) have to be flagged if processed }
- hp:=TCmdStrListItem(hp.next);
- end;
- end;
- {****************************************************************************
- TNLMCoffObjData
- ****************************************************************************}
- constructor TNLMCoffObjData.create(const n:string);
- begin
- inherited createcoff(n,true,TNLMCoffObjSection);
- end;
- {****************************************************************************
- TNLMoffObjSection
- ****************************************************************************}
- constructor TNLMCoffObjSection.create(AList:TFPHashObjectList;const aname:string;aalign:shortint;aoptions:TObjSectionOptions);
- begin
- inherited create(alist,aname,aalign,aoptions);
- end;
- constructor TNLMCoffObjOutput.create(AWriter:TObjectWriter);
- begin
- // ??????
- // if win32=false, .stabs and .stabstr will be written without oso_debug
- // Without oso_debug the sections will be removed by the linker
- inherited createcoff(AWriter,{win32}true);
- cobjdata:=TNLMCoffObjData;
- end;
- {****************************************************************************
- TDJCoffAssembler
- ****************************************************************************}
- constructor TNLMCoffAssembler.Create(smart:boolean);
- begin
- inherited Create(smart);
- CObjOutput:=TNLMCoffObjOutput;
- end;
- constructor TNLMCoffObjInput.create;
- begin
- inherited createcoff(true);
- cobjdata:=TNLMCoffObjData;
- end;
- {*****************************************************************************
- Initialize
- *****************************************************************************}
- const
- as_i386_nlmcoff_info : tasminfo =
- (
- id : as_i386_nlmcoff;
- idtxt : 'NLMCOFF';
- asmbin : '';
- asmcmd : '';
- supported_targets : [system_i386_Netware,system_i386_netwlibc];
- flags : [af_outputbinary,af_smartlink_sections];
- labelprefix : '.L';
- comment : '';
- );
- initialization
- {$ifdef i386}
- RegisterAssembler(as_i386_nlmcoff_info,TNLMCoffAssembler);
- {$endif i386}
- end.
|