paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-04 04:57:23 +01:00
Code Issues Packages Projects Releases Wiki Activity

* well, more changes, especially parts of secondload ported

Browse Source
This commit is contained in:
florian 1999-01-24 22:32:33 +00:00
parent ce1b4eff9e
commit a184e5ff43
6 changed files with 373 additions and 43 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
compiler/i386.pas
View File

@ -349,6 +349,8 @@ unit i386;
frame_pointer = R_EBP;
self_pointer = R_ESI;
{ This constant is an alias for the accumulator, as it's name may
differ from processor to processor. }
accumulator = R_EAX;
@ -1975,7 +1977,10 @@ Begin
end.
{
$Log$
Revision 1.31 1999-01-23 23:29:31 florian
Revision 1.32 1999-01-24 22:32:33 florian
* well, more changes, especially parts of secondload ported
Revision 1.31 1999/01/23 23:29:31 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed

5
compiler/new/TODO Normal file
View File

@ -0,0 +1,5 @@
Well, this list is very incomplete, mainly it contains things
which shoundn't be forgotten
Alpha processor:
- DLL variables

7
compiler/new/convtree.pas
View File

@ -34,7 +34,7 @@ unit convtree;
implementation
uses
verbose,nstatmnt;
verbose,nstatmnt,nmem;
function convtree2node(p : ptree) : pnode;
@ -59,7 +59,10 @@ unit convtree;
end.
{
$Log$
Revision 1.3 1999-01-23 23:29:47 florian
Revision 1.4 1999-01-24 22:32:35 florian
* well, more changes, especially parts of secondload ported
Revision 1.3 1999/01/23 23:29:47 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed

320
compiler/new/nmem.pas Normal file
View File

@ -0,0 +1,320 @@
{
$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
}

33
compiler/new/tempgen.inc Normal file
View File

@ -0,0 +1,33 @@
{
$Id$
Copyright (c) 1998 by Florian Klaempfl
This file includes the appropriate temp gen.
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.
****************************************************************************
}
,temp_gen
{$ifdef i386}
,tgeni386
{$endif i386}
{$ifdef m68k}
,tgenm68k
{$endif m68k}
{$ifdef alpha}
,tgalpha
{$endif alpha}

44
compiler/new/tree.pas
View File

@ -207,15 +207,6 @@ unit tree;
{$endif EXTDEBUG}
end;
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;
end;
{$ifndef nooldtree}
{ allows to determine which elementes are to be replaced }
tdisposetyp = (dt_nothing,dt_leftright,dt_left,
@ -570,36 +561,6 @@ unit tree;
end;
{$endif EXTDEBUG}
{****************************************************************************
TLOADNODE
****************************************************************************}
constructor tloadnode.init(v : pvarsym;st : psymtable);
var
p : ptree;
begin
inherited init;
p^.treetype:=loadn;
resulttype:=v^.definition;
symtableentry:=v;
symtable:=st;
p^.is_first := False;
p^.is_methodpointer:=false;
{ method pointer load nodes can use the left subtree }
{ !!!!! p^.left:=nil; }
end;
destructor tloadnode.done;
begin
inherited done;
{ method pointer load nodes can use the left subtree }
{ !!!!! dispose(left,done); }
end;
{****************************************************************************
TUNARYNODE
****************************************************************************}
@ -1935,7 +1896,10 @@ unit tree;
end.
{
$Log$
Revision 1.5 1999-01-23 23:29:49 florian
Revision 1.6 1999-01-24 22:32:36 florian
* well, more changes, especially parts of secondload ported
Revision 1.5 1999/01/23 23:29:49 florian
* first running version of the new code generator
* when compiling exceptions under Linux fixed