From 215880afe8824921d454bf4659b8758157bde56e Mon Sep 17 00:00:00 2001 From: mazen Date: Sun, 5 Jan 2003 21:32:35 +0000 Subject: [PATCH] * fixing several bugs compiling the RTL --- compiler/sparc/aasmcpu.pas | 7 ++- compiler/sparc/cgcpu.pas | 105 ++++++++++++++++++++--------------- compiler/sparc/cpupara.pas | 10 ++-- compiler/sparc/cpupi.pas | 16 +++--- compiler/sparc/ncpuinln.pas | 7 ++- rtl/inc/compproc.inc | 7 ++- rtl/inc/generic.inc | 73 ++++++++++++------------ rtl/linux/sparc/syscall.inc | 17 ++---- rtl/linux/sparc/syscallh.inc | 9 ++- rtl/sparc/setjump.inc | 92 +++++++++++++++++++++++++++--- rtl/sparc/setjumph.inc | 40 +++++++++++-- 11 files changed, 254 insertions(+), 129 deletions(-) diff --git a/compiler/sparc/aasmcpu.pas b/compiler/sparc/aasmcpu.pas index fed31065c6..5169b508cc 100644 --- a/compiler/sparc/aasmcpu.pas +++ b/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 diff --git a/compiler/sparc/cgcpu.pas b/compiler/sparc/cgcpu.pas index c0825f1d22..6081515472 100644 --- a/compiler/sparc/cgcpu.pas +++ b/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) diff --git a/compiler/sparc/cpupara.pas b/compiler/sparc/cpupara.pas index 4d3024219e..da8791016f 100644 --- a/compiler/sparc/cpupara.pas +++ b/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 diff --git a/compiler/sparc/cpupi.pas b/compiler/sparc/cpupi.pas index d60e4d7eee..5c770bb375 100644 --- a/compiler/sparc/cpupi.pas +++ b/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 diff --git a/compiler/sparc/ncpuinln.pas b/compiler/sparc/ncpuinln.pas index c70c20d02a..46eeb7c974 100644 --- a/compiler/sparc/ncpuinln.pas +++ b/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 diff --git a/rtl/inc/compproc.inc b/rtl/inc/compproc.inc index 5e0f0f1a31..0828f0c485 100644 --- a/rtl/inc/compproc.inc +++ b/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 diff --git a/rtl/inc/generic.inc b/rtl/inc/generic.inc index 663b0dc4bb..2bbb4b1849 100644 --- a/rtl/inc/generic.inc +++ b/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 diff --git a/rtl/linux/sparc/syscall.inc b/rtl/linux/sparc/syscall.inc index 2b6ec3b23f..6e6eb7fc0e 100644 --- a/rtl/linux/sparc/syscall.inc +++ b/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 diff --git a/rtl/linux/sparc/syscallh.inc b/rtl/linux/sparc/syscallh.inc index 02446723b1..672a3640be 100644 --- a/rtl/linux/sparc/syscallh.inc +++ b/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 diff --git a/rtl/sparc/setjump.inc b/rtl/sparc/setjump.inc index b2a08b9076..028347ba1a 100644 --- a/rtl/sparc/setjump.inc +++ b/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!!!!} + 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. */ + +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 -procedure longjmp(var S : jmp_buf;value : longint);{assembler;}[Public, alias : 'FPC_LONGJMP']; - begin{asm} - {$warning FIXME!!!!} - end; + 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 diff --git a/rtl/sparc/setjumph.inc b/rtl/sparc/setjumph.inc index 4fa524f8f8..6347e63f02 100644 --- a/rtl/sparc/setjumph.inc +++ b/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