?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Initial revision
[AROS-Contrib.git] / development / compilers / freepascal / compiler / cg68kmat.pas
blob8a253e347f142796cd95de373b936848970004af
1 {
2 $Id$
3 Copyright (c) 1998-2000 by Florian Klaempfl
4
5 Generate m68k assembler for math nodes
6
7 This program is free software; you can redistribute it and/or modify
8 it under the terms of the GNU General Public License as published by
9 the Free Software Foundation; either version 2 of the License, or
10 (at your option) any later version.
11
12 This program is distributed in the hope that it will be useful,
13 but WITHOUT ANY WARRANTY; without even the implied warranty of
14 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 GNU General Public License for more details.
16
17 You should have received a copy of the GNU General Public License
18 along with this program; if not, write to the Free Software
19 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
20
21 ****************************************************************************
22 }
23 unit cg68kmat;
24 interface
25
26 uses
27 tree;
28
29 procedure secondmoddiv(var p : ptree);
30 procedure secondshlshr(var p : ptree);
31 procedure secondunaryminus(var p : ptree);
32 procedure secondnot(var p : ptree);
33
34
35 implementation
36
37 uses
38 globtype,systems,symconst,
39 cobjects,verbose,globals,
40 symtable,aasm,types,
41 hcodegen,temp_gen,pass_2,
42 cpubase,cga68k,tgen68k;
43
44 {*****************************************************************************
45 SecondModDiv
46 *****************************************************************************}
47
48 { D0 and D1 used as temp (ok) }
49 procedure secondmoddiv(var p : ptree);
50
51 var
52 hreg1 : tregister;
53 power : longint;
54 hl : pasmlabel;
55 reg: tregister;
56 pushed: boolean;
57 hl1: pasmlabel;
58 begin
59 secondpass(p^.left);
60 set_location(p^.location,p^.left^.location);
61 pushed:=maybe_push(p^.right^.registers32,p);
62 secondpass(p^.right);
63 if pushed then restore(p);
64
65 { put numerator in register }
66 if p^.left^.location.loc<>LOC_REGISTER then
67 begin
68 if p^.left^.location.loc=LOC_CREGISTER then
69 begin
70 hreg1:=getregister32;
71 emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hreg1);
72 end
73 else
74 begin
75 del_reference(p^.left^.location.reference);
76 hreg1:=getregister32;
77 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
78 hreg1)));
79 end;
80 clear_location(p^.left^.location);
81 p^.left^.location.loc:=LOC_REGISTER;
82 p^.left^.location.register:=hreg1;
83 end
84 else hreg1:=p^.left^.location.register;
85
86 if (p^.treetype=divn) and (p^.right^.treetype=ordconstn) and
87 ispowerof2(p^.right^.value,power) then
88 begin
89 exprasmlist^.concat(new(paicpu, op_reg(A_TST, S_L, hreg1)));
90 getlabel(hl);
91 emitl(A_BPL,hl);
92 if (power = 1) then
93 exprasmlist^.concat(new(paicpu, op_const_reg(A_ADDQ, S_L,1, hreg1)))
94 else
95 Begin
96 { optimize using ADDQ if possible! }
97 if (p^.right^.value-1) < 9 then
98 exprasmlist^.concat(new(paicpu, op_const_reg(A_ADDQ, S_L,p^.right^.value-1, hreg1)))
99 else
100 exprasmlist^.concat(new(paicpu, op_const_reg(A_ADD, S_L,p^.right^.value-1, hreg1)));
101 end;
102 emitl(A_LABEL, hl);
103 if (power > 0) and (power < 9) then
104 exprasmlist^.concat(new(paicpu, op_const_reg(A_ASR, S_L,power, hreg1)))
105 else
106 begin
107 exprasmlist^.concat(new(paicpu, op_const_reg(A_MOVE,S_L,power, R_D0)));
108 exprasmlist^.concat(new(paicpu, op_reg_reg(A_ASR,S_L,R_D0, hreg1)));
109 end;
110 end
111 else
112 begin
113 { bring denominator to D1 }
114 { D1 is always free, it's }
115 { only used for temporary }
116 { purposes }
117 if (p^.right^.location.loc<>LOC_REGISTER) and
118 (p^.right^.location.loc<>LOC_CREGISTER) then
119 begin
120 del_reference(p^.right^.location.reference);
121 p^.left^.location.loc:=LOC_REGISTER;
122 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),R_D1)));
123 end
124 else
125 begin
126 ungetregister32(p^.right^.location.register);
127 emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
128 end;
129
130 { on entering this section D1 should contain the divisor }
131
132 if (aktoptprocessor = MC68020) then
133 begin
134 { Check if divisor is ZERO - if so call HALT_ERROR }
135 { with d0 = 200 (Division by zero!) }
136 getlabel(hl1);
137 exprasmlist^.concat(new(paicpu,op_reg(A_TST,S_L,R_D1)));
138 { if not zero then simply continue on }
139 emitl(A_BNE,hl1);
140 exprasmlist^.concat(new(paicpu,op_const_reg(A_MOVE,S_L,200,R_D0)));
141 emitcall('FPC_HALT_ERROR',true);
142 emitl(A_LABEL,hl1);
143 if (p^.treetype = modn) then
144 Begin
145 reg := getregister32;
146 exprasmlist^.concat(new(paicpu,op_reg(A_CLR,S_L,reg)));
147 getlabel(hl);
148 { here what we do is prepare the high register with the }
149 { correct sign. i.e we clear it, check if the low dword reg }
150 { which will participate in the division is signed, if so we}
151 { we extend the sign to the high doword register by inverting }
152 { all the bits. }
153 exprasmlist^.concat(new(paicpu,op_reg(A_TST,S_L,hreg1)));
154 emitl(A_BPL,hl);
155 exprasmlist^.concat(new(paicpu,op_reg(A_NOT,S_L,reg)));
156 emitl(A_LABEL,hl);
157 { reg:hreg1 / d1 }
158 exprasmlist^.concat(new(paicpu,op_reg_reg_reg(A_DIVSL,S_L,R_D1,reg,hreg1)));
159 { hreg1 already contains quotient }
160 { looking for remainder }
161 exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOVE,S_L,reg,hreg1)));
162 ungetregister32(reg);
163 end
164 else
165 { simple division... }
166 Begin
167 { reg:hreg1 / d1 }
168 exprasmlist^.concat(new(paicpu,op_reg_reg(A_DIVS,S_L,R_D1,hreg1)));
169 end;
170 end
171 else { MC68000 operations }
172 begin
173 { put numerator in d0 }
174 emit_reg_reg(A_MOVE,S_L,hreg1,R_D0);
175 { operation to perform on entry to both }
176 { routines... d0/d1 }
177 { return result in d0 }
178 if p^.treetype = divn then
179 emitcall('FPC_LONGDIV',true)
180 else
181 emitcall('FPC_LONGMOD',true);
182 emit_reg_reg(A_MOVE,S_L,R_D0,hreg1);
183 end; { endif }
184 end;
185 { this registers are always used when div/mod are present }
186 usedinproc:=usedinproc or ($800 shr word(R_D1));
187 usedinproc:=usedinproc or ($800 shr word(R_D0));
188 clear_location(p^.location);
189 p^.location.loc:=LOC_REGISTER;
190 p^.location.register:=hreg1;
191 end;
192
193
194 {*****************************************************************************
195 SecondShlShr
196 *****************************************************************************}
197
198 { D6 used as scratch (ok) }
199 procedure secondshlshr(var p : ptree);
200
201 var
202 hregister1,hregister2,hregister3 : tregister;
203 op : tasmop;
204 pushed : boolean;
205 begin
206
207 secondpass(p^.left);
208 pushed:=maybe_push(p^.right^.registers32,p);
209 secondpass(p^.right);
210 if pushed then restore(p);
211
212 { load left operators in a register }
213 if p^.left^.location.loc<>LOC_REGISTER then
214 begin
215 if p^.left^.location.loc=LOC_CREGISTER then
216 begin
217 hregister1:=getregister32;
218 emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
219 hregister1);
220 end
221 else
222 begin
223 del_reference(p^.left^.location.reference);
224 hregister1:=getregister32;
225 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
226 hregister1)));
227 end;
228 end
229 else hregister1:=p^.left^.location.register;
230
231 { determine operator }
232 if p^.treetype=shln then
233 op:=A_LSL
234 else
235 op:=A_LSR;
236
237 { shifting by a constant directly decode: }
238 if (p^.right^.treetype=ordconstn) then
239 begin
240 if (p^.right^.location.reference.offset and 31 > 0) and (p^.right^.location.reference.offset and 31 < 9) then
241 exprasmlist^.concat(new(paicpu,op_const_reg(op,S_L,p^.right^.location.reference.offset and 31,
242 hregister1)))
243 else
244 begin
245 exprasmlist^.concat(new(paicpu,op_const_reg(A_MOVE,S_L,p^.right^.location.reference.offset and 31,
246 R_D6)));
247 exprasmlist^.concat(new(paicpu,op_reg_reg(op,S_L,R_D6,hregister1)));
248 end;
249 p^.location.loc:=LOC_REGISTER;
250 p^.location.register:=hregister1;
251 end
252 else
253 begin
254 { load right operators in a register }
255 if p^.right^.location.loc<>LOC_REGISTER then
256 begin
257 if p^.right^.location.loc=LOC_CREGISTER then
258 begin
259 hregister2:=getregister32;
260 emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,
261 hregister2);
262 end
263 else
264 begin
265 del_reference(p^.right^.location.reference);
266 hregister2:=getregister32;
267 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),
268 hregister2)));
269 end;
270 end
271 else hregister2:=p^.right^.location.register;
272
273
274 emit_reg_reg(op,S_L,hregister2,hregister1);
275 p^.location.register:=hregister1;
276 end;
277 { this register is always used when shl/shr are present }
278 usedinproc:=usedinproc or ($800 shr byte(R_D6));
279 end;
280
281 {*****************************************************************************
282 Secondunaryminus
283 *****************************************************************************}
284
285 procedure secondunaryminus(var p : ptree);
286
287 begin
288 secondpass(p^.left);
289 p^.location.loc:=LOC_REGISTER;
290 case p^.left^.location.loc of
291 LOC_REGISTER : begin
292 p^.location.register:=p^.left^.location.register;
293 exprasmlist^.concat(new(paicpu,op_reg(A_NEG,S_L,p^.location.register)));
294 end;
295 LOC_CREGISTER : begin
296 p^.location.register:=getregister32;
297 emit_reg_reg(A_MOVE,S_L,p^.location.register,
298 p^.location.register);
299 exprasmlist^.concat(new(paicpu,op_reg(A_NEG,S_L,p^.location.register)));
300 end;
301 LOC_REFERENCE,LOC_MEM :
302 begin
303 del_reference(p^.left^.location.reference);
304 { change sign of a floating point }
305 { in the case of emulation, get }
306 { a free register, and change sign }
307 { manually. }
308 { otherwise simply load into an FPU}
309 { register. }
310 if (p^.left^.resulttype^.deftype=floatdef) and
311 (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
312 begin
313 { move to FPU }
314 floatload(pfloatdef(p^.left^.resulttype)^.typ,
315 p^.left^.location.reference,p^.location);
316 if (cs_fp_emulation) in aktmoduleswitches then
317 { if in emulation mode change sign manually }
318 exprasmlist^.concat(new(paicpu,op_const_reg(A_BCHG,S_L,31,
319 p^.location.fpureg)))
320 else
321 exprasmlist^.concat(new(paicpu,op_reg(A_FNEG,S_FX,
322 p^.location.fpureg)));
323 end
324 else
325 begin
326 p^.location.register:=getregister32;
327 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,
328 newreference(p^.left^.location.reference),
329 p^.location.register)));
330 exprasmlist^.concat(new(paicpu,op_reg(A_NEG,S_L,p^.location.register)));
331 end;
332 end;
333 LOC_FPU : begin
334 p^.location.loc:=LOC_FPU;
335 p^.location.fpureg := p^.left^.location.fpureg;
336 if (cs_fp_emulation) in aktmoduleswitches then
337 exprasmlist^.concat(new(paicpu,op_const_reg(A_BCHG,S_L,31,p^.location.fpureg)))
338 else
339 exprasmlist^.concat(new(paicpu,op_reg(A_FNEG,S_FX,p^.location.fpureg)));
340 end;
341 end;
342 { emitoverflowcheck;}
343 end;
344
345
346 {*****************************************************************************
347 SecondNot
348 *****************************************************************************}
349
350 procedure secondnot(var p : ptree);
351
352 const
353 flagsinvers : array[F_E..F_BE] of tresflags =
354 (F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C,
355 F_A,F_AE,F_B,F_BE);
356
357 var
358 hl : pasmlabel;
359
360 begin
361 if (p^.resulttype^.deftype=orddef) and
362 (porddef(p^.resulttype)^.typ=bool8bit) then
363 begin
364 case p^.location.loc of
365 LOC_JUMP : begin
366 hl:=truelabel;
367 truelabel:=falselabel;
368 falselabel:=hl;
369 secondpass(p^.left);
370 maketojumpbool(p^.left);
371 hl:=truelabel;
372 truelabel:=falselabel;
373 falselabel:=hl;
374 end;
375 LOC_FLAGS : begin
376 secondpass(p^.left);
377 p^.location.resflags:=flagsinvers[p^.left^.location.resflags];
378 end;
379 LOC_REGISTER : begin
380 secondpass(p^.left);
381 p^.location.register:=p^.left^.location.register;
382 exprasmlist^.concat(new(paicpu,op_const_reg(A_EOR,S_B,1,p^.location.register)));
383 end;
384 LOC_CREGISTER : begin
385 secondpass(p^.left);
386 p^.location.loc:=LOC_REGISTER;
387 p^.location.register:=getregister32;
388 emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,
389 p^.location.register);
390 exprasmlist^.concat(new(paicpu,op_const_reg(A_EOR,S_B,1,p^.location.register)));
391 end;
392 LOC_REFERENCE,LOC_MEM : begin
393 secondpass(p^.left);
394 del_reference(p^.left^.location.reference);
395 p^.location.loc:=LOC_REGISTER;
396 p^.location.register:=getregister32;
397 if p^.left^.location.loc=LOC_CREGISTER then
398 emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,
399 p^.location.register)
400 else
401 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_B,
402 newreference(p^.left^.location.reference),
403 p^.location.register)));
404 exprasmlist^.concat(new(paicpu,op_const_reg(A_EOR,S_B,1,p^.location.register)));
405 end;
406 end;
407 end
408 else
409 begin
410 secondpass(p^.left);
411 p^.location.loc:=LOC_REGISTER;
412
413 case p^.left^.location.loc of
414 LOC_REGISTER : begin
415 p^.location.register:=p^.left^.location.register;
416 exprasmlist^.concat(new(paicpu,op_reg(A_NOT,S_L,p^.location.register)));
417 end;
418 LOC_CREGISTER : begin
419 p^.location.register:=getregister32;
420 emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
421 p^.location.register);
422 exprasmlist^.concat(new(paicpu,op_reg(A_NOT,S_L,p^.location.register)));
423 end;
424 LOC_REFERENCE,LOC_MEM :
425 begin
426 del_reference(p^.left^.location.reference);
427 p^.location.register:=getregister32;
428 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,
429 newreference(p^.left^.location.reference),
430 p^.location.register)));
431 exprasmlist^.concat(new(paicpu,op_reg(A_NOT,S_L,p^.location.register)));
432 end;
433 end;
434 {if p^.left^.location.loc=loc_register then
435 p^.location.register:=p^.left^.location.register
436 else
437 begin
438 del_locref(p^.left^.location);
439 p^.location.register:=getregister32;
440 exprasmlist^.concat(new(paicpu,op_loc_reg(A_MOV,S_L,
441 p^.left^.location,
442 p^.location.register)));
443 end;
444 exprasmlist^.concat(new(paicpu,op_reg(A_NOT,S_L,p^.location.register)));}
445
446 end;
447 end;
448
449 end.
450 {
451 $Log$
452 Revision 1.1 2002/02/19 08:21:49 sasu
453 Initial revision
454
455 Revision 1.1 2000/07/13 06:29:46 michael
456 + Initial import
457
458 Revision 1.8 2000/02/09 13:22:49 peter
459 * log truncated
460
461 Revision 1.7 2000/01/07 01:14:22 peter
462 * updated copyright to 2000
463
464 Revision 1.6 1999/11/18 15:34:44 pierre
465 * Notes/Hints for local syms changed to
466 Set_varstate function
467
468 Revision 1.5 1999/09/16 23:05:51 florian
469 * m68k compiler is again compilable (only gas writer, no assembler reader)
470
471 }
Mirror of AROS' Contrib svn.