paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-10-31 02:51:37 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fixed several issues with powerpc

Browse Source 
+ applied a patch from Jonas for nested function calls (PowerPC only)
  * ...
This commit is contained in:
florian 2003-04-23 12:35:34 +00:00
parent 7dae726270
commit 0284016ee9
21 changed files with 640 additions and 156 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

24
compiler/cgbase.pas
View File

@ -72,6 +72,8 @@ unit cgbase;
procdef : tprocdef;
{# offset from frame pointer to get parent frame pointer reference
(used in nested routines only)
On the PowerPC, this is used to store the offset where the
frame pointer from the outer procedure is stored.
}
framepointer_offset : longint;
{# offset from frame pointer to get self reference }
@ -217,6 +219,8 @@ unit cgbase;
{ save the size of pushed parameter, needed for aligning }
pushedparasize : longint;
{ procinfo instance which is used in procedures created automatically by the compiler }
voidprocpi : tprocinfo;
{ message calls with codegenerror support }
procedure cgmessage(t : longint);
@ -515,6 +519,14 @@ implementation
ResourceStrings:=TResourceStrings.Create;
{ use the librarydata from current_module }
objectlibrary:=current_module.librarydata;
{ for the implicitly generated init/final. procedures for global init. variables,
a dummy procinfo is necessary }
voidprocpi:=cprocinfo.create;
with voidprocpi do
begin
framepointer.enum:=R_INTREGISTER;
framepointer.number:=NR_FRAME_POINTER_REG;
end;
end;
@ -549,6 +561,7 @@ implementation
{ resource strings }
ResourceStrings.free;
objectlibrary:=nil;
// voidprocpi.free;
end;
@ -644,7 +657,6 @@ implementation
commutativeop := list[op];
end;
{$ifdef fixLeaksOnError}
procedure hcodegen_do_stop;
var p: pprocinfo;
@ -652,7 +664,8 @@ begin
p := pprocinfo(procinfoStack.pop);
while p <> nil Do
begin
dispose(p,done);
if p<>voidprocpi then
p.free;
p := pprocinfo(procinfoStack.pop);
end;
procinfoStack.done;
@ -668,7 +681,12 @@ begin
end.
{
$Log$
Revision 1.40 2003-04-22 13:47:08 peter
Revision 1.41 2003-04-23 12:35:34 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.40 2003/04/22 13:47:08 peter
* fixed C style array of const
* fixed C array passing
* fixed left to right with high parameters

16
compiler/cginfo.pas
View File

@ -44,9 +44,14 @@ interface
LOC_FPUREGISTER, { FPU stack }
LOC_CFPUREGISTER, { if it is a FPU register variable on the fpu stack }
LOC_MMXREGISTER, { MMX register }
LOC_CMMXREGISTER, { MMX register variable }
{ MMX register variable }
LOC_CMMXREGISTER,
LOC_SSEREGISTER,
LOC_CSSEREGISTER
LOC_CSSEREGISTER,
{ multimedia register }
LOC_MMREGISTER,
{ Constant multimedia reg which shouldn't be modified }
LOC_CMMREGISTER
);
{# Generic opcodes, which must be supported by all processors
@ -126,7 +131,12 @@ implementation
end.
{
$Log$
Revision 1.19 2003-04-22 23:50:22 peter
Revision 1.20 2003-04-23 12:35:34 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.19 2003/04/22 23:50:22 peter
* firstpass uses expectloc
* checks if there are differences between the expectloc and
location.loc from secondpass in EXTDEBUG

9
compiler/cgobj.pas
View File

@ -1808,7 +1808,7 @@ unit cgobj;
var r:Tregister;
begin
r.enum:=R_INTREGISTER;;
r.enum:=R_INTREGISTER;
r.number:=NR_ACCUMULATOR;
a_load_ref_reg(list, OS_S32, href, r);
end;
@ -1838,7 +1838,12 @@ finalization
end.
{
$Log$
Revision 1.84 2003-04-22 14:33:38 peter
Revision 1.85 2003-04-23 12:35:34 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.84 2003/04/22 14:33:38 peter
* removed some notes/hints
Revision 1.83 2003/04/22 13:47:08 peter

10
compiler/fpcdefs.inc
View File

@ -52,6 +52,9 @@
{$define cpu64bit}
{$undef cpuflags}
{$endif alpha}
{$ifdef powerpc}
{$define callparatemp}
{$endif powerpc}
{ FPU Emulator support }
{$ifdef m68k}
@ -60,7 +63,12 @@
{
$Log$
Revision 1.14 2002-12-06 16:56:57 peter
Revision 1.15 2003-04-23 12:35:34 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.14 2002/12/06 16:56:57 peter
* only compile cs_fp_emulation support when cpufpuemu is defined
* define cpufpuemu for m68k only

35
compiler/m68k/cpubase.pas
View File

@ -288,35 +288,15 @@ uses
*****************************************************************************}
type
TLoc=(
LOC_INVALID, { added for tracking problems}
LOC_CONSTANT, { constant value }
LOC_JUMP, { boolean results only, jump to false or true label }
LOC_FLAGS, { boolean results only, flags are set }
LOC_CREFERENCE, { in memory constant value reference (cannot change) }
LOC_REFERENCE, { in memory value }
LOC_REGISTER, { in a processor register }
LOC_CREGISTER, { Constant register which shouldn't be modified }
LOC_FPUREGISTER, { FPU stack }
LOC_CFPUREGISTER, { if it is a FPU register variable on the fpu stack }
{ The m68k doesn't know multi media registers but this is for easier porting
because several generic parts of the compiler use it. }
LOC_MMREGISTER,
{ The m68k doesn't know multi media registers but this is for easier porting
because several generic parts of the compiler use it. }
LOC_CMMREGISTER
);
{ tparamlocation describes where a parameter for a procedure is stored.
References are given from the caller's point of view. The usual
TLocation isn't used, because contains a lot of unnessary fields.
}
tparalocation = packed record
size : TCGSize;
loc : TLoc;
loc : TCGLoc;
sp_fixup : longint;
case TLoc of
case TCGLoc of
LOC_REFERENCE : (reference : tparareference);
{ segment in reference at the same place as in loc_register }
LOC_REGISTER,LOC_CREGISTER : (
@ -331,9 +311,9 @@ uses
end;
tlocation = packed record
loc : TLoc;
loc : TCGLoc;
size : TCGSize;
case TLoc of
case TCGLoc of
LOC_FLAGS : (resflags : tresflags);
LOC_CONSTANT : (
case longint of
@ -726,7 +706,12 @@ implementation
end.
{
$Log$
Revision 1.18 2003-02-19 22:00:16 daniel
Revision 1.19 2003-04-23 12:35:35 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.18 2003/02/19 22:00:16 daniel
* Code generator converted to new register notation
- Horribily outdated todo.txt removed

106
compiler/ncal.pas
View File

@ -29,7 +29,7 @@ interface
uses
cutils,cclasses,
globtype,cpuinfo,
node,
node,nbas,
{$ifdef state_tracking}
nstate,
{$endif state_tracking}
@ -113,6 +113,9 @@ interface
function docompare(p: tnode): boolean; override;
procedure set_procvar(procvar:tnode);
private
{$ifdef callparatemp}
function extract_functioncall_paras: tblocknode;
{$endif callparatemp}
AbstractMethodsList : TStringList;
end;
tcallnodeclass = class of tcallnode;
@ -179,7 +182,8 @@ implementation
verbose,globals,
symconst,paramgr,defutil,defcmp,
htypechk,pass_1,cpubase,
nbas,ncnv,nld,ninl,nadd,ncon,nmem,
ncnv,nld,ninl,nadd,ncon,nmem,
nutils,
rgobj,cginfo,cgbase
;
@ -1958,6 +1962,58 @@ type
end;
{$ifdef callparatemp}
function tree_contains_function_call(var n: tnode): foreachnoderesult;
begin
result := fen_false;
if n.nodetype = calln then
{ stop when we encounter a call node }
result := fen_norecurse_true;
end;
function tcallnode.extract_functioncall_paras: tblocknode;
var
curpara: tcallparanode;
newblock: tblocknode;
newstatement: tstatementnode;
temp: ttempcreatenode;
foundcall: boolean;
begin
foundcall := false;
curpara := tcallparanode(left);
if assigned(curpara) then
curpara := tcallparanode(curpara.right);
newblock := nil;
while assigned(curpara) do
begin
if foreachnodestatic(curpara.left,@tree_contains_function_call) then
begin
if (not foundcall) then
begin
foundcall := true;
newblock := internalstatements(newstatement);
end;
temp := ctempcreatenode.create(curpara.left.resulttype,curpara.left.resulttype.def.size,true);
addstatement(newstatement,temp);
resulttypepass(newstatement);
addstatement(newstatement,
cassignmentnode.create(ctemprefnode.create(temp),curpara.left));
resulttypepass(newstatement);
{ after the assignment, turn the temp into a non-persistent one, so }
{ that it will be freed once it's used as parameter }
addstatement(newstatement,ctempdeletenode.create_normal_temp(temp));
resulttypepass(newstatement);
curpara.left := ctemprefnode.create(temp);
{ the para's themselves are "resulttypepassed" in in tcallnode.pass_1 }
end;
curpara := tcallparanode(curpara.right);
end;
result := newblock;
end;
{$endif callparatemp}
function tcallnode.pass_1 : tnode;
var
inlinecode : tnode;
@ -1965,6 +2021,11 @@ type
{$ifdef m68k}
regi : tregister;
{$endif}
{$ifdef callparatemp}
callparatemps, newblock: tblocknode;
statement: tstatementnode;
paras, oldright, newcall: tnode;
{$endif callparatemp}
label
errorexit;
begin
@ -1972,6 +2033,10 @@ type
inlined:=false;
inlinecode := nil;
{$ifdef callparatemp}
callparatemps := extract_functioncall_paras;
{$endif callparatemp}
{ work trough all parameters to get the register requirements }
if assigned(left) then
tcallparanode(left).det_registers;
@ -2176,9 +2241,39 @@ type
registersmmx:=max(left.registersmmx,registersmmx);
{$endif SUPPORT_MMX}
end;
{$ifdef callparatemp}
if (callparatemps <> nil) then
begin
{ we have to replace the callnode with a blocknode. firstpass will }
{ free the original call node. Avoid copying all subnodes though }
paras := left;
oldright := right;
left := nil;
right := nil;
newcall := self.getcopy;
tcallnode(newcall).left := paras;
tcallnode(newcall).right := oldright;
newblock := internalstatements(statement);
addstatement(statement,callparatemps);
{ add the copy of the call node after the callparatemps block }
{ and return that. The last statement of a bocknode determines }
{ the resulttype & location of the block -> ok. Working with a }
{ new block is easier than going to the end of the callparatemps }
{ block (JM) }
addstatement(statement,newcall);
result := newblock;
{ set to nil so we can free this one in case of an errorexit }
callparatemps := nil;
end;
{$endif callparatemp}
errorexit:
if inlined then
procdefinition.proccalloption:=pocall_inline;
{$ifdef callparatemp}
if assigned(callparatemps) then
callparatemps.free;
{$endif callparatemp}
end;
{$ifdef state_tracking}
@ -2391,7 +2486,12 @@ begin
end.
{
$Log$
Revision 1.139 2003-04-22 23:50:22 peter
Revision 1.140 2003-04-23 12:35:34 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.139 2003/04/22 23:50:22 peter
* firstpass uses expectloc
* checks if there are differences between the expectloc and
location.loc from secondpass in EXTDEBUG

27
compiler/ncgutil.pas
View File

@ -2000,7 +2000,11 @@ implementation
procedure genimplicitunitinit(list : TAAsmoutput);
var
oldprocinfo : tprocinfo;
begin
oldprocinfo:=procinfo;
procinfo:=voidprocpi;
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) and
target_info.use_function_relative_addresses then
@ -2008,17 +2012,26 @@ implementation
{$endif GDB}
list.concat(Tai_symbol.Createname_global('INIT$$'+current_module.modulename^,0));
list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_init',0));
{$ifndef i386}
{ on the 386, g_return_from_proc is a simple return, so we don't need a real stack frame }
cg.g_stackframe_entry(list,0);
{$endif i386}
{ using current_module.globalsymtable is hopefully }
{ more robust than symtablestack and symtablestack.next }
if assigned(current_module.globalsymtable) then
tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
cg.g_return_from_proc(list,0);
procinfo:=oldprocinfo;
end;
procedure genimplicitunitfinal(list : TAAsmoutput);
var
oldprocinfo : tprocinfo;
begin
oldprocinfo:=procinfo;
procinfo:=voidprocpi;
{$ifdef GDB}
if (cs_debuginfo in aktmoduleswitches) and
target_info.use_function_relative_addresses then
@ -2026,20 +2039,28 @@ implementation
{$endif GDB}
list.concat(Tai_symbol.Createname_global('FINALIZE$$'+current_module.modulename^,0));
list.concat(Tai_symbol.Createname_global(target_info.cprefix+current_module.modulename^+'_finalize',0));
{$ifndef i386}
{ on the 386, g_return_from_proc is a simple return, so we don't need a real stack frame }
cg.g_stackframe_entry(list,0);
{$endif i386}
{ using current_module.globalsymtable is hopefully }
{ more robust than symtablestack and symtablestack.next }
if assigned(current_module.globalsymtable) then
tsymtable(current_module.globalsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
tsymtable(current_module.localsymtable).foreach_static({$ifdef FPCPROCVAR}@{$endif}finalize_data,list);
cg.g_return_from_proc(list,0);
procinfo:=oldprocinfo;
end;
end.
{
$Log$
Revision 1.87 2003-04-22 14:33:38 peter
Revision 1.88 2003-04-23 12:35:34 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.87 2003/04/22 14:33:38 peter
* removed some notes/hints
Revision 1.86 2003/04/22 13:47:08 peter

156
compiler/nutils.pas Normal file
View File

@ -0,0 +1,156 @@
{
$Id$
Copyright (c) 1998-2002 by Florian Klaempfl
Type checking and register allocation for inline nodes
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 nutils;
{$i fpcdefs.inc}
interface
uses
node;
type
{ resulttype of functions that process on all nodes in a (sub)tree }
foreachnoderesult = (
{ false, continue recursion }
fen_false,
{ false, stop recursion }
fen_norecurse_false,
{ true, continue recursion }
fen_true,
{ true, stop recursion }
fen_norecurse_true
);
foreachnodefunction = function(var n: tnode): foreachnoderesult of object;
staticforeachnodefunction = function(var n: tnode): foreachnoderesult;
function foreachnode(var n: tnode; f: foreachnodefunction): boolean;
function foreachnodestatic(var n: tnode; f: staticforeachnodefunction): boolean;
implementation
uses nflw,nset,ncal;
function foreachnode(var n: tnode; f: foreachnodefunction): boolean;
begin
result := false;
if not assigned(n) then
exit;
case f(n) of
fen_norecurse_false:
exit;
fen_norecurse_true:
begin
result := true;
exit;
end;
fen_true:
result := true;
{ result is already false
fen_false:
result := false; }
end;
case n.nodetype of
calln:
result := foreachnode(tcallnode(n).methodpointer,f) or result;
procinlinen:
result := foreachnode(tprocinlinenode(n).inlinetree,f) or result;
ifn, whilerepeatn, forn:
begin
{ not in one statement, won't work because of b- }
result := foreachnode(tloopnode(n).t1,f) or result;
result := foreachnode(tloopnode(n).t2,f) or result;
end;
raisen:
result := foreachnode(traisenode(n).frametree,f) or result;
casen:
result := foreachnode(tcasenode(n). elseblock,f) or result;
end;
if n.inheritsfrom(tbinarynode) then
begin
result := foreachnode(tbinarynode(n).right,f) or result;
result := foreachnode(tbinarynode(n).left,f) or result;
end
else if n.inheritsfrom(tunarynode) then
result := foreachnode(tunarynode(n).left,f) or result;
end;
function foreachnodestatic(var n: tnode; f: staticforeachnodefunction): boolean;
begin
result := false;
if not assigned(n) then
exit;
case f(n) of
fen_norecurse_false:
exit;
fen_norecurse_true:
begin
result := true;
exit;
end;
fen_true:
result := true;
{ result is already false
fen_false:
result := false; }
end;
case n.nodetype of
calln:
result := foreachnodestatic(tcallnode(n).methodpointer,f) or result;
procinlinen:
result := foreachnodestatic(tprocinlinenode(n).inlinetree,f) or result;
ifn, whilerepeatn, forn:
begin
{ not in one statement, won't work because of b- }
result := foreachnodestatic(tloopnode(n).t1,f) or result;
result := foreachnodestatic(tloopnode(n).t2,f) or result;
end;
raisen:
result := foreachnodestatic(traisenode(n).frametree,f) or result;
casen:
result := foreachnodestatic(tcasenode(n). elseblock,f) or result;
end;
if n.inheritsfrom(tbinarynode) then
begin
result := foreachnodestatic(tbinarynode(n).right,f) or result;
result := foreachnodestatic(tbinarynode(n).left,f) or result;
end
else if n.inheritsfrom(tunarynode) then
result := foreachnodestatic(tunarynode(n).left,f) or result;
end;
end.
{
$Log$
Revision 1.1 2003-04-23 12:35:34 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
}

31
compiler/pmodules.pas
View File

@ -774,7 +774,9 @@ implementation
store_crc,store_interface_crc : cardinal;
s2 : ^string; {Saves stack space}
force_init_final : boolean;
initfinalcode : taasmoutput;
begin
initfinalcode:=taasmoutput.create;
consume(_UNIT);
if compile_level=1 then
Status.IsExe:=false;
@ -999,7 +1001,9 @@ implementation
{ now we can insert a cut }
if (cs_create_smart in aktmoduleswitches) then
codeSegment.concat(Tai_cut.Create);
genimplicitunitinit(codesegment);
genimplicitunitinit(initfinalcode);
initfinalcode.convert_registers;
codesegment.concatlist(initfinalcode);
end;
{ finalize? }
if token=_FINALIZATION then
@ -1021,7 +1025,9 @@ implementation
{ now we can insert a cut }
if (cs_create_smart in aktmoduleswitches) then
codeSegment.concat(Tai_cut.Create);
genimplicitunitfinal(codesegment);
genimplicitunitfinal(initfinalcode);
initfinalcode.convert_registers;
codesegment.concatlist(initfinalcode);
end;
{ the last char should always be a point }
@ -1166,7 +1172,10 @@ implementation
exit;
end;
initfinalcode.free;
Comment(V_Used,'Finished compiling module '+current_module.modulename^);
end;
@ -1175,7 +1184,9 @@ implementation
main_file: tinputfile;
st : tsymtable;
hp : tmodule;
initfinalcode : taasmoutput;
begin
initfinalcode:=taasmoutput.create;
DLLsource:=islibrary;
Status.IsLibrary:=IsLibrary;
Status.IsExe:=true;
@ -1318,11 +1329,15 @@ So, all parameters are passerd into registers in sparc architecture.}
{ Add initialize section }
if (cs_create_smart in aktmoduleswitches) then
codeSegment.concat(Tai_cut.Create);
genimplicitunitinit(codesegment);
genimplicitunitinit(initfinalcode);
initfinalcode.convert_registers;
codesegment.concatlist(initfinalcode);
{ Add finalize section }
if (cs_create_smart in aktmoduleswitches) then
codeSegment.concat(Tai_cut.Create);
genimplicitunitfinal(codesegment);
genimplicitunitfinal(initfinalcode);
initfinalcode.convert_registers;
codesegment.concatlist(initfinalcode);
end;
{ Add symbol to the exports section for win32 so smartlinking a
@ -1448,12 +1463,18 @@ So, all parameters are passerd into registers in sparc architecture.}
linker.MakeExecutable;
end;
end;
initfinalcode.free;
end;
end.
{
$Log$
Revision 1.100 2003-04-12 15:13:03 peter
Revision 1.101 2003-04-23 12:35:34 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.100 2003/04/12 15:13:03 peter
* Use the original unitname when defining a unitsym
Revision 1.99 2003/03/23 23:21:42 hajny

20
compiler/powerpc/agppcgas.pas
View File

@ -174,10 +174,10 @@ unit agppcgas;
if (symaddr <> refs_full) then
s := s+')'+symaddr2str[symaddr];
if (index.enum < firstreg) or (index.enum > lastreg) then
internalerror(20030312);
if (base.enum < firstreg) or (base.enum > lastreg) then
internalerror(200303123);
if (index.enum < firstreg) or (index.enum > lastreg) then
internalerror(20030312);
if (base.enum < firstreg) or (base.enum > lastreg) then
internalerror(200303123);
if (index.enum=R_NO) and (base.enum<>R_NO) then
begin
if offset=0 then
@ -192,7 +192,7 @@ unit agppcgas;
else if (index.enum<>R_NO) and (base.enum<>R_NO) and (offset=0) then
s:=s+gas_reg2str[base.enum]+','+gas_reg2str[index.enum]
else if ((index.enum<>R_NO) or (base.enum<>R_NO)) then
internalerror(19992);
internalerror(19992);
end;
getreferencestring:=s;
end;
@ -364,6 +364,9 @@ unit agppcgas;
sep:=#9;
for i:=0 to taicpu(hp).ops-1 do
begin
// debug code
// writeln(s);
// writeln(taicpu(hp).fileinfo.line);
s:=s+sep+getopstr(taicpu(hp).oper[i]);
sep:=',';
end;
@ -377,7 +380,12 @@ begin
end.
{
$Log$
Revision 1.21 2003-03-12 22:43:38 jonas
Revision 1.22 2003-04-23 12:35:35 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.21 2003/03/12 22:43:38 jonas
* more powerpc and generic fixes related to the new register allocator
Revision 1.20 2003/01/08 18:43:57 daniel

133
compiler/powerpc/cgcpu.pas
View File

@ -76,7 +76,7 @@ unit cgcpu;
procedure g_flags2reg(list: taasmoutput; size: TCgSize; const f: TResFlags; reg: TRegister); override;
procedure g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);override;
procedure g_stackframe_entry(list : taasmoutput;localsize : longint);override;
procedure g_return_from_proc(list : taasmoutput;parasize : aword); override;
procedure g_restore_frame_pointer(list : taasmoutput);override;
@ -958,7 +958,7 @@ const
{ following is the entry code as described in "Altivec Programming }
{ Interface Manual", bar the saving of AltiVec registers }
rsp.enum:=R_INTREGISTER;
rsp.number:=NR_STACK_POINTER_REG;;
rsp.number:=NR_STACK_POINTER_REG;
a_reg_alloc(list,rsp);
r.enum:=R_INTREGISTER;
r.number:=NR_R0;
@ -1824,6 +1824,128 @@ const
free_scratch_reg(list,dst.base);
end;
procedure tcgppc.g_copyvaluepara_openarray(list : taasmoutput;const ref:treference;elesize:integer);
var
lenref : treference;
power,len : longint;
{$ifndef __NOWINPECOFF__}
again,ok : tasmlabel;
{$endif}
r,r2,rsp:Tregister;
begin
{$warning !!!! FIX ME !!!!}
{!!!!
lenref:=ref;
inc(lenref.offset,4);
{ get stack space }
r.enum:=R_INTREGISTER;
r.number:=NR_EDI;
rsp.enum:=R_INTREGISTER;
rsp.number:=NR_ESP;
r2.enum:=R_INTREGISTER;
rg.getexplicitregisterint(list,NR_EDI);
list.concat(Taicpu.op_ref_reg(A_MOV,S_L,lenref,r));
list.concat(Taicpu.op_reg(A_INC,S_L,r));
if (elesize<>1) then
begin
if ispowerof2(elesize, power) then
list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r))
else
list.concat(Taicpu.op_const_reg(A_IMUL,S_L,elesize,r));
end;
{$ifndef __NOWINPECOFF__}
{ windows guards only a few pages for stack growing, }
{ so we have to access every page first }
if target_info.system=system_i386_win32 then
begin
objectlibrary.getlabel(again);
objectlibrary.getlabel(ok);
a_label(list,again);
list.concat(Taicpu.op_const_reg(A_CMP,S_L,winstackpagesize,r));
a_jmp_cond(list,OC_B,ok);
list.concat(Taicpu.op_const_reg(A_SUB,S_L,winstackpagesize-4,rsp));
r2.number:=NR_EAX;
list.concat(Taicpu.op_reg(A_PUSH,S_L,r));
list.concat(Taicpu.op_const_reg(A_SUB,S_L,winstackpagesize,r));
a_jmp_always(list,again);
a_label(list,ok);
list.concat(Taicpu.op_reg_reg(A_SUB,S_L,r,rsp));
rg.ungetregisterint(list,r);
{ now reload EDI }
rg.getexplicitregisterint(list,NR_EDI);
list.concat(Taicpu.op_ref_reg(A_MOV,S_L,lenref,r));
list.concat(Taicpu.op_reg(A_INC,S_L,r));
if (elesize<>1) then
begin
if ispowerof2(elesize, power) then
list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r))
else
list.concat(Taicpu.op_const_reg(A_IMUL,S_L,elesize,r));
end;
end
else
{$endif __NOWINPECOFF__}
list.concat(Taicpu.op_reg_reg(A_SUB,S_L,r,rsp));
{ align stack on 4 bytes }
list.concat(Taicpu.op_const_reg(A_AND,S_L,$fffffff4,rsp));
{ load destination }
a_load_reg_reg(list,OS_INT,OS_INT,rsp,r);
{ don't destroy the registers! }
r2.number:=NR_ECX;
list.concat(Taicpu.op_reg(A_PUSH,S_L,r2));
r2.number:=NR_ESI;
list.concat(Taicpu.op_reg(A_PUSH,S_L,r2));
{ load count }
r2.number:=NR_ECX;
a_load_ref_reg(list,OS_INT,lenref,r2);
{ load source }
r2.number:=NR_ESI;
a_load_ref_reg(list,OS_INT,ref,r2);
{ scheduled .... }
r2.number:=NR_ECX;
list.concat(Taicpu.op_reg(A_INC,S_L,r2));
{ calculate size }
len:=elesize;
opsize:=S_B;
if (len and 3)=0 then
begin
opsize:=S_L;
len:=len shr 2;
end
else
if (len and 1)=0 then
begin
opsize:=S_W;
len:=len shr 1;
end;
if ispowerof2(len, power) then
list.concat(Taicpu.op_const_reg(A_SHL,S_L,power,r2))
else
list.concat(Taicpu.op_const_reg(A_IMUL,S_L,len,r2));
list.concat(Taicpu.op_none(A_REP,S_NO));
case opsize of
S_B : list.concat(Taicpu.Op_none(A_MOVSB,S_NO));
S_W : list.concat(Taicpu.Op_none(A_MOVSW,S_NO));
S_L : list.concat(Taicpu.Op_none(A_MOVSD,S_NO));
end;
rg.ungetregisterint(list,r);
r2.number:=NR_ESI;
list.concat(Taicpu.op_reg(A_POP,S_L,r2));
r2.number:=NR_ECX;
list.concat(Taicpu.op_reg(A_POP,S_L,r2));
{ patch the new address }
a_load_reg_ref(list,OS_INT,rsp,ref);
!!!!}
end;
procedure tcgppc.g_overflowcheck(list: taasmoutput; const p: tnode);
@ -2215,7 +2337,12 @@ begin
end.
{
$Log$
Revision 1.78 2003-04-16 09:26:55 jonas
Revision 1.79 2003-04-23 12:35:35 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.78 2003/04/16 09:26:55 jonas
* assembler procedures now again get a stackframe if they have local
variables. No space is reserved for a function result however.
Also, the register parameters aren't automatically saved on the stack

42
compiler/powerpc/cpubase.pas
View File

@ -395,33 +395,6 @@ uses
*****************************************************************************}
type
TLoc=(
{ added for tracking problems}
LOC_INVALID,
{ ordinal constant }
LOC_CONSTANT,
{ in a processor register }
LOC_REGISTER,
{ Constant register which shouldn't be modified }
LOC_CREGISTER,
{ FPU register}
LOC_FPUREGISTER,
{ Constant FPU register which shouldn't be modified }
LOC_CFPUREGISTER,
{ multimedia register }
LOC_MMREGISTER,
{ Constant multimedia reg which shouldn't be modified }
LOC_CMMREGISTER,
{ in memory }
LOC_REFERENCE,
{ in memory (constant) }
LOC_CREFERENCE,
{ boolean results only, jump to false or true label }
LOC_JUMP,
{ boolean results only, flags are set }
LOC_FLAGS
);
{ tparamlocation describes where a parameter for a procedure is stored.
References are given from the caller's point of view. The usual
TLocation isn't used, because contains a lot of unnessary fields.
@ -431,7 +404,7 @@ uses
{ The location type where the parameter is passed, usually
LOC_REFERENCE,LOC_REGISTER or LOC_FPUREGISTER
}
loc : TLoc;
loc : TCGLoc;
{ The stack pointer must be decreased by this value before
the parameter is copied to the given destination.
This allows to "encode" pushes with tparalocation.
@ -439,7 +412,7 @@ uses
because several generic code accesses it.
}
sp_fixup : longint;
case TLoc of
case TCGLoc of
LOC_REFERENCE : (reference : tparareference);
LOC_FPUREGISTER, LOC_CFPUREGISTER, LOC_MMREGISTER, LOC_CMMREGISTER,
LOC_REGISTER,LOC_CREGISTER : (
@ -466,8 +439,8 @@ uses
tlocation = packed record
size : TCGSize;
loc : tloc;
case tloc of
loc : tcgloc;
case tcgloc of
LOC_CREFERENCE,LOC_REFERENCE : (reference : treference);
LOC_CONSTANT : (
case longint of
@ -879,7 +852,12 @@ implementation
end.
{
$Log$
Revision 1.47 2003-04-22 11:27:48 florian
Revision 1.48 2003-04-23 12:35:35 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.47 2003/04/22 11:27:48 florian
+ added first_ and last_imreg
Revision 1.46 2003/03/19 14:26:26 jonas

11
compiler/powerpc/cpupara.pas
View File

@ -67,7 +67,7 @@ unit cpupara;
end;
end;
function getparaloc(p : tdef) : tloc;
function getparaloc(p : tdef) : tcgloc;
begin
{ Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER
@ -129,7 +129,7 @@ unit cpupara;
paradef : tdef;
stack_offset : aword;
hp : tparaitem;
loc : tloc;
loc : tcgloc;
is_64bit: boolean;
procedure assignintreg;
@ -301,7 +301,12 @@ begin
end.
{
$Log$
Revision 1.25 2003-04-17 18:52:35 jonas
Revision 1.26 2003-04-23 12:35:35 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.25 2003/04/17 18:52:35 jonas
* process para's from first to last instead of the other way round
Revision 1.24 2003/04/16 07:55:07 jonas

9
compiler/powerpc/nppcadd.pas
View File

@ -73,7 +73,7 @@ interface
result := nil;
firstpass(left);
firstpass(right);
location.loc := LOC_FLAGS;
expectloc := LOC_FLAGS;
calcregisters(self,2,0,0);
exit;
end;
@ -1479,7 +1479,12 @@ begin
end.
{
$Log$
Revision 1.24 2003-03-11 21:46:24 jonas
Revision 1.25 2003-04-23 12:35:35 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.24 2003/03/11 21:46:24 jonas
* lots of new regallocator fixes, both in generic and ppc-specific code
(ppc compiler still can't compile the linux system unit though)

38
compiler/powerpc/nppccal.pas
View File

@ -72,38 +72,43 @@ implementation
end;
procedure tppccallnode.push_framepointer;
var
href : treference;
hregister1,hregister2 : tregister;
i : longint;
begin
{
if lexlevel=(tprocdef(procdefinition).parast.symtablelevel) then
begin
reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
cg.a_param_ref(exprasmlist,OS_ADDR,href,paramanager.getframepointerloc(procinfo.procdef));
{ pass the same framepointer as the current procedure got }
hregister2.enum:=R_INTREGISTER;
hregister2.number:=NR_R11;
cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,procinfo.framepointer,hregister2);
{ it must be adjusted! }
end
{ this is only true if the difference is one !!
but it cannot be more !! }
else if (lexlevel=(tprocdef(procdefinition).parast.symtablelevel)-1) then
begin
cg.a_param_reg(exprasmlist,OS_ADDR,procinfo^.framepointer,paramanager.getframepointerloc(procinfo.procdef));
// cg.a_param_reg(exprasmlist,OS_ADDR,procinfo.framepointer,paramanager.getframepointerloc(procinfo.procdef));
end
else if (lexlevel>(tprocdef(procdefinition).parast.symtablelevel)) then
begin
hregister:=rg.getregisterint(exprasmlist);
reference_reset_base(href,procinfo^.framepointer,procinfo^.framepointer_offset);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
hregister1:=rg.getregisterint(exprasmlist,OS_ADDR);
reference_reset_base(href,procinfo.framepointer,procinfo.framepointer_offset);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister1);
for i:=(tprocdef(procdefinition).parast.symtablelevel) to lexlevel-1 do
begin
{we should get the correct frame_pointer_offset at each level
how can we do this !!! }
reference_reset_base(href,hregister,procinfo^.framepointer_offset);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister);
reference_reset_base(href,hregister2,procinfo.framepointer_offset);
cg.a_load_ref_reg(exprasmlist,OS_ADDR,href,hregister1);
end;
cg.a_param_reg(exprasmlist,OS_ADDR,hregister,-1);
rg.ungetregisterint(exprasmlist,hregister);
hregister2.enum:=R_11;
cg.a_load_reg_reg(exprasmlist,OS_ADDR,OS_ADDR,hregister1,hregister2);
rg.ungetregisterint(exprasmlist,hregister1);
end
else
internalerror(2002081303);
}
end;
begin
@ -111,7 +116,12 @@ begin
end.
{
$Log$
Revision 1.5 2003-04-04 15:38:56 peter
Revision 1.6 2003-04-23 12:35:35 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.5 2003/04/04 15:38:56 peter
* moved generic code from n386cal to ncgcal, i386 now also
uses the generic ncgcal

9
compiler/powerpc/nppccnv.pas
View File

@ -272,7 +272,7 @@ implementation
begin
{ byte(boolean) or word(wordbool) or longint(longbool) must }
{ be accepted for var parameters }
if (nf_explizit in flags) and
if (nf_explicit in flags) and
(left.resulttype.def.size=resulttype.def.size) and
(left.location.loc in [LOC_REFERENCE,LOC_CREFERENCE,LOC_CREGISTER]) then
begin
@ -394,7 +394,12 @@ begin
end.
{
$Log$
Revision 1.30 2003-03-11 21:46:24 jonas
Revision 1.31 2003-04-23 12:35:35 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.30 2003/03/11 21:46:24 jonas
* lots of new regallocator fixes, both in generic and ppc-specific code
(ppc compiler still can't compile the linux system unit though)

16
compiler/powerpc/nppcinl.pas
View File

@ -64,7 +64,7 @@ implementation
function tppcinlinenode.first_abs_real : tnode;
begin
location.loc:=LOC_FPUREGISTER;
expectloc:=LOC_FPUREGISTER;
registers32:=left.registers32;
registersfpu:=max(left.registersfpu,1);
{$ifdef SUPPORT_MMX}
@ -75,7 +75,7 @@ implementation
function tppcinlinenode.first_sqr_real : tnode;
begin
location.loc:=LOC_FPUREGISTER;
expectloc:=LOC_FPUREGISTER;
registers32:=left.registers32;
registersfpu:=max(left.registersfpu,1);
{$ifdef SUPPORT_MMX}
@ -86,7 +86,7 @@ implementation
function tppcinlinenode.first_sqrt_real : tnode;
begin
location.loc:=LOC_FPUREGISTER;
expectloc:=LOC_FPUREGISTER;
registers32:=left.registers32;
registersfpu:=max(left.registersfpu,1);
{$ifdef SUPPORT_MMX}
@ -126,6 +126,7 @@ implementation
procedure tppcinlinenode.second_abs_real;
begin
location.loc:=LOC_FPUREGISTER;
load_fpu_location;
exprasmlist.concat(taicpu.op_reg_reg(A_FABS,location.register,
left.location.register));
@ -133,6 +134,7 @@ implementation
procedure tppcinlinenode.second_sqr_real;
begin
location.loc:=LOC_FPUREGISTER;
load_fpu_location;
exprasmlist.concat(taicpu.op_reg_reg_reg(A_FMUL,location.register,
left.location.register,left.location.register));
@ -140,6 +142,7 @@ implementation
procedure tppcinlinenode.second_sqrt_real;
begin
location.loc:=LOC_FPUREGISTER;
load_fpu_location;
exprasmlist.concat(taicpu.op_reg_reg(A_FSQRT,location.register,
left.location.register));
@ -150,7 +153,12 @@ begin
end.
{
$Log$
Revision 1.4 2002-11-25 17:43:28 peter
Revision 1.5 2003-04-23 12:35:35 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.4 2002/11/25 17:43:28 peter
* splitted defbase in defutil,symutil,defcmp
* merged isconvertable and is_equal into compare_defs(_ext)
* made operator search faster by walking the list only once

9
compiler/psub.pas
View File

@ -329,7 +329,7 @@ implementation
{When we are called to compile the body of a unit, aktprocsym should
point to the unit initialization. If the unit has no initialization,
aktprocsym=nil. But in that case code=nil. hus we should check for
aktprocsym=nil. But in that case code=nil. Thus we should check for
code=nil, when we use aktprocsym.}
{ set the start offset to the start of the temp area in the stack }
@ -884,7 +884,12 @@ implementation
end.
{
$Log$
Revision 1.101 2003-04-22 14:33:38 peter
Revision 1.102 2003-04-23 12:35:34 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.101 2003/04/22 14:33:38 peter
* removed some notes/hints
Revision 1.100 2003/04/22 13:47:08 peter

31
compiler/sparc/cpubase.pas
View File

@ -366,30 +366,14 @@ TYPE
Generic Location
*****************************************************************************}
TYPE
TLoc=( {information about the location of an operand}
LOC_INVALID, { added for tracking problems}
LOC_CONSTANT, { CONSTant value }
LOC_JUMP, { boolean results only, jump to false or true label }
LOC_FLAGS, { boolean results only, flags are set }
LOC_CREFERENCE, { in memory CONSTant value }
LOC_REFERENCE, { in memory value }
LOC_REGISTER, { in a processor register }
LOC_CREGISTER, { Constant register which shouldn't be modified }
LOC_FPUREGISTER, { FPU stack }
LOC_CFPUREGISTER, { if it is a FPU register variable on the fpu stack }
LOC_MMXREGISTER, { MMX register }
LOC_CMMXREGISTER, { MMX register variable }
LOC_MMREGISTER,
LOC_CMMREGISTER
);
{tparamlocation describes where a parameter for a procedure is stored.
References are given from the caller's point of view. The usual TLocation isn't
used, because contains a lot of unnessary fields.}
TParaLocation=PACKED RECORD
Size:TCGSize;
Loc:TLoc;
Loc:TCGLoc;
sp_fixup:LongInt;
CASE TLoc OF
CASE TCGLoc OF
LOC_REFERENCE:(reference:tparareference);
{ segment in reference at the same place as in loc_register }
LOC_REGISTER,LOC_CREGISTER : (
@ -405,9 +389,9 @@ used, because contains a lot of unnessary fields.}
LOC_MMXREGISTER,LOC_CMMXREGISTER : (mmxreg : tregister);
END;
TLocation=PACKED RECORD
loc : TLoc;
loc : TCGLoc;
size : TCGSize;
case TLoc of
case TCGLoc of
LOC_FLAGS : (resflags : tresflags);
LOC_CONSTANT : (
case longint of
@ -676,7 +660,12 @@ END.
{
$Log$
Revision 1.25 2003-03-10 21:59:54 mazen
Revision 1.26 2003-04-23 12:35:35 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.25 2003/03/10 21:59:54 mazen
* fixing index overflow in handling new registers arrays.
Revision 1.24 2003/02/26 22:06:27 mazen

11
compiler/sparc/cpupara.pas
View File

@ -63,7 +63,7 @@ function TSparcParaManager.GetIntParaLoc(nr:longint):TParaLocation;
reference.offset:=-68-nr*4;
end;
end;
function GetParaLoc(p:TDef):TLoc;
function GetParaLoc(p:TDef):TCGLoc;
begin
{Later, the LOC_REFERENCE is in most cases changed into LOC_REGISTER if
push_addr_param for the def is true}
@ -124,7 +124,7 @@ procedure TSparcParaManager.create_param_loc_info(p:TAbstractProcDef);
nextintreg,nextfloatreg:tregister;
stack_offset:aword;
hp:tparaitem;
loc:tloc;
loc:tcgloc;
is_64bit:boolean;
begin
nextintreg.enum:=R_O0;
@ -281,7 +281,12 @@ begin
end.
{
$Log$
Revision 1.14 2003-01-08 18:43:58 daniel
Revision 1.15 2003-04-23 12:35:35 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.14 2003/01/08 18:43:58 daniel
* Tregister changed into a record
Revision 1.13 2003/01/05 21:32:35 mazen

25
compiler/symdef.pas
View File

@ -687,11 +687,19 @@ interface
ordpointertype,
pvmttype : ttype; { type of classrefs, used for stabs }
{ pointer to the anchestor of all classes }
class_tobject : tobjectdef;
{ pointer to the ancestor of all COM interfaces }
interface_iunknown : tobjectdef;
{ pointer to the TGUID type
of all interfaces }
rec_tguid : trecorddef;
class_tobject : tobjectdef; { pointer to the anchestor of all classes }
interface_iunknown : tobjectdef; { KAZ: pointer to the ancestor }
rec_tguid : trecorddef; { KAZ: pointer to the TGUID type }
{ of all interfaces }
{ Pointer to a procdef with no parameters and no return value.
This is used for procedures which are generated automatically
by the compiler.
}
voidprocdef : tprocdef;
const
{$ifdef i386}
@ -5706,10 +5714,17 @@ implementation
(tobjectdef(def).objecttype in [odt_class,odt_interfacecom,odt_interfacecorba]);
end;
begin
voidprocdef:=tprocdef.create;
end.
{
$Log$
Revision 1.133 2003-04-10 17:57:53 peter
Revision 1.134 2003-04-23 12:35:34 florian
* fixed several issues with powerpc
+ applied a patch from Jonas for nested function calls (PowerPC only)
* ...
Revision 1.133 2003/04/10 17:57:53 peter
* vs_hidden released
Revision 1.132 2003/03/18 16:25:50 peter