?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
Initial revision
[AROS-Contrib.git] / development / compilers / freepascal / compiler / cg68kld.pas
blob73a96eab851d326abd0958c9c29016dacc97e33d
1 {
2 $Id$
3 Copyright (c) 1998-2000 by Florian Klaempfl
4
5 Generate m68k assembler for load/assignment 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 cg68kld;
24 interface
25
26 uses
27 tree,cpubase;
28
29 var
30 { this is for open arrays and strings }
31 { but be careful, this data is in the }
32 { generated code destroyed quick, and also }
33 { the next call of secondload destroys this }
34 { data }
35 { So be careful using the informations }
36 { provided by this variables }
37 highframepointer : tregister;
38 highoffset : longint;
39
40 procedure secondload(var p : ptree);
41 procedure secondassignment(var p : ptree);
42 procedure secondfuncret(var p : ptree);
43 procedure secondarrayconstruct(var p : ptree);
44
45
46 implementation
47
48 uses
49 cobjects,verbose,globals,symconst,
50 symtable,aasm,types,
51 hcodegen,temp_gen,pass_2,
52 cga68k,tgen68k;
53
54
55 {*****************************************************************************
56 SecondLoad
57 *****************************************************************************}
58
59 procedure secondload(var p : ptree);
60
61 var
62 hregister : tregister;
63 i : longint;
64 symtabletype: tsymtabletype;
65 hp : preference;
66
67 begin
68 simple_loadn:=true;
69 reset_reference(p^.location.reference);
70 case p^.symtableentry^.typ of
71 { this is only for toasm and toaddr }
72 absolutesym :
73 begin
74 stringdispose(p^.location.reference.symbol);
75 p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
76 end;
77 varsym :
78 begin
79 hregister:=R_NO;
80 symtabletype:=p^.symtable^.symtabletype;
81 { in case it is a register variable: }
82 { we simply set the location to the }
83 { correct register. }
84 if pvarsym(p^.symtableentry)^.reg<>R_NO then
85 begin
86 p^.location.loc:=LOC_CREGISTER;
87 p^.location.register:=pvarsym(p^.symtableentry)^.reg;
88 unused:=unused-[pvarsym(p^.symtableentry)^.reg];
89 end
90 else
91 begin
92 { --------------------- LOCAL AND TEMP VARIABLES ------------- }
93 if (symtabletype=parasymtable) or (symtabletype=localsymtable) then
94 begin
95
96 p^.location.reference.base:=procinfo^.framepointer;
97 p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
98
99 if (symtabletype=localsymtable) then
100 p^.location.reference.offset:=-p^.location.reference.offset;
101
102 if (symtabletype in [localsymtable,inlinelocalsymtable]) then
103 p^.location.reference.offset:=-p^.location.reference.offset;
104
105 if (lexlevel>(p^.symtable^.symtablelevel)) then
106 begin
107 hregister:=getaddressreg;
108
109 { make a reference }
110 new(hp);
111 reset_reference(hp^);
112 hp^.offset:=procinfo^.framepointer_offset;
113 hp^.base:=procinfo^.framepointer;
114
115 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,hp,hregister)));
116
117 simple_loadn:=false;
118 i:=lexlevel-1;
119 while i>(p^.symtable^.symtablelevel) do
120 begin
121 { make a reference }
122 new(hp);
123 reset_reference(hp^);
124 hp^.offset:=8;
125 hp^.base:=hregister;
126
127 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,hp,hregister)));
128 dec(i);
129 end;
130 p^.location.reference.base:=hregister;
131 end;
132 end
133 { --------------------- END OF LOCAL AND TEMP VARS ---------------- }
134 else
135 case symtabletype of
136 unitsymtable,globalsymtable,
137 staticsymtable : begin
138 stringdispose(p^.location.reference.symbol);
139 p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
140 end;
141 objectsymtable : begin
142 if sp_static in pvarsym(p^.symtableentry)^.symoptions then
143 begin
144 stringdispose(p^.location.reference.symbol);
145 p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
146 end
147 else
148 begin
149 p^.location.reference.base:=R_A5;
150 p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
151 end;
152 end;
153 withsymtable : begin
154 hregister:=getaddressreg;
155 p^.location.reference.base:=hregister;
156 { make a reference }
157 new(hp);
158 reset_reference(hp^);
159 hp^.offset:=p^.symtable^.datasize;
160 hp^.base:=procinfo^.framepointer;
161
162 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,hp,hregister)));
163
164 p^.location.reference.offset:=
165 pvarsym(p^.symtableentry)^.address;
166 end;
167 end;
168
169 { in case call by reference, then calculate: }
170 if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
171 is_open_array(pvarsym(p^.symtableentry)^.definition) or
172 is_array_of_const(pvarsym(p^.symtableentry)^.definition) or
173 ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
174 push_addr_param(pvarsym(p^.symtableentry)^.definition)) then
175 begin
176 simple_loadn:=false;
177 if hregister=R_NO then
178 hregister:=getaddressreg;
179 { ADDED FOR OPEN ARRAY SUPPORT. }
180 if (p^.location.reference.base=procinfo^.framepointer) then
181 begin
182 highframepointer:=p^.location.reference.base;
183 highoffset:=p^.location.reference.offset;
184 end
185 else
186 begin
187 highframepointer:=R_A1;
188 highoffset:=p^.location.reference.offset;
189 exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOVE,S_L,
190 p^.location.reference.base,R_A1)));
191 end;
192 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),
193 hregister)));
194 { END ADDITION }
195 clear_reference(p^.location.reference);
196 p^.location.reference.base:=hregister;
197 end;
198 { should be dereferenced later (FK)
199 if (pvarsym(p^.symtableentry)^.definition^.deftype=objectdef) and
200 ((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oo_is_class)<>0) then
201 begin
202 simple_loadn:=false;
203 if hregister=R_NO then
204 hregister:=getaddressreg;
205 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),
206 hregister)));
207 clear_reference(p^.location.reference);
208 p^.location.reference.base:=hregister;
209 end;
210 }
211 end;
212 end;
213 procsym:
214 begin
215 {!!!!! Be aware, work on virtual methods too }
216 stringdispose(p^.location.reference.symbol);
217 p^.location.reference.symbol:=
218 stringdup(pprocsym(p^.symtableentry)^.definition^.mangledname);
219 end;
220 typedconstsym :
221 begin
222 stringdispose(p^.location.reference.symbol);
223 p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
224 end;
225 else internalerror(4);
226 end;
227 end;
228
229
230 {*****************************************************************************
231 SecondAssignment
232 *****************************************************************************}
233
234 procedure secondassignment(var p : ptree);
235
236 var
237 opsize : topsize;
238 withresult : boolean;
239 otlabel,hlabel,oflabel : pasmlabel;
240 hregister : tregister;
241 loc : tloc;
242 pushed : boolean;
243
244 begin
245 otlabel:=truelabel;
246 oflabel:=falselabel;
247 getlabel(truelabel);
248 getlabel(falselabel);
249 withresult:=false;
250 { calculate left sides }
251 secondpass(p^.left);
252 if codegenerror then
253 exit;
254 loc:=p^.left^.location.loc;
255 { lets try to optimize this (PM) }
256 { define a dest_loc that is the location }
257 { and a ptree to verify that it is the right }
258 { place to insert it }
259 {$ifdef test_dest_loc}
260 if (aktexprlevel<4) then
261 begin
262 dest_loc_known:=true;
263 dest_loc:=p^.left^.location;
264 dest_loc_tree:=p^.right;
265 end;
266 {$endif test_dest_loc}
267
268 pushed:=maybe_push(p^.right^.registers32,p^.left);
269 secondpass(p^.right);
270 if pushed then restore(p^.left);
271
272 if codegenerror then
273 exit;
274 {$ifdef test_dest_loc}
275 dest_loc_known:=false;
276 if in_dest_loc then
277 begin
278 truelabel:=otlabel;
279 falselabel:=oflabel;
280 in_dest_loc:=false;
281 exit;
282 end;
283 {$endif test_dest_loc}
284 if p^.left^.resulttype^.deftype=stringdef then
285 begin
286 { we do not need destination anymore }
287 del_reference(p^.left^.location.reference);
288 { only source if withresult is set }
289 if not(withresult) then
290 del_reference(p^.right^.location.reference);
291 loadstring(p);
292 ungetiftemp(p^.right^.location.reference);
293 end
294 else case p^.right^.location.loc of
295 LOC_REFERENCE,
296 LOC_MEM : begin
297 { handle ordinal constants trimmed }
298 if (p^.right^.treetype in [ordconstn,fixconstn]) or
299 (loc=LOC_CREGISTER) then
300 begin
301 case p^.left^.resulttype^.size of
302 1 : opsize:=S_B;
303 2 : opsize:=S_W;
304 4 : opsize:=S_L;
305 end;
306 if loc=LOC_CREGISTER then
307 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,opsize,
308 newreference(p^.right^.location.reference),
309 p^.left^.location.register)))
310 else
311 exprasmlist^.concat(new(paicpu,op_const_ref(A_MOVE,opsize,
312 p^.right^.location.reference.offset,
313 newreference(p^.left^.location.reference))));
314 {exprasmlist^.concat(new(paicpu,op_const_loc(A_MOV,opsize,
315 p^.right^.location.reference.offset,
316 p^.left^.location)));}
317 end
318 else
319 begin
320 concatcopy(p^.right^.location.reference,
321 p^.left^.location.reference,p^.left^.resulttype^.size,
322 withresult);
323 ungetiftemp(p^.right^.location.reference);
324 end;
325 end;
326 LOC_REGISTER,
327 LOC_CREGISTER : begin
328 case p^.right^.resulttype^.size of
329 1 : opsize:=S_B;
330 2 : opsize:=S_W;
331 4 : opsize:=S_L;
332 end;
333 { simplified with op_reg_loc }
334 if loc=LOC_CREGISTER then
335 exprasmlist^.concat(new(paicpu,op_reg_reg(A_MOVE,opsize,
336 p^.right^.location.register,
337 p^.left^.location.register)))
338 else
339 exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOVE,opsize,
340 p^.right^.location.register,
341 newreference(p^.left^.location.reference))));
342 {exprasmlist^.concat(new(paicpu,op_reg_loc(A_MOV,opsize,
343 p^.right^.location.register,
344 p^.left^.location))); }
345
346 end;
347 LOC_FPU : begin
348 if loc<>LOC_REFERENCE then
349 internalerror(10010)
350 else
351 floatstore(pfloatdef(p^.left^.resulttype)^.typ,
352 p^.right^.location,p^.left^.location.reference);
353 end;
354 LOC_JUMP : begin
355 getlabel(hlabel);
356 emitl(A_LABEL,truelabel);
357 if loc=LOC_CREGISTER then
358 exprasmlist^.concat(new(paicpu,op_const_reg(A_MOVE,S_B,
359 1,p^.left^.location.register)))
360 else
361 exprasmlist^.concat(new(paicpu,op_const_ref(A_MOVE,S_B,
362 1,newreference(p^.left^.location.reference))));
363 {exprasmlist^.concat(new(paicpu,op_const_loc(A_MOV,S_B,
364 1,p^.left^.location)));}
365 emitl(A_JMP,hlabel);
366 emitl(A_LABEL,falselabel);
367 if loc=LOC_CREGISTER then
368 exprasmlist^.concat(new(paicpu,op_reg(A_CLR,S_B,
369 p^.left^.location.register)))
370 else
371 exprasmlist^.concat(new(paicpu,op_const_ref(A_MOVE,S_B,
372 0,newreference(p^.left^.location.reference))));
373 emitl(A_LABEL,hlabel);
374 end;
375 LOC_FLAGS : begin
376 if loc=LOC_CREGISTER then
377 begin
378 exprasmlist^.concat(new(paicpu,op_reg(flag_2_set[p^.right^.location.resflags],S_B,
379 p^.left^.location.register)));
380 exprasmlist^.concat(new(paicpu,op_reg(A_NEG,S_B,p^.left^.location.register)));
381 end
382 else
383 begin
384 exprasmlist^.concat(new(paicpu,op_ref(flag_2_set[p^.right^.location.resflags],S_B,
385 newreference(p^.left^.location.reference))));
386 exprasmlist^.concat(new(paicpu,op_ref(A_NEG,S_B,newreference(p^.left^.location.reference))));
387 end;
388
389 end;
390 end;
391 truelabel:=otlabel;
392 falselabel:=oflabel;
393 end;
394
395
396 {*****************************************************************************
397 SecondFuncRetN
398 *****************************************************************************}
399
400 procedure secondfuncret(var p : ptree);
401 var
402 hr : tregister;
403 hp : preference;
404 pp : pprocinfo;
405 hr_valid : boolean;
406 begin
407 clear_reference(p^.location.reference);
408 hr_valid:=false;
409 { !!!!!!! }
410
411 if @procinfo<>pprocinfo(p^.funcretprocinfo) then
412 begin
413 hr:=getaddressreg;
414 hr_valid:=true;
415 hp:=new_reference(procinfo^.framepointer,
416 procinfo^.framepointer_offset);
417 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,hp,hr)));
418
419 pp:=procinfo^.parent;
420 { walk up the stack frame }
421 while pp<>pprocinfo(p^.funcretprocinfo) do
422 begin
423 hp:=new_reference(hr,
424 pp^.framepointer_offset);
425 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,hp,hr)));
426 pp:=pp^.parent;
427 end;
428 p^.location.reference.base:=hr;
429 end
430 else
431 p^.location.reference.base:=procinfo^.framepointer;
432 p^.location.reference.offset:=procinfo^.retoffset;
433 if ret_in_param(p^.retdef) then
434 begin
435 if not hr_valid then
436 { this was wrong !! PM }
437 hr:=getaddressreg;
438 exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),hr)));
439 p^.location.reference.base:=hr;
440 p^.location.reference.offset:=0;
441 end;
442 end;
443
444 {*****************************************************************************
445 SecondArrayConstruct
446 *****************************************************************************}
447
448 const
449 vtInteger = 0;
450 vtBoolean = 1;
451 vtChar = 2;
452 vtExtended = 3;
453 vtString = 4;
454 vtPointer = 5;
455 vtPChar = 6;
456 vtObject = 7;
457 vtClass = 8;
458 vtWideChar = 9;
459 vtPWideChar = 10;
460 vtAnsiString = 11;
461 vtCurrency = 12;
462 vtVariant = 13;
463 vtInterface = 14;
464 vtWideString = 15;
465 vtInt64 = 16;
466
467 procedure secondarrayconstruct(var p : ptree);
468 begin
469 end;
470
471 end.
472 {
473 $Log$
474 Revision 1.1 2002/02/19 08:21:49 sasu
475 Initial revision
476
477 Revision 1.1 2000/07/13 06:29:46 michael
478 + Initial import
479
480 Revision 1.13 2000/02/09 13:22:49 peter
481 * log truncated
482
483 Revision 1.12 2000/01/07 01:14:22 peter
484 * updated copyright to 2000
485
486 Revision 1.11 1999/12/22 01:01:47 peter
487 - removed freelabel()
488 * added undefined label detection in internal assembler, this prevents
489 a lot of ld crashes and wrong .o files
490 * .o files aren't written anymore if errors have occured
491 * inlining of assembler labels is now correct
492
493 Revision 1.10 1999/11/10 00:06:08 pierre
494 * adapted to procinfo as pointer
495
496 Revision 1.9 1999/09/16 23:05:51 florian
497 * m68k compiler is again compilable (only gas writer, no assembler reader)
498
499 Revision 1.8 1999/09/16 11:34:54 pierre
500 * typo correction
501
502 }
Mirror of AROS' Contrib svn.