mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-04 06:10:16 +02:00
+ first implementation of Netware Module support, thanks to
Armin Diehl (diehl@nordrhein.de) for providing the patches
This commit is contained in:
parent
194b9f2958
commit
6159f4535f
@ -2094,7 +2094,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.7 2000-09-01 21:27:50 peter
|
||||
Revision 1.8 2000-09-11 17:00:22 florian
|
||||
+ first implementation of Netware Module support, thanks to
|
||||
Armin Diehl (diehl@nordrhein.de) for providing the patches
|
||||
|
||||
Revision 1.7 2000/09/01 21:27:50 peter
|
||||
* changed files to finput,fmodule
|
||||
|
||||
Revision 1.6 2000/08/18 14:33:07 marco
|
||||
@ -2114,4 +2118,4 @@ end.
|
||||
Revision 1.2 2000/07/13 11:32:32 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
}
|
||||
|
@ -80,6 +80,9 @@ uses
|
||||
{$ifndef NOTARGETWIN32}
|
||||
,t_win32
|
||||
{$endif}
|
||||
{$ifndef NOTARGETNETWARE}
|
||||
,t_nwm
|
||||
{$endif}
|
||||
{$ifndef NOTARGETGO32V2}
|
||||
,t_go32v2
|
||||
{$endif}
|
||||
@ -188,6 +191,8 @@ begin
|
||||
exportlib:=new(pexportliblinux,Init);
|
||||
target_i386_Win32 :
|
||||
exportlib:=new(pexportlibwin32,Init);
|
||||
target_i386_Netware :
|
||||
exportlib:=new(pexportlibnetware,Init);
|
||||
{
|
||||
target_i386_OS2 :
|
||||
exportlib:=new(pexportlibos2,Init);
|
||||
@ -214,7 +219,11 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-08-27 16:11:50 peter
|
||||
Revision 1.4 2000-09-11 17:00:22 florian
|
||||
+ first implementation of Netware Module support, thanks to
|
||||
Armin Diehl (diehl@nordrhein.de) for providing the patches
|
||||
|
||||
Revision 1.3 2000/08/27 16:11:50 peter
|
||||
* moved some util functions from globals,cobjects to cutils
|
||||
* splitted files into finput,fmodule
|
||||
|
||||
|
@ -118,7 +118,7 @@ unit globals;
|
||||
usewindowapi : boolean;
|
||||
description : string;
|
||||
dllversion : string;
|
||||
dllmajor,dllminor : word;
|
||||
dllmajor,dllminor,dllrevision : word; { revision only for netware }
|
||||
|
||||
{ current position }
|
||||
token, { current token being parsed }
|
||||
@ -1198,7 +1198,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.7 2000-08-27 16:11:51 peter
|
||||
Revision 1.8 2000-09-11 17:00:22 florian
|
||||
+ first implementation of Netware Module support, thanks to
|
||||
Armin Diehl (diehl@nordrhein.de) for providing the patches
|
||||
|
||||
Revision 1.7 2000/08/27 16:11:51 peter
|
||||
* moved some util functions from globals,cobjects to cutils
|
||||
* splitted files into finput,fmodule
|
||||
|
||||
|
@ -81,6 +81,9 @@ uses
|
||||
{$ifndef NOTARGETWIN32}
|
||||
,t_win32
|
||||
{$endif}
|
||||
{$ifndef NOTARGETNETWARE}
|
||||
,t_nwm
|
||||
{$endif}
|
||||
{$ifndef NOTARGETGO32V2}
|
||||
,t_go32v2
|
||||
{$endif}
|
||||
@ -228,6 +231,8 @@ begin
|
||||
importlib:=new(pimportlibwin32,Init);
|
||||
target_i386_OS2 :
|
||||
importlib:=new(pimportlibos2,Init);
|
||||
target_i386_Netware :
|
||||
importlib:=new(pimportlibnetware,Init);
|
||||
{$endif i386}
|
||||
{$ifdef m68k}
|
||||
target_m68k_Linux :
|
||||
@ -250,7 +255,11 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-08-27 16:11:51 peter
|
||||
Revision 1.4 2000-09-11 17:00:23 florian
|
||||
+ first implementation of Netware Module support, thanks to
|
||||
Armin Diehl (diehl@nordrhein.de) for providing the patches
|
||||
|
||||
Revision 1.3 2000/08/27 16:11:51 peter
|
||||
* moved some util functions from globals,cobjects to cutils
|
||||
* splitted files into finput,fmodule
|
||||
|
||||
|
@ -93,6 +93,9 @@ uses
|
||||
{$ifndef NOTARGETWIN32}
|
||||
,t_win32
|
||||
{$endif}
|
||||
{$ifndef NOTARGETNETWARE}
|
||||
,t_nwm
|
||||
{$endif}
|
||||
{$ifndef NOTARGETGO32V1}
|
||||
,t_go32v1
|
||||
{$endif}
|
||||
@ -474,6 +477,10 @@ begin
|
||||
target_i386_Win32 :
|
||||
linker:=new(plinkerwin32,Init);
|
||||
{$endif}
|
||||
{$ifndef NOTARGETNETWARE}
|
||||
target_i386_Netware :
|
||||
linker:=new(plinkernetware,Init);
|
||||
{$endif}
|
||||
{$ifndef NOTARGETGO32V1}
|
||||
target_i386_Go32v1 :
|
||||
linker:=new(plinkergo32v1,Init);
|
||||
@ -525,7 +532,11 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2000-09-04 09:40:23 michael
|
||||
Revision 1.6 2000-09-11 17:00:23 florian
|
||||
+ first implementation of Netware Module support, thanks to
|
||||
Armin Diehl (diehl@nordrhein.de) for providing the patches
|
||||
|
||||
Revision 1.5 2000/09/04 09:40:23 michael
|
||||
+ merged Patch from peter
|
||||
|
||||
Revision 1.4 2000/08/27 16:11:51 peter
|
||||
@ -539,4 +550,4 @@ end.
|
||||
* changed V_Hint's to V_Tried's (for attempts to smart/shared/static link)
|
||||
Revision 1.2 2000/07/13 11:32:43 michael
|
||||
+ removed logs
|
||||
}
|
||||
}
|
||||
|
@ -1261,7 +1261,8 @@ unit pdecl;
|
||||
Message(parser_e_syntax_error);
|
||||
consume_all_until(_SEMICOLON);
|
||||
end
|
||||
else if islibrary or (target_info.target=target_i386_WIN32) then
|
||||
else if islibrary or (target_info.target=target_i386_WIN32)
|
||||
or (target_info.target=target_i386_Netware) then // AD
|
||||
read_exports;
|
||||
end
|
||||
else break;
|
||||
@ -1296,7 +1297,11 @@ unit pdecl;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 2000-08-27 20:19:39 peter
|
||||
Revision 1.14 2000-09-11 17:00:23 florian
|
||||
+ first implementation of Netware Module support, thanks to
|
||||
Armin Diehl (diehl@nordrhein.de) for providing the patches
|
||||
|
||||
Revision 1.13 2000/08/27 20:19:39 peter
|
||||
* store strings with case in ppu, when an internal symbol is created
|
||||
a '$' is prefixed so it's not automatic uppercased
|
||||
|
||||
|
@ -703,10 +703,10 @@ const
|
||||
|
||||
procedure dir_description(t:tdirectivetoken);
|
||||
begin
|
||||
if not (target_info.target in [target_i386_os2,target_i386_win32]) then
|
||||
if not (target_info.target in [target_i386_os2,target_i386_win32,target_i386_netware]) then
|
||||
Message(scan_w_decription_not_support);
|
||||
{ change description global var in all cases }
|
||||
{ it not used but in win32 and os2 }
|
||||
{ it not used but in win32, os2 and netware }
|
||||
current_scanner^.skipspace;
|
||||
description:=current_scanner^.readcomment;
|
||||
end;
|
||||
@ -714,10 +714,10 @@ const
|
||||
|
||||
procedure dir_version(t:tdirectivetoken);
|
||||
var
|
||||
major, minor : longint;
|
||||
major, minor, revision : longint;
|
||||
error : integer;
|
||||
begin
|
||||
if not (target_info.target in [target_i386_os2,target_i386_win32]) then
|
||||
if not (target_info.target in [target_i386_os2,target_i386_win32,target_i386_netware]) then // AD
|
||||
begin
|
||||
Message(scan_n_version_not_support);
|
||||
exit;
|
||||
@ -727,12 +727,13 @@ const
|
||||
else
|
||||
begin
|
||||
{ change description global var in all cases }
|
||||
{ it not used but in win32 and os2 }
|
||||
{ it not used but in win32, os2 and netware }
|
||||
current_scanner^.skipspace;
|
||||
{ we should only accept Major.Minor format }
|
||||
{ we should only accept Major.Minor format for win32 and os2 }
|
||||
current_scanner^.readnumber;
|
||||
major:=0;
|
||||
minor:=0;
|
||||
revision:=0;
|
||||
valint(pattern,major,error);
|
||||
if error<>0 then
|
||||
begin
|
||||
@ -749,9 +750,28 @@ const
|
||||
Message1(scan_w_wrong_version_ignored,tostr(major)+'.'+pattern);
|
||||
exit;
|
||||
end;
|
||||
dllmajor:=major;
|
||||
dllminor:=minor;
|
||||
dllversion:=tostr(major)+'.'+tostr(minor);
|
||||
if (c='.') and
|
||||
(target_info.target = target_i386_netware) then // AD
|
||||
begin
|
||||
current_scanner^.readchar;
|
||||
current_scanner^.readnumber;
|
||||
valint(pattern,revision,error);
|
||||
if error<>0 then
|
||||
begin
|
||||
Message1(scan_w_wrong_version_ignored,tostr(revision)+'.'+pattern);
|
||||
exit;
|
||||
end;
|
||||
dllmajor:=major;
|
||||
dllminor:=minor;
|
||||
dllrevision:=revision;
|
||||
dllversion:=tostr(major)+','+tostr(minor)+','+tostr(revision);
|
||||
end
|
||||
else
|
||||
begin
|
||||
dllmajor:=major;
|
||||
dllminor:=minor;
|
||||
dllversion:=tostr(major)+'.'+tostr(minor);
|
||||
end;
|
||||
end
|
||||
else
|
||||
dllversion:=tostr(major);
|
||||
@ -1444,7 +1464,11 @@ const
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2000-09-10 21:18:15 peter
|
||||
Revision 1.6 2000-09-11 17:00:23 florian
|
||||
+ first implementation of Netware Module support, thanks to
|
||||
Armin Diehl (diehl@nordrhein.de) for providing the patches
|
||||
|
||||
Revision 1.5 2000/09/10 21:18:15 peter
|
||||
* macro warning (merged)
|
||||
|
||||
Revision 1.4 2000/08/12 15:30:44 peter
|
||||
|
@ -58,8 +58,9 @@ unit systems;
|
||||
type
|
||||
ttarget = (target_none
|
||||
,target_i386_GO32V1,target_i386_GO32V2,target_i386_linux,
|
||||
target_i386_OS2,target_i386_Win32
|
||||
,target_m68k_Amiga,target_m68k_Atari,target_m68k_Mac,
|
||||
target_i386_OS2,target_i386_Win32,
|
||||
target_i386_Netware, // AD
|
||||
target_m68k_Amiga,target_m68k_Atari,target_m68k_Mac,
|
||||
target_m68k_linux,target_m68k_PalmOS,target_alpha_linux,
|
||||
target_powerpc_linux,target_powerpc_macos
|
||||
);
|
||||
@ -72,7 +73,7 @@ unit systems;
|
||||
{ alias for supported_target field in tasminfo }
|
||||
target_any = target_none;
|
||||
|
||||
{$ifdef i386} i386targetcnt=5; {$else} i386targetcnt=0; {$endif}
|
||||
{$ifdef i386} i386targetcnt=6; {$else} i386targetcnt=0; {$endif}
|
||||
{$ifdef m68k} m68ktargetcnt=5; {$else} m68ktargetcnt=0; {$endif}
|
||||
{$ifdef alpha} alphatargetcnt=1; {$else} alphatargetcnt=0; {$endif}
|
||||
{$ifdef powerpc} powerpctargetcnt=2; {$else} powerpctargetcnt=0; {$endif}
|
||||
@ -127,11 +128,12 @@ unit systems;
|
||||
tos = ( os_none,
|
||||
os_i386_GO32V1,os_i386_GO32V2,os_i386_Linux,os_i386_OS2,
|
||||
os_i386_Win32,
|
||||
os_i386_Netware, // AD
|
||||
os_m68k_Amiga,os_m68k_Atari,os_m68k_Mac,os_m68k_Linux,
|
||||
os_m68k_PalmOS,os_alpha_linux,os_powerpc_linux,os_powerpc_macos
|
||||
);
|
||||
const
|
||||
i386oscnt=5;
|
||||
i386oscnt=6;
|
||||
m68koscnt=5;
|
||||
alphaoscnt=1;
|
||||
powerpcoscnt=2;
|
||||
@ -363,6 +365,28 @@ implementation
|
||||
use_bound_instruction : false;
|
||||
use_function_relative_addresses : true
|
||||
),
|
||||
(
|
||||
id : os_i386_Netware;
|
||||
name : 'Netware for i386';
|
||||
shortname : 'netware';
|
||||
sharedlibext : '.nlm';
|
||||
staticlibext : '.a';
|
||||
sourceext : '.pp';
|
||||
pasext : '.pas';
|
||||
exeext : '.nlm';
|
||||
defext : '.def';
|
||||
scriptext : '.sh';
|
||||
libprefix : '';
|
||||
Cprefix : '';
|
||||
newline : #13#10;
|
||||
endian : endian_little;
|
||||
stackalignment : 4;
|
||||
maxCrecordalignment : 4;
|
||||
size_of_pointer : 4;
|
||||
size_of_longint : 4;
|
||||
use_bound_instruction : false;
|
||||
use_function_relative_addresses : true
|
||||
),
|
||||
(
|
||||
id : os_m68k_amiga;
|
||||
name : 'Commodore Amiga';
|
||||
@ -750,7 +774,7 @@ implementation
|
||||
idtxt : 'ELF';
|
||||
asmbin : '';
|
||||
asmcmd : '';
|
||||
supported_target : target_i386_linux;
|
||||
supported_target : target_any; //target_i386_linux;
|
||||
allowdirect : false;
|
||||
externals : true;
|
||||
needar : false;
|
||||
@ -1104,6 +1128,30 @@ implementation
|
||||
heapsize : 256*1024;
|
||||
maxheapsize : 32*1024*1024;
|
||||
stacksize : 32*1024*1024
|
||||
),
|
||||
(
|
||||
target : target_i386_NETWARE;
|
||||
flags : [];
|
||||
cpu : i386;
|
||||
short_name : 'NETWARE';
|
||||
unit_env : 'NETWAREUNITS';
|
||||
system_unit : 'sysnetwa';
|
||||
smartext : '.sl';
|
||||
unitext : '.ppn';
|
||||
unitlibext : '.ppl';
|
||||
asmext : '.s';
|
||||
objext : '.on';
|
||||
resext : '.res';
|
||||
resobjext : '.or';
|
||||
exeext : '';
|
||||
os : os_i386_Netware;
|
||||
assem : as_i386_elf;
|
||||
assemsrc : as_i386_as;
|
||||
ar : ar_i386_ar;
|
||||
res : res_none;
|
||||
heapsize : 256*1024;
|
||||
maxheapsize : 32768*1024;
|
||||
stacksize : 8192
|
||||
)
|
||||
{$endif i386}
|
||||
{$ifdef m68k}
|
||||
@ -1660,7 +1708,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2000-08-12 19:14:59 peter
|
||||
Revision 1.6 2000-09-11 17:00:23 florian
|
||||
+ first implementation of Netware Module support, thanks to
|
||||
Armin Diehl (diehl@nordrhein.de) for providing the patches
|
||||
|
||||
Revision 1.5 2000/08/12 19:14:59 peter
|
||||
* ELF writer works now also with -g
|
||||
* ELF writer is default again for linux
|
||||
|
||||
|
449
compiler/t_nwm.pas
Normal file
449
compiler/t_nwm.pas
Normal file
@ -0,0 +1,449 @@
|
||||
{
|
||||
$Id$
|
||||
Copyright (c) 1998-2000 by Peter Vreman
|
||||
|
||||
This unit implements support import,export,link routines
|
||||
for the (i386) Netware target
|
||||
|
||||
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.
|
||||
|
||||
First Implementation 10 Sept 2000 Armin Diehl
|
||||
|
||||
Currently generating NetWare-NLM's only work under Linux. This is
|
||||
because nlmconf from binutils does not work with i.e. win32 coff
|
||||
object files. It works fine with ELF-Objects.
|
||||
|
||||
The following compiler-swiches are supported for NetWare:
|
||||
$DESCRIPTION : NLM-Description, will be displayed at load-time
|
||||
$M : For Stack-Size, Heap-Size will be ignored
|
||||
$VERSION x.x.x : Sets Major, Minor and Revision
|
||||
|
||||
Sorry, Displaying copyright does not work with nlmconv from gnu bunutils.
|
||||
|
||||
Exports will be handled like in win32:
|
||||
procedure bla;
|
||||
begin
|
||||
end;
|
||||
|
||||
exports bla name 'bla';
|
||||
|
||||
Without Name 'bla' this will be exported in upper-case.
|
||||
|
||||
The path to the import-Files (from netware-sdk, see developer.novell.com)
|
||||
must be specified by the library-path. All external modules are defined
|
||||
as autoload.
|
||||
|
||||
i.e. Procedure ConsolePrintf (p:pchar); cdecl; external 'clib.nlm';
|
||||
sets IMPORT @clib.imp and MODULE clib.
|
||||
|
||||
If you dont have nlmconv, compile gnu-binutils with
|
||||
./configure --enable-targets=i386-linux,i386-netware
|
||||
make all
|
||||
|
||||
Debugging is currently only possible at assembler level with nwdbg, written
|
||||
by Jan Beulich. Nwdbg supports symbols but it's not a source-level
|
||||
debugger. You can get nwdbg from developer.novell.com. To enter the
|
||||
debugger from your program, define "EnterDebugger" as external cdecl and
|
||||
call it. Int3 will not work with Netware 5.
|
||||
|
||||
A sample program:
|
||||
|
||||
Program Hello;
|
||||
(*$DESCRIPTION HelloWorldNlm*)
|
||||
(*$VERSION 1.2.2*)
|
||||
(*$M 8192,8192*)
|
||||
begin
|
||||
writeLn ('hello world');
|
||||
end.
|
||||
|
||||
compile with:
|
||||
ppc386 -Tnetware hello
|
||||
|
||||
ToDo:
|
||||
- No duplicate imports and autoloads
|
||||
- Screen and Thread-Names
|
||||
|
||||
****************************************************************************
|
||||
}
|
||||
unit t_nwm;
|
||||
interface
|
||||
|
||||
uses
|
||||
import,export,link;
|
||||
|
||||
type
|
||||
pimportlibnetware=^timportlibnetware;
|
||||
timportlibnetware=object(timportlib)
|
||||
procedure preparelib(const s:string);virtual;
|
||||
procedure importprocedure(const func,module:string;index:longint;const name:string);virtual;
|
||||
procedure importvariable(const varname,module:string;const name:string);virtual;
|
||||
procedure generatelib;virtual;
|
||||
end;
|
||||
|
||||
pexportlibnetware=^texportlibnetware;
|
||||
texportlibnetware=object(texportlib)
|
||||
procedure preparelib(const s : string);virtual;
|
||||
procedure exportprocedure(hp : pexported_item);virtual;
|
||||
procedure exportvar(hp : pexported_item);virtual;
|
||||
procedure generatelib;virtual;
|
||||
end;
|
||||
|
||||
plinkernetware=^tlinkernetware;
|
||||
tlinkernetware=object(tlinker)
|
||||
private
|
||||
Function WriteResponseFile(isdll:boolean) : Boolean;
|
||||
public
|
||||
constructor Init;
|
||||
procedure SetDefaultInfo;virtual;
|
||||
function MakeExecutable:boolean;virtual;
|
||||
end;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
cutils,verbose,strings,cobjects,systems,globtype,globals,
|
||||
symconst,script,
|
||||
fmodule,aasm,cpuasm,cpubase,symtable{$IFDEF NEWST},symbols{$ENDIF NEWST};
|
||||
|
||||
{*****************************************************************************
|
||||
TIMPORTLIBNETWARE
|
||||
*****************************************************************************}
|
||||
|
||||
procedure timportlibnetware.preparelib(const s : string);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure timportlibnetware.importprocedure(const func,module : string;index : longint;const name : string);
|
||||
begin
|
||||
{ insert sharedlibrary }
|
||||
{$IFDEF NEWST}
|
||||
current_module^.linkothersharedlibs.
|
||||
insert(new(Plinkitem,init(SplitName(module),link_allways)));
|
||||
{ do nothing with the procedure, only set the mangledname }
|
||||
if name<>'' then
|
||||
aktprocdef^.setmangledname(name)
|
||||
else
|
||||
message(parser_e_empty_import_name);
|
||||
{$ELSE}
|
||||
current_module^.linkothersharedlibs.
|
||||
insert(SplitName(module),link_allways);
|
||||
{ do nothing with the procedure, only set the mangledname }
|
||||
if name<>'' then
|
||||
aktprocsym^.definition^.setmangledname(name)
|
||||
else
|
||||
message(parser_e_empty_import_name);
|
||||
{$ENDIF NEWST}
|
||||
end;
|
||||
|
||||
|
||||
procedure timportlibnetware.importvariable(const varname,module:string;const name:string);
|
||||
begin
|
||||
{ insert sharedlibrary }
|
||||
{$IFDEF NEWST}
|
||||
current_module^.linkothersharedlibs.
|
||||
insert(new(Plinkitem,init(SplitName(module),link_allways)));
|
||||
{$ELSE}
|
||||
current_module^.linkothersharedlibs.
|
||||
insert(SplitName(module),link_allways);
|
||||
{$ENDIF NEWST}
|
||||
{ reset the mangledname and turn off the dll_var option }
|
||||
aktvarsym^.setmangledname(name);
|
||||
{$IFDEF NEWST}
|
||||
exclude(aktvarsym^.properties,vo_is_dll_var);
|
||||
{$ELSE}
|
||||
exclude(aktvarsym^.varoptions,vo_is_dll_var);
|
||||
{$ENDIF NEWST}
|
||||
end;
|
||||
|
||||
|
||||
procedure timportlibnetware.generatelib;
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TEXPORTLIBNETWARE
|
||||
*****************************************************************************}
|
||||
|
||||
procedure texportlibnetware.preparelib(const s:string);
|
||||
begin
|
||||
end;
|
||||
|
||||
|
||||
procedure texportlibnetware.exportprocedure(hp : pexported_item);
|
||||
var
|
||||
hp2 : pexported_item;
|
||||
begin
|
||||
{ first test the index value }
|
||||
if (hp^.options and eo_index)<>0 then
|
||||
begin
|
||||
Comment(V_Error,'can''t export with index under netware');
|
||||
exit;
|
||||
end;
|
||||
{ use pascal name is none specified }
|
||||
if (hp^.options and eo_name)=0 then
|
||||
begin
|
||||
hp^.name:=stringdup(hp^.sym^.name);
|
||||
hp^.options:=hp^.options or eo_name;
|
||||
end;
|
||||
{ now place in correct order }
|
||||
hp2:=pexported_item(current_module^._exports^.first);
|
||||
while assigned(hp2) and
|
||||
(hp^.name^>hp2^.name^) do
|
||||
hp2:=pexported_item(hp2^.next);
|
||||
{ insert hp there !! }
|
||||
if assigned(hp2) and (hp2^.name^=hp^.name^) then
|
||||
begin
|
||||
{ this is not allowed !! }
|
||||
Message1(parser_e_export_name_double,hp^.name^);
|
||||
exit;
|
||||
end;
|
||||
if hp2=pexported_item(current_module^._exports^.first) then
|
||||
current_module^._exports^.insert(hp)
|
||||
else if assigned(hp2) then
|
||||
begin
|
||||
hp^.next:=hp2;
|
||||
hp^.previous:=hp2^.previous;
|
||||
if assigned(hp2^.previous) then
|
||||
hp2^.previous^.next:=hp;
|
||||
hp2^.previous:=hp;
|
||||
end
|
||||
else
|
||||
current_module^._exports^.concat(hp);
|
||||
end;
|
||||
|
||||
|
||||
procedure texportlibnetware.exportvar(hp : pexported_item);
|
||||
begin
|
||||
hp^.is_var:=true;
|
||||
exportprocedure(hp);
|
||||
end;
|
||||
|
||||
|
||||
procedure texportlibnetware.generatelib;
|
||||
var
|
||||
hp2 : pexported_item;
|
||||
begin
|
||||
hp2:=pexported_item(current_module^._exports^.first);
|
||||
while assigned(hp2) do
|
||||
begin
|
||||
if not hp2^.is_var then
|
||||
begin
|
||||
{$ifdef i386}
|
||||
{ place jump in codesegment }
|
||||
codesegment^.concat(new(pai_align,init_op(4,$90)));
|
||||
codesegment^.concat(new(pai_symbol,initname_global(hp2^.name^,0)));
|
||||
codesegment^.concat(new(paicpu,op_sym(A_JMP,S_NO,newasmsymbol(hp2^.sym^.mangledname))));
|
||||
codesegment^.concat(new(pai_symbol_end,initname(hp2^.name^)));
|
||||
{$endif i386}
|
||||
end
|
||||
else
|
||||
Comment(V_Error,'Exporting of variables is not supported under netware');
|
||||
hp2:=pexported_item(hp2^.next);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
{*****************************************************************************
|
||||
TLINKERNETWARE
|
||||
*****************************************************************************}
|
||||
|
||||
Constructor TLinkerNetware.Init;
|
||||
begin
|
||||
Inherited Init;
|
||||
end;
|
||||
|
||||
|
||||
procedure TLinkerNetware.SetDefaultInfo;
|
||||
begin
|
||||
with Info do
|
||||
begin
|
||||
ExeCmd[1]:='nlmconv -T$RES';
|
||||
{DllCmd[1]:='ld $OPT -shared -L. -o $EXE $RES';}
|
||||
DllCmd[2]:='strip --strip-unneeded $EXE';
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
Function TLinkerNetware.WriteResponseFile(isdll:boolean) : Boolean;
|
||||
Var
|
||||
linkres : TLinkRes;
|
||||
i : longint;
|
||||
s,s2 : string;
|
||||
found : boolean;
|
||||
ProgNam : string [80];
|
||||
NlmNam : string [80];
|
||||
hp2 : pexported_item; { for exports }
|
||||
begin
|
||||
WriteResponseFile:=False;
|
||||
|
||||
ProgNam := current_module^.exefilename^;
|
||||
i:=Pos(target_os.exeext,ProgNam);
|
||||
if i>0 then
|
||||
Delete(ProgNam,i,255);
|
||||
NlmNam := ProgNam + target_os.exeext;
|
||||
|
||||
{ Open link.res file }
|
||||
LinkRes.Init(outputexedir+Info.ResName);
|
||||
|
||||
if Description <> '' then
|
||||
LinkRes.Add('DESCRIPTION "' + Description + '"');
|
||||
LinkRes.Add('VERSION '+tostr(dllmajor)+','+tostr(dllminor)+','+tostr(dllrevision));
|
||||
LinkRes.Add('SCREENNAME "' + ProgNam + '"'); { for that, we have }
|
||||
LinkRes.Add('THREADNAME "' + ProgNam + '"'); { to add comiler directives }
|
||||
if stacksize > 1024 then
|
||||
begin
|
||||
str (stacksize, s);
|
||||
LinkRes.Add ('STACKSIZE '+s);
|
||||
end;
|
||||
|
||||
{ add objectfiles, start with nwpre always }
|
||||
LinkRes.Add ('INPUT '+FindObjectFile('nwpre',''));
|
||||
|
||||
{ main objectfiles }
|
||||
while not ObjectFiles.Empty do
|
||||
begin
|
||||
s:=ObjectFiles.Get;
|
||||
if s<>'' then
|
||||
LinkRes.Add ('INPUT ' + FindObjectFile (s,''));
|
||||
end;
|
||||
|
||||
{ output file (nlm) }
|
||||
LinkRes.Add ('OUTPUT ' + NlmNam);
|
||||
|
||||
{ start and stop-procedures }
|
||||
LinkRes.Add ('START _Prelude'); { defined in rtl/netware/nwpre.pp }
|
||||
LinkRes.Add ('EXIT _Stop');
|
||||
|
||||
//if not (cs_link_strip in aktglobalswitches) then
|
||||
{ ahhhggg: how do i detect if we have debug-symbols ? }
|
||||
LinkRes.Add ('DEBUG');
|
||||
|
||||
{ Write staticlibraries, is that correct ? }
|
||||
if not StaticLibFiles.Empty then
|
||||
begin
|
||||
While not StaticLibFiles.Empty do
|
||||
begin
|
||||
S:=lower (StaticLibFiles.Get);
|
||||
if s<>'' then
|
||||
begin
|
||||
i:=Pos(target_os.staticlibext,S);
|
||||
if i>0 then
|
||||
Delete(S,i,255);
|
||||
S := S + '.imp';
|
||||
S := librarysearchpath.FindFile(S,found)+S;
|
||||
LinkRes.Add('IMPORT @'+s);
|
||||
end
|
||||
end;
|
||||
end;
|
||||
|
||||
if not SharedLibFiles.Empty then
|
||||
begin
|
||||
While not SharedLibFiles.Empty do
|
||||
begin
|
||||
{becuase of upper/lower case mix, we may get duplicate
|
||||
names but nlmconv ignores that.
|
||||
Here we are setting the import-files for nlmconv. I.e. for
|
||||
the module clib or clib.nlm we add IMPORT @clib.imp and also
|
||||
the module clib.nlm (autoload)
|
||||
? may it be better to set autoload's via StaticLibFiles ? }
|
||||
S:=lower (SharedLibFiles.Get);
|
||||
if s<>'' then
|
||||
begin
|
||||
s2:=s;
|
||||
i:=Pos(target_os.sharedlibext,S);
|
||||
if i>0 then
|
||||
Delete(S,i,255);
|
||||
S := S + '.imp';
|
||||
S := librarysearchpath.FindFile(S,found)+S;
|
||||
LinkRes.Add('IMPORT @'+s);
|
||||
LinkRes.Add('MODULE '+s2);
|
||||
end
|
||||
end;
|
||||
end;
|
||||
|
||||
{ write exports }
|
||||
hp2:=pexported_item(current_module^._exports^.first);
|
||||
while assigned(hp2) do
|
||||
begin
|
||||
if not hp2^.is_var then
|
||||
begin
|
||||
{ Export the Symbol
|
||||
Warning: The Symbol is converted to upper-case if not explicitly
|
||||
specified by >>Exports BlaBla NAME 'BlaBla';<< }
|
||||
Comment(V_Debug,'Exporting '+hp2^.name^);
|
||||
LinkRes.Add ('EXPORT '+hp2^.name^);
|
||||
end
|
||||
else
|
||||
{ really ? }
|
||||
Comment(V_Error,'Exporting of variables is not supported under netware');
|
||||
hp2:=pexported_item(hp2^.next);
|
||||
end;
|
||||
|
||||
{ Write and Close response }
|
||||
linkres.writetodisk;
|
||||
linkres.done;
|
||||
|
||||
WriteResponseFile:=True;
|
||||
end;
|
||||
|
||||
|
||||
function TLinkerNetware.MakeExecutable:boolean;
|
||||
var
|
||||
binstr,
|
||||
cmdstr : string;
|
||||
success : boolean;
|
||||
DynLinkStr : string[60];
|
||||
StaticStr,
|
||||
StripStr : string[40];
|
||||
begin
|
||||
if not(cs_link_extern in aktglobalswitches) then
|
||||
Message1(exec_i_linking,current_module^.exefilename^);
|
||||
|
||||
{ Create some replacements }
|
||||
StaticStr:='';
|
||||
StripStr:='';
|
||||
DynLinkStr:='';
|
||||
|
||||
{ Write used files and libraries }
|
||||
WriteResponseFile(false);
|
||||
|
||||
{ Call linker }
|
||||
SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
|
||||
Replace(cmdstr,'$EXE',current_module^.exefilename^);
|
||||
Replace(cmdstr,'$OPT',Info.ExtraOptions);
|
||||
Replace(cmdstr,'$RES',outputexedir+Info.ResName);
|
||||
Replace(cmdstr,'$STATIC',StaticStr);
|
||||
Replace(cmdstr,'$STRIP',StripStr);
|
||||
Replace(cmdstr,'$DYNLINK',DynLinkStr);
|
||||
success:=DoExec(FindUtil(BinStr),CmdStr,true,false);
|
||||
|
||||
{ Remove ReponseFile }
|
||||
if (success) and not(cs_link_extern in aktglobalswitches) then
|
||||
RemoveFile(outputexedir+Info.ResName);
|
||||
|
||||
MakeExecutable:=success; { otherwise a recursive call to link method }
|
||||
end;
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 2000-09-11 17:00:23 florian
|
||||
+ first implementation of Netware Module support, thanks to
|
||||
Armin Diehl (diehl@nordrhein.de) for providing the patches
|
||||
|
||||
}
|
Loading…
Reference in New Issue
Block a user