mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-06 11:10:17 +02:00
+ support for dll variables
This commit is contained in:
peter
parent
cdd4a7a793
commit
b4045fe57e
@ -71,6 +71,7 @@ implementation
|
||||
varsym :
|
||||
begin
|
||||
hregister:=R_NO;
|
||||
{ C variable }
|
||||
if (pvarsym(p^.symtableentry)^.var_options and vo_is_C_var)<>0 then
|
||||
begin
|
||||
stringdispose(p^.location.reference.symbol);
|
||||
@ -78,6 +79,18 @@ implementation
|
||||
if (pvarsym(p^.symtableentry)^.var_options and vo_is_external)<>0 then
|
||||
maybe_concat_external(p^.symtableentry^.owner,p^.symtableentry^.mangledname);
|
||||
end
|
||||
{ DLL variable }
|
||||
else if (pvarsym(p^.symtableentry)^.var_options and vo_is_dll_var)<>0 then
|
||||
begin
|
||||
hregister:=getregister32;
|
||||
stringdispose(p^.location.reference.symbol);
|
||||
p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.location.reference),hregister)));
|
||||
stringdispose(p^.location.reference.symbol);
|
||||
p^.location.reference.base:=hregister;
|
||||
if (pvarsym(p^.symtableentry)^.var_options and vo_is_external)<>0 then
|
||||
maybe_concat_external(p^.symtableentry^.owner,p^.symtableentry^.mangledname);
|
||||
end
|
||||
else
|
||||
begin
|
||||
symtabletype:=p^.symtable^.symtabletype;
|
||||
@ -679,7 +692,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.33 1998-11-27 14:50:33 peter
|
||||
Revision 1.34 1998-11-28 16:20:48 peter
|
||||
+ support for dll variables
|
||||
|
||||
Revision 1.33 1998/11/27 14:50:33 peter
|
||||
+ open strings, $P switch support
|
||||
|
||||
Revision 1.32 1998/11/26 09:53:36 florian
|
||||
|
||||
@ -26,19 +26,22 @@ uses
|
||||
cobjects;
|
||||
|
||||
type
|
||||
pimported_procedure = ^timported_procedure;
|
||||
timported_procedure = object(tlinkedlist_item)
|
||||
ordnr : word;
|
||||
name,func : pstring;
|
||||
lab : pointer; { should be plabel, but this gaves problems with circular units }
|
||||
pimported_item = ^timported_item;
|
||||
timported_item = object(tlinkedlist_item)
|
||||
ordnr : word;
|
||||
name,
|
||||
func : pstring;
|
||||
lab : pointer; { should be plabel, but this gaves problems with circular units }
|
||||
is_var : boolean;
|
||||
constructor init(const n,s : string;o : word);
|
||||
constructor init_var(const n,s : string);
|
||||
destructor done;virtual;
|
||||
end;
|
||||
|
||||
pimportlist = ^timportlist;
|
||||
timportlist = object(tlinkedlist_item)
|
||||
dllname : pstring;
|
||||
imported_procedures : plinkedlist;
|
||||
imported_items : plinkedlist;
|
||||
constructor init(const n : string);
|
||||
destructor done;virtual;
|
||||
end;
|
||||
@ -49,6 +52,7 @@ type
|
||||
destructor Done;
|
||||
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;
|
||||
|
||||
@ -70,20 +74,32 @@ uses
|
||||
;
|
||||
|
||||
{****************************************************************************
|
||||
TImported_procedure
|
||||
Timported_item
|
||||
****************************************************************************}
|
||||
|
||||
constructor timported_procedure.init(const n,s : string;o : word);
|
||||
constructor timported_item.init(const n,s : string;o : word);
|
||||
begin
|
||||
inherited init;
|
||||
func:=stringdup(n);
|
||||
name:=stringdup(s);
|
||||
ordnr:=o;
|
||||
lab:=nil;
|
||||
is_var:=false;
|
||||
end;
|
||||
|
||||
|
||||
destructor timported_procedure.done;
|
||||
constructor timported_item.init_var(const n,s : string);
|
||||
begin
|
||||
inherited init;
|
||||
func:=stringdup(n);
|
||||
name:=stringdup(s);
|
||||
ordnr:=0;
|
||||
lab:=nil;
|
||||
is_var:=true;
|
||||
end;
|
||||
|
||||
|
||||
destructor timported_item.done;
|
||||
begin
|
||||
stringdispose(name);
|
||||
inherited done;
|
||||
@ -98,13 +114,13 @@ constructor timportlist.init(const n : string);
|
||||
begin
|
||||
inherited init;
|
||||
dllname:=stringdup(n);
|
||||
imported_procedures:=new(plinkedlist,init);
|
||||
imported_items:=new(plinkedlist,init);
|
||||
end;
|
||||
|
||||
|
||||
destructor timportlist.done;
|
||||
begin
|
||||
dispose(imported_procedures,done);
|
||||
dispose(imported_items,done);
|
||||
stringdispose(dllname);
|
||||
end;
|
||||
|
||||
@ -135,6 +151,12 @@ begin
|
||||
end;
|
||||
|
||||
|
||||
procedure timportlib.importvariable(const varname,module:string;const name:string);
|
||||
begin
|
||||
Message(exec_e_dll_not_supported);
|
||||
end;
|
||||
|
||||
|
||||
procedure timportlib.generatelib;
|
||||
begin
|
||||
Message(exec_e_dll_not_supported);
|
||||
@ -172,7 +194,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 1998-10-19 18:07:12 peter
|
||||
Revision 1.9 1998-11-28 16:20:50 peter
|
||||
+ support for dll variables
|
||||
|
||||
Revision 1.8 1998/10/19 18:07:12 peter
|
||||
+ external dll_name name func support for linux
|
||||
|
||||
Revision 1.7 1998/10/19 15:41:02 peter
|
||||
|
||||
@ -31,6 +31,7 @@ interface
|
||||
timportliblinux=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;
|
||||
|
||||
@ -56,6 +57,16 @@ implementation
|
||||
end;
|
||||
|
||||
|
||||
procedure timportliblinux.importvariable(const varname,module:string;const name:string);
|
||||
begin
|
||||
{ insert sharedlibrary }
|
||||
current_module^.linksharedlibs.insert(SplitName(module));
|
||||
{ reset the mangledname and turn off the dll_var option }
|
||||
aktvarsym^.setmangledname(name);
|
||||
aktvarsym^.var_options:=aktvarsym^.var_options and (not vo_is_dll_var);
|
||||
end;
|
||||
|
||||
|
||||
procedure timportliblinux.generatelib;
|
||||
begin
|
||||
end;
|
||||
@ -64,7 +75,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.1 1998-10-19 18:07:13 peter
|
||||
Revision 1.2 1998-11-28 16:20:51 peter
|
||||
+ support for dll variables
|
||||
|
||||
Revision 1.1 1998/10/19 18:07:13 peter
|
||||
+ external dll_name name func support for linux
|
||||
|
||||
}
|
||||
|
||||
@ -56,7 +56,7 @@ unit pdecl;
|
||||
|
||||
uses
|
||||
cobjects,scanner,aasm,tree,pass_1,
|
||||
files,types,hcodegen,verbose,systems
|
||||
files,types,hcodegen,verbose,systems,import
|
||||
{$ifdef GDB}
|
||||
,gdb
|
||||
{$endif GDB}
|
||||
@ -76,7 +76,7 @@ unit pdecl;
|
||||
{ search in symtablestack used, but not defined type }
|
||||
procedure testforward_type(p : psym);{$ifndef FPC}far;{$endif}
|
||||
var
|
||||
recsymtable : psymtable;
|
||||
reaktvarsymtable : psymtable;
|
||||
oldaktfilepos : tfileposinfo;
|
||||
begin
|
||||
if not(p^.typ=typesym) then
|
||||
@ -95,13 +95,13 @@ unit pdecl;
|
||||
if (ptypesym(p)^.definition^.deftype in [recorddef,objectdef]) then
|
||||
begin
|
||||
if (ptypesym(p)^.definition^.deftype=recorddef) then
|
||||
recsymtable:=precdef(ptypesym(p)^.definition)^.symtable
|
||||
reaktvarsymtable:=precdef(ptypesym(p)^.definition)^.symtable
|
||||
else
|
||||
recsymtable:=pobjectdef(ptypesym(p)^.definition)^.publicsyms;
|
||||
reaktvarsymtable:=pobjectdef(ptypesym(p)^.definition)^.publicsyms;
|
||||
{$ifdef tp}
|
||||
recsymtable^.foreach(testforward_type);
|
||||
reaktvarsymtable^.foreach(testforward_type);
|
||||
{$else}
|
||||
recsymtable^.foreach(@testforward_type);
|
||||
reaktvarsymtable^.foreach(@testforward_type);
|
||||
{$endif}
|
||||
end;
|
||||
end;
|
||||
@ -258,9 +258,10 @@ unit pdecl;
|
||||
l : longint;
|
||||
code : word;
|
||||
{ c var }
|
||||
Csym : pvarsym;
|
||||
newtype : ptypesym;
|
||||
is_gpc_name,is_cdecl,extern_Csym,export_Csym : boolean;
|
||||
is_dll,
|
||||
is_gpc_name,is_cdecl,extern_aktvarsym,export_aktvarsym : boolean;
|
||||
dll_name,
|
||||
C_name : string;
|
||||
{ case }
|
||||
p,casedef : pdef;
|
||||
@ -303,11 +304,11 @@ unit pdecl;
|
||||
if not sc^.empty then
|
||||
Message(parser_e_absolute_only_one_var);
|
||||
dispose(sc,done);
|
||||
Csym:=new(pvarsym,init_C(s,target_os.Cprefix+C_name,p));
|
||||
aktvarsym:=new(pvarsym,init_C(s,target_os.Cprefix+C_name,p));
|
||||
tokenpos:=storetokenpos;
|
||||
Csym^.var_options:=Csym^.var_options or vo_is_external;
|
||||
externals^.concat(new(pai_external,init(Csym^.mangledname,EXT_NEAR)));
|
||||
symtablestack^.insert(Csym);
|
||||
aktvarsym^.var_options:=aktvarsym^.var_options or vo_is_external;
|
||||
externals^.concat(new(pai_external,init(aktvarsym^.mangledname,EXT_NEAR)));
|
||||
symtablestack^.insert(aktvarsym);
|
||||
symdone:=true;
|
||||
end;
|
||||
{ check for absolute }
|
||||
@ -412,9 +413,10 @@ unit pdecl;
|
||||
Message(parser_e_absolute_only_one_var);
|
||||
dispose(sc,done);
|
||||
{ defaults }
|
||||
is_dll:=false;
|
||||
is_cdecl:=false;
|
||||
extern_csym:=false;
|
||||
export_Csym:=false;
|
||||
extern_aktvarsym:=false;
|
||||
export_aktvarsym:=false;
|
||||
{ cdecl }
|
||||
if idtoken=_CVAR then
|
||||
begin
|
||||
@ -427,20 +429,27 @@ unit pdecl;
|
||||
if idtoken=_EXTERNAL then
|
||||
begin
|
||||
consume(_EXTERNAL);
|
||||
extern_csym:=true;
|
||||
extern_aktvarsym:=true;
|
||||
end;
|
||||
{ export }
|
||||
if idtoken in [_EXPORT,_PUBLIC] then
|
||||
begin
|
||||
consume(ID);
|
||||
if extern_csym then
|
||||
if extern_aktvarsym then
|
||||
Message(parser_e_not_external_and_export)
|
||||
else
|
||||
export_Csym:=true;
|
||||
export_aktvarsym:=true;
|
||||
end;
|
||||
{ external and export need a name after when no cdecl is used }
|
||||
if not is_cdecl then
|
||||
begin
|
||||
{ dll name ? }
|
||||
if (extern_aktvarsym) and (token=CSTRING) then
|
||||
begin
|
||||
is_dll:=true;
|
||||
dll_name:=pattern;
|
||||
consume(CSTRING);
|
||||
end;
|
||||
consume(_NAME);
|
||||
C_name:=pattern;
|
||||
{ allow also char }
|
||||
@ -450,22 +459,39 @@ unit pdecl;
|
||||
consume(CSTRING);
|
||||
end;
|
||||
{ consume the ; when export or external is used }
|
||||
if extern_csym or export_csym then
|
||||
if extern_aktvarsym or export_aktvarsym then
|
||||
consume(SEMICOLON);
|
||||
{ insert in the symtable }
|
||||
storetokenpos:=tokenpos;
|
||||
tokenpos:=declarepos;
|
||||
Csym:=new(pvarsym,init_C(s,C_name,p));
|
||||
if is_dll then
|
||||
aktvarsym:=new(pvarsym,init_dll(s,p))
|
||||
else
|
||||
aktvarsym:=new(pvarsym,init_C(s,C_name,p));
|
||||
tokenpos:=storetokenpos;
|
||||
if export_Csym then
|
||||
inc(Csym^.refs);
|
||||
if extern_Csym then
|
||||
{ set some vars options }
|
||||
if export_aktvarsym then
|
||||
inc(aktvarsym^.refs);
|
||||
if extern_aktvarsym then
|
||||
aktvarsym^.var_options:=aktvarsym^.var_options or vo_is_external;
|
||||
{ insert in the stack/datasegment }
|
||||
symtablestack^.insert(aktvarsym);
|
||||
{ now we can insert it in the import lib if its a dll, or
|
||||
add it to the externals }
|
||||
if extern_aktvarsym then
|
||||
begin
|
||||
Csym^.var_options:=Csym^.var_options or vo_is_external;
|
||||
{ correct type ?? }
|
||||
externals^.concat(new(pai_external,init(Csym^.mangledname,EXT_NEAR)));
|
||||
if is_dll then
|
||||
begin
|
||||
if not(current_module^.uses_imports) then
|
||||
begin
|
||||
current_module^.uses_imports:=true;
|
||||
importlib^.preparelib(current_module^.modulename^);
|
||||
end;
|
||||
importlib^.importvariable(aktvarsym^.mangledname,dll_name,C_name)
|
||||
end
|
||||
else
|
||||
externals^.concat(new(pai_external,init(aktvarsym^.mangledname,EXT_NEAR)));
|
||||
end;
|
||||
symtablestack^.insert(Csym);
|
||||
symdone:=true;
|
||||
end
|
||||
else
|
||||
@ -1037,7 +1063,7 @@ unit pdecl;
|
||||
hs : string;
|
||||
pcrd : pclassrefdef;
|
||||
hp1 : pdef;
|
||||
oldprocsym : Pprocsym;
|
||||
oldprocsym : pprocsym;
|
||||
oldparse_only : boolean;
|
||||
classnamelabel : plabel;
|
||||
storetypeforwardsallowed : boolean;
|
||||
@ -2097,7 +2123,10 @@ unit pdecl;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.85 1998-11-27 14:34:43 peter
|
||||
Revision 1.86 1998-11-28 16:20:52 peter
|
||||
+ support for dll variables
|
||||
|
||||
Revision 1.85 1998/11/27 14:34:43 peter
|
||||
* give error when string[0] decl is found
|
||||
|
||||
Revision 1.84 1998/11/17 10:40:15 peter
|
||||
|
||||
@ -163,7 +163,7 @@ unit pmodules;
|
||||
{ Generate an external entry to be sure that _mainCRTStarup will be
|
||||
linked, can't use concat_external because those aren't written for
|
||||
asw (PFV) }
|
||||
datasegment^.concat(new(pai_const,init_symbol('_mainCRTStartup')));
|
||||
datasegment^.concat(new(pai_const,init_symbol(strpnew('_mainCRTStartup'))));
|
||||
end;
|
||||
{$endif i386}
|
||||
{$ifdef m68k}
|
||||
@ -1099,7 +1099,7 @@ unit pmodules;
|
||||
|
||||
if islibrary then
|
||||
exportlib^.generatelib;
|
||||
|
||||
|
||||
{ insert heap }
|
||||
insertheap;
|
||||
|
||||
@ -1132,7 +1132,10 @@ unit pmodules;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.84 1998-11-18 09:18:03 pierre
|
||||
Revision 1.85 1998-11-28 16:20:54 peter
|
||||
+ support for dll variables
|
||||
|
||||
Revision 1.84 1998/11/18 09:18:03 pierre
|
||||
+ automatic loading of profile unit with -pg option
|
||||
in go32v2 mode (also defines FPC_PROFILE)
|
||||
* some memory leaks removed
|
||||
|
||||
@ -770,6 +770,7 @@
|
||||
if read_member then
|
||||
writelong(address);
|
||||
writedefref(definition);
|
||||
writebyte(var_options and (not vo_regable));
|
||||
writebyte(byte(abstyp));
|
||||
case abstyp of
|
||||
tovar : writestring(ref^.name);
|
||||
@ -857,12 +858,32 @@
|
||||
reg:=R_NO;
|
||||
end;
|
||||
|
||||
constructor tvarsym.load;
|
||||
|
||||
constructor tvarsym.init_dll(const n : string;p : pdef);
|
||||
begin
|
||||
{ The tvarsym is necessary for 0.99.5 (PFV) }
|
||||
tvarsym.init(n,p);
|
||||
var_options:=var_options or vo_is_dll_var;
|
||||
end;
|
||||
|
||||
|
||||
constructor tvarsym.init_C(const n,mangled : string;p : pdef);
|
||||
begin
|
||||
{ The tvarsym is necessary for 0.99.5 (PFV) }
|
||||
tvarsym.init(n,p);
|
||||
var_options:=var_options or vo_is_C_var;
|
||||
setmangledname(mangled);
|
||||
end;
|
||||
|
||||
|
||||
constructor tvarsym.load;
|
||||
begin
|
||||
tsym.load;
|
||||
typ:=varsym;
|
||||
_mangledname:=nil;
|
||||
reg:=R_NO;
|
||||
refs := 0;
|
||||
is_valid := 1;
|
||||
varspez:=tvarspez(readbyte);
|
||||
if read_member then
|
||||
address:=readlong
|
||||
@ -873,60 +894,37 @@
|
||||
islocalcopy:=false;
|
||||
{$endif}
|
||||
definition:=readdefref;
|
||||
refs := 0;
|
||||
is_valid := 1;
|
||||
{ symbols which are load are never candidates for a register }
|
||||
var_options:=0;
|
||||
{ was regable:=false; }
|
||||
reg:=R_NO;
|
||||
end;
|
||||
|
||||
constructor tvarsym.init_C(const n,mangled : string;p : pdef);
|
||||
|
||||
begin
|
||||
{ The tvarsym is necessary for 0.99.5 (PFV) }
|
||||
tvarsym.init(n,p);
|
||||
var_options:=var_options or vo_is_C_var;
|
||||
{ C prefix not allways added moved to
|
||||
pdecl PM }
|
||||
_mangledname:=strpnew(mangled);
|
||||
end;
|
||||
|
||||
constructor tvarsym.load_C;
|
||||
|
||||
begin
|
||||
{ Adding tvarsym removes the warning }
|
||||
tvarsym.load;
|
||||
typ:=varsym;
|
||||
var_options:=readbyte;
|
||||
_mangledname:=strpnew(readstring);
|
||||
if (var_options and vo_is_C_var)<>0 then
|
||||
setmangledname(readstring);
|
||||
end;
|
||||
|
||||
|
||||
procedure tvarsym.deref;
|
||||
|
||||
begin
|
||||
resolvedef(definition);
|
||||
end;
|
||||
|
||||
procedure tvarsym.write;
|
||||
|
||||
procedure tvarsym.write;
|
||||
begin
|
||||
tsym.write;
|
||||
writebyte(byte(varspez));
|
||||
|
||||
if read_member then
|
||||
writelong(address);
|
||||
|
||||
writedefref(definition);
|
||||
{ symbols which are load are never candidates for a register,
|
||||
turn of the regable }
|
||||
writebyte(var_options and (not vo_regable));
|
||||
if (var_options and vo_is_C_var)<>0 then
|
||||
begin
|
||||
writebyte(var_options);
|
||||
writestring(mangledname);
|
||||
end;
|
||||
if (var_options and vo_is_C_var)<>0 then
|
||||
current_ppu^.writeentry(ibvarsym_C)
|
||||
else
|
||||
current_ppu^.writeentry(ibvarsym);
|
||||
writestring(mangledname);
|
||||
current_ppu^.writeentry(ibvarsym);
|
||||
end;
|
||||
|
||||
|
||||
procedure tvarsym.setmangledname(const s : string);
|
||||
begin
|
||||
_mangledname:=strpnew(s);
|
||||
end;
|
||||
|
||||
|
||||
@ -952,6 +950,7 @@
|
||||
mangledname:=prefix+name;
|
||||
end;
|
||||
|
||||
|
||||
{$ifndef VALUEPARA}
|
||||
function tvarsym.getsize : longint;
|
||||
begin
|
||||
@ -1804,7 +1803,10 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.62 1998-11-27 14:50:48 peter
|
||||
Revision 1.63 1998-11-28 16:20:56 peter
|
||||
+ support for dll variables
|
||||
|
||||
Revision 1.62 1998/11/27 14:50:48 peter
|
||||
+ open strings, $P switch support
|
||||
|
||||
Revision 1.61 1998/11/18 15:44:18 peter
|
||||
|
||||
@ -185,18 +185,19 @@
|
||||
varspez : tvarspez; { sets the type of access }
|
||||
is_valid : byte;
|
||||
constructor init(const n : string;p : pdef);
|
||||
constructor load;
|
||||
constructor init_dll(const n : string;p : pdef);
|
||||
constructor init_C(const n,mangled : string;p : pdef);
|
||||
constructor load_C;
|
||||
constructor load;
|
||||
destructor done;virtual;
|
||||
function mangledname : string;virtual;
|
||||
procedure insert_in_data;virtual;
|
||||
function getsize : longint;
|
||||
{$ifdef VALUEPARA}
|
||||
function getpushsize : longint;
|
||||
{$endif}
|
||||
procedure write;virtual;
|
||||
procedure deref;virtual;
|
||||
procedure setmangledname(const s : string);
|
||||
function mangledname : string;virtual;
|
||||
procedure insert_in_data;virtual;
|
||||
function getsize : longint;
|
||||
{$ifdef VALUEPARA}
|
||||
function getpushsize : longint;
|
||||
{$endif}
|
||||
{$ifdef GDB}
|
||||
function stabstring : pchar;virtual;
|
||||
procedure concatstabto(asmlist : paasmoutput);virtual;
|
||||
@ -326,7 +327,10 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 1998-11-18 15:44:19 peter
|
||||
Revision 1.9 1998-11-28 16:20:57 peter
|
||||
+ support for dll variables
|
||||
|
||||
Revision 1.8 1998/11/18 15:44:19 peter
|
||||
* VALUEPARA for tp7 compatible value parameters
|
||||
|
||||
Revision 1.7 1998/11/16 10:13:50 peter
|
||||
|
||||
@ -32,6 +32,7 @@ unit win_targ;
|
||||
timportlibwin32=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;
|
||||
procedure generatesmartlib;
|
||||
end;
|
||||
@ -130,10 +131,9 @@ unit win_targ;
|
||||
end;
|
||||
|
||||
procedure timportlibwin32.importprocedure(const func,module : string;index : longint;const name : string);
|
||||
|
||||
var
|
||||
hp1 : pimportlist;
|
||||
hp2 : pimported_procedure;
|
||||
hp2 : pimported_item;
|
||||
hs : string;
|
||||
begin
|
||||
hs:=SplitName(module);
|
||||
@ -151,15 +151,41 @@ unit win_targ;
|
||||
hp1:=new(pimportlist,init(hs));
|
||||
current_module^.imports^.concat(hp1);
|
||||
end;
|
||||
hp2:=new(pimported_procedure,init(func,name,index));
|
||||
hp1^.imported_procedures^.concat(hp2);
|
||||
hp2:=new(pimported_item,init(func,name,index));
|
||||
hp1^.imported_items^.concat(hp2);
|
||||
end;
|
||||
|
||||
|
||||
procedure timportlibwin32.importvariable(const varname,module:string;const name:string);
|
||||
var
|
||||
hp1 : pimportlist;
|
||||
hp2 : pimported_item;
|
||||
hs : string;
|
||||
begin
|
||||
hs:=SplitName(module);
|
||||
{ search for the module }
|
||||
hp1:=pimportlist(current_module^.imports^.first);
|
||||
while assigned(hp1) do
|
||||
begin
|
||||
if hs=hp1^.dllname^ then
|
||||
break;
|
||||
hp1:=pimportlist(hp1^.next);
|
||||
end;
|
||||
{ generate a new item ? }
|
||||
if not(assigned(hp1)) then
|
||||
begin
|
||||
hp1:=new(pimportlist,init(hs));
|
||||
current_module^.imports^.concat(hp1);
|
||||
end;
|
||||
hp2:=new(pimported_item,init_var(varname,name));
|
||||
hp1^.imported_items^.concat(hp2);
|
||||
end;
|
||||
|
||||
|
||||
procedure timportlibwin32.generatesmartlib;
|
||||
var
|
||||
hp1 : pimportlist;
|
||||
hp2 : pimported_procedure;
|
||||
hp2 : pimported_item;
|
||||
lhead,lname,lcode,
|
||||
lidata4,lidata5 : plabel;
|
||||
r : preference;
|
||||
@ -209,26 +235,29 @@ unit win_targ;
|
||||
importssection^.concat(new(pai_string,init(hp1^.dllname^+target_os.sharedlibext+#0)));
|
||||
|
||||
{ create procedures }
|
||||
hp2:=pimported_procedure(hp1^.imported_procedures^.first);
|
||||
hp2:=pimported_item(hp1^.imported_items^.first);
|
||||
while assigned(hp2) do
|
||||
begin
|
||||
{ insert cuts }
|
||||
importssection^.concat(new(pai_cut,init));
|
||||
{ create indirect jump }
|
||||
getlabel(lcode);
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.symbol:=stringdup(lab2str(lcode));
|
||||
{ place jump in codesegment, insert a code section in the
|
||||
importsection to reduce the amount of .s files (PFV) }
|
||||
importssection^.concat(new(pai_section,init(sec_code)));
|
||||
if not hp2^.is_var then
|
||||
begin
|
||||
getlabel(lcode);
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.symbol:=stringdup(lab2str(lcode));
|
||||
{ place jump in codesegment, insert a code section in the
|
||||
importsection to reduce the amount of .s files (PFV) }
|
||||
importssection^.concat(new(pai_section,init(sec_code)));
|
||||
{$IfDef GDB}
|
||||
if (cs_debuginfo in aktmoduleswitches) then
|
||||
importssection^.concat(new(pai_stab_function_name,init(nil)));
|
||||
if (cs_debuginfo in aktmoduleswitches) then
|
||||
importssection^.concat(new(pai_stab_function_name,init(nil)));
|
||||
{$EndIf GDB}
|
||||
importssection^.concat(new(pai_align,init_op(4,$90)));
|
||||
importssection^.concat(new(pai_symbol,init_global(hp2^.func^)));
|
||||
importssection^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
|
||||
importssection^.concat(new(pai_align,init_op(4,$90)));
|
||||
importssection^.concat(new(pai_symbol,init_global(hp2^.func^)));
|
||||
importssection^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
|
||||
end;
|
||||
{ create head link }
|
||||
importssection^.concat(new(pai_section,init_idata(7)));
|
||||
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(lhead)))));
|
||||
@ -238,7 +267,10 @@ unit win_targ;
|
||||
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
|
||||
{ add jump field to importsection }
|
||||
importssection^.concat(new(pai_section,init_idata(5)));
|
||||
importssection^.concat(new(pai_label,init(lcode)));
|
||||
if hp2^.is_var then
|
||||
importssection^.concat(new(pai_symbol,init_global(hp2^.func^)))
|
||||
else
|
||||
importssection^.concat(new(pai_label,init(lcode)));
|
||||
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
|
||||
{ finally the import information }
|
||||
importssection^.concat(new(pai_section,init_idata(6)));
|
||||
@ -246,7 +278,7 @@ unit win_targ;
|
||||
importssection^.concat(new(pai_const,init_16bit(hp2^.ordnr)));
|
||||
importssection^.concat(new(pai_string,init(hp2^.name^+#0)));
|
||||
|
||||
hp2:=pimported_procedure(hp2^.next);
|
||||
hp2:=pimported_item(hp2^.next);
|
||||
end;
|
||||
hp1:=pimportlist(hp1^.next);
|
||||
end;
|
||||
@ -256,7 +288,7 @@ unit win_targ;
|
||||
procedure timportlibwin32.generatelib;
|
||||
var
|
||||
hp1 : pimportlist;
|
||||
hp2 : pimported_procedure;
|
||||
hp2 : pimported_item;
|
||||
l1,l2,l3,l4 : plabel;
|
||||
r : preference;
|
||||
begin
|
||||
@ -302,12 +334,12 @@ unit win_targ;
|
||||
importssection^.concat(new(pai_section,init_idata(4)));
|
||||
importssection^.concat(new(pai_label,init(l2)));
|
||||
|
||||
hp2:=pimported_procedure(hp1^.imported_procedures^.first);
|
||||
hp2:=pimported_item(hp1^.imported_items^.first);
|
||||
while assigned(hp2) do
|
||||
begin
|
||||
getlabel(plabel(hp2^.lab));
|
||||
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
|
||||
hp2:=pimported_procedure(hp2^.next);
|
||||
hp2:=pimported_item(hp2^.next);
|
||||
end;
|
||||
{ finalize the names ... }
|
||||
importssection^.concat(new(pai_const,init_32bit(0)));
|
||||
@ -315,36 +347,43 @@ unit win_targ;
|
||||
{ then the addresses and create also the indirect jump }
|
||||
importssection^.concat(new(pai_section,init_idata(5)));
|
||||
importssection^.concat(new(pai_label,init(l3)));
|
||||
hp2:=pimported_procedure(hp1^.imported_procedures^.first);
|
||||
hp2:=pimported_item(hp1^.imported_items^.first);
|
||||
while assigned(hp2) do
|
||||
begin
|
||||
getdatalabel(l4);
|
||||
{ create indirect jump }
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.symbol:=stringdup(lab2str(l4));
|
||||
{ place jump in codesegment }
|
||||
codesegment^.concat(new(pai_align,init_op(4,$90)));
|
||||
codesegment^.concat(new(pai_symbol,init_global(hp2^.func^)));
|
||||
codesegment^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
|
||||
{ add jump field to importsection }
|
||||
importssection^.concat(new(pai_label,init(l4)));
|
||||
if not hp2^.is_var then
|
||||
begin
|
||||
getdatalabel(l4);
|
||||
{ create indirect jump }
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.symbol:=stringdup(lab2str(l4));
|
||||
{ place jump in codesegment }
|
||||
codesegment^.concat(new(pai_align,init_op(4,$90)));
|
||||
codesegment^.concat(new(pai_symbol,init_global(hp2^.func^)));
|
||||
codesegment^.concat(new(pai386,op_ref(A_JMP,S_NO,r)));
|
||||
{ add jump field to importsection }
|
||||
importssection^.concat(new(pai_label,init(l4)));
|
||||
end
|
||||
else
|
||||
begin
|
||||
importssection^.concat(new(pai_symbol,init_global(hp2^.func^)));
|
||||
end;
|
||||
importssection^.concat(new(pai_const,init_rva(strpnew(lab2str(hp2^.lab)))));
|
||||
hp2:=pimported_procedure(hp2^.next);
|
||||
hp2:=pimported_item(hp2^.next);
|
||||
end;
|
||||
{ finalize the addresses }
|
||||
importssection^.concat(new(pai_const,init_32bit(0)));
|
||||
|
||||
{ finally the import information }
|
||||
importssection^.concat(new(pai_section,init_idata(6)));
|
||||
hp2:=pimported_procedure(hp1^.imported_procedures^.first);
|
||||
hp2:=pimported_item(hp1^.imported_items^.first);
|
||||
while assigned(hp2) do
|
||||
begin
|
||||
importssection^.concat(new(pai_label,init(hp2^.lab)));
|
||||
{ the ordinal number }
|
||||
importssection^.concat(new(pai_const,init_16bit(hp2^.ordnr)));
|
||||
importssection^.concat(new(pai_string,init(hp2^.name^+#0)));
|
||||
hp2:=pimported_procedure(hp2^.next);
|
||||
hp2:=pimported_item(hp2^.next);
|
||||
end;
|
||||
{ create import dll name }
|
||||
importssection^.concat(new(pai_section,init_idata(7)));
|
||||
@ -411,25 +450,27 @@ unit win_targ;
|
||||
peheaderpos : longint;
|
||||
|
||||
begin
|
||||
{ when -s is used quit, because there is no .exe }
|
||||
if cs_link_extern in aktglobalswitches then
|
||||
exit;
|
||||
{ open file }
|
||||
assign(f,n);
|
||||
{$i-}
|
||||
reset(f,1);
|
||||
{$I-}
|
||||
reset(f,1);
|
||||
if ioresult<>0 then
|
||||
Message1(execinfo_f_cant_open_executable,n);
|
||||
{ read headers }
|
||||
blockread(f,dosheader,sizeof(tdosheader));
|
||||
peheaderpos:=dosheader.e_lfanew;
|
||||
seek(f,peheaderpos);
|
||||
blockread(f,peheader,sizeof(tpeheader));
|
||||
|
||||
{ write info }
|
||||
Message1(execinfo_x_codesize,tostr(peheader.SizeOfCode));
|
||||
Message1(execinfo_x_initdatasize,tostr(peheader.SizeOfInitializedData));
|
||||
Message1(execinfo_x_uninitdatasize,tostr(peheader.SizeOfUninitializedData));
|
||||
Message1(execinfo_x_stackreserve,tostr(peheader.SizeOfStackReserve));
|
||||
Message1(execinfo_x_stackcommit,tostr(peheader.SizeOfStackCommit));
|
||||
|
||||
{ change the header }
|
||||
|
||||
{ sub system }
|
||||
{ gui=2 }
|
||||
{ cui=3 }
|
||||
@ -442,12 +483,16 @@ unit win_targ;
|
||||
close(f);
|
||||
if ioresult<>0 then
|
||||
Message1(execinfo_f_cant_process_executable,n);
|
||||
{$I+}
|
||||
end;
|
||||
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.13 1998-10-29 11:35:54 florian
|
||||
Revision 1.14 1998-11-28 16:21:00 peter
|
||||
+ support for dll variables
|
||||
|
||||
Revision 1.13 1998/10/29 11:35:54 florian
|
||||
* some dll support for win32
|
||||
* fixed assembler writing for PalmOS
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user