* make cycle fixed i.e. compilation with 0.99.10

  * some fixes for qword
  * start of register calling conventions

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

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

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

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;
-
-           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
-                  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
+                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 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
-                   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
+                   if p^.left^.location.loc=LOC_CREGISTER then
                      begin
-                        exprasmlist^.concat(new(pai386,op_reg(A_PUSH,S_L,R_EAX)));
-                        popeax:=true;
+                       hreg1:=getregister32;
+                       emit_reg_reg(A_MOV,S_L,p^.left^.location.register,hreg1);
+                     end
+                   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;
-                  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);
+                       emit_reg_reg(A_MOV,S_L,R_EDX,R_EAX);
+                     end
+                   else
+                     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;
-                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)));
+                   { 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
+                   { 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 hreg1=R_EAX then
-                          internalerror(112);
-                        emit_reg_reg(A_MOV,S_L,R_EAX,hreg1)
+                        { 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 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;
+                     {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

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

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

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

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

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
 

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

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

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