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

* make cycle fixed i.e. compilation with 0.99.10

Browse Source 
* some fixes for qword
  * start of register calling conventions
This commit is contained in:
florian 1999-06-02 10:11:39 +00:00
parent 707919f207
commit 2ad3da43e6
12 changed files with 408 additions and 242 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

31
compiler/cg386add.pas
View File

@ -157,9 +157,9 @@ implementation
{ to avoid problem with maybe_push and restore }
set_location(p^.location,p^.left^.location);
pushed:=maybe_push(p^.right^.registers32,p);
pushed:=maybe_push(p^.right^.registers32,p,false);
secondpass(p^.right);
if pushed then restore(p);
if pushed then restore(p,false);
{ release used registers }
case p^.right^.location.loc of
LOC_REFERENCE,LOC_MEM:
@ -195,9 +195,9 @@ implementation
begin
cmpop:=true;
secondpass(p^.left);
pushed:=maybe_push(p^.right^.registers32,p);
pushed:=maybe_push(p^.right^.registers32,p,false);
secondpass(p^.right);
if pushed then restore(p);
if pushed then restore(p,false);
{ release used registers }
case p^.right^.location.loc of
LOC_REFERENCE,LOC_MEM:
@ -301,9 +301,9 @@ implementation
begin
secondpass(p^.left);
{ are too few registers free? }
pushed:=maybe_push(p^.right^.registers32,p);
pushed:=maybe_push(p^.right^.registers32,p,false);
secondpass(p^.right);
if pushed then restore(p);
if pushed then restore(p,false);
{ only one node can be stringconstn }
{ else pass 1 would have evaluted }
{ this node }
@ -372,12 +372,12 @@ implementation
end;
{ are too few registers free? }
pushed:=maybe_push(p^.right^.registers32,p);
pushed:=maybe_push(p^.right^.registers32,p,false);
secondpass(p^.right);
if codegenerror then
exit;
if pushed then
restore(p);
restore(p,false);
set_location(p^.location,p^.left^.location);
@ -761,7 +761,7 @@ implementation
end;
end;
set_location(p^.location,p^.left^.location);
pushed:=maybe_push(p^.right^.registers32,p);
pushed:=maybe_push(p^.right^.registers32,p,false);
if p^.right^.location.loc=LOC_JUMP then
begin
otl:=truelabel;
@ -770,7 +770,7 @@ implementation
getlabel(falselabel);
end;
secondpass(p^.right);
if pushed then restore(p);
if pushed then restore(p,false);
case p^.right^.location.loc of
LOC_FLAGS:
locflags2reg(p^.right^.location,opsize);
@ -825,10 +825,10 @@ implementation
set_location(p^.location,p^.left^.location);
{ are too few registers free? }
pushed:=maybe_push(p^.right^.registers32,p);
pushed:=maybe_push(p^.right^.registers32,p,is_64bitint(p^.left^.resulttype));
secondpass(p^.right);
if pushed then
restore(p);
restore(p,is_64bitint(p^.left^.resulttype));
if (p^.left^.resulttype^.deftype=pointerdef) or
@ -2111,7 +2111,12 @@ implementation
end.
{
$Log$
Revision 1.63 1999-05-31 20:35:45 peter
Revision 1.64 1999-06-02 10:11:39 florian
* make cycle fixed i.e. compilation with 0.99.10
* some fixes for qword
* start of register calling conventions
Revision 1.63 1999/05/31 20:35:45 peter
* ansistring fixes, decr_ansistr called after all temp ansi reuses
Revision 1.62 1999/05/27 19:44:04 peter

11
compiler/cg386cal.pas
View File

@ -45,6 +45,10 @@ implementation
{$endif GDB}
hcodegen,temp_gen,pass_2,
i386base,i386asm,
{$ifdef dummy}
end { this overcomes the annoying highlighting problem in my TP IDE,
the IDE assumes i386asm start a asm block (FK) }
{$endif}
cgai386,tgeni386,cg386ld;
{*****************************************************************************
@ -1163,7 +1167,12 @@ implementation
end.
{
$Log$
Revision 1.89 1999-05-28 15:59:46 pierre
Revision 1.90 1999-06-02 10:11:40 florian
* make cycle fixed i.e. compilation with 0.99.10
* some fixes for qword
* start of register calling conventions
Revision 1.89 1999/05/28 15:59:46 pierre
* forgotten emitcall change in conditionnal
Revision 1.88 1999/05/28 11:00:49 peter

15
compiler/cg386inl.pas
View File

@ -204,6 +204,8 @@ implementation
iolabel : pasmlabel;
npara : longint;
begin
{ here we don't use register calling conventions }
dummycoll.register:=R_NO;
{ I/O check }
if (cs_check_io in aktlocalswitches) and
((aktprocsym^.definition^.options and poiocheck)=0) then
@ -499,6 +501,7 @@ implementation
procedureprefix : string;
begin
dummycoll.register:=R_NO;
pushusedregisters(pushed,$ff);
node:=p^.left;
is_real:=false;
@ -630,6 +633,7 @@ implementation
has_code, has_32bit_code, oldregisterdef: boolean;
begin
dummycoll.register:=R_NO;
node:=p^.left;
hp:=node;
node:=node^.right;
@ -1193,10 +1197,10 @@ implementation
else
begin
{ generate code for the element to set }
ispushed:=maybe_push(p^.left^.right^.left^.registers32,p^.left^.left);
ispushed:=maybe_push(p^.left^.right^.left^.registers32,p^.left^.left,false);
secondpass(p^.left^.right^.left);
if ispushed then
restore(p^.left^.left);
restore(p^.left^.left,false);
{ determine asm operator }
if p^.inlinenumber=in_include_x_y then
asmop:=A_BTS
@ -1246,7 +1250,12 @@ implementation
end.
{
$Log$
Revision 1.56 1999-05-31 12:43:32 peter
Revision 1.57 1999-06-02 10:11:43 florian
* make cycle fixed i.e. compilation with 0.99.10
* some fixes for qword
* start of register calling conventions
Revision 1.56 1999/05/31 12:43:32 peter
* fixed register allocation for storefuncresult
Revision 1.55 1999/05/27 19:44:13 peter

357
compiler/cg386mat.pas
View File

@ -40,6 +40,10 @@ implementation
symtable,aasm,types,
hcodegen,temp_gen,pass_2,
i386base,i386asm,
{$ifdef dummy}
end { this overcomes the annoying highlighting problem in my TP IDE,
the IDE assumes i386asm start a asm block (FK) }
{$endif}
cgai386,tgeni386;
{*****************************************************************************
@ -53,179 +57,223 @@ implementation
power : longint;
hl : pasmlabel;
hloc : tlocation;
pushedreg : tpushed;
typename,opname : string[6];
begin
shrdiv := false;
andmod := false;
secondpass(p^.left);
set_location(p^.location,p^.left^.location);
pushed:=maybe_push(p^.right^.registers32,p);
pushed:=maybe_push(p^.right^.registers32,p,is_64bitint(p^.left^.resulttype));
secondpass(p^.right);
if pushed then restore(p);
if pushed then restore(p,is_64bitint(p^.left^.resulttype));
{ put numerator in register }
if p^.left^.location.loc<>LOC_REGISTER then
if is_64bitint(p^.resulttype) then
begin
if p^.left^.location.loc=LOC_CREGISTER then
begin
hreg1:=getregister32;
emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hreg1);
end
{ save p^.lcoation, because we change it now }
set_location(hloc,p^.location);
release_qword_loc(p^.location);
release_qword_loc(p^.right^.location);
p^.location.registerlow:=getexplicitregister32(R_EAX);
p^.location.registerhigh:=getexplicitregister32(R_EDX);
pushusedregisters(pushedreg,$ff
and not($80 shr byte(p^.location.registerlow))
and not($80 shr byte(p^.location.registerhigh)));
if cs_check_overflow in aktlocalswitches then
push_int(1)
else
begin
del_reference(p^.left^.location.reference);
hreg1:=getregister32;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
hreg1)));
end;
clear_location(p^.left^.location);
p^.left^.location.loc:=LOC_REGISTER;
p^.left^.location.register:=hreg1;
end
else hreg1:=p^.left^.location.register;
push_int(0);
{ the left operand is in hloc, because the
location of left is p^.location but p^.location
is already destroyed
}
emit_pushq_loc(hloc);
clear_location(hloc);
emit_pushq_loc(p^.right^.location);
if (p^.treetype=divn) and (p^.right^.treetype=ordconstn) and
ispowerof2(p^.right^.value,power) then
Begin
shrdiv := true;
{for signed numbers, the numerator must be adjusted before the
shift instruction, but not wih unsigned numbers! Otherwise,
"Cardinal($ffffffff) div 16" overflows! (JM)}
If is_signed(p^.left^.resulttype) Then
Begin
exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,hreg1,hreg1)));
getlabel(hl);
emitjmp(C_NS,hl);
if power=1 then
exprasmlist^.concat(new(pai386,op_reg(A_INC,S_L,hreg1)))
if porddef(p^.resulttype)^.typ=u64bit then
typename:='QWORD'
else
typename:='INT64';
if p^.treetype=divn then
opname:='DIV_'
else
opname:='MOD_';
emitcall('FPC_'+opname+typename);
emit_reg_reg(A_MOV,S_L,R_EAX,p^.location.registerlow);
emit_reg_reg(A_MOV,S_L,R_EDX,p^.location.registerhigh);
popusedregisters(pushedreg);
p^.location.loc:=LOC_REGISTER;
end
else
begin
{ put numerator in register }
if p^.left^.location.loc<>LOC_REGISTER then
begin
if p^.left^.location.loc=LOC_CREGISTER then
begin
hreg1:=getregister32;
emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hreg1);
end
else
exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,p^.right^.value-1,hreg1)));
emitlab(hl);
exprasmlist^.concat(new(pai386,op_const_reg(A_SAR,S_L,power,hreg1)));
End
Else
exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_L,power,hreg1)));
End
else
if (p^.treetype=modn) and (p^.right^.treetype=ordconstn) and
ispowerof2(p^.right^.value,power) and Not(is_signed(p^.left^.resulttype)) Then
{is there a similar trick for MOD'ing signed numbers? (JM)}
Begin
exprasmlist^.concat(new(pai386,op_const_reg(A_AND,S_L,p^.right^.value-1,hreg1)));
andmod := true;
End
else
begin
{ bring denominator to EDI }
{ EDI is always free, it's }
{ only used for temporary }
{ purposes }
if (p^.right^.location.loc<>LOC_REGISTER) and
(p^.right^.location.loc<>LOC_CREGISTER) then
begin
del_reference(p^.right^.location.reference);
p^.left^.location.loc:=LOC_REGISTER;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.right^.location.reference),R_EDI)));
end
else
begin
emit_reg_reg(A_MOV,S_L,p^.right^.location.register,R_EDI);
ungetregister32(p^.right^.location.register);
end;
popedx:=false;
popeax:=false;
if hreg1=R_EDX then
begin
if not(R_EAX in unused) then
begin
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
popeax:=true;
del_reference(p^.left^.location.reference);
hreg1:=getregister32;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.left^.location.reference),
hreg1)));
end;
emit_reg_reg(A_MOV,S_L,R_EDX,R_EAX);
clear_location(p^.left^.location);
p^.left^.location.loc:=LOC_REGISTER;
p^.left^.location.register:=hreg1;
end
else
begin
if not(R_EDX in unused) then
else hreg1:=p^.left^.location.register;
if (p^.treetype=divn) and (p^.right^.treetype=ordconstn) and
ispowerof2(p^.right^.value,power) then
Begin
shrdiv := true;
{for signed numbers, the numerator must be adjusted before the
shift instruction, but not wih unsigned numbers! Otherwise,
"Cardinal($ffffffff) div 16" overflows! (JM)}
If is_signed(p^.left^.resulttype) Then
Begin
exprasmlist^.concat(new(pai386,op_reg_reg(A_OR,S_L,hreg1,hreg1)));
getlabel(hl);
emitjmp(C_NS,hl);
if power=1 then
exprasmlist^.concat(new(pai386,op_reg(A_INC,S_L,hreg1)))
else
exprasmlist^.concat(new(pai386,op_const_reg(A_ADD,S_L,p^.right^.value-1,hreg1)));
emitlab(hl);
exprasmlist^.concat(new(pai386,op_const_reg(A_SAR,S_L,power,hreg1)));
End
Else
exprasmlist^.concat(new(pai386,op_const_reg(A_SHR,S_L,power,hreg1)));
End
else
if (p^.treetype=modn) and (p^.right^.treetype=ordconstn) and
ispowerof2(p^.right^.value,power) and Not(is_signed(p^.left^.resulttype)) Then
{is there a similar trick for MOD'ing signed numbers? (JM)}
Begin
exprasmlist^.concat(new(pai386,op_const_reg(A_AND,S_L,p^.right^.value-1,hreg1)));
andmod := true;
End
else
begin
{ bring denominator to EDI }
{ EDI is always free, it's }
{ only used for temporary }
{ purposes }
if (p^.right^.location.loc<>LOC_REGISTER) and
(p^.right^.location.loc<>LOC_CREGISTER) then
begin
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDX)));
popedx:=true;
del_reference(p^.right^.location.reference);
p^.left^.location.loc:=LOC_REGISTER;
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(p^.right^.location.reference),R_EDI)));
end
else
begin
emit_reg_reg(A_MOV,S_L,p^.right^.location.register,R_EDI);
ungetregister32(p^.right^.location.register);
end;
if hreg1<>R_EAX then
popedx:=false;
popeax:=false;
if hreg1=R_EDX then
begin
if not(R_EAX in unused) then
if not(R_EAX in unused) then
begin
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
popeax:=true;
end;
emit_reg_reg(A_MOV,S_L,hreg1,R_EAX);
end;
end;
{ sign extension depends on the left type }
if porddef(p^.left^.resulttype)^.typ=u32bit then
exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_EDX,R_EDX)))
else
exprasmlist^.concat(new(pai386,op_none(A_CDQ,S_NO)));
{ division depends on the right type }
if porddef(p^.right^.resulttype)^.typ=u32bit then
exprasmlist^.concat(new(pai386,op_reg(A_DIV,S_L,R_EDI)))
else
exprasmlist^.concat(new(pai386,op_reg(A_IDIV,S_L,R_EDI)));
if p^.treetype=divn then
begin
{ if result register is busy then copy }
if popeax then
begin
if hreg1=R_EAX then
internalerror(112);
emit_reg_reg(A_MOV,S_L,R_EAX,hreg1)
emit_reg_reg(A_MOV,S_L,R_EDX,R_EAX);
end
else
if hreg1<>R_EAX then
Begin
ungetregister32(hreg1);
hreg1 := getexplicitregister32(R_EAX);
{ I don't think it's possible that now hreg1 <> R_EAX
since popeax is false, but for all certainty I do
support that situation (JM)}
if hreg1 <> R_EAX then
emit_reg_reg(A_MOV,S_L,R_EAX,hreg1);
end;
end
else
{if we did the mod by an "and", the result is in hreg1 and
EDX certainly hasn't been pushed (JM)}
if not(andmod) Then
if popedx then
{the mod was done by an (i)div (so the result is now in
edx), but edx was occupied prior to the division, so
move the result into a safe place (JM)}
emit_reg_reg(A_MOV,S_L,R_EDX,hreg1)
else
Begin
{Get rid of the unnecessary hreg1 if possible (same as with
EAX in divn) (JM)}
ungetregister32(hreg1);
hreg1 := getexplicitregister32(R_EDX);
if hreg1 <> R_EDX then
emit_reg_reg(A_MOV,S_L,R_EDX,hreg1);;
End;
if popeax then
exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
if popedx then
exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDX)));
end;
If not(andmod or shrdiv) then
{andmod and shrdiv only use hreg1 (which is already in usedinproc,
since it was acquired with getregister), the others also use both
EAX and EDX (JM)}
Begin
usedinproc:=usedinproc or ($80 shr byte(R_EAX));
usedinproc:=usedinproc or ($80 shr byte(R_EDX));
End;
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=hreg1;
begin
if not(R_EDX in unused) then
begin
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EDX)));
popedx:=true;
end;
if hreg1<>R_EAX then
begin
if not(R_EAX in unused) then
begin
exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
popeax:=true;
end;
emit_reg_reg(A_MOV,S_L,hreg1,R_EAX);
end;
end;
{ sign extension depends on the left type }
if porddef(p^.left^.resulttype)^.typ=u32bit then
exprasmlist^.concat(new(pai386,op_reg_reg(A_XOR,S_L,R_EDX,R_EDX)))
else
exprasmlist^.concat(new(pai386,op_none(A_CDQ,S_NO)));
{ division depends on the right type }
if porddef(p^.right^.resulttype)^.typ=u32bit then
exprasmlist^.concat(new(pai386,op_reg(A_DIV,S_L,R_EDI)))
else
exprasmlist^.concat(new(pai386,op_reg(A_IDIV,S_L,R_EDI)));
if p^.treetype=divn then
begin
{ if result register is busy then copy }
if popeax then
begin
if hreg1=R_EAX then
internalerror(112);
emit_reg_reg(A_MOV,S_L,R_EAX,hreg1)
end
else
if hreg1<>R_EAX then
Begin
ungetregister32(hreg1);
hreg1 := getexplicitregister32(R_EAX);
{ I don't think it's possible that now hreg1 <> R_EAX
since popeax is false, but for all certainty I do
support that situation (JM)}
if hreg1 <> R_EAX then
emit_reg_reg(A_MOV,S_L,R_EAX,hreg1);
end;
end
else
{if we did the mod by an "and", the result is in hreg1 and
EDX certainly hasn't been pushed (JM)}
if not(andmod) Then
if popedx then
{the mod was done by an (i)div (so the result is now in
edx), but edx was occupied prior to the division, so
move the result into a safe place (JM)}
emit_reg_reg(A_MOV,S_L,R_EDX,hreg1)
else
Begin
{Get rid of the unnecessary hreg1 if possible (same as with
EAX in divn) (JM)}
ungetregister32(hreg1);
hreg1 := getexplicitregister32(R_EDX);
if hreg1 <> R_EDX then
emit_reg_reg(A_MOV,S_L,R_EDX,hreg1);;
End;
if popeax then
exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EAX)));
if popedx then
exprasmlist^.concat(new(pai386,op_reg(A_POP,S_L,R_EDX)));
end;
If not(andmod or shrdiv) then
{andmod and shrdiv only use hreg1 (which is already in usedinproc,
since it was acquired with getregister), the others also use both
EAX and EDX (JM)}
Begin
usedinproc:=usedinproc or ($80 shr byte(R_EAX));
usedinproc:=usedinproc or ($80 shr byte(R_EDX));
End;
clear_location(p^.location);
p^.location.loc:=LOC_REGISTER;
p^.location.register:=hreg1;
end;
end;
@ -246,10 +294,10 @@ implementation
popecx:=false;
secondpass(p^.left);
pushed:=maybe_push(p^.right^.registers32,p);
pushed:=maybe_push(p^.right^.registers32,p,is_64bitint(p^.left^.resulttype));
secondpass(p^.right);
if pushed then
restore(p);
restore(p,is_64bitint(p^.left^.resulttype));
if is_64bitint(p^.left^.resulttype) then
begin
@ -886,7 +934,12 @@ implementation
end.
{
$Log$
Revision 1.25 1999-05-27 19:44:16 peter
Revision 1.26 1999-06-02 10:11:44 florian
* make cycle fixed i.e. compilation with 0.99.10
* some fixes for qword
* start of register calling conventions
Revision 1.25 1999/05/27 19:44:16 peter
* removed oldasm
* plabel -> pasmlabel
* -a switches to source writing automaticly

11
compiler/cg386mem.pas
View File

@ -609,10 +609,10 @@ implementation
if (p^.location.loc<>LOC_REFERENCE) and
(p^.location.loc<>LOC_MEM) then
CGMessage(cg_e_illegal_expression);
is_pushed:=maybe_push(p^.right^.registers32,p);
is_pushed:=maybe_push(p^.right^.registers32,p,false);
secondpass(p^.right);
if is_pushed then
restore(p);
restore(p,false);
{ here we change the location of p^.right
and the update was forgotten so it
led to wrong code in emitrangecheck later PM
@ -849,7 +849,12 @@ implementation
end.
{
$Log$
Revision 1.46 1999-05-27 19:44:17 peter
Revision 1.47 1999-06-02 10:11:45 florian
* make cycle fixed i.e. compilation with 0.99.10
* some fixes for qword
* start of register calling conventions
Revision 1.46 1999/05/27 19:44:17 peter
* removed oldasm
* plabel -> pasmlabel
* -a switches to source writing automaticly

11
compiler/cg386set.pas
View File

@ -172,10 +172,10 @@ implementation
{ Only process the right if we are not generating jumps }
if not genjumps then
begin
pushed:=maybe_push(p^.right^.registers32,p^.left);
pushed:=maybe_push(p^.right^.registers32,p^.left,false);
secondpass(p^.right);
if pushed then
restore(p^.left);
restore(p^.left,false);
end;
if codegenerror then
exit;
@ -816,7 +816,12 @@ implementation
end.
{
$Log$
Revision 1.32 1999-05-27 19:44:19 peter
Revision 1.33 1999-06-02 10:11:48 florian
* make cycle fixed i.e. compilation with 0.99.10
* some fixes for qword
* start of register calling conventions
Revision 1.32 1999/05/27 19:44:19 peter
* removed oldasm
* plabel -> pasmlabel
* -a switches to source writing automaticly

34
compiler/cgai386.pas
View File

@ -27,6 +27,9 @@ unit cgai386;
uses
cobjects,tree,
i386base,i386asm,
{$ifdef dummy}
end { to get correct syntax highlighting }
{$endif dummy}
aasm,symtable;
{$define TESTGETTEMP to store const that
@ -77,18 +80,18 @@ unit cgai386;
procedure copyshortstringtoansistring(const dref,sref : treference);
{$endif}
function maybe_push(needed : byte;p : ptree) : boolean;
function maybe_push(needed : byte;p : ptree;isint64 : boolean) : boolean;
procedure push_int(l : longint);
procedure emit_push_mem(const ref : treference);
procedure emitpushreferenceaddr(const ref : treference);
procedure pushsetelement(p : ptree);
procedure restore(p : ptree);
procedure restore(p : ptree;isint64 : boolean);
procedure push_value_para(p:ptree;inlined:boolean;para_offset:longint;alignment : longint);
{$ifdef TEMPS_NOT_PUSH}
{ does the same as restore/maybe_push, but uses temp. space instead of pushing }
function maybe_push(needed : byte;p : ptree) : boolean;
procedure restorefromtemp(p : ptree);
function maybe_push(needed : byte;p : ptree;isint64 : boolean) : boolean;
procedure restorefromtemp(p : ptree;isint64 : boolean);
{$endif TEMPS_NOT_PUSH}
procedure floatload(t : tfloattype;const ref : treference);
@ -784,7 +787,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
Emit Push Functions
*****************************************************************************}
function maybe_push(needed : byte;p : ptree) : boolean;
function maybe_push(needed : byte;p : ptree;isint64 : boolean) : boolean;
var
pushed : boolean;
@ -799,7 +802,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
if (p^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
begin
{$ifdef INT64}
if is_64bitint(p^.resulttype) then
if isint64 then
begin
{$ifdef TEMPS_NOT_PUSH}
gettempofsizereference(href,8);
@ -853,7 +856,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
end;
{$ifdef TEMPS_NOT_PUSH}
function maybe_savetotemp(needed : byte;p : ptree) : boolean;
function maybe_savetotemp(needed : byte;p : ptree;isint64 : boolean) : boolean;
var
pushed : boolean;
@ -865,7 +868,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
if (p^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
begin
{$ifdef INT64}
if is_64bitint(p^.resulttype) then
if isint64(p^.resulttype) then
begin
gettempofsizereference(href,8);
p^.temp_offset:=href.offset;
@ -1036,7 +1039,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
end;
procedure restore(p : ptree);
procedure restore(p : ptree;isint64 : boolean);
var
hregister : tregister;
{$ifdef TEMPS_NOT_PUSH}
@ -1056,7 +1059,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
p^.location.register:=hregister;
{$ifdef INT64}
if is_64bitint(p^.resulttype) then
if isint64 then
begin
p^.location.registerhigh:=getregister32;
{$ifdef TEMPS_NOT_PUSH}
@ -1082,7 +1085,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
end;
{$ifdef TEMPS_NOT_PUSH}
procedure restorefromtemp(p : ptree);
procedure restorefromtemp(p : ptree;isint64 : boolean);
var
hregister : tregister;
href : treference;
@ -1097,7 +1100,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
begin
p^.location.register:=hregister;
{$ifdef INT64}
if is_64bitint(p^.resulttype) then
if isint64 then
begin
p^.location.registerhigh:=getregister32;
href.offset:=p^.temp_offset+4;
@ -3083,7 +3086,12 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
end.
{
$Log$
Revision 1.1 1999-06-01 19:33:18 peter
Revision 1.2 1999-06-02 10:11:49 florian
* make cycle fixed i.e. compilation with 0.99.10
* some fixes for qword
* start of register calling conventions
Revision 1.1 1999/06/01 19:33:18 peter
* reinserted
Revision 1.158 1999/06/01 14:45:46 peter

13
compiler/symdef.inc
View File

@ -2122,6 +2122,7 @@
hp^.paratyp:=vsp;
hp^.data:=p;
hp^.next:=para1;
hp^.register:=R_NO;
para1:=hp;
end;
@ -2166,6 +2167,8 @@
begin
new(hp);
hp^.paratyp:=tvarspez(readbyte);
{ hp^.register:=tregister(readbyte); }
hp^.register:=R_NO;
hp^.data:=readdefref;
hp^.next:=nil;
if para1=nil then
@ -2222,6 +2225,7 @@
while assigned(hp) do
begin
writebyte(byte(hp^.paratyp));
{ writebyte(byte(hp^.register)); }
writedefref(hp^.data);
hp:=hp^.next;
end;
@ -2303,7 +2307,7 @@
inc(refcount);
end;
lastref:=defref;
{ first, we assume, that all registers are used }
{ first, we assume that all registers are used }
{$ifdef i386}
usedregisters:=$ff;
{$endif i386}
@ -3485,7 +3489,12 @@ Const local_symtable_index : longint = $8001;
{
$Log$
Revision 1.125 1999-06-01 14:45:56 peter
Revision 1.126 1999-06-02 10:11:50 florian
* make cycle fixed i.e. compilation with 0.99.10
* some fixes for qword
* start of register calling conventions
Revision 1.125 1999/06/01 14:45:56 peter
* @procvar is now always needed for FPC
Revision 1.124 1999/05/31 16:42:33 peter

8
compiler/symdefh.inc
View File

@ -104,6 +104,7 @@
paratyp : tvarspez;
argconvtyp : targconvtyp;
convertlevel : byte;
register : tregister;
end;
tfiletype = (ft_text,ft_typed,ft_untyped);
@ -519,7 +520,12 @@
{
$Log$
Revision 1.31 1999-05-31 16:42:35 peter
Revision 1.32 1999-06-02 10:11:51 florian
* make cycle fixed i.e. compilation with 0.99.10
* some fixes for qword
* start of register calling conventions
Revision 1.31 1999/05/31 16:42:35 peter
* interfacedef flag for procdef if it's defined in the interface, to
make a difference with 'forward;' directive forwarddef. Fixes 253

70
compiler/tcadd.pas
View File

@ -447,6 +447,37 @@ implementation
calcregisters(p,1,0,0);
convdone:=true;
end
{ is there a 64 bit type ? }
else if (porddef(rd)^.typ=s64bitint) or (porddef(ld)^.typ=s64bitint) then
begin
if (porddef(ld)^.typ<>s64bitint) then
begin
p^.left:=gentypeconvnode(p^.left,cs64bitintdef);
firstpass(p^.left);
end;
if (porddef(rd)^.typ<>s64bitint) then
begin
p^.right:=gentypeconvnode(p^.right,cs64bitintdef);
firstpass(p^.right);
end;
calcregisters(p,2,0,0);
convdone:=true;
end
else if (porddef(rd)^.typ=u64bit) or (porddef(ld)^.typ=u64bit) then
begin
if (porddef(ld)^.typ<>u64bit) then
begin
p^.left:=gentypeconvnode(p^.left,cu64bitdef);
firstpass(p^.left);
end;
if (porddef(rd)^.typ<>u64bit) then
begin
p^.right:=gentypeconvnode(p^.right,cu64bitdef);
firstpass(p^.right);
end;
calcregisters(p,2,0,0);
convdone:=true;
end
else
{ is there a cardinal? }
if (porddef(rd)^.typ=u32bit) or (porddef(ld)^.typ=u32bit) then
@ -472,37 +503,7 @@ implementation
end;
calcregisters(p,1,0,0);
convdone:=true;
end
else if (porddef(rd)^.typ=s64bitint) or (porddef(ld)^.typ=s64bitint) then
begin
if (porddef(ld)^.typ<>s64bitint) then
begin
p^.left:=gentypeconvnode(p^.left,cs64bitintdef);
firstpass(p^.left);
end;
if (porddef(rd)^.typ<>s64bitint) then
begin
p^.right:=gentypeconvnode(p^.right,cs64bitintdef);
firstpass(p^.right);
end;
calcregisters(p,2,0,0);
convdone:=true;
end
else if (porddef(rd)^.typ=u64bit) or (porddef(ld)^.typ=u64bit) then
begin
if (porddef(ld)^.typ<>u64bit) then
begin
p^.left:=gentypeconvnode(p^.left,cu64bitdef);
firstpass(p^.left);
end;
if (porddef(rd)^.typ<>u64bit) then
begin
p^.right:=gentypeconvnode(p^.right,cu64bitdef);
firstpass(p^.right);
end;
calcregisters(p,2,0,0);
convdone:=true;
end;
end;
end
else
@ -1093,7 +1094,12 @@ implementation
end.
{
$Log$
Revision 1.33 1999-05-27 19:45:12 peter
Revision 1.34 1999-06-02 10:11:52 florian
* make cycle fixed i.e. compilation with 0.99.10
* some fixes for qword
* start of register calling conventions
Revision 1.33 1999/05/27 19:45:12 peter
* removed oldasm
* plabel -> pasmlabel
* -a switches to source writing automaticly

79
compiler/tcmat.pas
View File

@ -55,6 +55,8 @@ implementation
var
t : ptree;
rv,lv : longint;
rd,ld : pdef;
begin
firstpass(p^.left);
firstpass(p^.right);
@ -82,27 +84,65 @@ implementation
p:=t;
exit;
end;
if not(p^.right^.resulttype^.deftype=orddef) or
not(porddef(p^.right^.resulttype)^.typ in [s32bit,u32bit]) then
p^.right:=gentypeconvnode(p^.right,s32bitdef);
if (p^.left^.resulttype^.deftype=orddef) and (p^.right^.resulttype^.deftype=orddef) and
(is_64bitint(p^.left^.resulttype) or is_64bitint(p^.right^.resulttype)) then
begin
rd:=p^.right^.resulttype;
ld:=p^.left^.resulttype;
if (porddef(rd)^.typ=s64bitint) or (porddef(ld)^.typ=s64bitint) then
begin
if (porddef(ld)^.typ<>s64bitint) then
begin
p^.left:=gentypeconvnode(p^.left,cs64bitintdef);
firstpass(p^.left);
end;
if (porddef(rd)^.typ<>s64bitint) then
begin
p^.right:=gentypeconvnode(p^.right,cs64bitintdef);
firstpass(p^.right);
end;
calcregisters(p,2,0,0);
end
else if (porddef(rd)^.typ=u64bit) or (porddef(ld)^.typ=u64bit) then
begin
if (porddef(ld)^.typ<>u64bit) then
begin
p^.left:=gentypeconvnode(p^.left,cu64bitdef);
firstpass(p^.left);
end;
if (porddef(rd)^.typ<>u64bit) then
begin
p^.right:=gentypeconvnode(p^.right,cu64bitdef);
firstpass(p^.right);
end;
calcregisters(p,2,0,0);
end;
p^.resulttype:=p^.left^.resulttype;
end
else
begin
if not(p^.right^.resulttype^.deftype=orddef) or
not(porddef(p^.right^.resulttype)^.typ in [s32bit,u32bit]) then
p^.right:=gentypeconvnode(p^.right,s32bitdef);
if not(p^.left^.resulttype^.deftype=orddef) or
not(porddef(p^.left^.resulttype)^.typ in [s32bit,u32bit]) then
p^.left:=gentypeconvnode(p^.left,s32bitdef);
if not(p^.left^.resulttype^.deftype=orddef) or
not(porddef(p^.left^.resulttype)^.typ in [s32bit,u32bit]) then
p^.left:=gentypeconvnode(p^.left,s32bitdef);
firstpass(p^.left);
firstpass(p^.right);
firstpass(p^.left);
firstpass(p^.right);
{ the resulttype depends on the right side, because the left becomes }
{ always 64 bit }
p^.resulttype:=p^.right^.resulttype;
{ the resulttype depends on the right side, because the left becomes }
{ always 64 bit }
p^.resulttype:=p^.right^.resulttype;
if codegenerror then
exit;
if codegenerror then
exit;
left_right_max(p);
if p^.left^.registers32<=p^.right^.registers32 then
inc(p^.registers32);
left_right_max(p);
if p^.left^.registers32<=p^.right^.registers32 then
inc(p^.registers32);
end;
p^.location.loc:=LOC_REGISTER;
end;
@ -373,7 +413,12 @@ implementation
end.
{
$Log$
Revision 1.15 1999-05-27 19:45:22 peter
Revision 1.16 1999-06-02 10:11:54 florian
* make cycle fixed i.e. compilation with 0.99.10
* some fixes for qword
* start of register calling conventions
Revision 1.15 1999/05/27 19:45:22 peter
* removed oldasm
* plabel -> pasmlabel
* -a switches to source writing automaticly

10
compiler/types.pas
View File

@ -211,7 +211,8 @@ implementation
{ check for method pointer }
ismethod:=(def1^.owner^.symtabletype=objectsymtable) and
(pobjectdef(def1^.owner^.defowner)^.isclass);
if ismethod<>((def2^.options and pomethodpointer)<>0) then
if (ismethod and not ((def2^.options and pomethodpointer)<>0)) or
(not(ismethod) and ((def2^.options and pomethodpointer)<>0)) then
begin
Message(type_e_no_method_and_procedure_not_compatible);
exit;
@ -886,7 +887,12 @@ implementation
end.
{
$Log$
Revision 1.68 1999-06-01 19:27:58 peter
Revision 1.69 1999-06-02 10:11:55 florian
* make cycle fixed i.e. compilation with 0.99.10
* some fixes for qword
* start of register calling conventions
Revision 1.68 1999/06/01 19:27:58 peter
* better checks for procvar and methodpointer
Revision 1.67 1999/05/31 22:54:19 peter