2
$Id: cg68kinl.pas,v 1.1 2000/07/13 06:29:46 michael Exp $
3
Copyright (c) 1998-2000 by Florian Klaempfl
5
Generate m68k inline nodes
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.
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.
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.
21
****************************************************************************
29
procedure secondinline(var p : ptree);
35
globtype,systems,symconst,
36
cobjects,verbose,globals,
38
hcodegen,temp_gen,pass_2,
39
cpubase,cga68k,tgen68k,cg68kld,cg68kcal;
42
{*****************************************************************************
44
*****************************************************************************}
46
{ reverts the parameter list }
47
var nb_para : integer;
49
function reversparameter(p : ptree) : ptree;
71
{*****************************************************************************
73
*****************************************************************************}
75
procedure secondinline(var p : ptree);
77
{ tfloattype = (f32bit,s32real,s64real,s80real,s64bit); }
78
float_name: array[tfloattype] of string[8]=
79
('FIXED','SINGLE','REAL','EXTENDED','COMP','FIXED16');
80
addqconstsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADDQ,A_SUBQ);
81
addconstsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADD,A_SUB);
82
addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADD,A_SUB);
90
addconstant : boolean;
94
procedure handlereadwrite(doread,doln : boolean);
95
{ produces code for READ(LN) and WRITE(LN) }
99
io:array[0..1] of string[7]=('_OUTPUT','_INPUT');
105
r^.symbol:=stringdup(
106
'U_'+upper(target_info.system_unit)+io[byte(doread)]);
107
exprasmlist^.concat(new(paicpu,op_ref_reg(A_LEA,S_L,r,R_A0)))
114
has_length : boolean;
115
dummycoll : tdefcoll;
121
if (cs_check_io in aktlocalswitches) and
122
not(po_iocheck in aktprocsym^.definition^.procoptions) then
125
emitl(A_LABEL,iolabel);
129
{ for write of real with the length specified }
132
{ reserve temporary pointer to data variable }
134
gettempofsizereference(4,aktfile);
135
{ first state text data }
137
{ and state a parameter ? }
140
{ the following instructions are for "writeln;" }
142
{ save @aktfile in temporary variable }
143
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOVE,S_L,R_A0,newreference(aktfile))));
148
node:=reversparameter(p^.left);
152
{ calculate data variable }
153
{ is first parameter a file type ? }
154
if node^.left^.resulttype^.deftype=filedef then
156
ft:=pfiledef(node^.left^.resulttype)^.filetype;
158
typedtyp:=pfiledef(node^.left^.resulttype)^.typed_as;
159
secondpass(node^.left);
163
{ save reference in temporary variables }
164
if node^.left^.location.loc<>LOC_REFERENCE then
166
CGMessage(cg_e_illegal_expression);
170
exprasmlist^.concat(new(paicpu,op_ref_reg(A_LEA,S_L,newreference(node^.left^.location.reference),R_A0)));
172
{ skip to the next parameter }
177
{ load stdin/stdout stream }
181
{ save @aktfile in temporary variable }
182
exprasmlist^.concat(new(paicpu,op_reg_ref(A_MOVE,S_L,R_A0,newreference(aktfile))));
184
{ parameter by READ gives call by reference }
185
dummycoll.paratyp:=vs_var
186
{ an WRITE Call by "Const" }
188
dummycoll.paratyp:=vs_const;
190
{ because of secondcallparan, which otherwise attaches }
192
{ this is to avoid copy of simple const parameters }
193
{dummycoll.data:=new(pformaldef,init)}
194
dummycoll.data:=cformaldef
196
{ I think, this isn't a good solution (FK) }
199
while assigned(node) do
201
pushusedregisters(pushed,$ff);
205
if hp^.is_colon_para then
206
CGMessage(parser_e_illegal_colon_qualifier);
208
never_copy_const_param:=true;
209
secondcallparan(hp,@dummycoll,false);
211
never_copy_const_param:=false;
216
emit_push_mem(aktfile);
217
if (ft=ft_typed) then
219
{ OK let's try this }
220
{ first we must only allow the right type }
221
{ we have to call blockread or blockwrite }
222
{ but the real problem is that }
223
{ reset and rewrite should have set }
225
{ as recordsize for that file !!!! }
226
{ how can we make that }
227
{ I think that is only possible by adding }
228
{ reset and rewrite to the inline list a call }
229
{ allways read only one record by element }
230
push_int(typedtyp^.size);
232
emitcall('FPC_TYPED_READ',true)
234
emitcall('FPC_TYPED_WRITE',true);
238
{ save current position }
239
pararesult:=hp^.left^.resulttype;
240
{ handle possible field width }
241
{ of course only for write(ln) }
244
{ handle total width parameter }
245
if assigned(node) and node^.is_colon_para then
250
secondcallparan(hp,@dummycoll,false);
257
if pararesult^.deftype<>floatdef then
261
{ a second colon para for a float ? }
262
if assigned(node) and node^.is_colon_para then
267
secondcallparan(hp,@dummycoll,false);
269
if pararesult^.deftype<>floatdef then
270
CGMessage(parser_e_illegal_colon_qualifier);
276
if pararesult^.deftype=floatdef then
280
case pararesult^.deftype of
284
{ push maximum string length }
285
push_int(pstringdef(pararesult)^.len);
286
case pstringdef(pararesult)^.string_typ of
288
emitcall ('FPC_READ_TEXT_STRING',true);
290
emitcall ('FPC_READ_TEXT_ANSISTRING',true);
292
emitcall ('FPC_READ_TEXT_LONGSTRING',true);
294
emitcall ('FPC_READ_TEXT_ANSISTRING',true);
298
Case pstringdef(Pararesult)^.string_typ of
300
emitcall ('FPC_WRITE_TEXT_STRING',true);
302
emitcall ('FPC_WRITE_TEXT_ANSISTRING',true);
304
emitcall ('FPC_WRITE_TEXT_LONGSTRING',true);
306
emitcall ('FPC_WRITE_TEXT_ANSISTRING',true);
310
if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
313
emitcall('FPC_READ_TEXT_PCHAR_AS_POINTER',true)
315
emitcall('FPC_WRITE_TEXT_PCHAR_AS_POINTER',true);
319
if (parraydef(pararesult)^.lowrange=0) and
320
is_equal(parraydef(pararesult)^.definition,cchardef) then
323
emitcall('FPC_READ_TEXT_PCHAR_AS_ARRAY',true)
325
emitcall('FPC_WRITE_TEXT_PCHAR_AS_ARRAY',true);
330
emitcall('FPC_READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
332
emitcall('FPC_WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
335
case porddef(pararesult)^.typ of
336
u8bit : if doread then
337
emitcall('FPC_READ_TEXT_BYTE',true);
338
s8bit : if doread then
339
emitcall('FPC_READ_TEXT_SHORTINT',true);
340
u16bit : if doread then
341
emitcall('FPC_READ_TEXT_WORD',true);
342
s16bit : if doread then
343
emitcall('FPC_READ_TEXT_INTEGER',true);
344
s32bit : if doread then
345
emitcall('FPC_READ_TEXT_LONGINT',true)
347
emitcall('FPC_WRITE_TEXT_LONGINT',true);
348
u32bit : if doread then
349
emitcall('FPC_READ_TEXT_CARDINAL',true)
351
emitcall('FPC_WRITE_TEXT_CARDINAL',true);
352
uchar : if doread then
353
emitcall('FPC_READ_TEXT_CHAR',true)
355
emitcall('FPC_WRITE_TEXT_CHAR',true);
358
bool32bit : if doread then
359
CGMessage(parser_e_illegal_parameter_list)
361
emitcall('FPC_WRITE_TEXT_BOOLEAN',true);
366
{ load ESI in methods again }
367
popusedregisters(pushed);
371
{ Insert end of writing for textfiles }
374
pushusedregisters(pushed,$ff);
375
emit_push_mem(aktfile);
379
emitcall('FPC_READLN_END',true)
381
emitcall('FPC_READ_END',true);
386
emitcall('FPC_WRITELN_END',true)
388
emitcall('FPC_WRITE_END',true);
390
popusedregisters(pushed);
393
{ Insert IOCheck if set }
394
if assigned(iolabel) then
396
{ registers are saved in the procedure }
397
exprasmlist^.concat(new(paicpu,op_csymbol(A_PEA,S_L,newcsymbol(iolabel^.name,0))));
398
emitcall('FPC_IOCHECK',true);
400
{ Freeup all used temps }
401
ungetiftemp(aktfile);
402
if assigned(p^.left) then
404
p^.left:=reversparameter(p^.left);
405
if npara<>nb_para then
406
CGMessage(cg_f_internal_error_in_secondinline);
408
while assigned(hp) do
410
if assigned(hp^.left) then
411
if (hp^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
412
ungetiftemp(hp^.left^.location.reference);
418
procedure handle_str;
422
dummycoll : tdefcoll;
423
is_real,has_length : boolean;
426
pushusedregisters(pushed,$ff);
430
while assigned(node^.right) do node:=node^.right;
431
{ if a real parameter somewhere then call REALSTR }
432
if (node^.left^.resulttype^.deftype=floatdef) then
436
{ we have at least two args }
437
{ with at max 2 colon_para in between }
439
{ first arg longint or float }
443
dummycoll.data:=hp^.resulttype;
446
dummycoll.paratyp:=vs_var;
447
secondcallparan(hp,@dummycoll,false);
451
dummycoll.paratyp:=vs_const;
460
if hp^.is_colon_para and assigned(node) and
461
node^.is_colon_para then
463
dummycoll.data:=hp^.resulttype;
464
secondcallparan(hp,@dummycoll,false);
477
{ third arg, length only if is_real }
478
if hp^.is_colon_para then
480
dummycoll.data:=hp^.resulttype;
481
secondcallparan(hp,@dummycoll,false);
495
{ last arg longint or real }
496
secondcallparan(hp,@dummycoll,false);
503
emitcall('FPC_STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true)
504
else if porddef(hp^.resulttype)^.typ=u32bit then
505
emitcall('FPC_STR_CARDINAL',true)
507
emitcall('FPC_STR_LONGINT',true);
508
popusedregisters(pushed);
515
hregister : tregister;
516
otlabel,oflabel,filenamestring : pasmlabel;
517
oldpushedparasize : longint;
519
{ save & reset pushedparasize }
520
oldpushedparasize:=pushedparasize;
522
case p^.inlinenumber of
531
p^.location.loc:=LOC_REGISTER;
532
if p^.left^.location.loc<>LOC_REGISTER then
534
if p^.left^.location.loc=LOC_CREGISTER then
536
p^.location.register:=getregister32;
537
emit_reg_reg(A_MOVE,S_W,p^.left^.location.register,
538
p^.location.register);
542
del_reference(p^.left^.location.reference);
543
p^.location.register:=getregister32;
544
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_W,
545
newreference(p^.left^.location.reference),
546
p^.location.register)));
549
else p^.location.register:=p^.left^.location.register;
550
if p^.inlinenumber=in_hi_word then
551
exprasmlist^.concat(new(paicpu,op_const_reg(A_LSR,S_W,8,p^.location.register)));
552
p^.location.register:=p^.location.register;
556
if is_open_array(p^.left^.resulttype) then
559
del_reference(p^.left^.location.reference);
560
p^.location.register:=getregister32;
563
r^.base:=highframepointer;
564
r^.offset:=highoffset+4;
565
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,
566
r,p^.location.register)));
572
{ sizeof(openarray) handling }
573
if (p^.inlinenumber=in_sizeof_x) and
574
is_open_array(p^.left^.resulttype) then
576
{ sizeof(openarray)=high(openarray)+1 }
578
del_reference(p^.left^.location.reference);
579
p^.location.register:=getregister32;
582
r^.base:=highframepointer;
583
r^.offset:=highoffset+4;
584
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,
585
r,p^.location.register)));
586
exprasmlist^.concat(new(paicpu,op_const_reg(A_ADD,S_L,
587
1,p^.location.register)));
588
if parraydef(p^.left^.resulttype)^.elesize<>1 then
589
exprasmlist^.concat(new(paicpu,op_const_reg(A_MULS,S_L,
590
parraydef(p^.left^.resulttype)^.elesize,p^.location.register)));
594
{ for both cases load vmt }
595
if p^.left^.treetype=typen then
597
exprasmlist^.concat(new(paicpu,op_csymbol_reg(A_LEA,
598
S_L,newcsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,0),
600
p^.location.register:=getregister32;
601
emit_reg_reg(A_MOVE,S_L,R_A0,p^.location.register);
606
del_reference(p^.left^.location.reference);
607
p^.location.loc:=LOC_REGISTER;
608
p^.location.register:=getregister32;
610
inc(p^.left^.location.reference.offset,
611
pobjectdef(p^.left^.resulttype)^.vmt_offset);
612
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,
613
newreference(p^.left^.location.reference),
614
p^.location.register)));
616
{ in sizeof load size }
617
if p^.inlinenumber=in_sizeof_x then
621
{ load the address in A0 }
622
{ because now supposedly p^.location.register is an }
624
emit_reg_reg(A_MOVE, S_L, p^.location.register, R_A0);
626
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,r,
627
p^.location.register)));
634
p^.location.loc:=LOC_REGISTER;
635
if p^.left^.location.loc<>LOC_REGISTER then
637
if p^.left^.location.loc=LOC_CREGISTER then
639
p^.location.register:=getregister32;
640
emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
641
p^.location.register);
645
del_reference(p^.left^.location.reference);
646
p^.location.register:=getregister32;
647
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,
648
newreference(p^.left^.location.reference),
649
p^.location.register)));
652
else p^.location.register:=p^.left^.location.register;
653
if p^.inlinenumber=in_hi_long then
655
exprasmlist^.concat(new(paicpu,op_const_reg(A_MOVEQ, S_L, 16, R_D1)));
656
exprasmlist^.concat(new(paicpu,op_reg_reg(A_LSR,S_L,R_D1,p^.location.register)));
658
p^.location.register:=p^.location.register;
663
set_location(p^.location,p^.left^.location);
664
{ length in ansi strings is at offset -8 }
665
if is_ansistring(p^.left^.resulttype) then
666
dec(p^.location.reference.offset,8);
672
if p^.inlinenumber=in_pred_x then
676
case p^.resulttype^.size of
681
internalerror(10080);
683
p^.location.loc:=LOC_REGISTER;
684
if p^.left^.location.loc<>LOC_REGISTER then
686
p^.location.register:=getregister32;
687
if p^.left^.location.loc=LOC_CREGISTER then
688
emit_reg_reg(A_MOVE,opsize,p^.left^.location.register,
689
p^.location.register)
691
if p^.left^.location.loc=LOC_FLAGS then
692
exprasmlist^.concat(new(paicpu,op_reg(flag_2_set[p^.left^.location.resflags],S_NO,
693
p^.location.register)))
696
del_reference(p^.left^.location.reference);
697
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,opsize,newreference(p^.left^.location.reference),
698
p^.location.register)));
701
else p^.location.register:=p^.left^.location.register;
702
exprasmlist^.concat(new(paicpu,op_const_reg(asmop,opsize,1,
703
p^.location.register)))
704
{ here we should insert bounds check ? }
705
{ and direct call to bounds will crash the program }
706
{ if we are at the limit }
707
{ we could also simply say that pred(first)=first and succ(last)=last }
708
{ could this be usefull I don't think so (PM)
717
{ load first parameter, must be a reference }
718
secondpass(p^.left^.left);
719
case p^.left^.left^.resulttype^.deftype of
722
case p^.left^.left^.resulttype^.size of
730
addvalue:=ppointerdef(p^.left^.left^.resulttype)^.definition^.size;
733
internalerror(10081);
735
{ second argument specified?, must be a s32bit in register }
736
if assigned(p^.left^.right) then
738
secondpass(p^.left^.right^.left);
739
{ when constant, just multiply the addvalue }
740
if is_constintnode(p^.left^.right^.left) then
741
addvalue:=addvalue*get_ordinal_value(p^.left^.right^.left)
744
case p^.left^.right^.left^.location.loc of
746
LOC_CREGISTER : hregister:=p^.left^.right^.left^.location.register;
748
LOC_REFERENCE : begin
749
hregister:=getregister32;
750
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOVE,S_L,
751
newreference(p^.left^.right^.left^.location.reference),hregister)));
754
internalerror(10082);
756
{ insert multiply with addvalue if its >1 }
758
exprasmlist^.concat(new(paicpu,op_const_reg(A_MULS,opsize,
759
addvalue,hregister)));
763
{ write the add instruction }
766
if (addvalue > 0) and (addvalue < 9) then
767
exprasmlist^.concat(new(paicpu,op_const_ref(addqconstsubop[p^.inlinenumber],opsize,
768
addvalue,newreference(p^.left^.left^.location.reference))))
770
exprasmlist^.concat(new(paicpu,op_const_ref(addconstsubop[p^.inlinenumber],opsize,
771
addvalue,newreference(p^.left^.left^.location.reference))));
775
exprasmlist^.concat(new(paicpu,op_reg_ref(addsubop[p^.inlinenumber],opsize,
776
hregister,newreference(p^.left^.left^.location.reference))));
777
ungetregister32(hregister);
779
emitoverflowcheck(p^.left^.left);
783
secondpass(p^.left^.left);
784
p^.location.loc:=LOC_FLAGS;
785
if (p^.left^.left^.location.loc=LOC_REGISTER) or
786
(p^.left^.left^.location.loc=LOC_CREGISTER) then
788
exprasmlist^.concat(new(paicpu,op_reg(A_TST,S_L,
789
p^.left^.left^.location.register)));
790
ungetregister32(p^.left^.left^.location.register);
794
exprasmlist^.concat(new(paicpu,op_ref(A_TST,S_L,
795
newreference(p^.left^.left^.location.reference))));
796
del_reference(p^.left^.left^.location.reference);
798
p^.location.resflags:=F_NE;
800
in_reset_typedfile,in_rewrite_typedfile :
802
pushusedregisters(pushed,$ffff);
803
exprasmlist^.concat(new(paicpu,op_const_reg(A_MOVE,S_L,
804
pfiledef(p^.left^.resulttype)^.typed_as^.size,R_SPPUSH)));
806
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
807
if p^.inlinenumber=in_reset_typedfile then
808
emitcall('FPC_RESET_TYPED',true)
810
emitcall('FPC_REWRITE_TYPED',true);
811
popusedregisters(pushed);
814
handlereadwrite(false,false);
816
handlereadwrite(false,true);
818
handlereadwrite(true,false);
820
handlereadwrite(true,true);
829
CGMessage(cg_e_include_not_implemented);
831
(* secondpass(p^.left^.left);
832
if p^.left^.right^.left^.treetype=ordconstn then
834
{ calculate bit position }
835
l:=1 shl (p^.left^.right^.left^.value mod 32);
837
{ determine operator }
838
if p^.inlinenumber=in_include_x_y then
845
if (p^.left^.left^.location.loc=LOC_REFERENCE) then
847
inc(p^.left^.left^.location.reference.offset,(p^.left^.right^.left^.value div 32)*4);
848
exprasmlist^.concat(new(paicpu,op_const_ref(asmop,S_L,
849
l,newreference(p^.left^.left^.location.reference))));
850
del_reference(p^.left^.left^.location.reference);
854
exprasmlist^.concat(new(paicpu,op_const_reg(asmop,S_L,
855
l,p^.left^.left^.location.register)));
859
{ generate code for the element to set }
860
ispushed:=maybe_push(p^.left^.right^.left^.registers32,p^.left^.left);
861
secondpass(p^.left^.right^.left);
863
restore(p^.left^.left);
864
{ determine asm operator }
865
if p^.inlinenumber=in_include_x_y then
869
if psetdef(p^.left^.resulttype)^.settype=smallset then
871
if p^.left^.right^.left^.location.loc in [LOC_CREGISTER,LOC_REGISTER] then
872
hregister:=p^.left^.right^.left^.location.register
876
exprasmlist^.concat(new(paicpu,op_ref_reg(A_MOV,S_L,
877
newreference(p^.left^.right^.left^.location.reference),R_EDI)));
879
if (p^.left^.left^.location.loc=LOC_REFERENCE) then
880
exprasmlist^.concat(new(paicpu,op_reg_ref(asmop,S_L,R_EDI,
881
newreference(p^.left^.right^.left^.location.reference))))
883
exprasmlist^.concat(new(paicpu,op_reg_reg(asmop,S_L,R_EDI,
884
p^.left^.right^.left^.location.register)));
888
internalerror(10083);
897
pushedparasize:=oldpushedparasize;
902
$Log: cg68kinl.pas,v $
903
Revision 1.1 2000/07/13 06:29:46 michael
906
Revision 1.22 2000/02/09 13:22:49 peter
909
Revision 1.21 2000/01/07 01:14:22 peter
910
* updated copyright to 2000
912
Revision 1.20 1999/12/20 21:42:35 pierre
913
+ dllversion global variable
914
* FPC_USE_CPREFIX code removed, not necessary anymore
915
as we use .edata direct writing by default now.
917
Revision 1.19 1999/11/20 01:22:18 pierre
918
+ cond FPC_USE_CPREFIX (needs also some RTL changes)
919
this allows to use unit global vars as DLL exports
920
(the underline prefix seems needed by dlltool)
922
Revision 1.18 1999/09/16 23:05:51 florian
923
* m68k compiler is again compilable (only gas writer, no assembler reader)
925
Revision 1.17 1999/08/25 11:59:50 jonas
926
* changed pai386, paippc and paiapha (same for tai*) to paicpu (taicpu)
added
removed
compiler/cg68kinl.pas
