paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-23 16:09:22 +02:00
Code Issues Packages Projects Releases Wiki Activity

* some new stuff for the new cg

Browse Source
This commit is contained in:
florian 2000-03-01 15:36:11 +00:00
parent 51443d110f
commit 9573dc7006
13 changed files with 522 additions and 308 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
compiler/cg386ld.pas
View File

@ -407,46 +407,8 @@ implementation
if codegenerror then
exit;
{$ifdef dummy}
{ we use now the standard mechanism via maybe_push/restore
to do that (FK)
}
case p^.left^.location.loc of
LOC_REFERENCE : begin
{ in case left operator uses to register }
{ but to few are free then LEA }
if (p^.left^.location.reference.base<>R_NO) and
(p^.left^.location.reference.index<>R_NO) and
(usablereg32<p^.right^.registers32) then
begin
del_reference(p^.left^.location.reference);
hregister:=getregister32;
emit_ref_reg(A_LEA,S_L,newreference(
p^.left^.location.reference),
hregister);
reset_reference(p^.left^.location.reference);
p^.left^.location.reference.base:=hregister;
p^.left^.location.reference.index:=R_NO;
end;
loc:=LOC_REFERENCE;
end;
LOC_CFPUREGISTER:
loc:=LOC_CFPUREGISTER;
LOC_CREGISTER:
loc:=LOC_CREGISTER;
LOC_MMXREGISTER:
loc:=LOC_MMXREGISTER;
LOC_CMMXREGISTER:
loc:=LOC_CMMXREGISTER;
else
begin
CGMessage(cg_e_illegal_expression);
exit;
end;
end;
{$endif dummy}
if not(p^.left^.location.loc in [LOC_REFERENCE,LOC_CFPUREGISTER,
LOC_CREGISTER,LOC_MMXREGISTER,LOC_CMMXREGISTER]) then
LOC_CREGISTER,LOC_CMMXREGISTER]) then
begin
CGMessage(cg_e_illegal_expression);
exit;
@ -513,9 +475,7 @@ implementation
begin
emit_const_ref(A_MOV,S_B,
0,newreference(p^.left^.location.reference));
{$IfDef regallocfix}
del_reference(p^.left^.location.reference);
{$EndIf regallocfix}
end
else
loadansi2short(p^.right,p^.left);
@ -1019,7 +979,10 @@ implementation
end.
{
$Log$
Revision 1.102 2000-03-01 13:20:33 pierre
Revision 1.103 2000-03-01 15:36:11 florian
* some new stuff for the new cg
Revision 1.102 2000/03/01 13:20:33 pierre
* fix for bug 859
Revision 1.101 2000/03/01 00:03:11 pierre

48
compiler/cgai386.pas
View File

@ -3298,16 +3298,31 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
if not(po_assembler in aktprocsym^.definition^.procoptions) then
aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}copyvalueparas);
{ initialisizes local data }
aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}initialize_data);
{ initialisize local data like ansistrings }
case aktprocsym^.definition^.proctypeoption of
potype_unitinit:
begin
{ using current_module^.globalsymtable is hopefully }
{ more robust than symtablestack and symtablestack^.next }
psymtable(current_module^.globalsymtable)^.foreach({$ifndef TP}@{$endif}initialize_data);
psymtable(current_module^.localsymtable)^.foreach({$ifndef TP}@{$endif}initialize_data);
end;
{ units have seperate code for initilization and finalization }
potype_unitfinalize: ;
else
aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}initialize_data);
end;
{ add a reference to all call by value/const parameters }
aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}incr_data);
{ initilisizes temp. ansi/wide string data }
{ initialisizes temp. ansi/wide string data }
inittempansistrings;
{ do we need an exception frame because of ansi/widestrings ? }
if (procinfo^.flags and pi_needs_implicit_finally)<>0 then
if ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
{ but it's useless in init/final code of units }
not(aktprocsym^.definition^.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
begin
usedinproc:=usedinproc or ($80 shr byte(R_EAX));
@ -3491,15 +3506,29 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
{ finalize temporary data }
finalizetempansistrings;
{ finalize local data }
aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}finalize_data);
{ finalize local data like ansistrings}
case aktprocsym^.definition^.proctypeoption of
potype_unitfinalize:
begin
{ using current_module^.globalsymtable is hopefully }
{ more robust than symtablestack and symtablestack^.next }
psymtable(current_module^.globalsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
psymtable(current_module^.localsymtable)^.foreach({$ifndef TP}@{$endif}finalize_data);
end;
{ units have seperate code for initialization and finalization }
potype_unitinit: ;
else
aktprocsym^.definition^.localst^.foreach({$ifndef TP}@{$endif}finalize_data);
end;
{ finalize paras data }
if assigned(aktprocsym^.definition^.parast) then
aktprocsym^.definition^.parast^.foreach({$ifndef TP}@{$endif}finalize_data);
{ do we need to handle exceptions because of ansi/widestrings ? }
if (procinfo^.flags and pi_needs_implicit_finally)<>0 then
if ((procinfo^.flags and pi_needs_implicit_finally)<>0) and
{ but it's useless in init/final code of units }
not(aktprocsym^.definition^.proctypeoption in [potype_unitfinalize,potype_unitinit]) then
begin
{ the exception helper routines modify all registers }
aktprocsym^.definition^.usedregisters:=$ff;
@ -3782,7 +3811,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
end.
{
$Log$
Revision 1.85 2000-03-01 12:35:44 pierre
Revision 1.86 2000-03-01 15:36:11 florian
* some new stuff for the new cg
Revision 1.85 2000/03/01 12:35:44 pierre
* fix for bug 855
Revision 1.84 2000/03/01 00:03:12 pierre

10
compiler/cpubase.pas
View File

@ -509,6 +509,9 @@ const
fpuregs = [];
mmregs = [R_MM0..R_MM7];
lvaluelocations = [LOC_REFERENCE,LOC_CFPUREGISTER,
LOC_CREGISTER,LOC_MMXREGISTER,LOC_CMMXREGISTER];
registers_saved_on_cdecl = [R_ESI,R_EDI,R_EBX];
{ generic register names }
@ -901,7 +904,10 @@ end;
end.
{
$Log$
Revision 1.22 2000-02-09 13:22:51 peter
Revision 1.23 2000-03-01 15:36:11 florian
* some new stuff for the new cg
Revision 1.22 2000/02/09 13:22:51 peter
* log truncated
Revision 1.21 2000/01/28 09:41:39 peter
@ -973,4 +979,4 @@ end.
+ floating point register variables !!
* pairegalloc is now generated for register variables
}
}

39
compiler/new/README
View File

@ -32,6 +32,8 @@ intregs all!! available integer register
fpuregs all!! available fpu register
mmregs all!! available multimedia register
lvaluelocations a set of all locations which can be an l-value
Intel specific
--------------
unusedregssse
@ -39,9 +41,9 @@ availabletempregssse
countusableregssse
Jonas Maebe schrieb:
>
>
> Hello,
>
>
> Is there any difference between the localsize parameter of
> g_stackframe_entry and the parasize parameter of g_return_from_proc, or
> are they both the same value?
@ -50,7 +52,7 @@ They are different, I think the value of g_return_from_proc doesn't matter
for the PowerPC. It's the size of parameters passed on the stack
and only important for the i386/m68k probably.
>
>
> And for the PowerPC, what will they contain? Just the size of the local
> variables and parameters, or also the maximum needed size for parameters
> of any procedure called by the current one (the caller must reserve space
@ -67,7 +69,32 @@ I'll commit it soon) will contain
all registers which must be saved by the entry and restored by the exit code of a procedure
and you have to add extra space to do that.
The code generation
-------------------
The code generation can be seperated into 3 layers:
1. the method secondpass of the tnode childs
2. the procedure variables p2_
3. the code generator object
1.: This procedure does very high level stuff, if the code generation
is processor independed, it calls the appropriate procedures of the
code generator object to generate the code, but in most cases, it
calls procedure variables of the second layer
2. This procedure variables must be initialized to match to the match the
current processor
The following procedure variables are currently used
Name Purpose Alternatives
-----------------------------------------------------------------------------
p2_assignment
p2_assignment_int64_reg Do an assignment of a int64
3. The code generator object does very basic operations like generating
move code etc.
Alignment
---------
@ -83,7 +110,9 @@ CVS Log
-------
$Log$
Revision 1.4 1999-10-14 14:57:54 florian
Revision 1.5 2000-03-01 15:36:12 florian
* some new stuff for the new cg
Revision 1.4 1999/10/14 14:57:54 florian
- removed the hcodegen use in the new cg, use cgbase instead

11
compiler/new/alpha/cpubase.pas
View File

@ -166,6 +166,10 @@ Type
LOC_MEM,
LOC_REFERENCE,
LOC_JUMP,
{ the alpha doesn't have flags, but this }
{ avoid some conditional compiling }
{ DON'T USE for the alpha }
LOC_FLAGS,
LOC_CREGISTER,
LOC_CONST);
@ -299,7 +303,10 @@ end;
end.
{
$Log$
Revision 1.16 2000-01-07 01:14:56 peter
Revision 1.17 2000-03-01 15:36:13 florian
* some new stuff for the new cg
Revision 1.16 2000/01/07 01:14:56 peter
* updated copyright to 2000
Revision 1.15 1999/11/09 22:57:09 peter
@ -354,4 +361,4 @@ end.
Revision 1.2 1998/09/09 20:14:00 peter
- dup files already used elsewhere
}
}

51
compiler/new/cg64f32.pas Normal file
View File

@ -0,0 +1,51 @@
{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Member of the Free Pascal development team
This unit implements the code generation for 64 bit int
arithmethics on 32 bit processors
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 cgi64f32;
interface
uses
cgobj;
implementation
uses
nmem;
procedure int64f32_assignment_int64_reg(p : passignmentnode);
begin
end;
begin
p2_assignment:=@int64f32_assignement_int64;
end.
{
$Log$
Revision 1.1 2000-03-01 15:36:13 florian
* some new stuff for the new cg
}

60
compiler/new/cgflags.pas Normal file
View File

@ -0,0 +1,60 @@
{
$Id$
Copyright (c) 1998-2000 by Florian Klaempfl
Member of the Free Pascal development team
This unit implements the code generation for things regarding
flags, this unit applies of course only for cpus support flags
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 cgflags;
interface
uses
cgobj;
implementation
uses
cgobj,nmem;
procedure flags_assignment_flags(p : passignmentnode);
begin
if loc=LOC_CREGISTER then
emit_flag2reg(p^.right^.location.resflags,p^.left^.location.register)
else
begin
ai:=new(paicpu,op_ref(A_Setcc,S_B,newreference(p^.left^.location.reference)));
ai^.SetCondition(flag_2_cond[p^.right^.location.resflags]);
exprasmlist^.concat(ai);
end;
del_reference(p^.left^.location.reference);
end;
begin
p2_assignment_flags:=@flags_assignment_flags;
end.
{
$Log$
Revision 1.1 2000-03-01 15:36:13 florian
* some new stuff for the new cg
}

9
compiler/new/cgobj.pas
View File

@ -29,8 +29,6 @@ unit cgobj;
cobjects,aasm,symtable,symconst,cpuasm,cpubase,cgbase,cpuinfo,tainst;
type
qword = comp;
talignment = (AM_NATURAL,AM_NONE,AM_2BYTE,AM_4BYTE,AM_8BYTE);
pcg = ^tcg;
@ -1116,7 +1114,10 @@ unit cgobj;
end.
{
$Log$
Revision 1.34 2000-02-20 20:49:46 florian
Revision 1.35 2000-03-01 15:36:13 florian
* some new stuff for the new cg
Revision 1.34 2000/02/20 20:49:46 florian
* newcg is compiling
* fixed the dup id problem reported by Paul Y.
@ -1228,4 +1229,4 @@ end.
Revision 1.1 1998/12/15 16:32:58 florian
+ first version, derived from old routines
}
}

45
compiler/new/i386/tgcpu.pas
View File

@ -40,6 +40,12 @@ unit tgcpu;
procedure ungetregister(r : tregister);virtual;
function istemp(const ref : treference) : boolean;virtual;
procedure del_reference(const ref : treference);virtual;
procedure pushusedregisters(var pushed : tpushed;b : byte);virtual;
procedure popusedregisters(const pushed : tpushed);virtual;
procedure saveusedregisters(var saved : tsaved;b : byte);virtual;
procedure restoreusedregisters(const saved : tsaved);virtual;
procedure clearregistercount;virtual;
procedure resetusableregisters;virtual;
end;
var
@ -47,6 +53,9 @@ unit tgcpu;
implementation
{ !!!!!!!! the following procedures need to be implemented !!!!!!!!!! }
procedure ttgobji386.ungetregister(r : tregister);
begin
@ -62,13 +71,45 @@ unit tgcpu;
begin
end;
procedure ttgobji386.pushusedregisters(var pushed : tpushed;b : byte);
begin
end;
procedure ttgobji386.popusedregisters(const pushed : tpushed);
begin
end;
procedure ttgobji386.saveusedregisters(var saved : tsaved;b : byte);
begin
end;
procedure ttgobji386.restoreusedregisters(const saved : tsaved);
begin
end;
procedure ttgobji386.clearregistercount;
begin
end;
procedure ttgobji386.resetusableregisters;
begin
end;
begin
tg.init;
end.
{
$Log$
Revision 1.6 2000-01-07 01:14:57 peter
Revision 1.7 2000-03-01 15:36:13 florian
* some new stuff for the new cg
Revision 1.6 2000/01/07 01:14:57 peter
* updated copyright to 2000
Revision 1.5 1999/09/15 20:35:47 florian
@ -90,4 +131,4 @@ end.
Revision 1.1 1999/08/02 17:14:14 florian
+ changed the temp. generator to an object
}
}

451
compiler/new/nmem.pas
View File

@ -45,21 +45,22 @@ unit nmem;
passignmentnode = ^tassignmentnode;
tassignmentnode = object(tbinarynode)
assigntyp : tassigntyp;
concat_string : boolean;
constructor init(l,r : pnode);
destructor done;virtual;
procedure det_temp;virtual;
procedure det_resulttype;virtual;
procedure secondpass;virtual;
procedure loadansistring;
procedure loadshortstring;
procedure loadansi2short(l,r : pnode);
end;
var
{ this is necessary for the const section }
simple_loadn : boolean;
p2_assignment : procedure(p : passignmentnode);
p2_assignment_flags : procedure(p : passignmentnode);
p2_assignment_string : procedure(p : passignmentnode);
p2_assignment_int64_reg : procedure(p : passignmentnode);
implementation
uses
@ -323,80 +324,9 @@ unit nmem;
inherited done;
end;
procedure tassignmentnode.loadansistring;
begin
abstract;
end;
procedure tassignmentnode.loadshortstring;
begin
abstract;
end;
procedure tassignmentnode.loadansi2short(l,r : pnode);
begin
abstract;
end;
procedure tassignmentnode.det_temp;
begin
{$ifdef dummy}
store_valid:=must_be_valid;
must_be_valid:=false;
{ must be made unique }
set_unique(p^.left);
firstpass(p^.left);
if codegenerror then
exit;
{ test if we can avoid copying string to temp
as in s:=s+...; (PM) }
must_be_valid:=true;
firstpass(p^.right);
must_be_valid:=store_valid;
if codegenerror then
exit;
{ some string functions don't need conversion, so treat them separatly }
if is_shortstring(p^.left^.resulttype) and (assigned(p^.right^.resulttype)) then
begin
if not (is_shortstring(p^.right^.resulttype) or
is_ansistring(p^.right^.resulttype) or
is_char(p^.right^.resulttype)) then
begin
p^.right:=gentypeconvnode(p^.right,p^.left^.resulttype);
firstpass(p^.right);
if codegenerror then
exit;
end;
{ we call STRCOPY }
procinfo.flags:=procinfo.flags or pi_do_call;
hp:=p^.right;
end
else
begin
p^.right:=gentypeconvnode(p^.right,p^.left^.resulttype);
firstpass(p^.right);
if codegenerror then
exit;
end;
{ set assigned flag for varsyms }
if (p^.left^.treetype=loadn) and
(p^.left^.symtableentry^.typ=varsym) and
(pvarsym(p^.left^.symtableentry)^.varstate=vs_declared) then
pvarsym(p^.left^.symtableentry)^.varstate:=vs_assigned;
p^.registersint:=p^.left^.registersint+p^.right^.registersint;
p^.registersfpu:=max(p^.left^.registersfpu,p^.right^.registersfpu);
p^.registersmm:=max(p^.left^.registersmm,p^.right^.registersmm);
{$endif dummy}
end;
procedure tassignmentnode.det_resulttype;
@ -409,206 +339,228 @@ unit nmem;
CGMessage(type_e_mismatch);
end;
procedure tassignmentnode.secondpass;
var
r : treference;
opsize : tcgsize;
{ updated from old cg on 29.2.00 by FK }
procedure generic_p2_stringassignment(p : passignmentnode);
begin
if left^.resulttype^.deftype=stringdef then
if is_ansistring(left^.resulttype) then
begin
if is_ansistring(left^.resulttype) then
begin
{ the source and destinations are released
in loadansistring, because an ansi string can
also be in a register
}
loadansistring;
end
else
if is_shortstring(left^.resulttype) then
begin
if is_ansistring(right^.resulttype) then
begin
if (right^.treetype=stringconstn) and
(pstringconstnode(right)^.length=0) then
begin
cg^.a_load_const_ref(list,OS_8,0,left^.location.reference);
tg.del_reference(left^.location.reference);
end
else
loadansi2short(right,left);
end
else
begin
{ we do not need destination anymore }
tg.del_reference(left^.location.reference);
tg.del_reference(right^.location.reference);
loadshortstring;
tg.ungetiftemp(right^.location.reference);
end;
end
else if is_longstring(left^.resulttype) then
begin
abstract;
end
else
begin
{ its the only thing we have to do }
tg.del_reference(right^.location.reference);
end
{ the source and destinations are released
in loadansistring, because an ansi string can
also be in a register
}
loadansistring;
end
else case right^.location.loc of
else
if is_shortstring(left^.resulttype) then
begin
if is_ansistring(right^.resulttype) then
begin
if (right^.treetype=stringconstn) and
(pstringconstnode(right)^.length=0) then
begin
cg^.a_load_const_ref(list,OS_8,0,left^.location.reference);
tg.del_reference(left^.location.reference);
end
else
loadansi2short(right,left);
end
else
begin
{ we do not need destination anymore }
tg.del_reference(left^.location.reference);
{ tg.del_reference(right^.location.reference);
done in loadshortstring }
loadshortstring;
tg.ungetiftemp(right^.location.reference);
end;
end
else if is_longstring(left^.resulttype) then
begin
abstract;
end
else
begin
{ its the only thing we have to do }
tg.del_reference(right^.location.reference);
end
end;
procedure generic_p2_assignment_int64_reg(p : passignmentnode);
begin
{ we don't know it better here }
generic_p2_assignment(p);
end;
{ updated from old cg on 29.2.00 by FK }
procedure generic_p2_assignment_flags(p : passignmentnode);
begin
{ for example the alpha doesn't have flags }
abstract;
end;
{ updated from old cg on 29.2.00 by FK }
procedure generic_p2_assignment(p : passignmentnode);
var
opsize : topsize;
otlabel,hlabel,oflabel : pasmlabel;
fputyp : tfloattype;
loc : tloc;
r : preference;
ai : paicpu;
op : tasmop;
begin
loc:=left^.location.loc;
case right^.location.loc of
LOC_REFERENCE,
LOC_MEM : begin
{$ifdef dummy}
{ extra handling for ordinal constants }
if (right^.treetype in [ordconstn,fixconstn]) or
if (p^.right^.treetype in [ordconstn,fixconstn]) or
(loc=LOC_CREGISTER) then
begin
case p^.left^.resulttype^.size of
1 : opsize:=OS_B;
2 : opsize:=OS_W;
4 : opsize:=OS_L;
{ S_L is correct, the copy is done }
{ with two moves }
8 : opsize:=OS_L;
1 : opsize:=OS_8;
2 : opsize:=OS_16;
4 : opsize:=OS_32;
8 : opsize:=OS_64;
end;
if loc=LOC_CREGISTER then
begin
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOV,opsize,
emit_ref_reg(A_MOV,opsize,
newreference(p^.right^.location.reference),
p^.left^.location.register)));
p^.left^.location.register);
!!!!!!!!!!!! only 32 bit cpus
if is_64bitint(p^.right^.resulttype) then
begin
r:=newreference(p^.right^.location.reference);
inc(r^.offset,4);
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOV,opsize,r,
p^.left^.location.registerhigh)));
emit_ref_reg(A_MOV,opsize,r,
p^.left^.location.registerhigh);
end;
{$IfDef regallocfix}
del_reference(p^.right^.location.reference);
{$EndIf regallocfix}
tg.del_reference(right^.location.reference);
end
else
begin
exprasmlist^.concat(new(paicpu,op_const_ref(A_MOV,opsize,
emit_const_ref(A_MOV,opsize,
p^.right^.location.reference.offset,
newreference(p^.left^.location.reference))));
newreference(p^.left^.location.reference));
!!!!!!!!!!!! only 32 bit cpus
if is_64bitint(p^.right^.resulttype) then
begin
r:=newreference(p^.left^.location.reference);
inc(r^.offset,4);
exprasmlist^.concat(new(paicpu,op_const_ref(A_MOV,opsize,
0,r)));
emit_const_ref(A_MOV,opsize,
0,r);
end;
{$IfDef regallocfix}
del_reference(p^.left^.location.reference);
{$EndIf regallocfix}
{exprasmlist^.concat(new(paicpu,op_const_loc(A_MOV,opsize,
p^.right^.location.reference.offset,
p^.left^.location)));}
del_reference(left^.location.reference);
end;
end
!!!!!!!!!!!! only 386
else if loc=LOC_CFPUREGISTER then
begin
floatloadops(pfloatdef(p^.right^.resulttype)^.typ,op,opsize);
exprasmlist^.concat(new(paicpu,op_ref(op,opsize,
newreference(p^.right^.location.reference))));
exprasmlist^.concat(new(paicpu,op_reg(A_FSTP,S_NO,
correct_fpuregister(p^.left^.location.register,fpuvaroffset+1))));
emit_ref(op,opsize,
newreference(p^.right^.location.reference));
emit_reg(A_FSTP,S_NO,
correct_fpuregister(p^.left^.location.register,fpuvaroffset+1));
end
else
{$endif dummy}
begin
if (right^.resulttype^.needs_inittable) and
( (right^.resulttype^.deftype<>objectdef) or
((right^.resulttype^.deftype<>objectdef) or
not(pobjectdef(right^.resulttype)^.is_class)) then
begin
{ this would be a problem }
if not(left^.resulttype^.needs_inittable) then
internalerror(3457);
internalerror(292001);
{ increment source reference counter }
r.symbol:=right^.resulttype^.get_inittable_label;
cg^.a_param_ref_addr(list,r,2);
cg^.a_param_ref_addr(list,right^.location.reference,1);
cg^.a_call_name(list,'FPC_ADDREF',0);
{ decrement destination reference counter }
r.symbol:=left^.resulttype^.get_inittable_label;
cg^.a_param_ref_addr(list,r,2);
cg^.a_param_ref_addr(list,left^.location.reference,1);
cg^.a_call_name(list,'FPC_DECREF',0)
end;
cg^.g_concatcopy(list,right^.location.reference,
left^.location.reference,left^.resulttype^.size,false);
tg.ungetiftemp(right^.location.reference);
end;
new(r);
reset_reference(r^);
r^.symbol:=p^.right^.resulttype^.get_inittable_label;
emitpushreferenceaddr(r^);
emitpushreferenceaddr(p^.right^.location.reference);
emitcall('FPC_ADDREF');
{ decrement destination reference counter }
new(r);
reset_reference(r^);
r^.symbol:=p^.left^.resulttype^.get_inittable_label;
emitpushreferenceaddr(r^);
emitpushreferenceaddr(p^.left^.location.reference);
emitcall('FPC_DECREF');
end;
{$ifdef regallocfix}
concatcopy(p^.right^.location.reference,
p^.left^.location.reference,p^.left^.resulttype^.size,true,false);
ungetiftemp(p^.right^.location.reference);
{$Else regallocfix}
concatcopy(p^.right^.location.reference,
p^.left^.location.reference,p^.left^.resulttype^.size,false,false);
ungetiftemp(p^.right^.location.reference);
{$endif regallocfix}
end;
end;
end; { needs to be removed together with the dummy }
{$ifdef dummy}
{$ifdef SUPPORT_MMX}
LOC_CMMXREGISTER,
LOC_MMXREGISTER:
begin
if loc=LOC_CMMXREGISTER then
exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOVQ,S_NO,
p^.right^.location.register,p^.left^.location.register)))
emit_reg_reg(A_MOVQ,S_NO,
p^.right^.location.register,p^.left^.location.register)
else
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOVQ,S_NO,
p^.right^.location.register,newreference(p^.left^.location.reference))));
emit_reg_ref(A_MOVQ,S_NO,
p^.right^.location.register,newreference(p^.left^.location.reference));
end;
{$endif SUPPORT_MMX}
LOC_REGISTER,
LOC_CREGISTER : begin
case p^.right^.resulttype^.size of
1 : opsize:=S_B;
2 : opsize:=S_W;
4 : opsize:=S_L;
8 : opsize:=S_L;
1 : opsize:=OS_8;
2 : opsize:=OS_16;
4 : opsize:=OS_32;
8 : opsize:=OS_64;
end;
{ simplified with op_reg_loc }
if loc=LOC_CREGISTER then
begin
exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOV,opsize,
emit_reg_reg(A_MOV,opsize,
p^.right^.location.register,
p^.left^.location.register)));
{$IfDef regallocfix}
p^.left^.location.register);
ungetregister(p^.right^.location.register);
{$EndIf regallocfix}
end
else
Begin
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,
emit_reg_ref(A_MOV,opsize,
p^.right^.location.register,
newreference(p^.left^.location.reference))));
{$IfDef regallocfix}
newreference(p^.left^.location.reference));
ungetregister(p^.right^.location.register);
del_reference(p^.left^.location.reference);
{$EndIf regallocfix}
end;
if is_64bitint(p^.right^.resulttype) then
begin
{ simplified with op_reg_loc }
if loc=LOC_CREGISTER then
exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOV,opsize,
emit_reg_reg(A_MOV,opsize,
p^.right^.location.registerhigh,
p^.left^.location.registerhigh)))
p^.left^.location.registerhigh)
else
begin
r:=newreference(p^.left^.location.reference);
inc(r^.offset,4);
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOV,opsize,
p^.right^.location.registerhigh,r)));
emit_reg_ref(A_MOV,opsize,
p^.right^.location.registerhigh,r);
end;
end;
{exprasmlist^.concat(new(paicpu,op_reg_loc(A_MOV,opsize,
p^.right^.location.register,
p^.left^.location))); }
end;
LOC_FPU : begin
if (p^.left^.resulttype^.deftype=floatdef) then
@ -625,8 +577,8 @@ unit nmem;
case loc of
LOC_CFPUREGISTER:
begin
exprasmlist^.concat(new(paicpu,op_reg(A_FSTP,S_NO,
correct_fpuregister(p^.left^.location.register,fpuvaroffset))));
emit_reg(A_FSTP,S_NO,
correct_fpuregister(p^.left^.location.register,fpuvaroffset));
dec(fpuvaroffset);
end;
LOC_REFERENCE:
@ -635,6 +587,8 @@ unit nmem;
internalerror(48991);
end;
end;
!!!!!!!!!!!! only 386
LOC_CFPUREGISTER: begin
if (p^.left^.resulttype^.deftype=floatdef) then
fputyp:=pfloatdef(p^.left^.resulttype)^.typ
@ -647,14 +601,14 @@ unit nmem;
fputyp:=pfloatdef(p^.right^.left^.resulttype)^.typ
else
fputyp:=s32real;
exprasmlist^.concat(new(paicpu,op_reg(A_FLD,S_NO,
correct_fpuregister(p^.right^.location.register,fpuvaroffset))));
emit_reg(A_FLD,S_NO,
correct_fpuregister(p^.right^.location.register,fpuvaroffset));
inc(fpuvaroffset);
case loc of
LOC_CFPUREGISTER:
begin
exprasmlist^.concat(new(paicpu,op_reg(A_FSTP,S_NO,
correct_fpuregister(p^.right^.location.register,fpuvaroffset))));
emit_reg(A_FSTP,S_NO,
correct_fpuregister(p^.right^.location.register,fpuvaroffset));
dec(fpuvaroffset);
end;
LOC_REFERENCE:
@ -664,54 +618,81 @@ unit nmem;
end;
end;
LOC_JUMP : begin
{ support every type of boolean here }
case p^.right^.resulttype^.size of
1 : opsize:=OS_8;
2 : opsize:=OS_16;
4 : opsize:=OS_32;
{ this leads to an efficiency of 1.5 }
{ per cent regarding memory usage .... }
8 : opsize:=OS_64;
end;
getlabel(hlabel);
emitlab(truelabel);
a_label(p^.list,p^.truelabel);
if loc=LOC_CREGISTER then
exprasmlist^.concat(new(paicpu,op_const_reg(A_MOV,S_B,
1,p^.left^.location.register)))
a_load_const_reg(p^.list,opsize,1,
p^.left^.location.register)
else
exprasmlist^.concat(new(paicpu,op_const_ref(A_MOV,S_B,
1,newreference(p^.left^.location.reference))));
{exprasmlist^.concat(new(paicpu,op_const_loc(A_MOV,S_B,
1,p^.left^.location)));}
emitjmp(C_None,hlabel);
emitlab(falselabel);
a_load_const_ref(p^.list,opsize,1,
newreference(p^.left^.location.reference));
a_jmp_cond(p^.list,C_None,hlabel);
a_label(p^.list,p^.falselabel);
if loc=LOC_CREGISTER then
exprasmlist^.concat(new(paicpu,op_reg_reg(A_XOR,S_B,
p^.left^.location.register,
p^.left^.location.register)))
a_load_const_reg(p^.list,opsize,0,
p^.left^.location.register);
else
begin
exprasmlist^.concat(new(paicpu,op_const_ref(A_MOV,S_B,
0,newreference(p^.left^.location.reference))));
{$IfDef regallocfix}
del_reference(p^.left^.location.reference);
{$EndIf regallocfix}
a_load_const_ref(p^.list,opsize,0,
newreference(p^.left^.location.reference));
tg.del_reference(p^.left^.location.reference);
end;
emitlab(hlabel);
a_label(p^.list,hlabel);
end;
LOC_FLAGS : begin
if loc=LOC_CREGISTER then
emit_flag2reg(p^.right^.location.resflags,p^.left^.location.register)
else
begin
ai:=new(paicpu,op_ref(A_Setcc,S_B,newreference(p^.left^.location.reference)));
ai^.SetCondition(flag_2_cond[p^.right^.location.resflags]);
exprasmlist^.concat(ai);
end;
{$IfDef regallocfix}
del_reference(p^.left^.location.reference);
{$EndIf regallocfix}
end;
else internalerror(68997);
LOC_FLAGS:
p2_assignment_flags(p);
end;
{$endif dummy}
end;
procedure tassignmentnode.secondpass;
var
r : treference;
opsize : tcgsize;
begin
if not(left^.location.loc in lvaluelocations) then
begin
CGMessage(cg_e_illegal_expression);
exit;
end;
if left^.resulttype^.deftype=stringdef then
p2_assignment_string(@self);
{ if is an int64 which has to do with registers, we
need to call probably a procedure for 32 bit processors
}
else if is_64bitint(left^.resulttype) and
((left^.location in [LOC_REGISGTER,LOC_CREGISTER) or
(left^.location in [LOC_REGISGTER,LOC_CREGISTER)) then
else
p2_assignment_int64_reg(@self)
else
p2_assignment(@self);
end;
begin
p2_assignment:=@generic_p2_assignment;
p2_assignment_flags:=p2_assignment_flags;
p2_assignment_string:=@generic_p2_assignment_string;
p2_assignment_int64_reg:=@generic_p2_assignment_int64_reg;
end.
{
$Log$
Revision 1.16 2000-01-07 01:14:53 peter
Revision 1.17 2000-03-01 15:36:13 florian
* some new stuff for the new cg
Revision 1.16 2000/01/07 01:14:53 peter
* updated copyright to 2000
Revision 1.15 1999/12/06 18:17:10 peter
@ -765,4 +746,4 @@ end.
Revision 1.1 1999/01/24 22:32:36 florian
* well, more changes, especially parts of secondload ported
}
}

16
compiler/pmodules.pas
View File

@ -44,7 +44,7 @@ unit pmodules;
globtype,version,systems,tokens,
cobjects,comphook,compiler,
globals,verbose,files,
symconst,symtable,aasm,
symconst,symtable,aasm,types,
{$ifdef newcg}
cgbase,
{$else newcg}
@ -963,6 +963,8 @@ unit pmodules;
store_crc,store_interface_crc : longint;
{$endif}
s1,s2 : ^string; {Saves stack space}
force_init_final : boolean;
begin
consume(_UNIT);
if Compile_Level=1 then
@ -1196,6 +1198,11 @@ unit pmodules;
{ avoid self recursive destructor call !! PM }
aktprocsym^.definition^.localst:=nil;
{ if the unit contains ansi/widestrings, initialization and
finalization code must be forced }
force_init_final:=needs_init_final(current_module^.globalsymtable)
or needs_init_final(current_module^.localsymtable);
{ finalize? }
if token=_FINALIZATION then
begin
@ -1632,7 +1639,10 @@ unit pmodules;
end.
{
$Log$
Revision 1.185 2000-02-09 13:22:57 peter
Revision 1.186 2000-03-01 15:36:11 florian
* some new stuff for the new cg
Revision 1.185 2000/02/09 13:22:57 peter
* log truncated
Revision 1.184 2000/02/06 17:20:53 peter
@ -1702,4 +1712,4 @@ end.
* Pavel's changes for reloc section in executable
+ warning that -g needs -WN under win32
}
}

9
compiler/tree.pas
View File

@ -369,7 +369,7 @@ unit tree;
{$I innr.inc}
{$ifdef newcg}
{$I new/nodeh.inc}
{$I nodeh.inc}
{$endif newcg}
implementation
@ -2061,12 +2061,15 @@ unit tree;
end;
{$ifdef newcg}
{$I new/node.inc}
{$I node.inc}
{$endif newcg}
end.
{
$Log$
Revision 1.115 2000-03-01 11:43:55 daniel
Revision 1.116 2000-03-01 15:36:12 florian
* some new stuff for the new cg
Revision 1.115 2000/03/01 11:43:55 daniel
* Some more work on the new symtable.
+ Symtable stack unit 'symstack' added.

34
compiler/types.pas
View File

@ -175,12 +175,39 @@ interface
{ returns true, if sym needs an entry in the proplist of a class rtti }
function needs_prop_entry(sym : psym) : boolean;
{ returns true, if p contains data which needs init/final code }
function needs_init_final(p : psymtable) : boolean;
implementation
uses
strings,globtype,globals,htypechk,
tree,verbose,symconst;
var
b_needs_init_final : boolean;
procedure _needs_init_final(p : pnamedindexobject);{$ifndef FPC}far;{$endif}
begin
if (psym(p)^.typ=varsym) and
assigned(pvarsym(p)^.vartype.def) and
not((pvarsym(p)^.vartype.def^.deftype=objectdef) and
pobjectdef(pvarsym(p)^.vartype.def)^.is_class) and
pvarsym(p)^.vartype.def^.needs_inittable then
b_needs_init_final:=true;
end;
{ returns true, if p contains data which needs init/final code }
function needs_init_final(p : psymtable) : boolean;
begin
b_needs_init_final:=false;
p^.foreach({$ifndef TP}@{$endif}_needs_init_final);
needs_init_final:=b_needs_init_final;
end;
function needs_prop_entry(sym : psym) : boolean;
begin
@ -1014,7 +1041,10 @@ implementation
end.
{
$Log$
Revision 1.98 2000-02-28 17:23:57 daniel
Revision 1.99 2000-03-01 15:36:12 florian
* some new stuff for the new cg
Revision 1.98 2000/02/28 17:23:57 daniel
* Current work of symtable integration committed. The symtable can be
activated by defining 'newst', but doesn't compile yet. Changes in type
checking and oop are completed. What is left is to write a new
@ -1099,4 +1129,4 @@ end.
* open array checks also for s32bitdef, because u32bit also has a
high range of -1
}
}