From 2ad3da43e61d4874edc3f20dddc793127b66b39b Mon Sep 17 00:00:00 2001 From: florian Date: Wed, 2 Jun 1999 10:11:39 +0000 Subject: [PATCH] * make cycle fixed i.e. compilation with 0.99.10 * some fixes for qword * start of register calling conventions --- compiler/cg386add.pas | 31 ++-- compiler/cg386cal.pas | 11 +- compiler/cg386inl.pas | 15 +- compiler/cg386mat.pas | 357 ++++++++++++++++++++++++------------------ compiler/cg386mem.pas | 11 +- compiler/cg386set.pas | 11 +- compiler/cgai386.pas | 34 ++-- compiler/symdef.inc | 13 +- compiler/symdefh.inc | 8 +- compiler/tcadd.pas | 70 +++++---- compiler/tcmat.pas | 79 ++++++++-- compiler/types.pas | 10 +- 12 files changed, 408 insertions(+), 242 deletions(-) diff --git a/compiler/cg386add.pas b/compiler/cg386add.pas index 105cb34411..e7a0a872a9 100644 --- a/compiler/cg386add.pas +++ b/compiler/cg386add.pas @@ -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 diff --git a/compiler/cg386cal.pas b/compiler/cg386cal.pas index 1bf0b683de..051cb84479 100644 --- a/compiler/cg386cal.pas +++ b/compiler/cg386cal.pas @@ -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 diff --git a/compiler/cg386inl.pas b/compiler/cg386inl.pas index e30723a169..bee340c5b8 100644 --- a/compiler/cg386inl.pas +++ b/compiler/cg386inl.pas @@ -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 diff --git a/compiler/cg386mat.pas b/compiler/cg386mat.pas index 30573d0d19..d4a4fb69fa 100644 --- a/compiler/cg386mat.pas +++ b/compiler/cg386mat.pas @@ -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 diff --git a/compiler/cg386mem.pas b/compiler/cg386mem.pas index b554c198e4..88d1e95754 100644 --- a/compiler/cg386mem.pas +++ b/compiler/cg386mem.pas @@ -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 diff --git a/compiler/cg386set.pas b/compiler/cg386set.pas index 148e01fdf1..4af82cc782 100644 --- a/compiler/cg386set.pas +++ b/compiler/cg386set.pas @@ -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 diff --git a/compiler/cgai386.pas b/compiler/cgai386.pas index af555506c7..a7d938a608 100644 --- a/compiler/cgai386.pas +++ b/compiler/cgai386.pas @@ -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 diff --git a/compiler/symdef.inc b/compiler/symdef.inc index 3dd315692b..5b92b653b9 100644 --- a/compiler/symdef.inc +++ b/compiler/symdef.inc @@ -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 diff --git a/compiler/symdefh.inc b/compiler/symdefh.inc index fd6705f142..c7d4537d67 100644 --- a/compiler/symdefh.inc +++ b/compiler/symdefh.inc @@ -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 diff --git a/compiler/tcadd.pas b/compiler/tcadd.pas index d8eb73b96c..99df72991c 100644 --- a/compiler/tcadd.pas +++ b/compiler/tcadd.pas @@ -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 diff --git a/compiler/tcmat.pas b/compiler/tcmat.pas index 34de66f1d6..7035674b97 100644 --- a/compiler/tcmat.pas +++ b/compiler/tcmat.pas @@ -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 diff --git a/compiler/types.pas b/compiler/types.pas index 73fc12cb52..dca8281162 100644 --- a/compiler/types.pas +++ b/compiler/types.pas @@ -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