* fixing several bugs compiling the RTL

compiler/sparc/aasmcpu.pas

@@ -282,9 +282,7 @@ constructor taicpu.op_caddr_reg(op:TAsmOp;rgb:TRegister;cnst:Integer;reg:TRegist
     inherited create(op);
     init(S_SW);
     ops:=2;
-        WriteLn(1,std_reg2str[rgb]);
     loadcaddr(0,rgb,cnst);
-        WriteLn(2,std_reg2str[rgb]);
     loadreg(1,reg);
   end;
 constructor taicpu.op_raddr_reg(op:TAsmOp;rg1,rg2,reg:TRegister);
@@ -1083,7 +1081,10 @@ procedure InitAsm;
 end.
 {
     $Log$
-    Revision 1.14  2002-12-14 15:02:03  carl
+    Revision 1.15  2003-01-05 21:32:35  mazen
+    * fixing several bugs compiling the RTL
+
+    Revision 1.14  2002/12/14 15:02:03  carl
       * maxoperands -> max_operands (for portability in rautils.pas)
       * fix some range-check errors with loadconst
       + add ncgadd unit to m68k

compiler/sparc/cgcpu.pas

@@ -27,7 +27,7 @@ USES
   cpubase,cpuinfo,cpupara,
   node,symconst;
 TYPE
-  tcgSPARC=CLASS(tcg)
+  TCgSparc=CLASS(tcg)
 {This method is used to pass a parameter, which is located in a register, to a
 routine. It should give the parameter to the routine, as required by the
 specific processor ABI. It is overriden for each CPU target.
@@ -80,6 +80,8 @@ specific processor ABI. It is overriden for each CPU target.
     procedure g_stackframe_entry(list:TAasmOutput;localsize:LongInt);override;
     procedure g_restore_frame_pointer(list:TAasmOutput);override;
     procedure g_return_from_proc(list:TAasmOutput;parasize:aword);override;
+    procedure g_save_all_registers(list : taasmoutput);override;
+    procedure g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);override;
     procedure g_concatcopy(list:TAasmOutput;CONST source,dest:TReference;len:aword;delsource,loadref:boolean);override;
     class function reg_cgsize(CONST reg:tregister):tcgsize;override;
   PRIVATE
@@ -109,7 +111,7 @@ USES
   rgobj,tgobj,rgcpu,cpupi;
     { we implement the following routines because otherwise we can't }
     { instantiate the class since it's abstract                      }
-procedure tcgSPARC.a_param_reg(list:TAasmOutput;size:tcgsize;r:tregister;const LocPara:TParaLocation);
+procedure TCgSparc.a_param_reg(list:TAasmOutput;size:tcgsize;r:tregister;const LocPara:TParaLocation);
   begin
     if(Size<>OS_32)and(Size<>OS_S32)
     then
@@ -124,7 +126,7 @@ procedure tcgSPARC.a_param_reg(list:TAasmOutput;size:tcgsize;r:tregister;const L
           InternalError(2002101002);
       end;
   end;
-procedure tcgSPARC.a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST LocPara:TParaLocation);
+procedure TCgSparc.a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST LocPara:TParaLocation);
   var
     Ref:TReference;
   begin
@@ -146,7 +148,7 @@ procedure tcgSPARC.a_param_const(list:TAasmOutput;size:tcgsize;a:aword;CONST Loc
     then
       InternalError(2002122201);
   end;
-procedure tcgSPARC.a_param_ref(list:TAasmOutput;sz:TCgSize;const r:TReference;const LocPara:TParaLocation);
+procedure TCgSparc.a_param_ref(list:TAasmOutput;sz:TCgSize;const r:TReference;const LocPara:TParaLocation);
   var
     ref: treference;
     tmpreg:TRegister;
@@ -183,7 +185,7 @@ procedure tcgSPARC.a_param_ref(list:TAasmOutput;sz:TCgSize;const r:TReference;co
                 internalerror(2002081103);
         end;
   end;
-procedure tcgSPARC.a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation);
+procedure TCgSparc.a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST LocPara:TParaLocation);
   VAR
     tmpreg:TRegister;
   BEGIN
@@ -209,7 +211,7 @@ procedure tcgSPARC.a_paramaddr_ref(list:TAasmOutput;CONST r:TReference;CONST Loc
         free_scratch_reg(list,tmpreg);
       END;
   END;
-procedure tcgSPARC.a_call_name(list:TAasmOutput;CONST s:string);
+procedure TCgSparc.a_call_name(list:TAasmOutput;CONST s:string);
   BEGIN
     WITH List,objectlibrary DO
       BEGIN
@@ -217,7 +219,7 @@ procedure tcgSPARC.a_call_name(list:TAasmOutput;CONST s:string);
         concat(taicpu.op_none(A_NOP));
       END;
   END;
-procedure tcgSPARC.a_call_ref(list:TAasmOutput;CONST ref:TReference);
+procedure TCgSparc.a_call_ref(list:TAasmOutput;CONST ref:TReference);
   begin
     list.concat(taicpu.op_ref(A_CALL,ref));
     list.concat(taicpu.op_none(A_NOP));
@@ -231,12 +233,12 @@ procedure TCgSparc.a_call_reg(list:TAasmOutput;Reg:TRegister);
     procinfo.flags:=procinfo.flags or pi_do_call;
  end;
 {********************** branch instructions ********************}
-procedure TCgSPARC.a_jmp_always(List:TAasmOutput;l:TAsmLabel);
+procedure TCgSparc.a_jmp_always(List:TAasmOutput;l:TAsmLabel);
   begin
     List.Concat(TAiCpu.op_sym(A_BA,S_NO,objectlibrary.newasmsymbol(l.name)));
   end;
 {********************** load instructions ********************}
-procedure tcgSPARC.a_load_const_reg(list:TAasmOutput;size:TCGSize;a:aword;reg:TRegister);
+procedure TCgSparc.a_load_const_reg(list:TAasmOutput;size:TCGSize;a:aword;reg:TRegister);
   BEGIN
     WITH List DO
       IF a<>0
@@ -245,7 +247,7 @@ procedure tcgSPARC.a_load_const_reg(list:TAasmOutput;size:TCGSize;a:aword;reg:TR
       ELSE{The is no A_MOV in sparc, that's why we use A_OR with help of R_G0}
         Concat(taicpu.op_reg_reg_reg(A_OR,R_G0,R_G0,reg));
   END;
-procedure tcgSPARC.a_load_const_ref(list:TAasmOutput;size:tcgsize;a:aword;CONST ref:TReference);
+procedure TCgSparc.a_load_const_ref(list:TAasmOutput;size:tcgsize;a:aword;CONST ref:TReference);
   BEGIN
     WITH List DO
       IF a=0
@@ -264,11 +266,11 @@ procedure tcgSPARC.a_load_const_ref(list:TAasmOutput;size:tcgsize;a:aword;CONST
           end;
         END;
   END;
-procedure tcgSPARC.a_load_reg_ref(list:TAasmOutput;size:TCGSize;reg:tregister;CONST ref:TReference);
+procedure TCgSparc.a_load_reg_ref(list:TAasmOutput;size:TCGSize;reg:tregister;CONST ref:TReference);
   BEGIN
     list.concat(taicpu.op_reg_ref(A_ST,reg,ref));
   END;
-procedure tcgSPARC.a_load_ref_reg(list:TAasmOutput;size:TCgSize;const ref:TReference;reg:tregister);
+procedure TCgSparc.a_load_ref_reg(list:TAasmOutput;size:TCgSize;const ref:TReference;reg:tregister);
   var
     op:tasmop;
     s:topsize;
@@ -308,7 +310,7 @@ procedure tcgSPARC.a_load_ref_reg(list:TAasmOutput;size:TCgSize;const ref:TRefer
     with list do
       concat(taicpu.op_ref_reg(op,ref,reg));
   end;
-procedure tcgSPARC.a_load_reg_reg(list:TAasmOutput;fromsize,tosize:tcgsize;reg1,reg2:tregister);
+procedure TCgSparc.a_load_reg_reg(list:TAasmOutput;fromsize,tosize:tcgsize;reg1,reg2:tregister);
   var
     op:tasmop;
     s:topsize;
@@ -336,7 +338,7 @@ procedure tcgSPARC.a_load_reg_reg(list:TAasmOutput;fromsize,tosize:tcgsize;reg1,
   end;
     { all fpu load routines expect that R_ST[0-7] means an fpu regvar and }
     { R_ST means "the current value at the top of the fpu stack" (JM)     }
-procedure tcgSPARC.a_loadfpu_reg_reg(list:TAasmOutput;reg1, reg2:tregister);
+procedure TCgSparc.a_loadfpu_reg_reg(list:TAasmOutput;reg1, reg2:tregister);
 
        begin
 {         if NOT (reg1 IN [R_F0..R_F31]) then
@@ -354,7 +356,7 @@ procedure tcgSPARC.a_loadfpu_reg_reg(list:TAasmOutput;reg1, reg2:tregister);
        end;
 
 
-    procedure tcgSPARC.a_loadfpu_ref_reg(list:TAasmOutput;size:tcgsize;CONST ref:TReference;reg:tregister);
+    procedure TCgSparc.a_loadfpu_ref_reg(list:TAasmOutput;size:tcgsize;CONST ref:TReference;reg:tregister);
 
        begin
          floatload(list,size,ref);
@@ -363,7 +365,7 @@ procedure tcgSPARC.a_loadfpu_reg_reg(list:TAasmOutput;reg1, reg2:tregister);
        end;
 
 
-    procedure tcgSPARC.a_loadfpu_reg_ref(list:TAasmOutput;size:tcgsize;reg:tregister;CONST ref:TReference);
+    procedure TCgSparc.a_loadfpu_reg_ref(list:TAasmOutput;size:tcgsize;reg:tregister;CONST ref:TReference);
 
        begin
 {         if reg <> R_ST then
@@ -372,26 +374,26 @@ procedure tcgSPARC.a_loadfpu_reg_reg(list:TAasmOutput;reg1, reg2:tregister);
        end;
 
 
-    procedure tcgSPARC.a_loadmm_reg_reg(list:TAasmOutput;reg1, reg2:tregister);
+    procedure TCgSparc.a_loadmm_reg_reg(list:TAasmOutput;reg1, reg2:tregister);
 
        begin
 //         list.concat(taicpu.op_reg_reg(A_NONEQ,S_NO,reg1,reg2));
        end;
 
 
-    procedure tcgSPARC.a_loadmm_ref_reg(list:TAasmOutput;CONST ref:TReference;reg:tregister);
+    procedure TCgSparc.a_loadmm_ref_reg(list:TAasmOutput;CONST ref:TReference;reg:tregister);
 
        begin
 //         list.concat(taicpu.op_ref_reg(A_NONEQ,S_NO,ref,reg));
        end;
 
 
-    procedure tcgSPARC.a_loadmm_reg_ref(list:TAasmOutput;reg:tregister;CONST ref:TReference);
+    procedure TCgSparc.a_loadmm_reg_ref(list:TAasmOutput;reg:tregister;CONST ref:TReference);
 
        begin
 //         list.concat(taicpu.op_reg_ref(A_NONEQ,S_NO,reg,ref));
        end;
-procedure tcgSPARC.a_parammm_reg(list:TAasmOutput;reg:tregister);
+procedure TCgSparc.a_parammm_reg(list:TAasmOutput;reg:tregister);
   VAR
     href:TReference;
   BEGIN
@@ -399,7 +401,7 @@ procedure tcgSPARC.a_parammm_reg(list:TAasmOutput;reg:tregister);
 //    reference_reset_base(href,R_ESP,0);
 //    list.concat(taicpu.op_reg_ref(A_NONEQ,S_NO,reg,href));
   END;
-procedure tcgSPARC.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegister);
+procedure TCgSparc.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegister);
 
       var
         opcode:tasmop;
@@ -483,7 +485,7 @@ procedure tcgSPARC.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegiste
       end;
 
 
-     procedure tcgSPARC.a_op_const_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;a:AWord;CONST ref:TReference);
+     procedure TCgSparc.a_op_const_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;a:AWord;CONST ref:TReference);
 
       var
         opcode:tasmop;
@@ -567,7 +569,7 @@ procedure tcgSPARC.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegiste
       end;
 
 
-     procedure tcgSPARC.a_op_reg_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;src, dst:TRegister);
+     procedure TCgSparc.a_op_reg_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;src, dst:TRegister);
 
         var
           regloadsize:tcgsize;
@@ -648,7 +650,7 @@ procedure tcgSPARC.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegiste
         end;
 
 
-     procedure tcgSPARC.a_op_ref_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;CONST ref:TReference;reg:TRegister);
+     procedure TCgSparc.a_op_ref_reg(list:TAasmOutput;Op:TOpCG;size:TCGSize;CONST ref:TReference;reg:TRegister);
 
        var
          opsize:topsize;
@@ -672,7 +674,7 @@ procedure tcgSPARC.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegiste
        end;
 
 
-     procedure tcgSPARC.a_op_reg_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;reg:TRegister;CONST ref:TReference);
+     procedure TCgSparc.a_op_reg_ref(list:TAasmOutput;Op:TOpCG;size:TCGSize;reg:TRegister;CONST ref:TReference);
 
        var
          opsize:topsize;
@@ -703,7 +705,7 @@ procedure tcgSPARC.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegiste
        end;
 
 
-    procedure tcgSPARC.a_op_const_reg_reg(list:TAasmOutput;op:TOpCg;
+    procedure TCgSparc.a_op_const_reg_reg(list:TAasmOutput;op:TOpCg;
         size:tcgsize;a:aword;src, dst:tregister);
       var
         tmpref:TReference;
@@ -747,7 +749,7 @@ procedure tcgSPARC.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegiste
         end;
       end;
 
-    procedure tcgSPARC.a_op_reg_reg_reg(list:TAasmOutput;op:TOpCg;
+    procedure TCgSparc.a_op_reg_reg_reg(list:TAasmOutput;op:TOpCg;
         size:tcgsize;src1, src2, dst:tregister);
       var
         tmpref:TReference;
@@ -783,7 +785,7 @@ procedure tcgSPARC.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegiste
 
 {*************** compare instructructions ****************}
 
-      procedure tcgSPARC.a_cmp_const_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;reg:tregister;
+      procedure TCgSparc.a_cmp_const_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;reg:tregister;
         l:tasmlabel);
 
         begin
@@ -794,7 +796,7 @@ procedure tcgSPARC.a_op_const_reg(list:TAasmOutput;Op:TOpCG;a:AWord;reg:TRegiste
           a_jmp_cond(list,cmp_op,l);
         end;
 
-procedure tcgSPARC.a_cmp_const_ref_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;const ref:TReference;l:tasmlabel);
+procedure TCgSparc.a_cmp_const_ref_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;a:aword;const ref:TReference;l:tasmlabel);
   begin
     with List do
       begin
@@ -804,7 +806,7 @@ procedure tcgSPARC.a_cmp_const_ref_label(list:TAasmOutput;size:tcgsize;cmp_op:to
     a_jmp_cond(list,cmp_op,l);
   end;
 
-      procedure tcgSPARC.a_cmp_reg_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;
+      procedure TCgSparc.a_cmp_reg_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;
         reg1,reg2:tregister;l:tasmlabel);
 
         begin
@@ -814,7 +816,7 @@ procedure tcgSPARC.a_cmp_const_ref_label(list:TAasmOutput;size:tcgsize;cmp_op:to
           a_jmp_cond(list,cmp_op,l);}
         end;
 
-procedure tcgSPARC.a_cmp_ref_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;CONST ref:TReference;reg:tregister;l:tasmlabel);
+procedure TCgSparc.a_cmp_ref_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topcmp;CONST ref:TReference;reg:tregister;l:tasmlabel);
   var
     TempReg:TRegister;
    begin
@@ -824,7 +826,7 @@ procedure tcgSPARC.a_cmp_ref_reg_label(list:TAasmOutput;size:tcgsize;cmp_op:topc
      a_jmp_cond(list,cmp_op,l);
      cg.free_scratch_reg(exprasmlist,TempReg);
    end;
-procedure tcgSPARC.a_jmp_cond(list:TAasmOutput;cond:TOpCmp;l:tasmlabel);
+procedure TCgSparc.a_jmp_cond(list:TAasmOutput;cond:TOpCmp;l:tasmlabel);
 
        var
          ai:taicpu;
@@ -841,7 +843,7 @@ procedure tcgSPARC.a_jmp_cond(list:TAasmOutput;cond:TOpCmp;l:tasmlabel);
          list.concat(ai);
        end;
 
-     procedure tcgSPARC.a_jmp_flags(list:TAasmOutput;CONST f:TResFlags;l:tasmlabel);
+     procedure TCgSparc.a_jmp_flags(list:TAasmOutput;CONST f:TResFlags;l:tasmlabel);
        var
          ai:taicpu;
        begin
@@ -851,7 +853,7 @@ procedure tcgSPARC.a_jmp_cond(list:TAasmOutput;cond:TOpCmp;l:tasmlabel);
          list.concat(ai);
        end;
 
-procedure tcgSPARC.g_flags2reg(list:TAasmOutput;Size:TCgSize;CONST f:tresflags;reg:TRegister);
+procedure TCgSparc.g_flags2reg(list:TAasmOutput;Size:TCgSize;CONST f:tresflags;reg:TRegister);
   VAR
     ai:taicpu;
     hreg:tregister;
@@ -888,7 +890,7 @@ procedure TCgSparc.g_overflowCheck(List:TAasmOutput;const p:TNode);
     end;
 { *********** entry/exit code and address loading ************ }
 
-procedure tcgSPARC.g_stackframe_entry(list:TAasmOutput;LocalSize:LongInt);
+procedure TCgSparc.g_stackframe_entry(list:TAasmOutput;LocalSize:LongInt);
   var
     href:TReference;
     i:integer;
@@ -905,12 +907,12 @@ after execution of that instruction is the called function stack pointer}
     with list do
       concat(Taicpu.Op_reg_const_reg(A_SAVE,Stack_Pointer_Reg,-LocalSize,Stack_Pointer_Reg));
   end;
-procedure tcgSPARC.g_restore_frame_pointer(list:TAasmOutput);
+procedure TCgSparc.g_restore_frame_pointer(list:TAasmOutput);
   begin
 {This function intontionally does nothing as frame pointer is restored in the
 delay slot of the return instrucion done in g_return_from_proc}
   end;
-procedure tcgSPARC.g_return_from_proc(list:TAasmOutput;parasize:aword);
+procedure TCgSparc.g_return_from_proc(list:TAasmOutput;parasize:aword);
   begin
 {According to the SPARC ABI, the stack is cleared using the RESTORE instruction
 which is genereted in the g_restore_frame_pointer. Notice that SPARC has no
@@ -931,7 +933,15 @@ already set result onto %i0}
         concat(Taicpu.Op_reg_const_reg(A_RESTORE,R_G0,0,R_G0));
       end
   end;
-procedure tcgSPARC.a_loadaddr_ref_reg(list:TAasmOutput;CONST ref:TReference;r:tregister);
+procedure TCgSparc.g_save_all_registers(list : taasmoutput);
+  begin
+    {$warning FIX ME TCgSparc.g_save_all_registers}
+  end;
+procedure TCgSparc.g_save_standard_registers(list : taasmoutput; usedinproc : tregisterset);
+  begin
+    {$warning FIX ME tcgppc.g_save_standard_registers}
+  end;
+procedure TCgSparc.a_loadaddr_ref_reg(list:TAasmOutput;CONST ref:TReference;r:tregister);
 
        begin
 //         list.concat(taicpu.op_ref_reg(A_LEA,S_SW,ref,r));
@@ -1204,7 +1214,7 @@ procedure TCgSparc.g_concatcopy(list:taasmoutput;const source,dest:treference;le
        if not orgdst then
          free_scratch_reg(list,dst.base);
       end;
-function tcgSPARC.reg_cgsize(CONST reg:tregister):tcgsize;
+function TCgSparc.reg_cgsize(CONST reg:tregister):tcgsize;
   begin
     result:=OS_32;
   end;
@@ -1223,7 +1233,7 @@ function TCgSparc.IsSimpleRef(const ref:treference):boolean;
               ((ref.index <> R_NO) and
               (ref.offset = 0)));
   end;
-procedure tcgSPARC.sizes2load(s1:tcgsize;s2:topsize;var op:tasmop;var s3:topsize);
+procedure TCgSparc.sizes2load(s1:tcgsize;s2:topsize;var op:tasmop;var s3:topsize);
   begin
     case s2 of
       S_B:
@@ -1266,7 +1276,7 @@ procedure tcgSPARC.sizes2load(s1:tcgsize;s2:topsize;var op:tasmop;var s3:topsize
     else
       op := A_NONE;
   end;
-procedure tcgSPARC.floatloadops(t:tcgsize;VAR op:tasmop;VAR s:topsize);
+procedure TCgSparc.floatloadops(t:tcgsize;VAR op:tasmop;VAR s:topsize);
   BEGIN
 (*         case t of
             OS_F32:begin
@@ -1289,7 +1299,7 @@ procedure tcgSPARC.floatloadops(t:tcgsize;VAR op:tasmop;VAR s:topsize);
             else internalerror(17);
          end;*)
   END;
-procedure tcgSPARC.floatload(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
+procedure TCgSparc.floatload(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
   VAR
     op:tasmop;
     s:topsize;
@@ -1298,7 +1308,7 @@ procedure tcgSPARC.floatload(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
     list.concat(Taicpu.Op_ref(op,ref));
 {    inc(trgcpu(rg).fpuvaroffset);}
   END;
-procedure tcgSPARC.floatstoreops(t:tcgsize;var op:tasmop;var s:topsize);
+procedure TCgSparc.floatstoreops(t:tcgsize;var op:tasmop;var s:topsize);
   BEGIN
 {         case t of
             OS_F32:begin
@@ -1321,7 +1331,7 @@ procedure tcgSPARC.floatstoreops(t:tcgsize;var op:tasmop;var s:topsize);
            internalerror(17);
          end;}
       end;
-procedure tcgSPARC.floatstore(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
+procedure TCgSparc.floatstore(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
   VAR
     op:tasmop;
     s:topsize;
@@ -1331,11 +1341,14 @@ procedure tcgSPARC.floatstore(list:TAasmOutput;t:tcgsize;CONST ref:TReference);
 {    dec(trgcpu(rg).fpuvaroffset);}
   END;
 BEGIN
-  cg:=tcgSPARC.create;
+  cg:=TCgSparc.create;
 END.
 {
   $Log$
-  Revision 1.30  2003-01-05 13:36:53  florian
+  Revision 1.31  2003-01-05 21:32:35  mazen
+  * fixing several bugs compiling the RTL
+
+  Revision 1.30  2003/01/05 13:36:53  florian
     * x86-64 compiles
     + very basic support for float128 type (x86-64 only)
 

compiler/sparc/cpupara.pas

@@ -17,7 +17,7 @@
     You should have received a copy of the GNU General Public License
     along with this program; if not, write to the Free Software
     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- ****************************************************************************}
+ *****************************************************************************}
 unit cpupara;
 {SPARC specific calling conventions are handled by this unit}
 {$INCLUDE fpcdefs.inc}
@@ -119,7 +119,7 @@ push_addr_param for the def is true}
         internalerror(2002071001);
     end;
   end;
-procedure TSparcParaManager.create_param_loc_info(p:tabstractprocdef);
+procedure TSparcParaManager.create_param_loc_info(p:TAbstractProcDef);
   var
     nextintreg,nextfloatreg:tregister;
     stack_offset:aword;
@@ -184,7 +184,6 @@ procedure TSparcParaManager.create_param_loc_info(p:tabstractprocdef);
                   else
                     begin
                       {!!!!!!!}
-                      WriteLn('NextIntReg=',std_reg2str[NextIntReg]);
                       hp.paraloc.size:=def_cgsize(hp.paratype.def);
                       internalerror(2002071006);
                     end;
@@ -282,7 +281,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.12  2002-11-25 19:21:49  mazen
+  Revision 1.13  2003-01-05 21:32:35  mazen
+  * fixing several bugs compiling the RTL
+
+  Revision 1.12  2002/11/25 19:21:49  mazen
   * fixed support of nSparcInline
 
   Revision 1.11  2002/11/25 17:43:28  peter

compiler/sparc/cpupi.pas

@@ -60,10 +60,9 @@ constructor TSparcprocinfo.create;
 procedure TSparcprocinfo.after_header;
 	begin
   	{First 16 words are in the frame are used to save registers in case of a
-    register overflow/underflow}
-    {The 17th word is used to save the address of the variable which will
-    receive the return value of the called function}
-    Return_Offset:=64;{16*4}
+    register overflow/underflow.The 17th word is used to save the address of
+    the variable which will receive the return value of the called function}
+    Return_Offset:=16*4;
     procdef.parast.address_fixup:=(16+1)*4;
 	end;
 procedure TSparcProcInfo.after_pass1;
@@ -81,8 +80,8 @@ procedure TSparcProcInfo.after_pass1;
 		    firsttemp_offset:=localst.address_fixup+localst.datasize;
         with tg do
           begin
-        		FirstTemp:=firsttemp_offset;
-		        LastTemp:=firsttemp_offset;
+        		SetFirstTemp(firsttemp_offset);
+		        //LastTemp:=firsttemp_offset;
           end;
       end;
 	end;
@@ -91,7 +90,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.10  2002-12-24 21:30:20  mazen
+  Revision 1.11  2003-01-05 21:32:35  mazen
+  * fixing several bugs compiling the RTL
+
+  Revision 1.10  2002/12/24 21:30:20  mazen
   - some writeln(s) removed in compiler
   + many files added to RTL
   * some errors fixed in RTL

compiler/sparc/ncpuinln.pas

@@ -61,7 +61,7 @@ function tSparcInlineNode.first_sqr_real : tnode;
     location.loc:=LOC_FPUREGISTER;
     registers32:=left.registers32;
     registersfpu:=max(left.registersfpu,1);
-    first_sqr_real := nil;
+    first_sqr_real:=nil;
   end;
 function tSparcInlineNode.first_sqrt_real : tnode;
   begin
@@ -120,7 +120,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.2  2002-12-30 21:17:22  mazen
+  Revision 1.3  2003-01-05 21:32:35  mazen
+  * fixing several bugs compiling the RTL
+
+  Revision 1.2  2002/12/30 21:17:22  mazen
   - unit cga no more used in sparc compiler.
 
   Revision 1.1  2002/11/30 20:03:49  mazen

rtl/inc/compproc.inc

@@ -215,7 +215,7 @@ Function fpc_Catches(Objtype : TClass) : TObject; compilerproc;
 Procedure fpc_DestroyException(o : TObject); compilerproc;
 procedure fpc_help_constructor; compilerproc;
 procedure fpc_help_fail; compilerproc;
-procedure fpc_help_destructor; compilerproc;
+procedure fpc_help_destructor(var _self : pointer; vmt : pointer; vmt_pos : cardinal);saveregisters;compilerproc;
 procedure fpc_new_class; compilerproc;
 procedure fpc_dispose_class; compilerproc;
 procedure fpc_help_fail_class; compilerproc;
@@ -283,7 +283,10 @@ function fpc_qword_to_double(q: qword): double; compilerproc;
 
 {
   $Log$
-  Revision 1.30  2002-12-29 16:59:17  peter
+  Revision 1.31  2003-01-05 21:32:35  mazen
+  * fixing several bugs compiling the RTL
+
+  Revision 1.30  2002/12/29 16:59:17  peter
     * implemented some more conversions
 
   Revision 1.29  2002/11/26 23:02:07  peter

rtl/inc/generic.inc

@@ -27,7 +27,7 @@ procedure Move(const source;var dest;count:longint);
 type
   bytearray    = array [0..maxlongint-1] of byte;
 var
-  i,size : longint;
+  i:longint;
 begin
   if count <= 0 then exit;
   Dec(count);
@@ -170,7 +170,7 @@ function CompareByte(Const buf1,buf2;len:longint):longint;
 type
   bytearray    = array [0..maxlongint-1] of byte;
 var
-  I,J : longint;
+  I : longint;
 begin
   I:=0;
   if (Len<>0) and (@Buf1<>@Buf2) then
@@ -199,7 +199,7 @@ function CompareWord(Const buf1,buf2;len:longint):longint;
 type
   wordarray    = array [0..maxlongint div 2] of word;
 var
-  I,J : longint;
+  I : longint;
 begin
   I:=0;
   if (Len<>0) and (@Buf1<>@Buf2) then
@@ -228,7 +228,7 @@ function CompareDWord(Const buf1,buf2;len:longint):longint;
 type
   longintarray    = array [0..maxlongint div 4] of longint;
 var
-  I,J : longint;
+  I : longint;
 begin
   I:=0;
   if (Len<>0) and (@Buf1<>@Buf2) then
@@ -328,36 +328,38 @@ end;
   FPC_HELP_CONSTRUCTOR : generic allways means aa little less efficient (PM) }
 { I don't think we really need to save any registers here      }
 { since this is called at the start of the constructor (CEC)   }
-function fpc_help_constructor(var _self : pointer; var vmt : pointer; vmt_pos : cardinal) : pointer; [public,alias:'FPC_HELP_CONSTRUCTOR'];  {$ifdef hascompilerproc} compilerproc; {$endif}
-   type
-     ppointer = ^pointer;
-     pvmt = ^tvmt;
-     tvmt = packed record
-        size,msize : longint;
-        parent : pointer;
-        end;
-   var
-      objectsize : longint;
-      vmtcopy : pointer;
+procedure fpc_help_constructor;[public,alias:'FPC_HELP_CONSTRUCTOR'];{$ifdef hascompilerproc}compilerproc;{$endif}
+  type
+    ppointer = ^pointer;
+    pvmt = ^tvmt;
+    tvmt=packed record
+      size,msize:longint;
+      parent:pointer;
+    end;
+  var
+    objectsize:longint;
+    vmtcopy:pointer;
+    _self:pointer;
+    vmt:pointer;
+    vmt_pos:cardinal;
 begin
-   if vmt=nil then
-     begin
-       fpc_help_constructor:=_self;
-       exit;
-     end;
-   vmtcopy:=vmt;
-   objectsize:=pvmt(vmtcopy)^.size;
-   if _self=nil then
-     begin
-       getmem(_self,objectsize);
-       longint(vmt):=-1; { needed for fail }
-     end;
-   if _self<>nil then
-     begin
-       fillchar(_self^,objectsize,#0);
-       ppointer(_self+vmt_pos)^:=vmtcopy;
-     end;
-   fpc_help_constructor:=_self;
+  if vmt=nil
+  then
+    exit;
+  vmtcopy:=vmt;
+  objectsize:=pvmt(vmtcopy)^.size;
+  if _self=nil
+  then
+    begin
+      getmem(_self,objectsize);
+      longint(vmt):=-1; { needed for fail }
+    end;
+  if _self<>nil
+  then
+    begin
+      fillchar(_self^,objectsize,#0);
+      ppointer(_self+vmt_pos)^:=vmtcopy;
+    end;
 end;
 
 {$endif FPC_SYSTEM_HAS_FPC_HELP_CONSTRUCTOR}
@@ -948,7 +950,10 @@ end;
 
 {
   $Log$
-  Revision 1.44  2002-12-23 21:27:13  peter
+  Revision 1.45  2003-01-05 21:32:35  mazen
+  * fixing several bugs compiling the RTL
+
+  Revision 1.44  2002/12/23 21:27:13  peter
     * fix wrong var names for shortstr_compare
 
   Revision 1.43  2002/10/20 11:51:54  carl

rtl/linux/sparc/syscall.inc

@@ -18,18 +18,6 @@
   {$UNDEF SYSCALL_DEBUG}
 {$ENDIF SYS_LINUX}
 
-
-Type
-
-  TSysResult = Longint; // all platforms, cint=32-bit.
-			// On platforms with off_t =64-bit, people should
-			// use int64, and typecast all other calls to cint.
-
-// I don't think this is going to work on several platforms 64-bit machines
-// don't have only 64-bit params.
-
-  TSysParam  = Longint; 
-
 {*****************************************************************************
                      --- Main:The System Call Self ---
 *****************************************************************************}
@@ -227,7 +215,10 @@ end;
 
 {
   $Log$
-  Revision 1.2  2002-12-24 21:30:20  mazen
+  Revision 1.3  2003-01-05 21:32:35  mazen
+  * fixing several bugs compiling the RTL
+
+  Revision 1.2  2002/12/24 21:30:20  mazen
   - some writeln(s) removed in compiler
   + many files added to RTL
   * some errors fixed in RTL

rtl/linux/sparc/syscallh.inc

@@ -34,19 +34,22 @@ Type
 
   TSysParam  = Longint;
 
-function Do_SysCall(sysnr:TSysParam):TSysResult;  external name 'FPC_SYSCALL0';
+{function Do_SysCall(sysnr:TSysParam):TSysResult;  external name 'FPC_SYSCALL0';
 function Do_SysCall(sysnr,param1:TSysParam):TSysResult; external name 'FPC_SYSCALL1';
 function Do_SysCall(sysnr,param1,param2:TSysParam):TSysResult;  external name 'FPC_SYSCALL2';
 function Do_SysCall(sysnr,param1,param2,param3:TSysParam):TSysResult; external name 'FPC_SYSCALL3';
 function Do_SysCall(sysnr,param1,param2,param3,param4:TSysParam):TSysResult; external name 'FPC_SYSCALL4';
-function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;  external name 'FPC_SYSCALL5';
+function Do_SysCall(sysnr,param1,param2,param3,param4,param5:TSysParam):TSysResult;  external name 'FPC_SYSCALL5';}
 {$ifdef notsupported}
 function Do_SysCall(sysnr,param1,param2,param3,param4,param5,param6:TSysParam):TSysResult;  external name 'FPC_SYSCALL5';
 {$endif notsupported}
 
 {
   $Log$
-  Revision 1.1  2002-12-24 21:30:20  mazen
+  Revision 1.2  2003-01-05 21:32:35  mazen
+  * fixing several bugs compiling the RTL
+
+  Revision 1.1  2002/12/24 21:30:20  mazen
   - some writeln(s) removed in compiler
   + many files added to RTL
   * some errors fixed in RTL

rtl/sparc/setjump.inc

@@ -14,21 +14,95 @@
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
  **********************************************************************}
+{#define ENV(base,reg) [%base + (reg * 4)]
+#define ST_FLUSH_WINDOWS 3
+#define RW_FP [%fp + 0x48]
+}
+procedure longjmp(var S:jmp_buf;value:longint);{assembler;}[Public,alias:'FPC_LONGJMP'];
+  begin{asm
+         /* Store our arguments in global registers so we can still
+            use them while unwinding frames and their register windows.  */
 
-{ the necessary code can be copied from the linux kernel sources }
-function setjmp(var S : jmp_buf) : longint;{assembler;}[Public, alias : 'FPC_SETJMP'];
-  begin{asm}
-    {$warning FIXME!!!!}
-  end;
+         ld ENV(o0,JB_FP), %g3   /* Cache target FP in register %g3.  */
+         mov %o0, %g1            /* ENV in %g1 */
+         orcc %o1, %g0, %g2      /* VAL in %g2 */
+         be,a 0f                 /* Branch if zero; else skip delay slot.  */
+          mov 1, %g2             /* Delay slot only hit if zero: VAL = 1.  */
+0:
+         xor %fp, %g3, %o0
+         add %fp, 512, %o1
+         andncc %o0, 4095, %o0
+         bne LOC(thread)
+          cmp %o1, %g3
+         bl LOC(thread)
+
+         /* Now we will loop, unwinding the register windows up the stack
+            until the restored %fp value matches the target value in %g3.  */
+
+LOC(loop):
+         cmp %fp, %g3            /* Have we reached the target frame? */
+         bl,a LOC(loop)          /* Loop while current fp is below target.  */
+          restore                /* Unwind register window in delay slot.  */
+         be,a LOC(found)         /* Better have hit it exactly.  */
+          ld ENV(g1,JB_SP), %o0  /* Delay slot: extract target SP.  */
+
+LOC(thread):
+         /*
+          * Do a "flush register windows trap".  The trap handler in the
+          * kernel writes all the register windows to their stack slots, and
+          * marks them all as invalid (needing to be sucked up from the
+          * stack when used).  This ensures that all information needed to
+          * unwind to these callers is in memory, not in the register
+          * windows.
+          */
+         ta      ST_FLUSH_WINDOWS
+         ld      ENV(g1,JB_PC), %o7 /* Set return PC. */
+         ld      ENV(g1,JB_SP), %fp /* Set saved SP on restore below. */
+         sub     %fp, 64, %sp    /* Allocate a register frame. */
+         st      %g3, RW_FP      /* Set saved FP on restore below. */
+         retl
+          restore %g2, 0, %o0    /* Restore values from above register frame. */
 
-procedure longjmp(var S : jmp_buf;value : longint);{assembler;}[Public, alias : 'FPC_LONGJMP'];
-  begin{asm}
-    {$warning FIXME!!!!}
+LOC(found):
+         /* We have unwound register windows so %fp matches the target.  */
+         mov %o0, %sp            /* OK, install new SP.  */
+
+LOC(sp_ok):
+         ld ENV(g1,JB_PC), %o0   /* Extract target return PC.  */
+         jmp %o0 + 8             /* Return there.  */
+          mov %g2, %o0           /* Delay slot: set return value.  */
+}
+end;
+function setjmp(var S:jmp_buf):longint;{assembler;}[Public,alias:'FPC_SETJMP'];
+  begin{asm
+         b       1f
+          set    0, %o1}
   end;
+{ENTRY (__sigsetjmp)
+1:
+         /* Save our PC, SP and FP.  Save the signal mask if requested with
+            a tail-call for simplicity; it always returns zero.  */
+         ta      ST_FLUSH_WINDOWS
+
+         st      %o7, [%o0 + (JB_PC * 4)]
+         st      %sp, [%o0 + (JB_SP * 4)]
+         st      %fp, [%o0 + (JB_FP * 4)]
 
+         mov     %o7, %g1
+         call    __sigjmp_save
+          mov    %g1, %o7
+END(__sigsetjmp)
+/* Test if longjmp to JMPBUF would unwind the frame
+    containing a local variable at ADDRESS.  */
+#define _JMPBUF_UNWINDS(jmpbuf, address) \
+   ((int) (address) < (jmpbuf)[JB_SP])
+}
 {
   $Log$
-  Revision 1.3  2002-12-24 21:30:20  mazen
+  Revision 1.4  2003-01-05 21:32:35  mazen
+  * fixing several bugs compiling the RTL
+
+  Revision 1.3  2002/12/24 21:30:20  mazen
   - some writeln(s) removed in compiler
   + many files added to RTL
   * some errors fixed in RTL

rtl/sparc/setjumph.inc

@@ -9,23 +9,51 @@
     See the file COPYING.FPC, included in this distribution,
     for details about the copyright.
 
+    This file was adapted from 
+Guardian:/usr/local/src/glibc-2.2.3/sysdeps/sparc/sparc32# more setjmp.S
+Guardian:/usr/local/src/glibc-2.2.3/sysdeps/sparc/sparc32# more __longjmp.S
+    Copyright (C) 1991, 93, 94, 96, 97, 98 Free Software Foundation, Inc.
+    This file is part of the GNU C Library.
+
+    The GNU C Library is free software; you can redistribute it and/or
+    modify it under the terms of the GNU Library General Public License as
+    published by the Free Software Foundation; either version 2 of the
+    License, or (at your option) any later version.
+
+    The GNU C Library is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+    Library General Public License for more details.
+
+    You should have received a copy of the GNU Library General Public
+    License along with the GNU C Library; see the file COPYING.LIB.  If not,
+    write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+    Boston, MA 02111-1307, USA.
+
     This program is distributed in the hope that it will be useful,
     but WITHOUT ANY WARRANTY; without even the implied warranty of
     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
 
 ******************************************************************************}
+{@Define the machine-dependent type `jmp_buf'.  SPARC version.}
 type
-  jmp_buf = packed record
-    ProgramCounter,
-    StackPointer,
-    BasePointer:Pointer;
+  jmp_buf=packed record
+    {stack pointer}
+    JB_SP,
+    {frame pointer}
+    JB_FP,
+    {program counter}
+    JB_PV:Pointer;
   end;
-  Pjmp_buf = ^jmp_buf;
+  Pjmp_buf=^jmp_buf;
 function setjmp(var S:jmp_buf):longint;
 procedure longjmp(var S:jmp_buf;value:longint);
 {
   $Log$
-  Revision 1.3  2003-01-01 18:24:41  mazen
+  Revision 1.4  2003-01-05 21:32:35  mazen
+  * fixing several bugs compiling the RTL
+
+  Revision 1.3  2003/01/01 18:24:41  mazen
   * just put register pointers
 
   Revision 1.2  2002/11/24 18:19:44  mazen