1 {
2     Copyright (c) 1998-2002 by Florian Klaempfl
3 
4     This unit implements the code generator for the SPARC
5 
6     This program is free software; you can redistribute it and/or modify
7     it under the terms of the GNU General Public License as published by
8     the Free Software Foundation; either version 2 of the License, or
9     (at your option) any later version.
10 
11     This program is distributed in the hope that it will be useful,
12     but WITHOUT ANY WARRANTY; without even the implied warranty of
13     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14     GNU General Public License for more details.
15 
16     You should have received a copy of the GNU General Public License
17     along with this program; if not, write to the Free Software
18     Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
19 
20  ****************************************************************************
21 }
22 unit cgcpu;
23 
24 {$i fpcdefs.inc}
25 
26 interface
27 
28     uses
29        globtype,parabase,
30        cgbase,cgutils,cgobj,
31        cg64f32,
32        aasmbase,aasmtai,aasmdata,aasmcpu,
33        cpubase,cpuinfo,
34        node,symconst,SymType,symdef,
35        rgcpu,
36        cgsparc;
37 
38     type
39       TCGSparc=class(TCGSparcGen)
40         procedure a_load_reg_reg(list : TAsmList; fromsize,tosize : tcgsize; reg1,reg2 : tregister);override;
41         procedure a_load_const_reg(list : TAsmList; size : TCGSize; a : tcgint; reg : TRegister);override;
42       end;
43 
44       TCg64Sparc=class(tcg64f32)
45       private
46         procedure get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp;checkoverflow : boolean);
47       public
48         procedure a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);override;
49         procedure a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);override;
50         procedure a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);override;
51         procedure a_op64_reg_reg(list:TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst:TRegister64);override;
52         procedure a_op64_const_reg(list:TAsmList;op:TOpCG;size : tcgsize;value:int64;regdst:TRegister64);override;
53         procedure a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64);override;
54         procedure a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);override;
55         procedure a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
56         procedure a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);override;
57       end;
58 
59     procedure create_codegen;
60 
61   implementation
62 
63     uses
64       verbose,
65       systems;
66 
67     procedure TCGSparc.a_load_reg_reg(list:TAsmList;fromsize,tosize:tcgsize;reg1,reg2:tregister);
68       var
69         instr : taicpu;
70       begin
71          if (tcgsize2size[fromsize] > tcgsize2size[tosize]) or
72             ((tcgsize2size[fromsize] = tcgsize2size[tosize]) and
73              (fromsize <> tosize)) or
74             { needs to mask out the sign in the top 16 bits }
75             ((fromsize = OS_S8) and
76              (tosize = OS_16)) then
77            case tosize of
78              OS_8 :
79                list.concat(taicpu.op_reg_const_reg(A_AND,reg1,$ff,reg2));
80              OS_16 :
81                begin
82                  list.concat(taicpu.op_reg_const_reg(A_SLL,reg1,16,reg2));
83                  list.concat(taicpu.op_reg_const_reg(A_SRL,reg2,16,reg2));
84                end;
85              OS_32,
86              OS_S32 :
87                begin
88                  instr:=taicpu.op_reg_reg(A_MOV,reg1,reg2);
89                  list.Concat(instr);
90                  { Notify the register allocator that we have written a move instruction so
91                   it can try to eliminate it. }
92                  add_move_instruction(instr);
93                end;
94              OS_S8 :
95                begin
96                  list.concat(taicpu.op_reg_const_reg(A_SLL,reg1,24,reg2));
97                  list.concat(taicpu.op_reg_const_reg(A_SRA,reg2,24,reg2));
98                end;
99              OS_S16 :
100                begin
101                  list.concat(taicpu.op_reg_const_reg(A_SLL,reg1,16,reg2));
102                  list.concat(taicpu.op_reg_const_reg(A_SRA,reg2,16,reg2));
103                end;
104              else
105                internalerror(2002090901);
106            end
107          else
108            begin
109              instr:=taicpu.op_reg_reg(A_MOV,reg1,reg2);
110              list.Concat(instr);
111              { Notify the register allocator that we have written a move instruction so
112               it can try to eliminate it. }
113              add_move_instruction(instr);
114            end;
115       end;
116 
117 
118     procedure TCGSparc.a_load_const_reg(list : TAsmList;size : TCGSize;a : tcgint;reg : TRegister);
119       begin
120         { we don't use the set instruction here because it could be evalutated to two
121           instructions which would cause problems with the delay slot (FK) }
122         if (a=0) then
123           list.concat(taicpu.op_reg(A_CLR,reg))
124         else if (a>=simm13lo) and (a<=simm13hi) then
125           list.concat(taicpu.op_const_reg(A_MOV,a,reg))
126         else
127           begin
128             list.concat(taicpu.op_const_reg(A_SETHI,aint(a) shr 10,reg));
129             if (aint(a) and aint($3ff))<>0 then
130               list.concat(taicpu.op_reg_const_reg(A_OR,reg,aint(a) and aint($3ff),reg));
131           end;
132       end;
133 
134 
135 {****************************************************************************
136                                TCG64Sparc
137 ****************************************************************************}
138 
139     procedure tcg64sparc.a_load64_reg_ref(list : TAsmList;reg : tregister64;const ref : treference);
140       var
141         tmpref: treference;
142       begin
143         { Override this function to prevent loading the reference twice }
144         tmpref:=ref;
145         cg.a_load_reg_ref(list,OS_32,OS_32,reg.reghi,tmpref);
146         inc(tmpref.offset,4);
147         cg.a_load_reg_ref(list,OS_32,OS_32,reg.reglo,tmpref);
148       end;
149 
150 
151     procedure tcg64sparc.a_load64_ref_reg(list : TAsmList;const ref : treference;reg : tregister64);
152       var
153         tmpref: treference;
154       begin
155         { Override this function to prevent loading the reference twice }
156         tmpref:=ref;
157         cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reghi);
158         inc(tmpref.offset,4);
159         cg.a_load_ref_reg(list,OS_32,OS_32,tmpref,reg.reglo);
160       end;
161 
162 
163     procedure tcg64sparc.a_load64_ref_cgpara(list : TAsmList;const r : treference;const paraloc : tcgpara);
164       var
165         hreg64 : tregister64;
166       begin
167         { Override this function to prevent loading the reference twice.
168           Use here some extra registers, but those are optimized away by the RA }
169         hreg64.reglo:=cg.GetIntRegister(list,OS_32);
170         hreg64.reghi:=cg.GetIntRegister(list,OS_32);
171         a_load64_ref_reg(list,r,hreg64);
172         a_load64_reg_cgpara(list,hreg64,paraloc);
173       end;
174 
175 
176     procedure TCg64Sparc.get_64bit_ops(op:TOpCG;var op1,op2:TAsmOp;checkoverflow : boolean);
177       begin
178         case op of
179           OP_ADD :
180             begin
181               op1:=A_ADDCC;
182               if checkoverflow then
183                 op2:=A_ADDXCC
184               else
185                 op2:=A_ADDX;
186             end;
187           OP_SUB :
188             begin
189               op1:=A_SUBCC;
190               if checkoverflow then
191                 op2:=A_SUBXCC
192               else
193                 op2:=A_SUBX;
194             end;
195           OP_XOR :
196             begin
197               op1:=A_XOR;
198               op2:=A_XOR;
199             end;
200           OP_OR :
201             begin
202               op1:=A_OR;
203               op2:=A_OR;
204             end;
205           OP_AND :
206             begin
207               op1:=A_AND;
208               op2:=A_AND;
209             end;
210           else
211             internalerror(200203241);
212         end;
213       end;
214 
215 
216     procedure TCg64Sparc.a_op64_reg_reg(list:TAsmList;op:TOpCG;size : tcgsize;regsrc,regdst:TRegister64);
217       begin
218         case op of
219           OP_NEG :
220             begin
221               { Use the simple code: y=0-z }
222               list.concat(taicpu.op_reg_reg_reg(A_SUBcc,NR_G0,regsrc.reglo,regdst.reglo));
223               list.concat(taicpu.op_reg_reg_reg(A_SUBX,NR_G0,regsrc.reghi,regdst.reghi));
224             end;
225           OP_NOT :
226             begin
227               list.concat(taicpu.op_reg_reg_reg(A_XNOR,regsrc.reglo,NR_G0,regdst.reglo));
228               list.concat(taicpu.op_reg_reg_reg(A_XNOR,regsrc.reghi,NR_G0,regdst.reghi));
229             end;
230         else
231           a_op64_reg_reg_reg(list,op,size,regsrc,regdst,regdst);
232         end;
233       end;
234 
235 
236     procedure TCg64Sparc.a_op64_const_reg(list:TAsmList;op:TOpCG;size : tcgsize;value:int64;regdst:TRegister64);
237       begin
238         a_op64_const_reg_reg(list,op,size,value,regdst,regdst);
239       end;
240 
241 
242     procedure tcg64sparc.a_op64_const_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;value : int64; regsrc,regdst : tregister64);
243       var
244         l : tlocation;
245       begin
246         a_op64_const_reg_reg_checkoverflow(list,op,size,value,regsrc,regdst,false,l);
247       end;
248 
249 
250     procedure tcg64sparc.a_op64_reg_reg_reg(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64);
251       var
252         l : tlocation;
253       begin
254         a_op64_reg_reg_reg_checkoverflow(list,op,size,regsrc1,regsrc2,regdst,false,l);
255       end;
256 
257 
258     procedure tcg64sparc.a_op64_const_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;value : int64;regsrc,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
259       var
260         op1,op2:TAsmOp;
261       begin
262         case op of
263           OP_NEG,
264           OP_NOT :
265             internalerror(200306017);
266           OP_AND,OP_OR,OP_XOR:
267             begin
268               cg.a_op_const_reg_reg(list,op,OS_INT,tcgint(lo(value)),regsrc.reglo,regdst.reglo);
269               cg.a_op_const_reg_reg(list,op,OS_INT,tcgint(hi(value)),regsrc.reghi,regdst.reghi);
270             end;
271         else
272           get_64bit_ops(op,op1,op2,setflags);
273           tcgsparc(cg).handle_reg_const_reg(list,op1,regsrc.reglo,tcgint(lo(value)),regdst.reglo);
274           tcgsparc(cg).handle_reg_const_reg(list,op2,regsrc.reghi,tcgint(hi(value)),regdst.reghi);
275         end;
276       end;
277 
278 
279     procedure tcg64sparc.a_op64_reg_reg_reg_checkoverflow(list: TAsmList;op:TOpCG;size : tcgsize;regsrc1,regsrc2,regdst : tregister64;setflags : boolean;var ovloc : tlocation);
280       var
281         op1,op2:TAsmOp;
282       begin
283         case op of
284           OP_NEG,
285           OP_NOT :
286             internalerror(200306017);
287         end;
288         get_64bit_ops(op,op1,op2,setflags);
289         list.concat(taicpu.op_reg_reg_reg(op1,regsrc2.reglo,regsrc1.reglo,regdst.reglo));
290         list.concat(taicpu.op_reg_reg_reg(op2,regsrc2.reghi,regsrc1.reghi,regdst.reghi));
291       end;
292 
293 
294     procedure create_codegen;
295       begin
296         cg:=TCgSparc.Create;
297         if target_info.system=system_sparc_linux then
298           TCgSparc(cg).use_unlimited_pic_mode:=true
299         else
300           TCgSparc(cg).use_unlimited_pic_mode:=false;
301         cg64:=TCg64Sparc.Create;
302       end;
303 
304 end.
305 
306