mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-06-28 22:08:23 +02:00
320 lines
15 KiB
ObjectPascal
320 lines
15 KiB
ObjectPascal
{
|
|
$Id$
|
|
Copyright (C) 1993-99 by Florian Klaempfl
|
|
|
|
This unit implements load nodes etc.
|
|
|
|
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 nmem;
|
|
|
|
interface
|
|
|
|
uses
|
|
tree,symtable;
|
|
|
|
type
|
|
ploadnode = ^tloadnode;
|
|
tloadnode = object(tnode)
|
|
symtableentry : psym;
|
|
symtable : psymtable;
|
|
is_absolute,is_first,is_methodpointer : boolean;
|
|
constructor init(v : pvarsym;st : psymtable);
|
|
destructor done;virtual;
|
|
|
|
procedure secondpass;virtual;
|
|
end;
|
|
|
|
var
|
|
{ this is necessary for the const section }
|
|
simple_loadn : boolean;
|
|
|
|
implementation
|
|
|
|
uses
|
|
cobjects,aasm,cgbase,cgobj
|
|
{$I cpuunit.inc}
|
|
{$I tempgen.inc}
|
|
;
|
|
|
|
{****************************************************************************
|
|
TLOADNODE
|
|
****************************************************************************}
|
|
|
|
constructor tloadnode.init(v : pvarsym;st : psymtable);
|
|
|
|
var
|
|
p : ptree;
|
|
|
|
begin
|
|
inherited init;
|
|
treetype:=loadn;
|
|
resulttype:=v^.definition;
|
|
symtableentry:=v;
|
|
symtable:=st;
|
|
is_first := False;
|
|
is_methodpointer:=false;
|
|
|
|
{ method pointer load nodes can use the left subtree }
|
|
{ !!!!! left:=nil; }
|
|
end;
|
|
|
|
destructor tloadnode.done;
|
|
|
|
begin
|
|
inherited done;
|
|
{ method pointer load nodes can use the left subtree }
|
|
{ !!!!! dispose(left,done); }
|
|
end;
|
|
|
|
procedure tloadnode.secondpass;
|
|
|
|
var
|
|
hregister : tregister;
|
|
symtabletype : tsymtabletype;
|
|
i : longint;
|
|
hp : preference;
|
|
|
|
begin
|
|
simple_loadn:=true;
|
|
reset_reference(location.reference);
|
|
case symtableentry^.typ of
|
|
{ this is only for toasm and toaddr }
|
|
absolutesym :
|
|
begin
|
|
if (pabsolutesym(symtableentry)^.abstyp=toaddr) then
|
|
begin
|
|
{$ifdef i386}
|
|
{ absseg is go32v2 target specific }
|
|
if pabsolutesym(symtableentry)^.absseg then
|
|
location.reference.segment:=R_FS;
|
|
{$endif i386}
|
|
location.reference.offset:=pabsolutesym(symtableentry)^.address;
|
|
end
|
|
else
|
|
location.reference.symbol:=stringdup(symtableentry^.mangledname);
|
|
maybe_concat_external(symtableentry^.owner,symtableentry^.mangledname);
|
|
end;
|
|
varsym :
|
|
begin
|
|
hregister:=R_NO;
|
|
{ C variable }
|
|
if (pvarsym(symtableentry)^.var_options and vo_is_C_var)<>0 then
|
|
begin
|
|
location.reference.symbol:=stringdup(symtableentry^.mangledname);
|
|
if (pvarsym(symtableentry)^.var_options and vo_is_external)<>0 then
|
|
maybe_concat_external(symtableentry^.owner,symtableentry^.mangledname);
|
|
end
|
|
|
|
{$ifdef i386}
|
|
{ DLL variable, DLL variables are onyl available on the win32 target }
|
|
{ maybe we've to add this later for the alpha WinNT }
|
|
else if (pvarsym(symtableentry)^.var_options and vo_is_dll_var)<>0 then
|
|
begin
|
|
hregister:=getregister32;
|
|
stringdispose(location.reference.symbol);
|
|
location.reference.symbol:=stringdup(symtableentry^.mangledname);
|
|
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(location.reference),hregister)));
|
|
stringdispose(location.reference.symbol);
|
|
location.reference.base:=hregister;
|
|
if (pvarsym(symtableentry)^.var_options and vo_is_external)<>0 then
|
|
maybe_concat_external(symtableentry^.owner,symtableentry^.mangledname);
|
|
end
|
|
{$endif i386}
|
|
else
|
|
begin
|
|
symtabletype:=symtable^.symtabletype;
|
|
{ in case it is a register variable: }
|
|
if pvarsym(symtableentry)^.reg<>R_NO then
|
|
begin
|
|
location.loc:=LOC_CREGISTER;
|
|
location.register:=pvarsym(symtableentry)^.reg;
|
|
unused:=unused-[pvarsym(symtableentry)^.reg];
|
|
end
|
|
else
|
|
begin
|
|
{ first handle local and temporary variables }
|
|
if (symtabletype in [parasymtable,inlinelocalsymtable,
|
|
inlineparasymtable,localsymtable]) then
|
|
begin
|
|
location.reference.base:=procinfo.framepointer;
|
|
location.reference.offset:=pvarsym(symtableentry)^.address;
|
|
if (symtabletype=localsymtable) or (symtabletype=inlinelocalsymtable) then
|
|
location.reference.offset:=-location.reference.offset;
|
|
if (symtabletype=parasymtable) or (symtabletype=inlineparasymtable) then
|
|
inc(location.reference.offset,symtable^.call_offset);
|
|
if (lexlevel>(symtable^.symtablelevel)) then
|
|
begin
|
|
hregister:=getregister32;
|
|
|
|
{ make a reference }
|
|
hp:=new_reference(procinfo.framepointer,
|
|
procinfo.framepointer_offset);
|
|
|
|
|
|
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));
|
|
|
|
simple_loadn:=false;
|
|
i:=lexlevel-1;
|
|
while i>(symtable^.symtablelevel) do
|
|
begin
|
|
{ make a reference }
|
|
hp:=new_reference(hregister,8);
|
|
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));
|
|
dec(i);
|
|
end;
|
|
location.reference.base:=hregister;
|
|
end;
|
|
end
|
|
else
|
|
case symtabletype of
|
|
unitsymtable,globalsymtable,
|
|
staticsymtable : begin
|
|
stringdispose(location.reference.symbol);
|
|
location.reference.symbol:=stringdup(symtableentry^.mangledname);
|
|
if symtabletype=unitsymtable then
|
|
concat_external(symtableentry^.mangledname,EXT_NEAR);
|
|
end;
|
|
stt_exceptsymtable:
|
|
begin
|
|
location.reference.base:=procinfo.framepointer;
|
|
location.reference.offset:=pvarsym(symtableentry)^.address;
|
|
end;
|
|
objectsymtable:
|
|
begin
|
|
if (pvarsym(symtableentry)^.properties and sp_static)<>0 then
|
|
begin
|
|
stringdispose(location.reference.symbol);
|
|
location.reference.symbol:=
|
|
stringdup(symtableentry^.mangledname);
|
|
if symtable^.defowner^.owner^.symtabletype=unitsymtable then
|
|
concat_external(symtableentry^.mangledname,EXT_NEAR);
|
|
end
|
|
else
|
|
begin
|
|
location.reference.base:=self_pointer;
|
|
location.reference.offset:=pvarsym(symtableentry)^.address;
|
|
end;
|
|
end;
|
|
withsymtable:
|
|
begin
|
|
hregister:=getregister32;
|
|
location.reference.base:=hregister;
|
|
{ make a reference }
|
|
{ symtable datasize field
|
|
contains the offset of the temp
|
|
stored }
|
|
hp:=new_reference(procinfo.framepointer,
|
|
symtable^.datasize);
|
|
|
|
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,hp,hregister)));
|
|
|
|
location.reference.offset:=
|
|
pvarsym(symtableentry)^.address;
|
|
end;
|
|
end;
|
|
end;
|
|
{ in case call by reference, then calculate: }
|
|
if (pvarsym(symtableentry)^.varspez=vs_var) or
|
|
((pvarsym(symtableentry)^.varspez=vs_const) and
|
|
{$ifndef VALUEPARA}
|
|
dont_copy_const_param(pvarsym(symtableentry)^.definition)) or
|
|
{ call by value open arrays are also indirect addressed }
|
|
is_open_array(pvarsym(symtableentry)^.definition) then
|
|
{$else}
|
|
push_addr_param(pvarsym(symtableentry)^.definition)) then
|
|
{$endif}
|
|
begin
|
|
simple_loadn:=false;
|
|
if hregister=R_NO then
|
|
hregister:=getregister32;
|
|
if is_open_array(pvarsym(symtableentry)^.definition) or
|
|
is_open_string(pvarsym(symtableentry)^.definition) then
|
|
begin
|
|
if (location.reference.base=procinfo.framepointer) then
|
|
begin
|
|
highframepointer:=location.reference.base;
|
|
highoffset:=location.reference.offset;
|
|
end
|
|
else
|
|
begin
|
|
highframepointer:=R_EDI;
|
|
highoffset:=location.reference.offset;
|
|
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
|
|
location.reference.base,R_EDI)));
|
|
end;
|
|
end;
|
|
if location.loc=LOC_CREGISTER then
|
|
begin
|
|
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,S_L,
|
|
location.register,hregister)));
|
|
location.loc:=LOC_REFERENCE;
|
|
end
|
|
else
|
|
begin
|
|
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
|
newreference(location.reference),
|
|
hregister)));
|
|
end;
|
|
clear_reference(location.reference);
|
|
location.reference.base:=hregister;
|
|
end;
|
|
end;
|
|
end;
|
|
procsym:
|
|
begin
|
|
if is_methodpointer then
|
|
begin
|
|
secondpass(left);
|
|
stringdispose(location.reference.symbol);
|
|
{ virtual method ? }
|
|
if (pprocsym(symtableentry)^.definition^.options and povirtualmethod)<>0 then
|
|
begin
|
|
end
|
|
else
|
|
begin
|
|
location.reference.symbol:=stringdup(pprocsym(symtableentry)^.definition^.mangledname);
|
|
maybe_concat_external(symtable,symtableentry^.mangledname);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{!!!!! Be aware, work on virtual methods too }
|
|
stringdispose(location.reference.symbol);
|
|
location.reference.symbol:=stringdup(pprocsym(symtableentry)^.definition^.mangledname);
|
|
maybe_concat_external(symtable,symtableentry^.mangledname);
|
|
end;
|
|
end;
|
|
typedconstsym :
|
|
begin
|
|
stringdispose(location.reference.symbol);
|
|
location.reference.symbol:=stringdup(symtableentry^.mangledname);
|
|
maybe_concat_external(symtable,symtableentry^.mangledname);
|
|
end;
|
|
else internalerror(4);
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.1 1999-01-24 22:32:36 florian
|
|
* well, more changes, especially parts of secondload ported
|
|
|
|
} |