|
|
@@ -1,5571 +0,0 @@
|
|
|
-{
|
|
|
- $Id$
|
|
|
- Copyright (c) 1993,98 by Florian Klaempfl, Carl Eric Codere
|
|
|
-
|
|
|
- This unit generates 68000 (or better) assembler from the parse tree
|
|
|
-
|
|
|
- This program is free software; you can redistribute it and/or modify
|
|
|
- it under the terms of the GNU General Public License as published by
|
|
|
- the Free Software Foundation; either version 2 of the License, or
|
|
|
- (at your option) any later version.
|
|
|
-
|
|
|
- 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. See the
|
|
|
- GNU General Public License for more details.
|
|
|
-
|
|
|
- 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.
|
|
|
-
|
|
|
- ****************************************************************************}
|
|
|
-{$ifdef tp}
|
|
|
-{$E+,F+,N+,D+,L+,Y+}
|
|
|
-{$endif}
|
|
|
-
|
|
|
-{---------------------------------------------------------------------------}
|
|
|
-{ LEFT TO DO IN CG68k AND CG68k2 }
|
|
|
-{---------------------------------------------------------------------------}
|
|
|
-{ o Test and correct problems with extended support. }
|
|
|
-{ o Optimize secondmoddiv when doing a constant modulo. }
|
|
|
-{ o Add emulation support for Cardinal under MC68000. }
|
|
|
-{---------------------------------------------------------------------------}
|
|
|
-
|
|
|
-unit cg68k;
|
|
|
-
|
|
|
-
|
|
|
-{***************************************************************************}
|
|
|
-interface
|
|
|
-{***************************************************************************}
|
|
|
-
|
|
|
-uses objects,verbose,cobjects,comphook,systems,globals,tree,
|
|
|
- symtable,types,strings,pass_1,hcodegen,temp_gen,
|
|
|
- aasm,m68k,tgen68k,files,cga68k,cg68k2,link
|
|
|
-{$ifdef GDB}
|
|
|
- ,gdb
|
|
|
-{$endif}
|
|
|
- ;
|
|
|
-
|
|
|
-{ produces assembler for the expression in variable p }
|
|
|
-{ and produces an assembler node at the end }
|
|
|
-procedure generatecode(var p : ptree);
|
|
|
-
|
|
|
-
|
|
|
-{ produces the actual code }
|
|
|
-function do_secondpass(var p : ptree) : boolean;
|
|
|
-
|
|
|
-procedure secondpass(var p : ptree);
|
|
|
-
|
|
|
-{$ifdef test_dest_loc}
|
|
|
-const { used to avoid temporary assignments }
|
|
|
- dest_loc_known : boolean = false;
|
|
|
- in_dest_loc : boolean = false;
|
|
|
- dest_loc_tree : ptree = nil;
|
|
|
-
|
|
|
-var dest_loc : tlocation;
|
|
|
-
|
|
|
-procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
|
|
-
|
|
|
-{$endif test_dest_loc}
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-{***************************************************************************}
|
|
|
-implementation
|
|
|
-{***************************************************************************}
|
|
|
-
|
|
|
- uses
|
|
|
- scanner;
|
|
|
-
|
|
|
-
|
|
|
- const
|
|
|
- never_copy_const_param : boolean = false;
|
|
|
- bytes2Sxx:array[1..4] of Topsize=(S_B,S_W,S_NO,S_L);
|
|
|
- { used to avoid temporary assignments }
|
|
|
- dest_loc_known : boolean = false;
|
|
|
- in_dest_loc : boolean = false;
|
|
|
- dest_loc_tree : ptree = nil;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
- var
|
|
|
- { this is for open arrays and strings }
|
|
|
- { but be careful, this data is in the }
|
|
|
- { generated code destroyed quick, and also }
|
|
|
- { the next call of secondload destroys this }
|
|
|
- { data }
|
|
|
- { So be careful using the informations }
|
|
|
- { provided by this variables }
|
|
|
- highframepointer : tregister;
|
|
|
- highoffset : longint;
|
|
|
- dest_loc : tlocation;
|
|
|
-
|
|
|
- procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
|
|
-
|
|
|
- begin
|
|
|
- if (dest_loc.loc=LOC_CREGISTER) or (dest_loc.loc=LOC_REGISTER) then
|
|
|
- begin
|
|
|
- emit_reg_reg(A_MOVE,s,reg,dest_loc.register);
|
|
|
- p^.location:=dest_loc;
|
|
|
- in_dest_loc:=true;
|
|
|
- end
|
|
|
- else
|
|
|
- if (dest_loc.loc=LOC_REFERENCE) or (dest_loc.loc=LOC_MEM) then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,s,reg,newreference(dest_loc.reference))));
|
|
|
- p^.location:=dest_loc;
|
|
|
- in_dest_loc:=true;
|
|
|
- end
|
|
|
- else
|
|
|
- internalerror(20080);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
- procedure error(const t : tmsgconst);
|
|
|
-
|
|
|
- begin
|
|
|
- if not(codegenerror) then
|
|
|
- verbose.Message(t);
|
|
|
- codegenerror:=true;
|
|
|
- end;
|
|
|
-
|
|
|
- type
|
|
|
- secondpassproc = procedure(var p : ptree);
|
|
|
-
|
|
|
- procedure seconderror(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- p^.error:=true;
|
|
|
- codegenerror:=true;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondstatement(var p : ptree);
|
|
|
- var
|
|
|
- hp : ptree;
|
|
|
-
|
|
|
- begin
|
|
|
- hp:=p;
|
|
|
- while assigned(hp) do
|
|
|
- begin
|
|
|
- { assignments could be distance optimized }
|
|
|
- if assigned(hp^.right) then
|
|
|
- begin
|
|
|
- cleartempgen;
|
|
|
- secondpass(hp^.right);
|
|
|
- end;
|
|
|
- hp:=hp^.left;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondload(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- hregister : tregister;
|
|
|
- i : longint;
|
|
|
- symtabletype: tsymtabletype;
|
|
|
- hp : preference;
|
|
|
-
|
|
|
- begin
|
|
|
- simple_loadn:=true;
|
|
|
- reset_reference(p^.location.reference);
|
|
|
- case p^.symtableentry^.typ of
|
|
|
- { this is only for toasm and toaddr }
|
|
|
- absolutesym :
|
|
|
- begin
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
|
|
|
- if p^.symtableentry^.owner^.symtabletype=unitsymtable then
|
|
|
- concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
|
|
|
- end;
|
|
|
- varsym :
|
|
|
- begin
|
|
|
- hregister:=R_NO;
|
|
|
- symtabletype:=p^.symtable^.symtabletype;
|
|
|
- { in case it is a register variable: }
|
|
|
- { we simply set the location to the }
|
|
|
- { correct register. }
|
|
|
- if pvarsym(p^.symtableentry)^.reg<>R_NO then
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_CREGISTER;
|
|
|
- p^.location.register:=pvarsym(p^.symtableentry)^.reg;
|
|
|
- unused:=unused-[pvarsym(p^.symtableentry)^.reg];
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { --------------------- LOCAL AND TEMP VARIABLES ------------- }
|
|
|
- if (symtabletype=parasymtable) or (symtabletype=localsymtable) then
|
|
|
- begin
|
|
|
-
|
|
|
- p^.location.reference.base:=procinfo.framepointer;
|
|
|
- p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
|
|
|
-
|
|
|
- if (symtabletype=localsymtable) then
|
|
|
- p^.location.reference.offset:=-p^.location.reference.offset;
|
|
|
-
|
|
|
- if (symtabletype=parasymtable) then
|
|
|
- inc(p^.location.reference.offset,p^.symtable^.call_offset);
|
|
|
-
|
|
|
- if (lexlevel>(p^.symtable^.symtablelevel)) then
|
|
|
- begin
|
|
|
- hregister:=getaddressreg;
|
|
|
-
|
|
|
- { make a reference }
|
|
|
- new(hp);
|
|
|
- reset_reference(hp^);
|
|
|
- hp^.offset:=procinfo.framepointer_offset;
|
|
|
- hp^.base:=procinfo.framepointer;
|
|
|
-
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hregister)));
|
|
|
-
|
|
|
- simple_loadn:=false;
|
|
|
- i:=lexlevel-1;
|
|
|
- while i>(p^.symtable^.symtablelevel) do
|
|
|
- begin
|
|
|
- { make a reference }
|
|
|
- new(hp);
|
|
|
- reset_reference(hp^);
|
|
|
- hp^.offset:=8;
|
|
|
- hp^.base:=hregister;
|
|
|
-
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hregister)));
|
|
|
- dec(i);
|
|
|
- end;
|
|
|
- p^.location.reference.base:=hregister;
|
|
|
- end;
|
|
|
- end
|
|
|
- { --------------------- END OF LOCAL AND TEMP VARS ---------------- }
|
|
|
- else
|
|
|
- case symtabletype of
|
|
|
- unitsymtable,globalsymtable,
|
|
|
- staticsymtable : begin
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
|
|
|
- if symtabletype=unitsymtable then
|
|
|
- concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
|
|
|
- end;
|
|
|
- objectsymtable : begin
|
|
|
- if (pvarsym(p^.symtableentry)^.properties and sp_static)<>0 then
|
|
|
- begin
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
|
|
|
- if p^.symtable^.defowner^.owner^.symtabletype=unitsymtable then
|
|
|
- concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- p^.location.reference.base:=R_A5;
|
|
|
- p^.location.reference.offset:=pvarsym(p^.symtableentry)^.address;
|
|
|
- end;
|
|
|
- end;
|
|
|
- withsymtable : begin
|
|
|
- hregister:=getaddressreg;
|
|
|
- p^.location.reference.base:=hregister;
|
|
|
- { make a reference }
|
|
|
- new(hp);
|
|
|
- reset_reference(hp^);
|
|
|
- hp^.offset:=p^.symtable^.datasize;
|
|
|
- hp^.base:=procinfo.framepointer;
|
|
|
-
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,hp,hregister)));
|
|
|
-
|
|
|
- p^.location.reference.offset:=
|
|
|
- pvarsym(p^.symtableentry)^.address;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- { in case call by reference, then calculate: }
|
|
|
- if (pvarsym(p^.symtableentry)^.varspez=vs_var) or
|
|
|
- ((pvarsym(p^.symtableentry)^.varspez=vs_const) and
|
|
|
- dont_copy_const_param(pvarsym(p^.symtableentry)^.definition)) then
|
|
|
- begin
|
|
|
- simple_loadn:=false;
|
|
|
- if hregister=R_NO then
|
|
|
- hregister:=getaddressreg;
|
|
|
- { ADDED FOR OPEN ARRAY SUPPORT. }
|
|
|
- if (p^.location.reference.base=procinfo.framepointer) then
|
|
|
- begin
|
|
|
- highframepointer:=p^.location.reference.base;
|
|
|
- highoffset:=p^.location.reference.offset;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- highframepointer:=R_A1;
|
|
|
- highoffset:=p^.location.reference.offset;
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
|
|
|
- p^.location.reference.base,R_A1)));
|
|
|
- end;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),
|
|
|
- hregister)));
|
|
|
- { END ADDITION }
|
|
|
- clear_reference(p^.location.reference);
|
|
|
- p^.location.reference.base:=hregister;
|
|
|
- end;
|
|
|
- { should be dereferenced later (FK)
|
|
|
- if (pvarsym(p^.symtableentry)^.definition^.deftype=objectdef) and
|
|
|
- ((pobjectdef(pvarsym(p^.symtableentry)^.definition)^.options and oois_class)<>0) then
|
|
|
- begin
|
|
|
- simple_loadn:=false;
|
|
|
- if hregister=R_NO then
|
|
|
- hregister:=getaddressreg;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),
|
|
|
- hregister)));
|
|
|
- clear_reference(p^.location.reference);
|
|
|
- p^.location.reference.base:=hregister;
|
|
|
- end;
|
|
|
- }
|
|
|
- end;
|
|
|
- end;
|
|
|
- procsym:
|
|
|
- begin
|
|
|
- {!!!!! Be aware, work on virtual methods too }
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- p^.location.reference.symbol:=
|
|
|
- stringdup(pprocsym(p^.symtableentry)^.definition^.mangledname);
|
|
|
- if p^.symtable^.symtabletype=unitsymtable then
|
|
|
- concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
|
|
|
- end;
|
|
|
- typedconstsym :
|
|
|
- begin
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- p^.location.reference.symbol:=stringdup(p^.symtableentry^.mangledname);
|
|
|
- if p^.symtable^.symtabletype=unitsymtable then
|
|
|
- concat_external(p^.symtableentry^.mangledname,EXT_NEAR);
|
|
|
- end;
|
|
|
- else internalerror(4);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- { D0 and D1 used as temp (ok) }
|
|
|
- procedure secondmoddiv(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- hreg1 : tregister;
|
|
|
- power : longint;
|
|
|
- hl : plabel;
|
|
|
- reg: tregister;
|
|
|
- pushed: boolean;
|
|
|
- hl1: plabel;
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- set_location(p^.location,p^.left^.location);
|
|
|
- pushed:=maybe_push(p^.right^.registers32,p);
|
|
|
- secondpass(p^.right);
|
|
|
- if pushed then restore(p);
|
|
|
-
|
|
|
- { put numerator in register }
|
|
|
- if p^.left^.location.loc<>LOC_REGISTER then
|
|
|
- begin
|
|
|
- if p^.left^.location.loc=LOC_CREGISTER then
|
|
|
- begin
|
|
|
- hreg1:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hreg1);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- hreg1:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
|
|
|
- hreg1)));
|
|
|
- end;
|
|
|
- p^.left^.location.loc:=LOC_REGISTER;
|
|
|
- p^.left^.location.register:=hreg1;
|
|
|
- end
|
|
|
- else hreg1:=p^.left^.location.register;
|
|
|
-
|
|
|
- if (p^.treetype=divn) and (p^.right^.treetype=ordconstn) and
|
|
|
- ispowerof2(p^.right^.value,power) then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k, op_reg(A_TST, S_L, hreg1)));
|
|
|
- getlabel(hl);
|
|
|
- emitl(A_BPL,hl);
|
|
|
- if (power = 1) then
|
|
|
- exprasmlist^.concat(new(pai68k, op_const_reg(A_ADDQ, S_L,1, hreg1)))
|
|
|
- else
|
|
|
- Begin
|
|
|
- { optimize using ADDQ if possible! }
|
|
|
- if (p^.right^.value-1) < 9 then
|
|
|
- exprasmlist^.concat(new(pai68k, op_const_reg(A_ADDQ, S_L,p^.right^.value-1, hreg1)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k, op_const_reg(A_ADD, S_L,p^.right^.value-1, hreg1)));
|
|
|
- end;
|
|
|
- emitl(A_LABEL, hl);
|
|
|
- if (power > 0) and (power < 9) then
|
|
|
- exprasmlist^.concat(new(pai68k, op_const_reg(A_ASR, S_L,power, hreg1)))
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k, op_const_reg(A_MOVE,S_L,power, R_D0)));
|
|
|
- exprasmlist^.concat(new(pai68k, op_reg_reg(A_ASR,S_L,R_D0, hreg1)));
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { bring denominator to D1 }
|
|
|
- { D1 is always free, it's }
|
|
|
- { only used for temporary }
|
|
|
- { purposes }
|
|
|
- if (p^.right^.location.loc<>LOC_REGISTER) and
|
|
|
- (p^.right^.location.loc<>LOC_CREGISTER) then
|
|
|
- begin
|
|
|
- del_reference(p^.right^.location.reference);
|
|
|
- p^.left^.location.loc:=LOC_REGISTER;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),R_D1)));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- ungetregister32(p^.right^.location.register);
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
|
|
|
- end;
|
|
|
-
|
|
|
- { on entering this section D1 should contain the divisor }
|
|
|
-
|
|
|
- if (aktoptprocessor = MC68020) then
|
|
|
- begin
|
|
|
- { Check if divisor is ZERO - if so call HALT_ERROR }
|
|
|
- { with d0 = 200 (Division by zero!) }
|
|
|
- getlabel(hl1);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,R_D1)));
|
|
|
- { if not zero then simply continue on }
|
|
|
- emitl(A_BNE,hl1);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,200,R_D0)));
|
|
|
- emitcall('HALT_ERROR',true);
|
|
|
- emitl(A_LABEL,hl1);
|
|
|
- if (p^.treetype = modn) then
|
|
|
- Begin
|
|
|
- reg := getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,reg)));
|
|
|
- getlabel(hl);
|
|
|
- { here what we do is prepare the high register with the }
|
|
|
- { correct sign. i.e we clear it, check if the low dword reg }
|
|
|
- { which will participate in the division is signed, if so we}
|
|
|
- { we extend the sign to the high doword register by inverting }
|
|
|
- { all the bits. }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,hreg1)));
|
|
|
- emitl(A_BPL,hl);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,reg)));
|
|
|
- emitl(A_LABEL,hl);
|
|
|
- { reg:hreg1 / d1 }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg_reg(A_DIVSL,S_L,R_D1,reg,hreg1)));
|
|
|
- { hreg1 already contains quotient }
|
|
|
- { looking for remainder }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,reg,hreg1)));
|
|
|
- ungetregister32(reg);
|
|
|
- end
|
|
|
- else
|
|
|
- { simple division... }
|
|
|
- Begin
|
|
|
- { reg:hreg1 / d1 }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_DIVS,S_L,R_D1,hreg1)));
|
|
|
- end;
|
|
|
- end
|
|
|
- else { MC68000 operations }
|
|
|
- begin
|
|
|
- { put numerator in d0 }
|
|
|
- emit_reg_reg(A_MOVE,S_L,hreg1,R_D0);
|
|
|
- { operation to perform on entry to both }
|
|
|
- { routines... d0/d1 }
|
|
|
- { return result in d0 }
|
|
|
- if p^.treetype = divn then
|
|
|
- emitcall('LONGDIV',true)
|
|
|
- else
|
|
|
- emitcall('LONGMOD',true);
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_D0,hreg1);
|
|
|
- end; { endif }
|
|
|
- end;
|
|
|
- { this registers are always used when div/mod are present }
|
|
|
- usedinproc:=usedinproc or ($800 shr word(R_D1));
|
|
|
- usedinproc:=usedinproc or ($800 shr word(R_D0));
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=hreg1;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- { D6 used as scratch (ok) }
|
|
|
- procedure secondshlshr(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- hregister1,hregister2,hregister3 : tregister;
|
|
|
- op : tasmop;
|
|
|
- pushed : boolean;
|
|
|
- begin
|
|
|
-
|
|
|
- secondpass(p^.left);
|
|
|
- pushed:=maybe_push(p^.right^.registers32,p);
|
|
|
- secondpass(p^.right);
|
|
|
- if pushed then restore(p);
|
|
|
-
|
|
|
- { load left operators in a register }
|
|
|
- if p^.left^.location.loc<>LOC_REGISTER then
|
|
|
- begin
|
|
|
- if p^.left^.location.loc=LOC_CREGISTER then
|
|
|
- begin
|
|
|
- hregister1:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
|
|
|
- hregister1);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- hregister1:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
|
|
|
- hregister1)));
|
|
|
- end;
|
|
|
- end
|
|
|
- else hregister1:=p^.left^.location.register;
|
|
|
-
|
|
|
- { determine operator }
|
|
|
- if p^.treetype=shln then
|
|
|
- op:=A_LSL
|
|
|
- else
|
|
|
- op:=A_LSR;
|
|
|
-
|
|
|
- { shifting by a constant directly decode: }
|
|
|
- if (p^.right^.treetype=ordconstn) then
|
|
|
- begin
|
|
|
- if (p^.right^.location.reference.offset and 31 > 0) and (p^.right^.location.reference.offset and 31 < 9) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(op,S_L,p^.right^.location.reference.offset and 31,
|
|
|
- hregister1)))
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,p^.right^.location.reference.offset and 31,
|
|
|
- R_D6)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(op,S_L,R_D6,hregister1)));
|
|
|
- end;
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=hregister1;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { load right operators in a register }
|
|
|
- if p^.right^.location.loc<>LOC_REGISTER then
|
|
|
- begin
|
|
|
- if p^.right^.location.loc=LOC_CREGISTER then
|
|
|
- begin
|
|
|
- hregister2:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,
|
|
|
- hregister2);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- del_reference(p^.right^.location.reference);
|
|
|
- hregister2:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),
|
|
|
- hregister2)));
|
|
|
- end;
|
|
|
- end
|
|
|
- else hregister2:=p^.right^.location.register;
|
|
|
-
|
|
|
-
|
|
|
- emit_reg_reg(op,S_L,hregister2,hregister1);
|
|
|
- p^.location.register:=hregister1;
|
|
|
- end;
|
|
|
- { this register is always used when shl/shr are present }
|
|
|
- usedinproc:=usedinproc or ($800 shr byte(R_D6));
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure secondrealconst(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- hp1 : pai;
|
|
|
- lastlabel : plabel;
|
|
|
- found : boolean;
|
|
|
-
|
|
|
- begin
|
|
|
- clear_reference(p^.location.reference);
|
|
|
- lastlabel:=nil;
|
|
|
- found:=false;
|
|
|
- { const already used ? }
|
|
|
- if p^.labnumber=-1 then
|
|
|
- begin
|
|
|
- { tries to found an old entry }
|
|
|
- hp1:=pai(consts^.first);
|
|
|
- while assigned(hp1) do
|
|
|
- begin
|
|
|
- if hp1^.typ=ait_label then
|
|
|
- lastlabel:=pai_label(hp1)^.l
|
|
|
- else
|
|
|
- begin
|
|
|
- if (hp1^.typ=p^.realtyp) and (lastlabel<>nil) then
|
|
|
- begin
|
|
|
- { Florian this caused a internalerror(10)=> no free reg !! }
|
|
|
- {if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) or
|
|
|
- ((p^.realtyp=ait_real_80bit) and (pai_extended(hp1)^.value=p^.valued)) or
|
|
|
- ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then }
|
|
|
- if ((p^.realtyp=ait_real_64bit) and (pai_double(hp1)^.value=p^.valued)) then
|
|
|
- found:=true;
|
|
|
- if ((p^.realtyp=ait_real_32bit) and (pai_single(hp1)^.value=p^.valued)) then
|
|
|
- found:=true;
|
|
|
- if ((p^.realtyp=ait_real_extended) and (pai_extended(hp1)^.value=p^.valued)) then
|
|
|
- found:=true;
|
|
|
- if found then
|
|
|
- begin
|
|
|
- { found! }
|
|
|
- p^.labnumber:=lastlabel^.nb;
|
|
|
- break;
|
|
|
- end;
|
|
|
- end;
|
|
|
- lastlabel:=nil;
|
|
|
- end;
|
|
|
- hp1:=pai(hp1^.next);
|
|
|
- end;
|
|
|
- { :-(, we must generate a new entry }
|
|
|
- if p^.labnumber=-1 then
|
|
|
- begin
|
|
|
- getlabel(lastlabel);
|
|
|
- p^.labnumber:=lastlabel^.nb;
|
|
|
- case p^.realtyp of
|
|
|
- ait_real_64bit : consts^.insert(new(pai_double,init(p^.valued)));
|
|
|
- ait_real_32bit : consts^.insert(new(pai_single,init(p^.valued)));
|
|
|
- ait_real_extended : consts^.insert(new(pai_extended,init(p^.valued)));
|
|
|
- else
|
|
|
- internalerror(10120);
|
|
|
- end;
|
|
|
- consts^.insert(new(pai_label,init(lastlabel)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondfixconst(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- { an fix comma const. behaves as a memory reference }
|
|
|
- p^.location.loc:=LOC_MEM;
|
|
|
- p^.location.reference.isintvalue:=true;
|
|
|
- p^.location.reference.offset:=p^.valuef;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondordconst(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- { an integer const. behaves as a memory reference }
|
|
|
- p^.location.loc:=LOC_MEM;
|
|
|
- p^.location.reference.isintvalue:=true;
|
|
|
- p^.location.reference.offset:=p^.value;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondniln(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_MEM;
|
|
|
- p^.location.reference.isintvalue:=true;
|
|
|
- p^.location.reference.offset:=0;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondstringconst(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- hp1 : pai;
|
|
|
- lastlabel : plabel;
|
|
|
- pc : pchar;
|
|
|
- same_string : boolean;
|
|
|
- i : word;
|
|
|
-
|
|
|
- begin
|
|
|
- clear_reference(p^.location.reference);
|
|
|
- lastlabel:=nil;
|
|
|
- { const already used ? }
|
|
|
- if p^.labstrnumber=-1 then
|
|
|
- begin
|
|
|
- { tries to found an old entry }
|
|
|
- hp1:=pai(consts^.first);
|
|
|
- while assigned(hp1) do
|
|
|
- begin
|
|
|
- if hp1^.typ=ait_label then
|
|
|
- lastlabel:=pai_label(hp1)^.l
|
|
|
- else
|
|
|
- begin
|
|
|
- if (hp1^.typ=ait_string) and (lastlabel<>nil) and
|
|
|
- (pai_string(hp1)^.len=length(p^.values^)+2) then
|
|
|
- begin
|
|
|
- same_string:=true;
|
|
|
- for i:=1 to length(p^.values^) do
|
|
|
- if pai_string(hp1)^.str[i]<>p^.values^[i] then
|
|
|
- begin
|
|
|
- same_string:=false;
|
|
|
- break;
|
|
|
- end;
|
|
|
- if same_string then
|
|
|
- begin
|
|
|
- { found! }
|
|
|
- p^.labstrnumber:=lastlabel^.nb;
|
|
|
- break;
|
|
|
- end;
|
|
|
- end;
|
|
|
- lastlabel:=nil;
|
|
|
- end;
|
|
|
- hp1:=pai(hp1^.next);
|
|
|
- end;
|
|
|
- { :-(, we must generate a new entry }
|
|
|
- if p^.labstrnumber=-1 then
|
|
|
- begin
|
|
|
- getlabel(lastlabel);
|
|
|
- p^.labstrnumber:=lastlabel^.nb;
|
|
|
- getmem(pc,length(p^.values^)+3);
|
|
|
- move(p^.values^,pc^,length(p^.values^)+1);
|
|
|
- pc[length(p^.values^)+1]:=#0;
|
|
|
- { we still will have a problem if there is a #0 inside the pchar }
|
|
|
- consts^.insert(new(pai_string,init_pchar(pc)));
|
|
|
- { to overcome this problem we set the length explicitly }
|
|
|
- { with the ending null char }
|
|
|
- pai_string(consts^.first)^.len:=length(p^.values^)+2;
|
|
|
- consts^.insert(new(pai_label,init(lastlabel)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- p^.location.reference.symbol:=stringdup(lab2str(lastlabel));
|
|
|
- p^.location.loc := LOC_MEM;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondumminus(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- case p^.left^.location.loc of
|
|
|
- LOC_REGISTER : begin
|
|
|
- p^.location.register:=p^.left^.location.register;
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_L,p^.location.register)));
|
|
|
- end;
|
|
|
- LOC_CREGISTER : begin
|
|
|
- p^.location.register:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.location.register,
|
|
|
- p^.location.register);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_L,p^.location.register)));
|
|
|
- end;
|
|
|
- LOC_REFERENCE,LOC_MEM :
|
|
|
- begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- { change sign of a floating point }
|
|
|
- { in the case of emulation, get }
|
|
|
- { a free register, and change sign }
|
|
|
- { manually. }
|
|
|
- { otherwise simply load into an FPU}
|
|
|
- { register. }
|
|
|
- if (p^.left^.resulttype^.deftype=floatdef) and
|
|
|
- (pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
|
|
|
- begin
|
|
|
- { move to FPU }
|
|
|
- floatload(pfloatdef(p^.left^.resulttype)^.typ,
|
|
|
- p^.left^.location.reference,p^.location);
|
|
|
- if (cs_fp_emulation) in aktmoduleswitches then
|
|
|
- { if in emulation mode change sign manually }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_BCHG,S_L,31,
|
|
|
- p^.location.fpureg)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_FNEG,S_FX,
|
|
|
- p^.location.fpureg)));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- p^.location.register:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(p^.left^.location.reference),
|
|
|
- p^.location.register)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_L,p^.location.register)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- LOC_FPU : begin
|
|
|
- p^.location.loc:=LOC_FPU;
|
|
|
- p^.location.fpureg := p^.left^.location.fpureg;
|
|
|
- if (cs_fp_emulation) in aktmoduleswitches then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_BCHG,S_L,31,p^.location.fpureg)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_FNEG,S_FX,p^.location.fpureg)));
|
|
|
- end;
|
|
|
- end;
|
|
|
-{ emitoverflowcheck;}
|
|
|
- end;
|
|
|
-
|
|
|
- { use of A6 is required only temp (ok) }
|
|
|
- procedure secondaddr(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=getregister32;
|
|
|
- {@ on a procvar means returning an address to the procedure that
|
|
|
- is stored in it.}
|
|
|
- { yes but p^.left^.symtableentry can be nil
|
|
|
- for example on @self !! }
|
|
|
- { symtableentry can be also invalid, if left is no tree node }
|
|
|
- if (p^.left^.treetype=loadn) and
|
|
|
- assigned(p^.left^.symtableentry) and
|
|
|
- (p^.left^.symtableentry^.typ=varsym) and
|
|
|
- (Pvarsym(p^.left^.symtableentry)^.definition^.deftype=
|
|
|
- procvardef) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(p^.left^.location.reference),
|
|
|
- p^.location.register)))
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
|
|
|
- newreference(p^.left^.location.reference),R_A0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
|
|
|
- R_A0,p^.location.register)));
|
|
|
- end;
|
|
|
- { for use of other segments }
|
|
|
- { if p^.left^.location.reference.segment<>R_DEFAULT_SEG then
|
|
|
- p^.location.segment:=p^.left^.location.reference.segment;
|
|
|
- }
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- end;
|
|
|
-
|
|
|
- { register a6 used as scratch }
|
|
|
- procedure seconddoubleaddr(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- p^.location.register:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
|
|
|
- newreference(p^.left^.location.reference),R_A0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
|
|
|
- R_A0,p^.location.register)));
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondnot(var p : ptree);
|
|
|
-
|
|
|
- const
|
|
|
- flagsinvers : array[F_E..F_BE] of tresflags =
|
|
|
- (F_NE,F_E,F_LE,F_GE,F_L,F_G,F_NC,F_C,
|
|
|
- F_A,F_AE,F_B,F_BE);
|
|
|
-
|
|
|
- var
|
|
|
- hl : plabel;
|
|
|
-
|
|
|
- begin
|
|
|
- if (p^.resulttype^.deftype=orddef) and
|
|
|
- (porddef(p^.resulttype)^.typ=bool8bit) then
|
|
|
- begin
|
|
|
- case p^.location.loc of
|
|
|
- LOC_JUMP : begin
|
|
|
- hl:=truelabel;
|
|
|
- truelabel:=falselabel;
|
|
|
- falselabel:=hl;
|
|
|
- secondpass(p^.left);
|
|
|
- maketojumpbool(p^.left);
|
|
|
- hl:=truelabel;
|
|
|
- truelabel:=falselabel;
|
|
|
- falselabel:=hl;
|
|
|
- end;
|
|
|
- LOC_FLAGS : begin
|
|
|
- secondpass(p^.left);
|
|
|
- p^.location.resflags:=flagsinvers[p^.left^.location.resflags];
|
|
|
- end;
|
|
|
- LOC_REGISTER : begin
|
|
|
- secondpass(p^.left);
|
|
|
- p^.location.register:=p^.left^.location.register;
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_EOR,S_B,1,p^.location.register)));
|
|
|
- end;
|
|
|
- LOC_CREGISTER : begin
|
|
|
- secondpass(p^.left);
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,
|
|
|
- p^.location.register);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_EOR,S_B,1,p^.location.register)));
|
|
|
- end;
|
|
|
- LOC_REFERENCE,LOC_MEM : begin
|
|
|
- secondpass(p^.left);
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=getregister32;
|
|
|
- if p^.left^.location.loc=LOC_CREGISTER then
|
|
|
- emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,
|
|
|
- p^.location.register)
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
|
|
|
- newreference(p^.left^.location.reference),
|
|
|
- p^.location.register)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_EOR,S_B,1,p^.location.register)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
-
|
|
|
- case p^.left^.location.loc of
|
|
|
- LOC_REGISTER : begin
|
|
|
- p^.location.register:=p^.left^.location.register;
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
|
|
|
- end;
|
|
|
- LOC_CREGISTER : begin
|
|
|
- p^.location.register:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
|
|
|
- p^.location.register);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
|
|
|
- end;
|
|
|
- LOC_REFERENCE,LOC_MEM :
|
|
|
- begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- p^.location.register:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(p^.left^.location.reference),
|
|
|
- p^.location.register)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- {if p^.left^.location.loc=loc_register then
|
|
|
- p^.location.register:=p^.left^.location.register
|
|
|
- else
|
|
|
- begin
|
|
|
- del_locref(p^.left^.location);
|
|
|
- p^.location.register:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_loc_reg(A_MOV,S_L,
|
|
|
- p^.left^.location,
|
|
|
- p^.location.register)));
|
|
|
- end;
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_NOT,S_L,p^.location.register)));}
|
|
|
-
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondnothing(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondassignment(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- opsize : topsize;
|
|
|
- withresult : boolean;
|
|
|
- otlabel,hlabel,oflabel : plabel;
|
|
|
- hregister : tregister;
|
|
|
- loc : tloc;
|
|
|
-
|
|
|
- begin
|
|
|
- otlabel:=truelabel;
|
|
|
- oflabel:=falselabel;
|
|
|
- getlabel(truelabel);
|
|
|
- getlabel(falselabel);
|
|
|
- withresult:=false;
|
|
|
- { calculate left sides }
|
|
|
- secondpass(p^.left);
|
|
|
- case p^.left^.location.loc of
|
|
|
- LOC_REFERENCE : begin
|
|
|
- { in case left operator uses too many registers }
|
|
|
- { but to few are free then LEA }
|
|
|
- if (p^.left^.location.reference.base<>R_NO) and
|
|
|
- (p^.left^.location.reference.index<>R_NO) and
|
|
|
- (usableaddress<p^.right^.registers32) then
|
|
|
- begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- hregister:=getaddressreg;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(
|
|
|
- p^.left^.location.reference),
|
|
|
- hregister)));
|
|
|
- clear_reference(p^.left^.location.reference);
|
|
|
- p^.left^.location.reference.base:=hregister;
|
|
|
- p^.left^.location.reference.index:=R_NO;
|
|
|
- end;
|
|
|
- loc:=LOC_REFERENCE;
|
|
|
- end;
|
|
|
- LOC_CREGISTER : loc:=LOC_CREGISTER;
|
|
|
- else
|
|
|
- begin
|
|
|
- Message(cg_e_illegal_expression);
|
|
|
- exit;
|
|
|
- end;
|
|
|
- end;
|
|
|
- { lets try to optimize this (PM) }
|
|
|
- { define a dest_loc that is the location }
|
|
|
- { and a ptree to verify that it is the right }
|
|
|
- { place to insert it }
|
|
|
-{$ifdef test_dest_loc}
|
|
|
- if (aktexprlevel<4) then
|
|
|
- begin
|
|
|
- dest_loc_known:=true;
|
|
|
- dest_loc:=p^.left^.location;
|
|
|
- dest_loc_tree:=p^.right;
|
|
|
- end;
|
|
|
-{$endif test_dest_loc}
|
|
|
-
|
|
|
- if (p^.right^.treetype=realconstn) then
|
|
|
- begin
|
|
|
- if p^.left^.resulttype^.deftype=floatdef then
|
|
|
- begin
|
|
|
- case pfloatdef(p^.left^.resulttype)^.typ of
|
|
|
- s32real : p^.right^.realtyp:=ait_real_32bit;
|
|
|
- s64real : p^.right^.realtyp:=ait_real_64bit;
|
|
|
- s80real : p^.right^.realtyp:=ait_real_extended;
|
|
|
- { what about f32bit and s64bit }
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- secondpass(p^.right);
|
|
|
-{$ifdef test_dest_loc}
|
|
|
- dest_loc_known:=false;
|
|
|
- if in_dest_loc then
|
|
|
- begin
|
|
|
- truelabel:=otlabel;
|
|
|
- falselabel:=oflabel;
|
|
|
- in_dest_loc:=false;
|
|
|
- exit;
|
|
|
- end;
|
|
|
-{$endif test_dest_loc}
|
|
|
- if p^.left^.resulttype^.deftype=stringdef then
|
|
|
- begin
|
|
|
- { we do not need destination anymore }
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- { only source if withresult is set }
|
|
|
- if not(withresult) then
|
|
|
- del_reference(p^.right^.location.reference);
|
|
|
- loadstring(p);
|
|
|
- ungetiftemp(p^.right^.location.reference);
|
|
|
- end
|
|
|
- else case p^.right^.location.loc of
|
|
|
- LOC_REFERENCE,
|
|
|
- LOC_MEM : begin
|
|
|
- { handle ordinal constants trimmed }
|
|
|
- if (p^.right^.treetype in [ordconstn,fixconstn]) or
|
|
|
- (loc=LOC_CREGISTER) then
|
|
|
- begin
|
|
|
- case p^.left^.resulttype^.size of
|
|
|
- 1 : opsize:=S_B;
|
|
|
- 2 : opsize:=S_W;
|
|
|
- 4 : opsize:=S_L;
|
|
|
- end;
|
|
|
- if loc=LOC_CREGISTER then
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
|
|
|
- newreference(p^.right^.location.reference),
|
|
|
- p^.left^.location.register)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,opsize,
|
|
|
- p^.right^.location.reference.offset,
|
|
|
- newreference(p^.left^.location.reference))));
|
|
|
- {exprasmlist^.concat(new(pai68k,op_const_loc(A_MOV,opsize,
|
|
|
- p^.right^.location.reference.offset,
|
|
|
- p^.left^.location)));}
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- concatcopy(p^.right^.location.reference,
|
|
|
- p^.left^.location.reference,p^.left^.resulttype^.size,
|
|
|
- withresult);
|
|
|
- ungetiftemp(p^.right^.location.reference);
|
|
|
- end;
|
|
|
- end;
|
|
|
- LOC_REGISTER,
|
|
|
- LOC_CREGISTER : begin
|
|
|
- case p^.right^.resulttype^.size of
|
|
|
- 1 : opsize:=S_B;
|
|
|
- 2 : opsize:=S_W;
|
|
|
- 4 : opsize:=S_L;
|
|
|
- end;
|
|
|
- { simplified with op_reg_loc }
|
|
|
- if loc=LOC_CREGISTER then
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,opsize,
|
|
|
- p^.right^.location.register,
|
|
|
- p^.left^.location.register)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,opsize,
|
|
|
- p^.right^.location.register,
|
|
|
- newreference(p^.left^.location.reference))));
|
|
|
- {exprasmlist^.concat(new(pai68k,op_reg_loc(A_MOV,opsize,
|
|
|
- p^.right^.location.register,
|
|
|
- p^.left^.location))); }
|
|
|
-
|
|
|
- end;
|
|
|
- LOC_FPU : begin
|
|
|
- if loc<>LOC_REFERENCE then
|
|
|
- internalerror(10010)
|
|
|
- else
|
|
|
- floatstore(pfloatdef(p^.left^.resulttype)^.typ,
|
|
|
- p^.right^.location,p^.left^.location.reference);
|
|
|
- end;
|
|
|
- LOC_JUMP : begin
|
|
|
- getlabel(hlabel);
|
|
|
- emitl(A_LABEL,truelabel);
|
|
|
- if loc=LOC_CREGISTER then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,
|
|
|
- 1,p^.left^.location.register)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,
|
|
|
- 1,newreference(p^.left^.location.reference))));
|
|
|
- {exprasmlist^.concat(new(pai68k,op_const_loc(A_MOV,S_B,
|
|
|
- 1,p^.left^.location)));}
|
|
|
- emitl(A_JMP,hlabel);
|
|
|
- emitl(A_LABEL,falselabel);
|
|
|
- if loc=LOC_CREGISTER then
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_B,
|
|
|
- p^.left^.location.register)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,
|
|
|
- 0,newreference(p^.left^.location.reference))));
|
|
|
- emitl(A_LABEL,hlabel);
|
|
|
- end;
|
|
|
- LOC_FLAGS : begin
|
|
|
- if loc=LOC_CREGISTER then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,
|
|
|
- p^.left^.location.register)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_NEG,S_B,p^.left^.location.register)));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref(flag_2_set[p^.right^.location.resflags],S_B,
|
|
|
- newreference(p^.left^.location.reference))));
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref(A_NEG,S_B,newreference(p^.left^.location.reference))));
|
|
|
- end;
|
|
|
-
|
|
|
- end;
|
|
|
- end;
|
|
|
- truelabel:=otlabel;
|
|
|
- falselabel:=oflabel;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondderef(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- hr : tregister;
|
|
|
-
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- clear_reference(p^.location.reference);
|
|
|
- case p^.left^.location.loc of
|
|
|
- LOC_REGISTER : Begin
|
|
|
- hr := getaddressreg;
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
|
|
|
- p^.location.reference.base:=hr;
|
|
|
- ungetregister(p^.left^.location.register);
|
|
|
- end;
|
|
|
- LOC_CREGISTER : begin
|
|
|
- { ... and reserve one for the pointer }
|
|
|
- hr:=getaddressreg;
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
|
|
|
- p^.location.reference.base:=hr;
|
|
|
- { LOC_REGISTER indicates that this is a
|
|
|
- variable register which should not be freed. }
|
|
|
-{ ungetregister(p^.left^.location.register); }
|
|
|
- end;
|
|
|
- else
|
|
|
- begin
|
|
|
- { free register }
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
-
|
|
|
- { ...and reserve one for the pointer }
|
|
|
- hr:=getaddressreg;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(
|
|
|
- A_MOVE,S_L,newreference(p^.left^.location.reference),
|
|
|
- hr)));
|
|
|
- p^.location.reference.base:=hr;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- { used D0, D1 as scratch (ok) }
|
|
|
- { arrays ... }
|
|
|
- { Sets up the array and string }
|
|
|
- { references . }
|
|
|
- procedure secondvecn(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- pushed : boolean;
|
|
|
- ind : tregister;
|
|
|
- _p : ptree;
|
|
|
-
|
|
|
- procedure calc_emit_mul;
|
|
|
-
|
|
|
- var
|
|
|
- l1,l2 : longint;
|
|
|
-
|
|
|
- begin
|
|
|
- l1:=p^.resulttype^.size;
|
|
|
- case l1 of
|
|
|
- 1 : p^.location.reference.scalefactor:=l1;
|
|
|
- 2 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,ind)));
|
|
|
- 4 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,ind)));
|
|
|
- 8 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,3,ind)));
|
|
|
- else
|
|
|
- begin
|
|
|
- if ispowerof2(l1,l2) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,l2,ind)))
|
|
|
- else
|
|
|
- begin
|
|
|
- { use normal MC68000 signed multiply }
|
|
|
- if (l1 >= -32768) and (l1 <= 32767) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_W,l1,ind)))
|
|
|
- else
|
|
|
- { use long MC68020 long multiply }
|
|
|
- if (aktoptprocessor = MC68020) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,S_L,l1,ind)))
|
|
|
- else
|
|
|
- { MC68000 long multiply }
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,l1,R_D0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,ind,R_D1)));
|
|
|
- emitcall('LONGMUL',true);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,ind)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- end; { else case }
|
|
|
- end; { end case }
|
|
|
- end; { calc_emit_mul }
|
|
|
-
|
|
|
- var
|
|
|
- extraoffset : longint;
|
|
|
- t : ptree;
|
|
|
- hp : preference;
|
|
|
- tai:pai68k;
|
|
|
- reg: tregister;
|
|
|
-
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- { RESULT IS IN p^.location.reference }
|
|
|
- set_location(p^.location,p^.left^.location);
|
|
|
-
|
|
|
- { offset can only differ from 0 if arraydef }
|
|
|
- if p^.left^.resulttype^.deftype=arraydef then
|
|
|
- dec(p^.location.reference.offset,
|
|
|
- p^.resulttype^.size*
|
|
|
- parraydef(p^.left^.resulttype)^.lowrange);
|
|
|
-
|
|
|
- if p^.right^.treetype=ordconstn then
|
|
|
- begin
|
|
|
- { offset can only differ from 0 if arraydef }
|
|
|
- if (p^.left^.resulttype^.deftype=arraydef) then
|
|
|
- begin
|
|
|
- if not(is_open_array(p^.left^.resulttype)) then
|
|
|
- begin
|
|
|
- if (p^.right^.value>parraydef(p^.left^.resulttype)^.highrange) or
|
|
|
- (p^.right^.value<parraydef(p^.left^.resulttype)^.lowrange) then
|
|
|
- Message(parser_e_range_check_error);
|
|
|
-
|
|
|
- dec(p^.left^.location.reference.offset,
|
|
|
- p^.resulttype^.size*parraydef(p^.left^.resulttype)^.lowrange);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { range checking for open arrays }
|
|
|
- end;
|
|
|
- end;
|
|
|
- inc(p^.left^.location.reference.offset,
|
|
|
- p^.right^.value*p^.resulttype^.size);
|
|
|
- p^.left^.resulttype:=p^.resulttype;
|
|
|
- disposetree(p^.right);
|
|
|
- _p:=p^.left;
|
|
|
- putnode(p);
|
|
|
- p:=_p;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { quick hack, to overcome Delphi 2 }
|
|
|
- if ( cs_regalloc in aktglobalswitches) and
|
|
|
- (p^.left^.resulttype^.deftype=arraydef) then
|
|
|
- begin
|
|
|
- extraoffset:=0;
|
|
|
- if (p^.right^.treetype=addn) then
|
|
|
- begin
|
|
|
- if p^.right^.right^.treetype=ordconstn then
|
|
|
- begin
|
|
|
- extraoffset:=p^.right^.right^.value;
|
|
|
- t:=p^.right^.left;
|
|
|
- putnode(p^.right);
|
|
|
- putnode(p^.right^.right);
|
|
|
- p^.right:=t
|
|
|
- end
|
|
|
- else if p^.right^.left^.treetype=ordconstn then
|
|
|
- begin
|
|
|
- extraoffset:=p^.right^.left^.value;
|
|
|
- t:=p^.right^.right;
|
|
|
- putnode(p^.right);
|
|
|
- putnode(p^.right^.left);
|
|
|
- p^.right:=t
|
|
|
- end;
|
|
|
- end
|
|
|
- else if (p^.right^.treetype=subn) then
|
|
|
- begin
|
|
|
- if p^.right^.right^.treetype=ordconstn then
|
|
|
- begin
|
|
|
- extraoffset:=p^.right^.right^.value;
|
|
|
- t:=p^.right^.left;
|
|
|
- putnode(p^.right);
|
|
|
- putnode(p^.right^.right);
|
|
|
- p^.right:=t
|
|
|
- end
|
|
|
- else if p^.right^.left^.treetype=ordconstn then
|
|
|
- begin
|
|
|
- extraoffset:=p^.right^.left^.value;
|
|
|
- t:=p^.right^.right;
|
|
|
- putnode(p^.right);
|
|
|
- putnode(p^.right^.left);
|
|
|
- p^.right:=t
|
|
|
- end;
|
|
|
- end;
|
|
|
- inc(p^.location.reference.offset,
|
|
|
- p^.resulttype^.size*extraoffset);
|
|
|
- end;
|
|
|
- { calculate from left to right }
|
|
|
- if (p^.location.loc<>LOC_REFERENCE) and
|
|
|
- (p^.location.loc<>LOC_MEM) then
|
|
|
- Message(cg_e_illegal_expression);
|
|
|
-
|
|
|
- pushed:=maybe_push(p^.right^.registers32,p);
|
|
|
- secondpass(p^.right);
|
|
|
- if pushed then restore(p);
|
|
|
- case p^.right^.location.loc of
|
|
|
- LOC_REGISTER : begin
|
|
|
- ind:=p^.right^.location.register;
|
|
|
- case p^.right^.resulttype^.size of
|
|
|
- 1: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
|
|
|
- $ff,ind)));
|
|
|
- 2: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
|
|
|
- $ffff,ind)));
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- LOC_CREGISTER : begin
|
|
|
- ind:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,ind);
|
|
|
- case p^.right^.resulttype^.size of
|
|
|
- 1: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
|
|
|
- $ff,ind)));
|
|
|
- 2: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
|
|
|
- $ffff,ind)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- LOC_FLAGS:
|
|
|
- begin
|
|
|
- ind:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,ind)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,ind)));
|
|
|
- end
|
|
|
- else { else outer case }
|
|
|
- begin
|
|
|
- del_reference(p^.right^.location.reference);
|
|
|
- ind:=getregister32;
|
|
|
-
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(p^.right^.location.reference),ind)));
|
|
|
-
|
|
|
- {Booleans are stored in an 8 bit memory location, so
|
|
|
- the use of MOVL is not correct.}
|
|
|
- case p^.right^.resulttype^.size of
|
|
|
- 1: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
|
|
|
- $ff,ind)));
|
|
|
- 2: exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
|
|
|
- $ffff,ind)));
|
|
|
- end; { end case }
|
|
|
- end; { end else begin }
|
|
|
- end;
|
|
|
-
|
|
|
- { produce possible range check code: }
|
|
|
- if cs_check_range in aktlocalswitches then
|
|
|
- begin
|
|
|
- if p^.left^.resulttype^.deftype=arraydef then
|
|
|
- begin
|
|
|
- new(hp);
|
|
|
- reset_reference(hp^);
|
|
|
- parraydef(p^.left^.resulttype)^.genrangecheck;
|
|
|
- hp^.symbol:=stringdup('R_'+tostr(parraydef(p^.left^.resulttype)^.rangenr));
|
|
|
- emit_bounds_check(hp^,ind);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- { ------------------------ HANDLE INDEXING ----------------------- }
|
|
|
- { In Motorola 680x0 mode, displacement can only be of 64K max. }
|
|
|
- { Therefore instead of doing a direct displacement, we must first }
|
|
|
- { load the new address into an address register. Therefore the }
|
|
|
- { symbol is not used. }
|
|
|
- if assigned(p^.location.reference.symbol) then
|
|
|
- begin
|
|
|
- if p^.location.reference.base <> R_NO then
|
|
|
- Message(cg_f_secondvecn_base_defined_twice);
|
|
|
- p^.location.reference.base:=getaddressreg;
|
|
|
- exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_LEA,S_L,newcsymbol(p^.location.reference.symbol^,0),
|
|
|
- p^.location.reference.base)));
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- end;
|
|
|
-
|
|
|
- if (p^.location.reference.index=R_NO) then
|
|
|
- begin
|
|
|
- p^.location.reference.index:=ind;
|
|
|
- calc_emit_mul;
|
|
|
- { here we must check for the offset }
|
|
|
- { and if out of bounds for the motorola }
|
|
|
- { eg: out of signed d8 then reload index }
|
|
|
- { with correct value. }
|
|
|
- if p^.location.reference.offset > 127 then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_L,p^.location.reference.offset,ind)));
|
|
|
- p^.location.reference.offset := 0;
|
|
|
- end
|
|
|
- else
|
|
|
- if p^.location.reference.offset < -128 then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,S_L,-p^.location.reference.offset,ind)));
|
|
|
- p^.location.reference.offset := 0;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if p^.location.reference.base=R_NO then
|
|
|
- begin
|
|
|
- case p^.location.reference.scalefactor of
|
|
|
- 2 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,p^.location.reference.index)));
|
|
|
- 4 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,p^.location.reference.index)));
|
|
|
- 8 : exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,3,p^.location.reference.index)));
|
|
|
- end;
|
|
|
- calc_emit_mul;
|
|
|
-
|
|
|
- { we must use address register to put index in base }
|
|
|
- { compare with cgi386.pas }
|
|
|
-
|
|
|
- reg := getaddressreg;
|
|
|
- p^.location.reference.base := reg;
|
|
|
-
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.location.reference.index,reg);
|
|
|
- ungetregister(p^.location.reference.index);
|
|
|
-
|
|
|
- p^.location.reference.index:=ind;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- reg := getaddressreg;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(
|
|
|
- A_LEA,S_L,newreference(p^.location.reference),
|
|
|
- reg)));
|
|
|
-
|
|
|
- ungetregister(p^.location.reference.base);
|
|
|
- { the symbol offset is loaded, }
|
|
|
- { so release the symbol name and set symbol }
|
|
|
- { to nil }
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- p^.location.reference.offset:=0;
|
|
|
- calc_emit_mul;
|
|
|
- p^.location.reference.base:=reg;
|
|
|
- ungetregister32(p^.location.reference.index);
|
|
|
- p^.location.reference.index:=ind;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- { *************** Converting Types **************** }
|
|
|
-
|
|
|
- { produces if necessary rangecheckcode }
|
|
|
-
|
|
|
- procedure maybe_rangechecking(p : ptree;p2,p1 : pdef);
|
|
|
-
|
|
|
- var
|
|
|
- hp : preference;
|
|
|
- hregister : tregister;
|
|
|
- neglabel,poslabel : plabel;
|
|
|
-
|
|
|
- begin
|
|
|
- { convert from p2 to p1 }
|
|
|
- { range check from enums is not made yet !!}
|
|
|
- { and its probably not easy }
|
|
|
- if (p1^.deftype<>orddef) or (p2^.deftype<>orddef) then
|
|
|
- exit;
|
|
|
- { range checking is different for u32bit }
|
|
|
- { lets try to generate it allways }
|
|
|
- if (cs_check_range in aktlocalswitches) and
|
|
|
- { with $R+ explicit type conversations in TP aren't range checked! }
|
|
|
- (not(p^.explizit) or not(cs_tp_compatible in aktmoduleswitches)) and
|
|
|
- ((porddef(p1)^.low>porddef(p2)^.low) or
|
|
|
- (porddef(p1)^.high<porddef(p2)^.high) or
|
|
|
- (porddef(p1)^.typ=u32bit) or
|
|
|
- (porddef(p2)^.typ=u32bit)) then
|
|
|
- begin
|
|
|
- porddef(p1)^.genrangecheck;
|
|
|
- if porddef(p2)^.typ=u8bit then
|
|
|
- begin
|
|
|
- if (p^.location.loc=LOC_REGISTER) or
|
|
|
- (p^.location.loc=LOC_CREGISTER) then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,p^.location.register,R_D6)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$FF,R_D6)));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.location.reference),R_D6)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$FF,R_D6)));
|
|
|
- end;
|
|
|
- hregister:=R_D6;
|
|
|
- end
|
|
|
- else if porddef(p2)^.typ=s8bit then
|
|
|
- begin
|
|
|
- if (p^.location.loc=LOC_REGISTER) or
|
|
|
- (p^.location.loc=LOC_CREGISTER) then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,p^.location.register,R_D6)));
|
|
|
- { byte to long }
|
|
|
- if aktoptprocessor = MC68020 then
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_EXTB,S_L,R_D6)))
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_W,R_D6)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,R_D6)));
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.location.reference),R_D6)));
|
|
|
- { byte to long }
|
|
|
- if aktoptprocessor = MC68020 then
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_EXTB,S_L,R_D6)))
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_W,R_D6)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,R_D6)));
|
|
|
- end;
|
|
|
- end; { end outermost else }
|
|
|
- hregister:=R_D6;
|
|
|
- end
|
|
|
- { rangechecking for u32bit ?? !!!!!!}
|
|
|
- { lets try }
|
|
|
- else if (porddef(p2)^.typ=s32bit) or (porddef(p2)^.typ=u32bit) then
|
|
|
- begin
|
|
|
- if (p^.location.loc=LOC_REGISTER) or
|
|
|
- (p^.location.loc=LOC_CREGISTER) then
|
|
|
- hregister:=p^.location.register
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),R_D6)));
|
|
|
- hregister:=R_D6;
|
|
|
- end;
|
|
|
- end
|
|
|
- { rangechecking for u32bit ?? !!!!!!}
|
|
|
- else if porddef(p2)^.typ=u16bit then
|
|
|
- begin
|
|
|
- if (p^.location.loc=LOC_REGISTER) or
|
|
|
- (p^.location.loc=LOC_CREGISTER) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,R_D6)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),R_D6)));
|
|
|
- { unisgned extend }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$FFFF,R_D6)));
|
|
|
- hregister:=R_D6;
|
|
|
- end
|
|
|
- else if porddef(p2)^.typ=s16bit then
|
|
|
- begin
|
|
|
- if (p^.location.loc=LOC_REGISTER) or
|
|
|
- (p^.location.loc=LOC_CREGISTER) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,R_D6)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),R_D6)));
|
|
|
- { sign extend }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,R_D6)));
|
|
|
- hregister:=R_D6;
|
|
|
- end
|
|
|
- else internalerror(6);
|
|
|
- new(hp);
|
|
|
- reset_reference(hp^);
|
|
|
- hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr));
|
|
|
- if porddef(p1)^.low>porddef(p1)^.high then
|
|
|
- begin
|
|
|
- getlabel(neglabel);
|
|
|
- getlabel(poslabel);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,hregister)));
|
|
|
- emitl(A_BLT,neglabel);
|
|
|
- end;
|
|
|
- emit_bounds_check(hp^,hregister);
|
|
|
- if porddef(p1)^.low>porddef(p1)^.high then
|
|
|
- begin
|
|
|
- new(hp);
|
|
|
- reset_reference(hp^);
|
|
|
- hp^.symbol:=stringdup('R_'+tostr(porddef(p1)^.rangenr+1));
|
|
|
- emitl(A_JMP,poslabel);
|
|
|
- emitl(A_LABEL,neglabel);
|
|
|
- emit_bounds_check(hp^,hregister);
|
|
|
- emitl(A_LABEL,poslabel);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- type
|
|
|
- tsecondconvproc = procedure(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- procedure second_nothing(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- begin
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
- procedure second_only_rangecheck(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- begin
|
|
|
- maybe_rangechecking(p,hp^.resulttype,p^.resulttype);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure second_bigger(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- var
|
|
|
- hregister : tregister;
|
|
|
- opsize : topsize;
|
|
|
- op : tasmop;
|
|
|
- is_register : boolean;
|
|
|
-
|
|
|
- begin
|
|
|
- is_register:=p^.left^.location.loc=LOC_REGISTER;
|
|
|
- if not(is_register) and (p^.left^.location.loc<>LOC_CREGISTER) then
|
|
|
- begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- { we can do this here as we need no temp inside second_bigger }
|
|
|
- ungetiftemp(p^.left^.location.reference);
|
|
|
- end;
|
|
|
- { this is wrong !!!
|
|
|
- gives me movl (%eax),%eax
|
|
|
- for the length(string !!!
|
|
|
- use only for constant values }
|
|
|
- {Constanst cannot be loaded into registers using MOVZX!}
|
|
|
- if (p^.left^.location.loc<>LOC_MEM) or (not p^.left^.location.reference.isintvalue) then
|
|
|
- case convtyp of
|
|
|
- tc_u8bit_2_s32bit,
|
|
|
- tc_u8bit_2_u32bit,
|
|
|
- tc_s8bit_2_u32bit,
|
|
|
- tc_s8bit_2_s16bit,
|
|
|
- tc_s8bit_2_s32bit,
|
|
|
- tc_u8bit_2_u16bit,
|
|
|
- tc_s8bit_2_u16bit,
|
|
|
- tc_u8bit_2_s16bit: begin
|
|
|
- if is_register then
|
|
|
- hregister := p^.left^.location.register
|
|
|
- else
|
|
|
- hregister := getregister32;
|
|
|
- if is_register then
|
|
|
- emit_reg_reg(A_MOVE,S_B,p^.left^.location.register, hregister)
|
|
|
- else
|
|
|
- begin
|
|
|
- if p^.left^.location.loc = LOC_CREGISTER then
|
|
|
- emit_reg_reg(A_MOVE,S_B,p^.left^.location.register,hregister)
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE,S_B,
|
|
|
- newreference(P^.left^.location.reference), hregister)));
|
|
|
- end;
|
|
|
-
|
|
|
- case convtyp of
|
|
|
- tc_u8bit_2_s32bit,
|
|
|
- tc_u8bit_2_u32bit:
|
|
|
- exprasmlist^.concat(new(pai68k, op_const_reg(
|
|
|
- A_AND,S_L,$FF,hregister)));
|
|
|
- tc_s8bit_2_u32bit,
|
|
|
- tc_s8bit_2_s32bit:
|
|
|
- begin
|
|
|
- if aktoptprocessor = MC68020 then
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg
|
|
|
- (A_EXTB,S_L,hregister)))
|
|
|
- else { else if aktoptprocessor }
|
|
|
- begin
|
|
|
- { byte to word }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg
|
|
|
- (A_EXT,S_W,hregister)));
|
|
|
- { word to long }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg
|
|
|
- (A_EXT,S_L,hregister)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- tc_s8bit_2_u16bit,
|
|
|
- tc_u8bit_2_s16bit,
|
|
|
- tc_u8bit_2_u16bit:
|
|
|
- exprasmlist^.concat(new(pai68k, op_const_reg(
|
|
|
- A_AND,S_W,$FF,hregister)));
|
|
|
-
|
|
|
- tc_s8bit_2_s16bit:
|
|
|
- exprasmlist^.concat(new(pai68k, op_reg(
|
|
|
- A_EXT, S_W, hregister)));
|
|
|
-
|
|
|
- end; { inner case }
|
|
|
- end;
|
|
|
- tc_u16bit_2_u32bit,
|
|
|
- tc_u16bit_2_s32bit,
|
|
|
- tc_s16bit_2_u32bit,
|
|
|
- tc_s16bit_2_s32bit: begin
|
|
|
- if is_register then
|
|
|
- hregister := p^.left^.location.register
|
|
|
- else
|
|
|
- hregister := getregister32;
|
|
|
- if is_register then
|
|
|
- emit_reg_reg(A_MOVE,S_W,p^.left^.location.register, hregister)
|
|
|
- else
|
|
|
- begin
|
|
|
- if p^.left^.location.loc = LOC_CREGISTER then
|
|
|
- emit_reg_reg(A_MOVE,S_W,p^.left^.location.register,hregister)
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE,S_W,
|
|
|
- newreference(P^.left^.location.reference), hregister)));
|
|
|
- end;
|
|
|
- if (convtyp = tc_u16bit_2_s32bit) or
|
|
|
- (convtyp = tc_u16bit_2_u32bit) then
|
|
|
- exprasmlist^.concat(new(pai68k, op_const_reg(
|
|
|
- A_AND, S_L, $ffff, hregister)))
|
|
|
- else { tc_s16bit_2_s32bit }
|
|
|
- { tc_s16bit_2_u32bit }
|
|
|
- exprasmlist^.concat(new(pai68k, op_reg(A_EXT,S_L,
|
|
|
- hregister)));
|
|
|
- end;
|
|
|
- end { end case }
|
|
|
- else
|
|
|
- begin
|
|
|
- case convtyp of
|
|
|
- tc_u8bit_2_s32bit,
|
|
|
- tc_s8bit_2_s32bit,
|
|
|
- tc_u16bit_2_s32bit,
|
|
|
- tc_s16bit_2_s32bit,
|
|
|
- tc_u8bit_2_u32bit,
|
|
|
- tc_s8bit_2_u32bit,
|
|
|
- tc_u16bit_2_u32bit,
|
|
|
- tc_s16bit_2_u32bit:
|
|
|
-
|
|
|
- begin
|
|
|
- hregister:=getregister32;
|
|
|
- op:=A_MOVE;
|
|
|
- opsize:=S_L;
|
|
|
- end;
|
|
|
- tc_s8bit_2_u16bit,
|
|
|
- tc_s8bit_2_s16bit,
|
|
|
- tc_u8bit_2_s16bit,
|
|
|
- tc_u8bit_2_u16bit:
|
|
|
- begin
|
|
|
- hregister:=getregister32;
|
|
|
- op:=A_MOVE;
|
|
|
- opsize:=S_W;
|
|
|
- end;
|
|
|
- end;
|
|
|
- if is_register then
|
|
|
- begin
|
|
|
- emit_reg_reg(op,opsize,p^.left^.location.register,hregister);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if p^.left^.location.loc=LOC_CREGISTER then
|
|
|
- emit_reg_reg(op,opsize,p^.left^.location.register,hregister)
|
|
|
- else exprasmlist^.concat(new(pai68k,op_ref_reg(op,opsize,
|
|
|
- newreference(p^.left^.location.reference),hregister)));
|
|
|
- end;
|
|
|
- end; { end elseif }
|
|
|
-
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=hregister;
|
|
|
- maybe_rangechecking(p,p^.left^.resulttype,p^.resulttype);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
- procedure second_string_string(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- var
|
|
|
- pushedregs : tpushed;
|
|
|
-
|
|
|
- begin
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- gettempofsizereference(p^.resulttype^.size,p^.location.reference);
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- copystring(p^.location.reference,p^.left^.location.reference,pstringdef(p^.resulttype)^.len);
|
|
|
- ungetiftemp(p^.left^.location.reference);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure second_cstring_charpointer(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=getregister32;
|
|
|
- inc(p^.left^.location.reference.offset);
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
|
|
|
- R_A0)));
|
|
|
- emit_reg_reg(A_MOVE, S_L, R_A0, p^.location.register);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure second_cchar_charpointer(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- begin
|
|
|
- {!!!!}
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=getregister32;
|
|
|
- inc(p^.left^.location.reference.offset);
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
|
|
|
- R_A0)));
|
|
|
- emit_reg_reg(A_MOVE, S_L, R_A0, p^.location.register);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure second_string_chararray(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- begin
|
|
|
- inc(p^.location.reference.offset);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure second_array_to_pointer(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(p^.left^.location.reference),
|
|
|
- R_A0)));
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_A0, P^.location.register);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure second_pointer_to_array(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- var
|
|
|
- reg: tregister;
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_REFERENCE;
|
|
|
- clear_reference(p^.location.reference);
|
|
|
- { here, after doing some arithmetic on the pointer }
|
|
|
- { we put it back in an address register }
|
|
|
- if p^.left^.location.loc=LOC_REGISTER then
|
|
|
- begin
|
|
|
- reg := getaddressreg;
|
|
|
- { move the pointer in a data register back into }
|
|
|
- { an address register. }
|
|
|
- emit_reg_reg(A_MOVE, S_L, p^.left^.location.register,reg);
|
|
|
-
|
|
|
- p^.location.reference.base:=reg;
|
|
|
- ungetregister32(p^.left^.location.register);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if p^.left^.location.loc=LOC_CREGISTER then
|
|
|
- begin
|
|
|
- p^.location.reference.base:=getaddressreg;
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
|
|
|
- p^.location.reference.base);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- p^.location.reference.base:=getaddressreg;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
|
|
|
- p^.location.reference.base)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- { generates the code for the type conversion from an array of char }
|
|
|
- { to a string }
|
|
|
- procedure second_chararray_to_string(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- var
|
|
|
- l : longint;
|
|
|
-
|
|
|
- begin
|
|
|
- { this is a type conversion which copies the data, so we can't }
|
|
|
- { return a reference }
|
|
|
- p^.location.loc:=LOC_MEM;
|
|
|
-
|
|
|
- { first get the memory for the string }
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- gettempofsizereference(256,p^.location.reference);
|
|
|
-
|
|
|
- { calc the length of the array }
|
|
|
- l:=parraydef(p^.left^.resulttype)^.highrange-
|
|
|
- parraydef(p^.left^.resulttype)^.lowrange+1;
|
|
|
-
|
|
|
- if l>255 then
|
|
|
- Message(sym_e_type_mismatch);
|
|
|
-
|
|
|
- { write the length }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,l,
|
|
|
- newreference(p^.location.reference))));
|
|
|
-
|
|
|
- { copy to first char of string }
|
|
|
- inc(p^.location.reference.offset);
|
|
|
-
|
|
|
- { generates the copy code }
|
|
|
- { and we need the source never }
|
|
|
- concatcopy(p^.left^.location.reference,p^.location.reference,l,true);
|
|
|
-
|
|
|
- { correct the string location }
|
|
|
- dec(p^.location.reference.offset);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-(* procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- begin
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- gettempofsizereference(256,p^.location.reference);
|
|
|
- { is it a char const ? }
|
|
|
- if p^.left^.treetype=ordconstn then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_W,p^.left^.value*256+1,newreference(p^.location.reference))))
|
|
|
- else
|
|
|
- begin
|
|
|
- { not so elegant (goes better with extra register }
|
|
|
- { Here the conversion is done in one shot }
|
|
|
- { i.e we convert to a string with a single word which }
|
|
|
- { will be stored, the length followed by the char }
|
|
|
- { This is of course, endian specific. }
|
|
|
- if (p^.left^.location.loc=LOC_REGISTER) or
|
|
|
- (p^.left^.location.loc=LOC_CREGISTER) then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,p^.left^.location.register,R_D6)));
|
|
|
- exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_W, $FF, R_D6)));
|
|
|
- ungetregister32(p^.left^.location.register);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.left^.location.reference),R_D6)));
|
|
|
- exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_W, $FF, R_D6)));
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- end;
|
|
|
- if (aktoptprocessor = MC68020) then
|
|
|
- { alignment is not a problem on the 68020 and higher processors }
|
|
|
- Begin
|
|
|
- { add length of string to word }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_W,$0100,R_D6)));
|
|
|
- { put back into mem ... }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_W,R_D6,newreference(p^.location.reference))));
|
|
|
- end
|
|
|
- else
|
|
|
- Begin
|
|
|
- { alignment can cause problems }
|
|
|
- { add length of string to ref }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,1,newreference(p^.location.reference))));
|
|
|
- if abs(p^.location.reference.offset) >= 1 then
|
|
|
- Begin
|
|
|
- { temporarily decrease offset }
|
|
|
- Inc(p^.location.reference.offset);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_B,R_D6,newreference(p^.location.reference))));
|
|
|
- Dec(p^.location.reference.offset);
|
|
|
- { restore offset }
|
|
|
- end
|
|
|
- else
|
|
|
- Begin
|
|
|
- Comment(V_Debug,'SecondChar2String() internal error.');
|
|
|
- internalerror(34);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;*)
|
|
|
-
|
|
|
- procedure second_char_to_string(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- begin
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- gettempofsizereference(256,p^.location.reference);
|
|
|
- { call loadstring with correct left and right }
|
|
|
- p^.right:=p^.left;
|
|
|
- p^.left:=p;
|
|
|
- loadstring(p);
|
|
|
- p^.left:=nil; { reset left tree, which is empty }
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
- procedure second_int_real(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- var
|
|
|
- r : preference;
|
|
|
- reg:tregister;
|
|
|
- begin
|
|
|
- emitloadord2reg(p^.left^.location, porddef(p^.left^.resulttype), R_D6, true);
|
|
|
- ungetiftemp(p^.left^.location.reference);
|
|
|
- if porddef(p^.left^.resulttype)^.typ=u32bit then
|
|
|
- push_int(0);
|
|
|
-
|
|
|
- emit_reg_reg(A_MOVE, S_L, R_D6, R_SPPUSH);
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.base := R_SP;
|
|
|
- { no emulation }
|
|
|
-{ for u32bit a solution would be to push $0 and to load a
|
|
|
-+ comp
|
|
|
-+ if porddef(p^.left^.resulttype)^.typ=u32bit then
|
|
|
-+ exprasmlist^.concat(new(pai386,op_ref(A_FILD,S_IQ,r)))
|
|
|
-+ else}
|
|
|
- p^.location.loc := LOC_FPU;
|
|
|
- { get floating point register. }
|
|
|
- if (cs_fp_emulation in aktmoduleswitches) then
|
|
|
- begin
|
|
|
- p^.location.fpureg := getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE, S_L, r, R_D0)));
|
|
|
- emitcall('LONG2SINGLE',true);
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_D0,p^.location.fpureg);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- p^.location.fpureg := getfloatreg;
|
|
|
- exprasmlist^.concat(new(pai68k, op_ref_reg(A_FMOVE, S_L, r, p^.location.fpureg)))
|
|
|
- end;
|
|
|
- if porddef(p^.left^.resulttype)^.typ=u32bit then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_L,8,R_SP)))
|
|
|
- else
|
|
|
- { restore the stack to the previous address }
|
|
|
- exprasmlist^.concat(new(pai68k, op_const_reg(A_ADDQ, S_L, 4, R_SP)));
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure second_real_fix(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- var
|
|
|
- {hs : string;}
|
|
|
- rreg : tregister;
|
|
|
- ref : treference;
|
|
|
-
|
|
|
- begin
|
|
|
- rreg:=getregister32;
|
|
|
- { Are we in a LOC_FPU, if not then use scratch registers }
|
|
|
- { instead of allocating reserved registers. }
|
|
|
- if (p^.left^.location.loc<>LOC_FPU) then
|
|
|
- begin
|
|
|
- if (cs_fp_emulation in aktmoduleswitches) then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),R_D0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,65536,R_D1)));
|
|
|
- emitcall('LONGMUL',true);
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_D0,rreg);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,S_L,newreference(p^.left^.location.reference),R_FP0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_FMUL,S_L,65536,R_FP0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,S_L,R_FP0,rreg)));
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if (cs_fp_emulation in aktmoduleswitches) then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,65536,R_D1)));
|
|
|
- emitcall('LONGMUL',true);
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_D0,rreg);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_FMUL,S_L,65536,p^.left^.location.fpureg)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,S_L,p^.left^.location.fpureg,rreg)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=rreg;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure second_float_float(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- begin
|
|
|
- case p^.left^.location.loc of
|
|
|
- LOC_FPU : begin
|
|
|
- { reload }
|
|
|
- p^.location.loc := LOC_FPU;
|
|
|
- p^.location.fpureg := p^.left^.location.fpureg;
|
|
|
- end;
|
|
|
- LOC_MEM,
|
|
|
- LOC_REFERENCE : floatload(pfloatdef(p^.left^.resulttype)^.typ,
|
|
|
- p^.left^.location.reference,p^.location);
|
|
|
- end;
|
|
|
-{ ALREADY HANDLED BY FLOATLOAD }
|
|
|
-{ p^.location.loc:=LOC_FPU; }
|
|
|
- end;
|
|
|
-
|
|
|
- procedure second_fix_real(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- var
|
|
|
- startreg : tregister;
|
|
|
- hl : plabel;
|
|
|
- r : treference;
|
|
|
- reg1: tregister;
|
|
|
- hl1,hl2,hl3,hl4,hl5,hl6,hl7,hl8,hl9: plabel;
|
|
|
- begin
|
|
|
- if (p^.left^.location.loc=LOC_REGISTER) or
|
|
|
- (p^.left^.location.loc=LOC_CREGISTER) then
|
|
|
- begin
|
|
|
- startreg:=p^.left^.location.register;
|
|
|
- ungetregister(startreg);
|
|
|
- { move d0,d0 is removed by emit_reg_reg }
|
|
|
- emit_reg_reg(A_MOVE,S_L,startreg,R_D0);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
|
|
|
- p^.left^.location.reference),R_D0)));
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- startreg:=R_NO;
|
|
|
- end;
|
|
|
-
|
|
|
- reg1 := getregister32;
|
|
|
-
|
|
|
- { Motorola 68000 equivalent of CDQ }
|
|
|
- { we choose d1:d0 pair for quad word }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,R_D0)));
|
|
|
- getlabel(hl1);
|
|
|
- emitl(A_BPL,hl1);
|
|
|
- { we copy all bits (-ve number) }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,$ffffffff,R_D1)));
|
|
|
- getlabel(hl2);
|
|
|
- emitl(A_BRA,hl2);
|
|
|
- emitl(A_LABEL,hl1);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_D0)));
|
|
|
- emitl(A_LABEL,hl2);
|
|
|
- { end CDQ }
|
|
|
-
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_EOR,S_L,R_D1,R_D0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,reg1)));
|
|
|
- getlabel(hl3);
|
|
|
- emitl(A_BEQ,hl3);
|
|
|
-
|
|
|
- { Motorola 68000 equivalent of RCL }
|
|
|
- getlabel(hl4);
|
|
|
- emitl(A_BCC,hl4);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,reg1)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_L,1,reg1)));
|
|
|
- getlabel(hl5);
|
|
|
- emitl(A_BRA,hl5);
|
|
|
- emitl(A_LABEL,hl4);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,1,reg1)));
|
|
|
- emitl(A_LABEL,hl5);
|
|
|
- { end RCL }
|
|
|
-
|
|
|
- { Motorola 68000 equivalent of BSR }
|
|
|
- { save register }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,R_D6)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,31,R_D0)));
|
|
|
- getlabel(hl6);
|
|
|
- emitl(A_LABEL,hl6);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_BTST,S_L,R_D0,R_D1)));
|
|
|
- getlabel(hl7);
|
|
|
- emitl(A_BNE,hl7);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_B,1,R_D0)));
|
|
|
- emitl(A_BPL,hl6);
|
|
|
- { restore register }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D6,R_D0)));
|
|
|
- emitl(A_LABEL,hl7);
|
|
|
- { end BSR }
|
|
|
-
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,32,R_D6)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_SUB,S_B,R_D1,R_D6)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_LSL,S_L,R_D6,R_D0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_ADD,S_W,1007,R_D1)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,5,R_D1)));
|
|
|
-
|
|
|
- { Motorola 68000 equivalent of SHLD }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,11,R_D6)));
|
|
|
- { save register }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D1,R_A0)));
|
|
|
- getlabel(hl8);
|
|
|
- emitl(A_LABEL,hl8);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,R_D1)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,reg1)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_B,1,R_D6)));
|
|
|
- emitl(A_BNE,hl8);
|
|
|
- { restore register }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A0,R_D1)));
|
|
|
- { end Motorola equivalent of SHLD }
|
|
|
-
|
|
|
- { Motorola 68000 equivalent of SHLD }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,20,R_D6)));
|
|
|
- { save register }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,R_A0)));
|
|
|
- getlabel(hl9);
|
|
|
- emitl(A_LABEL,hl9);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,R_D0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_ROXL,S_W,1,reg1)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_B,1,R_D6)));
|
|
|
- emitl(A_BNE,hl9);
|
|
|
- { restore register }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A0,R_D0)));
|
|
|
- { end Motorola equivalent of SHLD }
|
|
|
-
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,20,R_D6)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_SUB,S_L,R_D6,R_D0)));
|
|
|
- emitl(A_LABEL, hl3);
|
|
|
-
|
|
|
- { create temp values and put on stack }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,reg1,R_SPPUSH)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_D0,R_SPPUSH)));
|
|
|
-
|
|
|
-
|
|
|
- reset_reference(r);
|
|
|
- r.base:=R_SP;
|
|
|
-
|
|
|
- if (cs_fp_emulation in aktmoduleswitches) then
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_FPU;
|
|
|
- p^.location.fpureg := getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(r),
|
|
|
- p^.left^.location.fpureg)))
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_FPU;
|
|
|
- p^.location.fpureg := getfloatreg;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,S_L,newreference(r),
|
|
|
- p^.left^.location.fpureg)))
|
|
|
- end;
|
|
|
- { clear temporary space }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDQ,S_L,8,R_SP)));
|
|
|
- ungetregister32(reg1);
|
|
|
-{ Alreadu handled above... }
|
|
|
-{ p^.location.loc:=LOC_FPU; }
|
|
|
- end;
|
|
|
-
|
|
|
- procedure second_int_fix(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- var
|
|
|
- {hs : string;}
|
|
|
- hregister : tregister;
|
|
|
-
|
|
|
- begin
|
|
|
- if (p^.left^.location.loc=LOC_REGISTER) then
|
|
|
- hregister:=p^.left^.location.register
|
|
|
- else if (p^.left^.location.loc=LOC_CREGISTER) then
|
|
|
- hregister:=getregister32
|
|
|
- else
|
|
|
- begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- hregister:=getregister32;
|
|
|
- case porddef(p^.left^.resulttype)^.typ of
|
|
|
- s8bit : begin
|
|
|
- exprasmlist^.concat(new(pai68k, op_ref_reg(A_MOVE,S_B,
|
|
|
- newreference(p^.left^.location.reference),hregister)));
|
|
|
- if aktoptprocessor = MC68020 then
|
|
|
- exprasmlist^.concat(new(pai68k, op_reg(A_EXTB,S_L,hregister)))
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k, op_reg(A_EXT,S_W,hregister)));
|
|
|
- exprasmlist^.concat(new(pai68k, op_reg(A_EXT,S_L,hregister)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- u8bit : begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,newreference(p^.left^.location.reference),
|
|
|
- hregister)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,hregister)));
|
|
|
- end;
|
|
|
- s16bit :begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.left^.location.reference),
|
|
|
- hregister)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_EXT,S_L,hregister)));
|
|
|
- end;
|
|
|
- u16bit : begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.left^.location.reference),
|
|
|
- hregister)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ffff,hregister)));
|
|
|
- end;
|
|
|
- s32bit,u32bit : exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
|
|
|
- hregister)));
|
|
|
- {!!!! u32bit }
|
|
|
- end;
|
|
|
- end;
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVEQ,S_L,16,R_D1)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_LSL,S_L,R_D1,hregister)));
|
|
|
-
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=hregister;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure second_smaller(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- var
|
|
|
- hregister,destregister : tregister;
|
|
|
- {opsize : topsize;}
|
|
|
- ref : boolean;
|
|
|
- hpp : preference;
|
|
|
-
|
|
|
- begin
|
|
|
- { !!!!!!!! Rangechecking }
|
|
|
- ref:=false;
|
|
|
- { problems with enums !! }
|
|
|
- { with $R+ explicit type conversations in TP aren't range checked! }
|
|
|
- if (p^.resulttype^.deftype=orddef) and
|
|
|
- (hp^.resulttype^.deftype=orddef) and
|
|
|
- ((porddef(p^.resulttype)^.low>porddef(hp^.resulttype)^.low) or
|
|
|
- (porddef(p^.resulttype)^.high<porddef(hp^.resulttype)^.high)) then
|
|
|
- begin
|
|
|
- if (cs_check_range in aktlocalswitches) and
|
|
|
- (not(p^.explizit){ or not(cs_tp_compatible in aktmoduleswitches)}) then
|
|
|
- porddef(p^.resulttype)^.genrangecheck;
|
|
|
- if porddef(hp^.resulttype)^.typ=s32bit then
|
|
|
- begin
|
|
|
- if (p^.location.loc=LOC_REGISTER) or
|
|
|
- (p^.location.loc=LOC_CREGISTER) then
|
|
|
- hregister:=p^.location.register
|
|
|
- else
|
|
|
- begin
|
|
|
- hregister:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.location.reference),hregister)));
|
|
|
- end;
|
|
|
- end
|
|
|
- { rangechecking for u32bit ?? !!!!!!}
|
|
|
- else if porddef(hp^.resulttype)^.typ=u16bit then
|
|
|
- begin
|
|
|
- hregister:=getregister32;
|
|
|
- if (p^.location.loc=LOC_REGISTER) or
|
|
|
- (p^.location.loc=LOC_CREGISTER) then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,hregister)));
|
|
|
- end
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),hregister)));
|
|
|
- { clear unused bits i.e unsigned extend}
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L, $FFFF, hregister)));
|
|
|
- end
|
|
|
- else if porddef(hp^.resulttype)^.typ=s16bit then
|
|
|
- begin
|
|
|
- hregister:=getregister32;
|
|
|
- if (p^.location.loc=LOC_REGISTER) or
|
|
|
- (p^.location.loc=LOC_CREGISTER) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,p^.location.register,hregister)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,newreference(p^.location.reference),hregister)));
|
|
|
- { sign extend }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_EXT, S_L, hregister)));
|
|
|
- end
|
|
|
- else internalerror(6);
|
|
|
-
|
|
|
- if (cs_check_range in aktlocalswitches) and
|
|
|
- (not(p^.explizit) {or not(cs_tp_compatible in aktmoduleswitches)}) then
|
|
|
- Begin
|
|
|
- new(hpp);
|
|
|
- reset_reference(hpp^);
|
|
|
- hpp^.symbol:=stringdup('R_'+tostr(porddef(p^.resulttype)^.rangenr));
|
|
|
-
|
|
|
-
|
|
|
- emit_bounds_check(hpp^, hregister);
|
|
|
- end;
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=hregister;
|
|
|
- exit;
|
|
|
- end
|
|
|
- { -------------- endian problems once again --------------------}
|
|
|
- { If RIGHT enumdef (32-bit) and we do a typecase to a smaller }
|
|
|
- { type we must absolutely load it into a register first. }
|
|
|
- { --------------------------------------------------------------}
|
|
|
- { ------------ supposing enumdef is always 32-bit --------------}
|
|
|
- { --------------------------------------------------------------}
|
|
|
- else
|
|
|
- if (hp^.resulttype^.deftype = enumdef) and (p^.resulttype^.deftype = orddef) then
|
|
|
- begin
|
|
|
- if (hp^.location.loc=LOC_REGISTER) or (hp^.location.loc=LOC_CREGISTER) then
|
|
|
- hregister:=hp^.location.register
|
|
|
- else
|
|
|
- begin
|
|
|
- hregister:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(hp^.location.reference),hregister)));
|
|
|
- end;
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=hregister;
|
|
|
- exit;
|
|
|
- end;
|
|
|
- if (p^.left^.location.loc=LOC_REGISTER) or
|
|
|
- (p^.left^.location.loc=LOC_CREGISTER) then
|
|
|
- begin
|
|
|
- { handled by secondpas by called routine ??? }
|
|
|
- p^.location.register:=p^.left^.location.register;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure second_proc_to_procvar(p,hp : ptree;convtyp : tconverttype);far;
|
|
|
-
|
|
|
- begin
|
|
|
- secondpass(hp);
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- del_reference(hp^.location.reference);
|
|
|
- p^.location.register:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
|
|
|
- newreference(hp^.location.reference),R_A0)));
|
|
|
-
|
|
|
- emit_reg_reg(A_MOVE, S_L, R_A0, P^.location.register);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure second_bool_to_int(p,hp : ptree;convtyp : tconverttype);
|
|
|
-
|
|
|
- var
|
|
|
- oldtruelabel,oldfalselabel,hlabel : plabel;
|
|
|
- hregister : tregister;
|
|
|
- newsize,
|
|
|
- opsize : topsize;
|
|
|
- op : tasmop;
|
|
|
- begin
|
|
|
- oldtruelabel:=truelabel;
|
|
|
- oldfalselabel:=falselabel;
|
|
|
- getlabel(truelabel);
|
|
|
- getlabel(falselabel);
|
|
|
- secondpass(hp);
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- del_reference(hp^.location.reference);
|
|
|
- hregister:=getregister32;
|
|
|
- case porddef(hp^.resulttype)^.typ of
|
|
|
- bool8bit : begin
|
|
|
- case porddef(p^.resulttype)^.typ of
|
|
|
- u8bit,s8bit,
|
|
|
- bool8bit : opsize:=S_B;
|
|
|
- u16bit,s16bit,
|
|
|
- bool16bit : opsize:=S_BW;
|
|
|
- u32bit,s32bit,
|
|
|
- bool32bit : opsize:=S_BL;
|
|
|
- end;
|
|
|
- end;
|
|
|
- bool16bit : begin
|
|
|
- case porddef(p^.resulttype)^.typ of
|
|
|
- u8bit,s8bit,
|
|
|
- bool8bit : opsize:=S_B;
|
|
|
- u16bit,s16bit,
|
|
|
- bool16bit : opsize:=S_W;
|
|
|
- u32bit,s32bit,
|
|
|
- bool32bit : opsize:=S_WL;
|
|
|
- end;
|
|
|
- end;
|
|
|
- bool32bit : begin
|
|
|
- case porddef(p^.resulttype)^.typ of
|
|
|
- u8bit,s8bit,
|
|
|
- bool8bit : opsize:=S_B;
|
|
|
- u16bit,s16bit,
|
|
|
- bool16bit : opsize:=S_W;
|
|
|
- u32bit,s32bit,
|
|
|
- bool32bit : opsize:=S_L;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- op:=A_MOVE;
|
|
|
-{ if opsize in [S_B,S_W,S_L] then
|
|
|
- op:=A_MOVE
|
|
|
- else
|
|
|
- if (porddef(p^.resulttype)^.typ in [s8bit,s16bit,s32bit]) then
|
|
|
- op:=A_MOVSX
|
|
|
- else
|
|
|
- op:=A_MOVZX; }
|
|
|
- case porddef(p^.resulttype)^.typ of
|
|
|
- bool8bit,u8bit,s8bit : begin
|
|
|
- p^.location.register:=hregister;
|
|
|
- newsize:=S_B;
|
|
|
- end;
|
|
|
- bool16bit,u16bit,s16bit : begin
|
|
|
- p^.location.register:=hregister;
|
|
|
- newsize:=S_W;
|
|
|
- end;
|
|
|
- bool32bit,u32bit,s32bit : begin
|
|
|
- p^.location.register:=hregister;
|
|
|
- newsize:=S_L;
|
|
|
- end;
|
|
|
- else
|
|
|
- internalerror(10060);
|
|
|
- end;
|
|
|
-
|
|
|
- case hp^.location.loc of
|
|
|
- LOC_MEM,
|
|
|
- LOC_REFERENCE : exprasmlist^.concat(new(pai68k,op_ref_reg(op,opsize,
|
|
|
- newreference(hp^.location.reference),p^.location.register)));
|
|
|
- LOC_REGISTER,
|
|
|
- LOC_CREGISTER : exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,
|
|
|
- hp^.location.register,p^.location.register)));
|
|
|
- LOC_FLAGS : begin
|
|
|
-{ hregister:=reg32toreg8(hregister); }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
|
|
|
-{ !!!!!!!!
|
|
|
- case porddef(p^.resulttype)^.typ of
|
|
|
- bool16bit,
|
|
|
- u16bit,s16bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
|
|
|
- bool32bit,
|
|
|
- u32bit,s32bit : exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
|
|
|
- end; }
|
|
|
- end;
|
|
|
- LOC_JUMP : begin
|
|
|
- getlabel(hlabel);
|
|
|
- emitl(A_LABEL,truelabel);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,newsize,1,hregister)));
|
|
|
- emitl(A_JMP,hlabel);
|
|
|
- emitl(A_LABEL,falselabel);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_CLR,newsize,hregister)));
|
|
|
- emitl(A_LABEL,hlabel);
|
|
|
- end;
|
|
|
- else
|
|
|
- internalerror(10061);
|
|
|
- end;
|
|
|
- truelabel:=oldtruelabel;
|
|
|
- falselabel:=oldfalselabel;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure second_int_to_bool(p,hp : ptree;convtyp : tconverttype);
|
|
|
- var
|
|
|
- hregister : tregister;
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- del_reference(hp^.location.reference);
|
|
|
- case hp^.location.loc of
|
|
|
- LOC_MEM,LOC_REFERENCE :
|
|
|
- begin
|
|
|
- hregister:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(hp^.location.reference),hregister)));
|
|
|
- end;
|
|
|
- LOC_REGISTER,LOC_CREGISTER :
|
|
|
- begin
|
|
|
- hregister:=hp^.location.register;
|
|
|
- end;
|
|
|
- else
|
|
|
- internalerror(10062);
|
|
|
- end;
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_OR,S_L,hregister,hregister)));
|
|
|
-{ hregister:=reg32toreg8(hregister); }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[hp^.location.resflags],S_B,hregister)));
|
|
|
- case porddef(p^.resulttype)^.typ of
|
|
|
- bool8bit : p^.location.register:=hregister;
|
|
|
-{ !!!!!!!!!!!
|
|
|
-
|
|
|
- bool16bit : begin
|
|
|
- p^.location.register:=reg8toreg16(hregister);
|
|
|
- exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BW,hregister,p^.location.register)));
|
|
|
- end;
|
|
|
- bool32bit : begin
|
|
|
- p^.location.register:=reg16toreg32(hregister);
|
|
|
- exprasmlist^.concat(new(pai386,op_reg_reg(A_MOVZX,S_BL,hregister,p^.location.register)));
|
|
|
- end; }
|
|
|
- else
|
|
|
- internalerror(10064);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
- procedure secondtypeconv(var p : ptree);
|
|
|
-
|
|
|
- const
|
|
|
- secondconvert : array[tc_u8bit_2_s32bit..tc_cchar_charpointer] of
|
|
|
- tsecondconvproc = (second_bigger,second_only_rangecheck,
|
|
|
- second_bigger,second_bigger,second_bigger,
|
|
|
- second_smaller,second_smaller,
|
|
|
- second_smaller,second_string_string,
|
|
|
- second_cstring_charpointer,second_string_chararray,
|
|
|
- second_array_to_pointer,second_pointer_to_array,
|
|
|
- second_char_to_string,second_bigger,
|
|
|
- second_bigger,second_bigger,
|
|
|
- second_smaller,second_smaller,
|
|
|
- second_smaller,second_smaller,
|
|
|
- second_bigger,second_smaller,
|
|
|
- second_only_rangecheck,second_bigger,
|
|
|
- second_bigger,second_bigger,
|
|
|
- second_bigger,second_only_rangecheck,
|
|
|
- second_smaller,second_smaller,
|
|
|
- second_smaller,second_smaller,
|
|
|
- second_bool_to_int,second_int_to_bool,
|
|
|
- second_int_real,second_real_fix,
|
|
|
- second_fix_real,second_int_fix,second_float_float,
|
|
|
- second_chararray_to_string,
|
|
|
- second_proc_to_procvar,
|
|
|
- { is constant char to pchar, is done by firstpass }
|
|
|
- second_nothing);
|
|
|
-
|
|
|
- begin
|
|
|
- { this isn't good coding, I think tc_bool_2_int, shouldn't be }
|
|
|
- { type conversion (FK) }
|
|
|
-
|
|
|
- { this is necessary, because second_bool_byte, have to change }
|
|
|
- { true- and false label before calling secondpass }
|
|
|
- if p^.convtyp<>tc_bool_2_int then
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- set_location(p^.location,p^.left^.location);
|
|
|
- end;
|
|
|
- if (p^.convtyp<>tc_equal) and (p^.convtyp<>tc_not_possible) then
|
|
|
- {the second argument only is for maybe_range_checking !}
|
|
|
- secondconvert[p^.convtyp](p,p^.left,p^.convtyp)
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
-
|
|
|
- { save the size of pushed parameter }
|
|
|
- var
|
|
|
- pushedparasize : longint;
|
|
|
-
|
|
|
- procedure secondcallparan(var p : ptree;defcoll : pdefcoll;
|
|
|
- push_from_left_to_right : boolean);
|
|
|
-
|
|
|
- var
|
|
|
- size : longint;
|
|
|
- stackref : treference;
|
|
|
- otlabel,hlabel,oflabel : plabel;
|
|
|
-
|
|
|
- { temporary variables: }
|
|
|
- tempdeftype : tdeftype;
|
|
|
- tempreference : treference;
|
|
|
- r : preference;
|
|
|
- s : topsize;
|
|
|
- op : tasmop;
|
|
|
- reg: tregister;
|
|
|
-
|
|
|
- begin
|
|
|
- { push from left to right if specified }
|
|
|
- if push_from_left_to_right and assigned(p^.right) then
|
|
|
- secondcallparan(p^.right,defcoll^.next,push_from_left_to_right);
|
|
|
- otlabel:=truelabel;
|
|
|
- oflabel:=falselabel;
|
|
|
- getlabel(truelabel);
|
|
|
- getlabel(falselabel);
|
|
|
- secondpass(p^.left);
|
|
|
- { in codegen.handleread.. defcoll^.data is set to nil }
|
|
|
- if assigned(defcoll^.data) and
|
|
|
- (defcoll^.data^.deftype=formaldef) then
|
|
|
- begin
|
|
|
- { allow @var }
|
|
|
- if p^.left^.treetype=addrn then
|
|
|
- begin
|
|
|
- { allways a register }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.left^.location.register,R_SPPUSH)));
|
|
|
- ungetregister32(p^.left^.location.register);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if (p^.left^.location.loc<>LOC_REFERENCE) and
|
|
|
- (p^.left^.location.loc<>LOC_MEM) then
|
|
|
- Message(sym_e_type_mismatch)
|
|
|
- else
|
|
|
- begin
|
|
|
- emitpushreferenceaddr(p^.left^.location.reference);
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- end;
|
|
|
- end;
|
|
|
- inc(pushedparasize,4);
|
|
|
- end
|
|
|
- { handle call by reference parameter }
|
|
|
- else if (defcoll^.paratyp=vs_var) then
|
|
|
- begin
|
|
|
- if (p^.left^.location.loc<>LOC_REFERENCE) then
|
|
|
- Message(cg_e_var_must_be_reference);
|
|
|
- { open array ? }
|
|
|
- { defcoll^.data can be nil for read/write }
|
|
|
- if assigned(defcoll^.data) and
|
|
|
- is_open_array(defcoll^.data) then
|
|
|
- begin
|
|
|
- { push high }
|
|
|
- if is_open_array(p^.left^.resulttype) then
|
|
|
- begin
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.base:=highframepointer;
|
|
|
- r^.offset:=highoffset+4;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_SPPUSH)));
|
|
|
- end
|
|
|
- else
|
|
|
- push_int(parraydef(p^.left^.resulttype)^.highrange-
|
|
|
- parraydef(p^.left^.resulttype)^.lowrange);
|
|
|
- inc(pushedparasize,4);
|
|
|
- end;
|
|
|
- emitpushreferenceaddr(p^.left^.location.reference);
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- inc(pushedparasize,4);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- tempdeftype:=p^.resulttype^.deftype;
|
|
|
- if tempdeftype=filedef then
|
|
|
- Message(cg_e_file_must_call_by_reference);
|
|
|
- if (defcoll^.paratyp=vs_const) and
|
|
|
- dont_copy_const_param(p^.resulttype) then
|
|
|
- begin
|
|
|
- emitpushreferenceaddr(p^.left^.location.reference);
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- inc(pushedparasize,4);
|
|
|
- end
|
|
|
- else
|
|
|
- case p^.left^.location.loc of
|
|
|
- LOC_REGISTER,
|
|
|
- LOC_CREGISTER : begin
|
|
|
- { HERE IS A BIG PROBLEM }
|
|
|
- { --> We *MUST* know the data size to push }
|
|
|
- { for the moment, we can say that the savesize }
|
|
|
- { indicates the parameter size to push, but }
|
|
|
- { that is CERTAINLY NOT TRUE! }
|
|
|
- { CAN WE USE LIKE LOC_MEM OR LOC_REFERENCE?? }
|
|
|
- case integer(p^.left^.resulttype^.savesize) of
|
|
|
- 1 : Begin
|
|
|
- { A byte sized value normally increments }
|
|
|
- { the SP by 2, BUT because how memory has }
|
|
|
- { been setup OR because of GAS, a byte sized }
|
|
|
- { push CRASHES the Amiga, therefore, we do it }
|
|
|
- { by hand instead. }
|
|
|
- { PUSH A WORD SHIFTED LEFT 8 }
|
|
|
- reg := getregister32;
|
|
|
- emit_reg_reg(A_MOVE, S_B, p^.left^.location.register, reg);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,
|
|
|
- 8, reg)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
|
|
|
- reg,R_SPPUSH)));
|
|
|
- { offset will be TWO greater }
|
|
|
- inc(pushedparasize,2);
|
|
|
- ungetregister32(reg);
|
|
|
- ungetregister32(p^.left^.location.register);
|
|
|
- end;
|
|
|
- 2 :
|
|
|
- Begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
|
|
|
- p^.left^.location.register,R_SPPUSH)));
|
|
|
- inc(pushedparasize,2);
|
|
|
- ungetregister32(p^.left^.location.register);
|
|
|
- end;
|
|
|
- 4 : Begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
|
|
|
- p^.left^.location.register,R_SPPUSH)));
|
|
|
- inc(pushedparasize,4);
|
|
|
- ungetregister32(p^.left^.location.register);
|
|
|
- end;
|
|
|
- else
|
|
|
- Begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
|
|
|
- p^.left^.location.register,R_SPPUSH)));
|
|
|
- inc(pushedparasize,4);
|
|
|
- ungetregister32(p^.left^.location.register);
|
|
|
- end;
|
|
|
- end; { end case }
|
|
|
- end;
|
|
|
- LOC_FPU : begin
|
|
|
- size:=pfloatdef(p^.left^.resulttype)^.size;
|
|
|
- inc(pushedparasize,size);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_L,size,R_SP)));
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.base:=R_SP;
|
|
|
- s:=getfloatsize(pfloatdef(p^.left^.resulttype)^.typ);
|
|
|
- if (cs_fp_emulation in aktmoduleswitches) or (s=S_FS) then
|
|
|
- begin
|
|
|
- { when in emulation mode... }
|
|
|
- { only single supported!!! }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,
|
|
|
- p^.left^.location.fpureg,r)));
|
|
|
- end
|
|
|
- else
|
|
|
- { convert back from extended to normal type }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_ref(A_FMOVE,s,
|
|
|
- p^.left^.location.fpureg,r)));
|
|
|
- end;
|
|
|
- LOC_REFERENCE,LOC_MEM :
|
|
|
- begin
|
|
|
- tempreference:=p^.left^.location.reference;
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- case p^.resulttype^.deftype of
|
|
|
- orddef : begin
|
|
|
- case porddef(p^.resulttype)^.typ of
|
|
|
- s32bit,u32bit :
|
|
|
- begin
|
|
|
- emit_push_mem(tempreference);
|
|
|
- inc(pushedparasize,4);
|
|
|
- end;
|
|
|
- s8bit,u8bit,uchar,bool8bit:
|
|
|
- Begin
|
|
|
- { We push a BUT, the SP is incremented by 2 }
|
|
|
- { as specified in the Motorola Prog's Ref Manual }
|
|
|
- { Therefore offet increments BY 2!!! }
|
|
|
- { BUG??? ... }
|
|
|
- { SWAP OPERANDS: }
|
|
|
- if tempreference.isintvalue then
|
|
|
- Begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,
|
|
|
- tempreference.offset shl 8,R_SPPUSH)));
|
|
|
- end
|
|
|
- else
|
|
|
- Begin
|
|
|
- { A byte sized value normally increments }
|
|
|
- { the SP by 2, BUT because how memory has }
|
|
|
- { been setup OR because of GAS, a byte sized }
|
|
|
- { push CRASHES the Amiga, therefore, we do it }
|
|
|
- { by hand instead. }
|
|
|
- { PUSH A WORD SHIFTED LEFT 8 }
|
|
|
- reg:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
|
|
|
- newreference(tempreference),reg)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,
|
|
|
- 8, reg)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,
|
|
|
- reg,R_SPPUSH)));
|
|
|
- ungetregister32(reg);
|
|
|
-{ exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
|
|
|
- newreference(tempreference),R_SPPUSH))); }
|
|
|
- end;
|
|
|
- inc(pushedparasize,2);
|
|
|
-
|
|
|
- end;
|
|
|
- s16bit,u16bit : begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
|
|
|
- newreference(tempreference),R_SPPUSH)));
|
|
|
- inc(pushedparasize,2);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- floatdef : begin
|
|
|
- case pfloatdef(p^.resulttype)^.typ of
|
|
|
- f32bit,
|
|
|
- s32real :
|
|
|
- begin
|
|
|
- emit_push_mem(tempreference);
|
|
|
- inc(pushedparasize,4);
|
|
|
- end;
|
|
|
- s64real:
|
|
|
- {s64bit }
|
|
|
- begin
|
|
|
- inc(tempreference.offset,4);
|
|
|
- emit_push_mem(tempreference);
|
|
|
- dec(tempreference.offset,4);
|
|
|
- emit_push_mem(tempreference);
|
|
|
- inc(pushedparasize,8);
|
|
|
- end;
|
|
|
-{$ifdef use48}
|
|
|
- s48real : begin
|
|
|
- end;
|
|
|
-{$endif}
|
|
|
- s80real : begin
|
|
|
- Message(cg_f_extended_cg68k_not_supported);
|
|
|
-{ inc(tempreference.offset,6);
|
|
|
- emit_push_mem(tempreference);
|
|
|
- dec(tempreference.offset,4);
|
|
|
- emit_push_mem(tempreference);
|
|
|
- dec(tempreference.offset,2);
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
|
|
|
- newreference(tempreference),R_SPPUSH)));
|
|
|
- inc(pushedparasize,extended_size);}
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- pointerdef,procvardef,
|
|
|
- enumdef,classrefdef: begin
|
|
|
- emit_push_mem(tempreference);
|
|
|
- inc(pushedparasize,4);
|
|
|
- end;
|
|
|
- arraydef,recorddef,stringdef,setdef,objectdef :
|
|
|
- begin
|
|
|
- if ((p^.resulttype^.deftype=setdef) and
|
|
|
- (psetdef(p^.resulttype)^.settype=smallset)) then
|
|
|
- begin
|
|
|
- emit_push_mem(tempreference);
|
|
|
- inc(pushedparasize,4);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- size:=p^.resulttype^.size;
|
|
|
-
|
|
|
- { Alignment }
|
|
|
- {
|
|
|
- if (size>=4) and ((size and 3)<>0) then
|
|
|
- inc(size,4-(size and 3))
|
|
|
- else if (size>=2) and ((size and 1)<>0) then
|
|
|
- inc(size,2-(size and 1))
|
|
|
- else
|
|
|
- if size=1 then size:=2;
|
|
|
- }
|
|
|
- { create stack space }
|
|
|
- if (size > 0) and (size < 9) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_L,size,R_SP)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBA,
|
|
|
- S_L,size,R_SP)));
|
|
|
- inc(pushedparasize,size);
|
|
|
- { create stack reference }
|
|
|
- stackref.symbol := nil;
|
|
|
- clear_reference(stackref);
|
|
|
- stackref.base:=R_SP;
|
|
|
- { produce copy }
|
|
|
- if p^.resulttype^.deftype=stringdef then
|
|
|
- begin
|
|
|
- copystring(stackref,p^.left^.location.reference,
|
|
|
- pstringdef(p^.resulttype)^.len);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- concatcopy(p^.left^.location.reference,
|
|
|
- stackref,p^.resulttype^.size,true);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- else Message(cg_e_illegal_expression);
|
|
|
- end;
|
|
|
- end;
|
|
|
- LOC_JUMP : begin
|
|
|
- getlabel(hlabel);
|
|
|
- inc(pushedparasize,2);
|
|
|
- emitl(A_LABEL,truelabel);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,1 shl 8,R_SPPUSH)));
|
|
|
- emitl(A_JMP,hlabel);
|
|
|
- emitl(A_LABEL,falselabel);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,0,R_SPPUSH)));
|
|
|
- emitl(A_LABEL,hlabel);
|
|
|
- end;
|
|
|
- LOC_FLAGS : begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.left^.location.resflags],S_B,
|
|
|
- R_D0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_NEG, S_B, R_D0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_W,$ff, R_D0)));
|
|
|
- inc(pushedparasize,2);
|
|
|
- { ----------------- HACK ----------------------- }
|
|
|
- { HERE IS THE BYTE SIZED PUSH HACK ONCE AGAIN }
|
|
|
- { SHIFT LEFT THE BYTE TO MAKE IT WORK! }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_W,8, R_D0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_W,R_D0,R_SPPUSH)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- truelabel:=otlabel;
|
|
|
- falselabel:=oflabel;
|
|
|
- { push from right to left }
|
|
|
- if not push_from_left_to_right and assigned(p^.right) then
|
|
|
- secondcallparan(p^.right,defcoll^.next,push_from_left_to_right);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondcalln(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- unusedregisters : tregisterset;
|
|
|
- pushed : tpushed;
|
|
|
- funcretref : treference;
|
|
|
- hregister : tregister;
|
|
|
- oldpushedparasize : longint;
|
|
|
- { true if a5 must be loaded again after the subroutine }
|
|
|
- loada5 : boolean;
|
|
|
- { true if a virtual method must be called directly }
|
|
|
- no_virtual_call : boolean;
|
|
|
- { true if we produce a con- or destrutor in a call }
|
|
|
- is_con_or_destructor : boolean;
|
|
|
- { true if a constructor is called again }
|
|
|
- extended_new : boolean;
|
|
|
- { adress returned from an I/O-error }
|
|
|
- iolabel : plabel;
|
|
|
- { lexlevel count }
|
|
|
- i : longint;
|
|
|
- { help reference pointer }
|
|
|
- r : preference;
|
|
|
- pp,params : ptree;
|
|
|
- { temp register allocation }
|
|
|
- reg: tregister;
|
|
|
- { help reference pointer }
|
|
|
- ref: preference;
|
|
|
-
|
|
|
- label
|
|
|
- dont_call;
|
|
|
-
|
|
|
- begin
|
|
|
- extended_new:=false;
|
|
|
- iolabel:=nil;
|
|
|
- loada5:=true;
|
|
|
- no_virtual_call:=false;
|
|
|
- unusedregisters:=unused;
|
|
|
- if not assigned(p^.procdefinition) then
|
|
|
- exit;
|
|
|
- { only if no proc var }
|
|
|
- if not(assigned(p^.right)) then
|
|
|
- is_con_or_destructor:=((p^.procdefinition^.options and poconstructor)<>0)
|
|
|
- or ((p^.procdefinition^.options and podestructor)<>0);
|
|
|
- { proc variables destroy all registers }
|
|
|
- if (p^.right=nil) and
|
|
|
- { virtual methods too }
|
|
|
- ((p^.procdefinition^.options and povirtualmethod)=0) then
|
|
|
- begin
|
|
|
- if ((p^.procdefinition^.options and poiocheck)<>0)
|
|
|
- and (cs_check_io in aktlocalswitches) then
|
|
|
- begin
|
|
|
- getlabel(iolabel);
|
|
|
- emitl(A_LABEL,iolabel);
|
|
|
- end
|
|
|
- else iolabel:=nil;
|
|
|
-
|
|
|
- { save all used registers }
|
|
|
- pushusedregisters(pushed,p^.procdefinition^.usedregisters);
|
|
|
-
|
|
|
- { give used registers through }
|
|
|
- usedinproc:=usedinproc or p^.procdefinition^.usedregisters;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- pushusedregisters(pushed,$ffff);
|
|
|
- usedinproc:=$ffff;
|
|
|
-
|
|
|
- { no IO check for methods and procedure variables }
|
|
|
- iolabel:=nil;
|
|
|
- end;
|
|
|
-
|
|
|
- { generate the code for the parameter and push them }
|
|
|
- oldpushedparasize:=pushedparasize;
|
|
|
- pushedparasize:=0;
|
|
|
- if (p^.resulttype<>pdef(voiddef)) and
|
|
|
- ret_in_param(p^.resulttype) then
|
|
|
- begin
|
|
|
- funcretref.symbol:=nil;
|
|
|
-{$ifdef test_dest_loc}
|
|
|
- if dest_loc_known and (dest_loc_tree=p) and
|
|
|
- (dest_loc.loc in [LOC_REFERENCE,LOC_MEM]) then
|
|
|
- begin
|
|
|
- funcretref:=dest_loc.reference;
|
|
|
- if assigned(dest_loc.reference.symbol) then
|
|
|
- funcretref.symbol:=stringdup(dest_loc.reference.symbol^);
|
|
|
- in_dest_loc:=true;
|
|
|
- end
|
|
|
- else
|
|
|
-{$endif test_dest_loc}
|
|
|
- gettempofsizereference(p^.procdefinition^.retdef^.size,funcretref);
|
|
|
- end;
|
|
|
- if assigned(p^.left) then
|
|
|
- begin
|
|
|
- pushedparasize:=0;
|
|
|
- { be found elsewhere }
|
|
|
- if assigned(p^.right) then
|
|
|
- secondcallparan(p^.left,pprocvardef(p^.right^.resulttype)^.para1,
|
|
|
- (p^.procdefinition^.options and poleftright)<>0)
|
|
|
- else
|
|
|
- secondcallparan(p^.left,p^.procdefinition^.para1,
|
|
|
- (p^.procdefinition^.options and poleftright)<>0);
|
|
|
- end;
|
|
|
- params:=p^.left;
|
|
|
- p^.left:=nil;
|
|
|
- if ret_in_param(p^.resulttype) then
|
|
|
- begin
|
|
|
- emitpushreferenceaddr(funcretref);
|
|
|
- inc(pushedparasize,4);
|
|
|
- end;
|
|
|
- { overloaded operator have no symtable }
|
|
|
- if (p^.right=nil) then
|
|
|
- begin
|
|
|
- { push self }
|
|
|
- if assigned(p^.symtable) and
|
|
|
- (p^.symtable^.symtabletype=withsymtable) then
|
|
|
- begin
|
|
|
- { dirty trick to avoid the secondcall below }
|
|
|
- p^.methodpointer:=genzeronode(callparan);
|
|
|
- p^.methodpointer^.location.loc:=LOC_REGISTER;
|
|
|
- p^.methodpointer^.location.register:=R_A5;
|
|
|
- { make a reference }
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.offset:=p^.symtable^.datasize;
|
|
|
- r^.base:=procinfo.framepointer;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
|
|
|
- end;
|
|
|
-
|
|
|
- { push self }
|
|
|
- if assigned(p^.symtable) and
|
|
|
- ((p^.symtable^.symtabletype=objectsymtable) or
|
|
|
- (p^.symtable^.symtabletype=withsymtable)) then
|
|
|
- begin
|
|
|
- if assigned(p^.methodpointer) then
|
|
|
- begin
|
|
|
- case p^.methodpointer^.treetype of
|
|
|
- typen : begin
|
|
|
- { direct call to inherited method }
|
|
|
- if (p^.procdefinition^.options and poabstractmethod)<>0 then
|
|
|
- begin
|
|
|
- Message(cg_e_cant_call_abstract_method);
|
|
|
- goto dont_call;
|
|
|
- end;
|
|
|
- { generate no virtual call }
|
|
|
- no_virtual_call:=true;
|
|
|
- if (p^.symtableprocentry^.properties and sp_static)<>0 then
|
|
|
- begin
|
|
|
- { well lets put the VMT address directly into a5 }
|
|
|
- { it is kind of dirty but that is the simplest }
|
|
|
- { way to accept virtual static functions (PM) }
|
|
|
- loada5:=true;
|
|
|
- exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,S_L,
|
|
|
- newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0),R_A5)));
|
|
|
- concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
|
|
|
- end
|
|
|
- else
|
|
|
-
|
|
|
- { this is a member call, so A5 isn't modfied }
|
|
|
- loada5:=false;
|
|
|
-
|
|
|
- if not(is_con_or_destructor and
|
|
|
- pobjectdef(p^.methodpointer^.resulttype)^.isclass and
|
|
|
- assigned(aktprocsym) and
|
|
|
- ((aktprocsym^.definition^.options and
|
|
|
- (poconstructor or podestructor))<>0)) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
|
|
|
- { if an inherited con- or destructor should be }
|
|
|
- { called in a con- or destructor then a warning }
|
|
|
- { will be made }
|
|
|
- { con- and destructors need a pointer to the vmt }
|
|
|
- if is_con_or_destructor and
|
|
|
- ((pobjectdef(p^.methodpointer^.resulttype)^.options and oois_class)=0) and
|
|
|
- assigned(aktprocsym) then
|
|
|
- begin
|
|
|
- if not ((aktprocsym^.definition^.options
|
|
|
- and (poconstructor or podestructor))<>0) then
|
|
|
- Message(cg_w_member_cd_call_from_method);
|
|
|
- end;
|
|
|
- { con- and destructors need a pointer to the vmt }
|
|
|
- if is_con_or_destructor then
|
|
|
- begin
|
|
|
- { classes need the mem ! }
|
|
|
- if ((pobjectdef(p^.methodpointer^.resulttype)^.options and
|
|
|
-
|
|
|
- oois_class)=0) then
|
|
|
- push_int(0)
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,
|
|
|
- S_L,newcsymbol(pobjectdef(p^.methodpointer^.
|
|
|
- resulttype)^.vmt_mangledname,0))));
|
|
|
- concat_external(pobjectdef(p^.methodpointer^.resulttype)^.
|
|
|
- vmt_mangledname,EXT_NEAR);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- hnewn : begin
|
|
|
- { extended syntax of new }
|
|
|
- { A5 must be zero }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,0,R_A5)));
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_A5, R_SPPUSH);
|
|
|
- { insert the vmt }
|
|
|
- exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
|
|
|
- newcsymbol(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
|
|
|
- concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
|
|
|
- extended_new:=true;
|
|
|
- end;
|
|
|
- hdisposen : begin
|
|
|
- secondpass(p^.methodpointer);
|
|
|
-
|
|
|
- { destructor with extended syntax called from dispose }
|
|
|
- { hdisposen always deliver LOC_REFRENZ }
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
|
|
|
- newreference(p^.methodpointer^.location.reference),R_A5)));
|
|
|
- del_reference(p^.methodpointer^.location.reference);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
|
|
|
- newcsymbol(pobjectdef
|
|
|
- (p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
|
|
|
- concat_external(pobjectdef(p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
|
|
|
- end;
|
|
|
- else
|
|
|
- begin
|
|
|
- { call to a instance member }
|
|
|
- if (p^.symtable^.symtabletype<>withsymtable) then
|
|
|
- begin
|
|
|
- secondpass(p^.methodpointer);
|
|
|
-
|
|
|
-
|
|
|
- case p^.methodpointer^.location.loc of
|
|
|
- LOC_REGISTER :
|
|
|
- begin
|
|
|
- ungetregister32(p^.methodpointer^.location.register);
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.methodpointer^.location.register,R_A5);
|
|
|
- end;
|
|
|
- else
|
|
|
- begin
|
|
|
- if (p^.methodpointer^.resulttype^.deftype=objectdef) and
|
|
|
- pobjectdef(p^.methodpointer^.resulttype)^.isclass then
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(p^.methodpointer^.location.reference),R_A5)))
|
|
|
- else
|
|
|
- Begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
|
|
|
- newreference(p^.methodpointer^.location.reference),R_A5)));
|
|
|
- end;
|
|
|
-
|
|
|
- del_reference(p^.methodpointer^.location.reference);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- { when calling a class method, we have
|
|
|
- to load ESI with the VMT !
|
|
|
- But that's wrong, if we call a class method via self
|
|
|
- }
|
|
|
- if ((p^.procdefinition^.options and poclassmethod)<>0)
|
|
|
- and not(p^.methodpointer^.treetype=selfn) then
|
|
|
- begin
|
|
|
- { class method needs current VMT }
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.base:=R_A5;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
|
|
|
- end;
|
|
|
-
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
|
|
|
- if is_con_or_destructor then
|
|
|
- begin
|
|
|
- { classes don't get a VMT pointer pushed }
|
|
|
- if (p^.methodpointer^.resulttype^.deftype=objectdef) and
|
|
|
- not(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
|
|
|
- begin
|
|
|
-
|
|
|
- if ((p^.procdefinition^.options and poconstructor)<>0) then
|
|
|
- begin
|
|
|
- { it's no bad idea, to insert the VMT }
|
|
|
- exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,
|
|
|
- newcsymbol(pobjectdef(
|
|
|
- p^.methodpointer^.resulttype)^.vmt_mangledname,0))));
|
|
|
- concat_external(pobjectdef(
|
|
|
- p^.methodpointer^.resulttype)^.vmt_mangledname,EXT_NEAR);
|
|
|
- end
|
|
|
- { destructors haven't to dispose the instance, if this is }
|
|
|
- { a direct call }
|
|
|
- else
|
|
|
- push_int(0);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if ((p^.procdefinition^.options and poclassmethod)<>0) and
|
|
|
- not(
|
|
|
- assigned(aktprocsym) and
|
|
|
- ((aktprocsym^.definition^.options and poclassmethod)<>0)
|
|
|
- ) then
|
|
|
- begin
|
|
|
- { class method needs current VMT }
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.base:=R_A5;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_A5)));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { member call, A5 isn't modified }
|
|
|
- loada5:=false;
|
|
|
- end;
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A5,R_SPPUSH)));
|
|
|
- { but a con- or destructor here would probably almost }
|
|
|
- { always be placed wrong }
|
|
|
- if is_con_or_destructor then
|
|
|
- begin
|
|
|
- Message(cg_w_member_cd_call_from_method);
|
|
|
- { not insert VMT pointer } { VMT-Zeiger nicht eintragen }
|
|
|
- push_int(0);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- { push base pointer ?}
|
|
|
- if (lexlevel>1) and assigned(pprocdef(p^.procdefinition)^.parast) and
|
|
|
- ((p^.procdefinition^.parast^.symtablelevel)>2) then
|
|
|
- begin
|
|
|
- { if we call a nested function in a method, we must }
|
|
|
- { push also SELF! }
|
|
|
- { THAT'S NOT TRUE, we have to load ESI via frame pointer }
|
|
|
- { access }
|
|
|
- {
|
|
|
- begin
|
|
|
- loadesi:=false;
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_PUSH,S_L,R_ESI)));
|
|
|
- end;
|
|
|
- }
|
|
|
- if lexlevel=(p^.procdefinition^.parast^.symtablelevel) then
|
|
|
- begin
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.offset:=procinfo.framepointer_offset;
|
|
|
- r^.base:=procinfo.framepointer;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_SPPUSH)))
|
|
|
- end
|
|
|
- { this is only true if the difference is one !!
|
|
|
- but it cannot be more !! }
|
|
|
- else if lexlevel=(p^.procdefinition^.parast^.symtablelevel)-1 then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,procinfo.framepointer,R_SPPUSH)))
|
|
|
- end
|
|
|
- else if lexlevel>(p^.procdefinition^.parast^.symtablelevel) then
|
|
|
- begin
|
|
|
- hregister:=getaddressreg;
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.offset:=procinfo.framepointer_offset;
|
|
|
- r^.base:=procinfo.framepointer;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,hregister)));
|
|
|
- for i:=(p^.procdefinition^.parast^.symtablelevel) to lexlevel-1 do
|
|
|
- begin
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- {we should get the correct frame_pointer_offset at each level
|
|
|
- how can we do this !!! }
|
|
|
- r^.offset:=procinfo.framepointer_offset;
|
|
|
- r^.base:=hregister;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,hregister)));
|
|
|
- end;
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,hregister,R_SPPUSH)));
|
|
|
- ungetregister32(hregister);
|
|
|
- end
|
|
|
- else
|
|
|
- internalerror(25000);
|
|
|
- end;
|
|
|
-
|
|
|
- { exported methods should be never called direct }
|
|
|
- if (p^.procdefinition^.options and poexports)<>0 then
|
|
|
- Message(cg_e_dont_call_exported_direct);
|
|
|
-
|
|
|
- if ((p^.procdefinition^.options and povirtualmethod)<>0) and
|
|
|
- not(no_virtual_call) then
|
|
|
- begin
|
|
|
- { static functions contain the vmt_address in ESI }
|
|
|
- { also class methods }
|
|
|
- if assigned(aktprocsym) then
|
|
|
- begin
|
|
|
- if ((aktprocsym^.properties and sp_static)<>0) or
|
|
|
- ((aktprocsym^.definition^.options and poclassmethod)<>0) or
|
|
|
- ((p^.procdefinition^.options and postaticmethod)<>0) or
|
|
|
- { A5 is already loaded }
|
|
|
- ((p^.procdefinition^.options and poclassmethod)<>0)then
|
|
|
- begin
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.base:=R_a5;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.base:=R_a5;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_a0)));
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.base:=R_a0;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.base:=R_a5;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,R_a0)));
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.base:=R_a0;
|
|
|
- end;
|
|
|
- if p^.procdefinition^.extnumber=-1 then
|
|
|
- internalerror($Da);
|
|
|
- r^.offset:=p^.procdefinition^.extnumber*4+12;
|
|
|
- if (cs_check_range in aktlocalswitches) then
|
|
|
- begin
|
|
|
- { If the base is already A0, the no instruction will }
|
|
|
- { be emitted! }
|
|
|
- emit_reg_reg(A_MOVE,S_L,r^.base,R_A0);
|
|
|
- emitcall('CHECK_OBJECT',true);
|
|
|
- end;
|
|
|
- { This was wrong we must then load the address into the }
|
|
|
- { register a0 and/or a5 }
|
|
|
- { Because doing an indirect call with offset is NOT }
|
|
|
- { allowed on the m68k! }
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(r^),R_A0)));
|
|
|
- { clear the reference }
|
|
|
- reset_reference(r^);
|
|
|
- r^.base := R_A0;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,r)));
|
|
|
- end
|
|
|
- else if (p^.procdefinition^.options and popalmossyscall)<>0 then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_const(A_TRAP,S_NO,15)));
|
|
|
- exprasmlist^.concat(new(pai_const,init_16bit(p^.procdefinition^.extnumber)));
|
|
|
- end
|
|
|
- else
|
|
|
- emitcall(p^.procdefinition^.mangledname,
|
|
|
- p^.symtableproc^.symtabletype=unitsymtable);
|
|
|
- if ((p^.procdefinition^.options and poclearstack)<>0) then
|
|
|
- begin
|
|
|
- if (pushedparasize > 0) and (pushedparasize < 9) then
|
|
|
- { restore the stack, to its initial value }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDQ,S_L,pushedparasize,R_SP)))
|
|
|
- else
|
|
|
- { restore the stack, to its initial value }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_ADDA,S_L,pushedparasize,R_SP)));
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- secondpass(p^.right);
|
|
|
- case p^.right^.location.loc of
|
|
|
- LOC_REGISTER,
|
|
|
- LOC_CREGISTER : begin
|
|
|
- if p^.right^.location.register in [R_D0..R_D7] then
|
|
|
- begin
|
|
|
- reg := getaddressreg;
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,reg);
|
|
|
- new(ref);
|
|
|
- reset_reference(ref^);
|
|
|
- ref^.base := reg;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,ref)));
|
|
|
- ungetregister(reg);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- new(ref);
|
|
|
- reset_reference(ref^);
|
|
|
- ref^.base := p^.right^.location.register;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,ref)));
|
|
|
- end;
|
|
|
- ungetregister32(p^.right^.location.register);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if assigned(p^.right^.location.reference.symbol) then
|
|
|
- { Here we have a symbolic name to the routine, so solve }
|
|
|
- { problem by loading the address first, and then emitting }
|
|
|
- { the call. }
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(p^.right^.location.reference),R_A1)));
|
|
|
- new(ref);
|
|
|
- reset_reference(ref^);
|
|
|
- ref^.base := R_A1;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,newreference(ref^))));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(p^.right^.location.reference),R_A1)));
|
|
|
- new(ref);
|
|
|
- reset_reference(ref^);
|
|
|
- ref^.base := R_A1;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref(A_JSR,S_NO,newreference(ref^))));
|
|
|
- end;
|
|
|
- del_reference(p^.right^.location.reference);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- dont_call:
|
|
|
- pushedparasize:=oldpushedparasize;
|
|
|
- unused:=unusedregisters;
|
|
|
-
|
|
|
- { handle function results }
|
|
|
- if p^.resulttype<>pdef(voiddef) then
|
|
|
- begin
|
|
|
-
|
|
|
- { a contructor could be a function with boolean result }
|
|
|
- if (p^.right=nil) and
|
|
|
- ((p^.procdefinition^.options and poconstructor)<>0) and
|
|
|
- { quick'n'dirty check if it is a class or an object }
|
|
|
- (p^.resulttype^.deftype=orddef) then
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_FLAGS;
|
|
|
- p^.location.resflags:=F_NE;
|
|
|
- if extended_new then
|
|
|
- begin
|
|
|
-{$ifdef test_dest_loc}
|
|
|
- if dest_loc_known and (dest_loc_tree=p) then
|
|
|
- mov_reg_to_dest(p,S_L,R_EAX)
|
|
|
- else
|
|
|
-{$endif test_dest_loc}
|
|
|
- hregister:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
|
|
|
- p^.location.register:=hregister;
|
|
|
- end;
|
|
|
- end
|
|
|
- { structed results are easy to handle.... }
|
|
|
- else if ret_in_param(p^.resulttype) then
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_MEM;
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- p^.location.reference:=funcretref;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if (p^.resulttype^.deftype=orddef) then
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- case porddef(p^.resulttype)^.typ of
|
|
|
- s32bit,u32bit :
|
|
|
- begin
|
|
|
- hregister:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
|
|
|
- p^.location.register:=hregister;
|
|
|
- end;
|
|
|
- uchar,u8bit,bool8bit,s8bit :
|
|
|
- begin
|
|
|
- hregister:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_B,R_D0,hregister);
|
|
|
- p^.location.register:=hregister;
|
|
|
- end;
|
|
|
- s16bit,u16bit :
|
|
|
- begin
|
|
|
- hregister:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
|
|
|
- p^.location.register:=hregister;
|
|
|
- end;
|
|
|
- else internalerror(7);
|
|
|
- end
|
|
|
- end
|
|
|
- else if (p^.resulttype^.deftype=floatdef) then
|
|
|
- case pfloatdef(p^.resulttype)^.typ of
|
|
|
- f32bit :
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- hregister:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
|
|
|
- p^.location.register:=hregister;
|
|
|
- end;
|
|
|
- s32real : Begin
|
|
|
- p^.location.loc:=LOC_FPU;
|
|
|
- hregister:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
|
|
|
- p^.location.fpureg:=hregister;
|
|
|
- end;
|
|
|
- s64bit,s64real,s80real: begin
|
|
|
- if cs_fp_emulation in aktmoduleswitches then
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_FPU;
|
|
|
- hregister:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
|
|
|
- p^.location.fpureg:=hregister;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { TRUE FPU mode }
|
|
|
- p^.location.loc:=LOC_FPU;
|
|
|
- { on exit of function result in R_FP0 }
|
|
|
- p^.location.fpureg:=R_FP0;
|
|
|
- end;
|
|
|
- end;
|
|
|
- else
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_FPU;
|
|
|
- p^.location.fpureg:=R_FP0;
|
|
|
- end;
|
|
|
- end {end case }
|
|
|
- else
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- hregister:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
|
|
|
- p^.location.register:=hregister;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- { perhaps i/o check ? }
|
|
|
- if iolabel<>nil then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0))));
|
|
|
- { this was wrong, probably an error due to diff3
|
|
|
- emitcall(p^.procdefinition^.mangledname);}
|
|
|
- emitcall('IOCHECK',true);
|
|
|
- end;
|
|
|
-
|
|
|
- { restore registers }
|
|
|
- popusedregisters(pushed);
|
|
|
-
|
|
|
- { at last, restore instance pointer (SELF) }
|
|
|
- if loada5 then
|
|
|
- maybe_loada5;
|
|
|
- pp:=params;
|
|
|
- while assigned(pp) do
|
|
|
- begin
|
|
|
- if assigned(pp^.left) then
|
|
|
- if (pp^.left^.location.loc=LOC_REFERENCE) or
|
|
|
- (pp^.left^.location.loc=LOC_MEM) then
|
|
|
- ungetiftemp(pp^.left^.location.reference);
|
|
|
- pp:=pp^.right;
|
|
|
- end;
|
|
|
- disposetree(params);
|
|
|
- end;
|
|
|
-
|
|
|
- { reverts the parameter list }
|
|
|
- var nb_para : integer;
|
|
|
-
|
|
|
- function reversparameter(p : ptree) : ptree;
|
|
|
-
|
|
|
- var
|
|
|
- hp1,hp2 : ptree;
|
|
|
-
|
|
|
- begin
|
|
|
- hp1:=nil;
|
|
|
- nb_para := 0;
|
|
|
- while assigned(p) do
|
|
|
- begin
|
|
|
- { pull out }
|
|
|
- hp2:=p;
|
|
|
- p:=p^.right;
|
|
|
- inc(nb_para);
|
|
|
- { pull in }
|
|
|
- hp2^.right:=hp1;
|
|
|
- hp1:=hp2;
|
|
|
- end;
|
|
|
- reversparameter:=hp1;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure secondloadvmt(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,
|
|
|
- S_L,newcsymbol(pobjectdef(pclassrefdef(p^.resulttype)^.definition)^.vmt_mangledname,0),
|
|
|
- p^.location.register)));
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure secondinline(var p : ptree);
|
|
|
- const
|
|
|
-{$ifdef OLDINC}
|
|
|
-
|
|
|
- in2size:array[in_inc_byte..in_dec_dword] of Topsize=
|
|
|
- (S_B,S_W,S_L,S_B,S_W,S_L);
|
|
|
- in2instr:array[in_inc_byte..in_dec_dword] of Tasmop=
|
|
|
- (A_ADDQ,A_ADDQ,A_ADDQ,A_SUBQ,A_SUBQ,A_SUBQ);
|
|
|
-{$endif}
|
|
|
-
|
|
|
- { tfloattype = (f32bit,s32real,s64real,s80real,s64bit); }
|
|
|
- float_name: array[tfloattype] of string[8]=
|
|
|
- { ('FIXED','SINGLE','REAL','EXTENDED','COMP','FIXED'); }
|
|
|
- { Since we only support the REAL (SINGLE IEEE) FLOAT }
|
|
|
- { type, here is what we do... }
|
|
|
- ('FIXED','REAL','REAL','REAL','COMP','FIXED');
|
|
|
- addsubop:array[in_inc_x..in_dec_x] of tasmop=(A_ADDQ,A_SUBQ);
|
|
|
- var
|
|
|
- opsize: topsize;
|
|
|
- asmop: tasmop;
|
|
|
-
|
|
|
- aktfile : treference;
|
|
|
- ft : tfiletype;
|
|
|
- pushed : tpushed;
|
|
|
- dummycoll : tdefcoll;
|
|
|
-
|
|
|
- procedure handlereadwrite(doread,doln : boolean);
|
|
|
- { produces code for READ(LN) and WRITE(LN) }
|
|
|
-
|
|
|
- procedure loadstream;
|
|
|
-
|
|
|
- const io:array[0..1] of string[7]=('_OUTPUT','_INPUT');
|
|
|
- var r : preference;
|
|
|
-
|
|
|
- begin
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.symbol:=stringdup('U_'+upper(target_info.system_unit)+io[byte(doread)]);
|
|
|
- if not (cs_compilesystem in aktmoduleswitches) then
|
|
|
- concat_external(r^.symbol^,EXT_NEAR);
|
|
|
-
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,r,R_A0)))
|
|
|
- end;
|
|
|
-
|
|
|
- var
|
|
|
- node,hp : ptree;
|
|
|
- typedtyp,pararesult : pdef;
|
|
|
- has_length : boolean;
|
|
|
- dummycoll : tdefcoll;
|
|
|
- iolabel : plabel;
|
|
|
- npara : longint;
|
|
|
-
|
|
|
- begin
|
|
|
- { I/O check }
|
|
|
- if cs_check_io in aktlocalswitches then
|
|
|
- begin
|
|
|
- getlabel(iolabel);
|
|
|
- emitl(A_LABEL,iolabel);
|
|
|
- end
|
|
|
- else iolabel:=nil;
|
|
|
- { for write of real with the length specified }
|
|
|
- has_length:=false;
|
|
|
- hp:=nil;
|
|
|
- { reserve temporary pointer to data variable }
|
|
|
- aktfile.symbol:=nil;
|
|
|
- gettempofsizereference(4,aktfile);
|
|
|
- { first state text data }
|
|
|
- ft:=ft_text;
|
|
|
- { and state a parameter ? }
|
|
|
- if p^.left=nil then
|
|
|
- begin
|
|
|
- { the following instructions are for "writeln;" }
|
|
|
- loadstream;
|
|
|
- { save @Dateivarible in temporary variable }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A0,newreference(aktfile))));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { revers paramters }
|
|
|
- node:=reversparameter(p^.left);
|
|
|
-
|
|
|
- p^.left := node;
|
|
|
- npara := nb_para;
|
|
|
- { calculate data variable }
|
|
|
- { is first parameter a file type ? }
|
|
|
- if node^.left^.resulttype^.deftype=filedef then
|
|
|
- begin
|
|
|
- ft:=pfiledef(node^.left^.resulttype)^.filetype;
|
|
|
- if ft=ft_typed then
|
|
|
- typedtyp:=pfiledef(node^.left^.resulttype)^.typed_as;
|
|
|
-
|
|
|
- secondpass(node^.left);
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
-
|
|
|
- { save reference in temporary variables } { reference in tempor„re Variable retten }
|
|
|
- if node^.left^.location.loc<>LOC_REFERENCE then
|
|
|
- begin
|
|
|
- Message(cg_e_illegal_expression);
|
|
|
- exit;
|
|
|
- end;
|
|
|
-
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(node^.left^.location.reference),R_A0)));
|
|
|
-
|
|
|
- { skip to the next parameter }
|
|
|
- node:=node^.right;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { load stdin/stdout stream }
|
|
|
- loadstream;
|
|
|
- end;
|
|
|
-
|
|
|
- { save @Dateivarible in temporary variable }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A0,newreference(aktfile))));
|
|
|
- if doread then
|
|
|
- { parameter by READ gives call by reference }
|
|
|
- dummycoll.paratyp:=vs_var
|
|
|
- else
|
|
|
- { an WRITE Call by "Const" }
|
|
|
- dummycoll.paratyp:=vs_const;
|
|
|
-
|
|
|
- { because of secondcallparan, which otherwise attaches }
|
|
|
- if ft=ft_typed then
|
|
|
- begin
|
|
|
- { this is to avoid copy of simple const parameters }
|
|
|
- dummycoll.data:=new(pformaldef,init);
|
|
|
- { use var for write also }
|
|
|
- { avoids problems with const passed by value }
|
|
|
- { but will not accept untyped const }
|
|
|
- { dummycoll.paratyp:=vs_var; }
|
|
|
- end
|
|
|
- else
|
|
|
- { I think, this isn't a good solution (FK) }
|
|
|
- dummycoll.data:=nil;
|
|
|
-
|
|
|
- while assigned(node) do
|
|
|
- begin
|
|
|
- pushusedregisters(pushed,$ffff);
|
|
|
- hp:=node;
|
|
|
- node:=node^.right;
|
|
|
- hp^.right:=nil;
|
|
|
- if hp^.is_colon_para then
|
|
|
- Message(parser_e_illegal_colon_qualifier);
|
|
|
- if hp^.is_colon_para then
|
|
|
- Message(parser_e_illegal_colon_qualifier);
|
|
|
- if ft=ft_typed then
|
|
|
- never_copy_const_param:=true;
|
|
|
- secondcallparan(hp,@dummycoll,false);
|
|
|
- if ft=ft_typed then
|
|
|
- never_copy_const_param:=false;
|
|
|
- hp^.right:=node;
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
-
|
|
|
- emit_push_mem(aktfile);
|
|
|
- if (ft=ft_typed) then
|
|
|
- begin
|
|
|
- { OK let's try this }
|
|
|
- { first we must only allow the right type }
|
|
|
- { we have to call blockread or blockwrite }
|
|
|
- { but the real problem is that }
|
|
|
- { reset and rewrite should have set }
|
|
|
- { the type size }
|
|
|
- { as recordsize for that file !!!! }
|
|
|
- { how can we make that }
|
|
|
- { I think that is only possible by adding }
|
|
|
- { reset and rewrite to the inline list a call }
|
|
|
- { allways read only one record by element }
|
|
|
- push_int(typedtyp^.size);
|
|
|
- if doread then
|
|
|
- emitcall('TYPED_READ',true)
|
|
|
- else
|
|
|
- emitcall('TYPED_WRITE',true)
|
|
|
- {!!!!!!!}
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { save current position }
|
|
|
- pararesult:=hp^.left^.resulttype;
|
|
|
- { handle possible field width }
|
|
|
- { of course only for write(ln) }
|
|
|
- if not doread then
|
|
|
- begin
|
|
|
- { handle total width parameter }
|
|
|
- if assigned(node) and node^.is_colon_para then
|
|
|
- begin
|
|
|
- hp:=node;
|
|
|
- node:=node^.right;
|
|
|
- hp^.right:=nil;
|
|
|
- secondcallparan(hp,@dummycoll,false);
|
|
|
- hp^.right:=node;
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
- has_length:=true;
|
|
|
- end
|
|
|
- else
|
|
|
- if pararesult^.deftype<>floatdef then
|
|
|
- push_int(0)
|
|
|
- else
|
|
|
- push_int(-32767);
|
|
|
- { a second colon para for a float ? }
|
|
|
- if assigned(node) and node^.is_colon_para then
|
|
|
- begin
|
|
|
- hp:=node;
|
|
|
- node:=node^.right;
|
|
|
- hp^.right:=nil;
|
|
|
- secondcallparan(hp,@dummycoll,false);
|
|
|
- hp^.right:=node;
|
|
|
- if pararesult^.deftype<>floatdef then
|
|
|
- Message(parser_e_illegal_colon_qualifier);
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if hp^.left^.resulttype^.deftype=floatdef then
|
|
|
- push_int(-1);
|
|
|
- end;
|
|
|
- end;
|
|
|
- case pararesult^.deftype of
|
|
|
- stringdef : begin
|
|
|
- if doread then
|
|
|
- begin
|
|
|
- { push maximum string length }
|
|
|
- push_int(pstringdef(pararesult)^.len);
|
|
|
- case pstringdef(pararesult)^.string_typ of
|
|
|
- st_shortstring: emitcall ('READ_TEXT_STRING',true);
|
|
|
- st_ansistring : emitcall ('READ_TEXT_ANSISTRING',true);
|
|
|
- st_longstring : emitcall ('READ_TEXT_LONGSTRING',true);
|
|
|
- st_widestring : emitcall ('READ_TEXT_ANSISTRING',true);
|
|
|
- end
|
|
|
- end
|
|
|
- else
|
|
|
- Case pstringdef(Pararesult)^.string_typ of
|
|
|
- st_shortstring: emitcall ('WRITE_TEXT_STRING',true);
|
|
|
- st_ansistring : emitcall ('WRITE_TEXT_ANSISTRING',true);
|
|
|
- st_longstring : emitcall ('WRITE_TEXT_LONGSTRING',true);
|
|
|
- st_widestring : emitcall ('WRITE_TEXT_ANSISTRING',true);
|
|
|
- end;
|
|
|
- end;
|
|
|
- pointerdef : begin
|
|
|
- if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
|
|
|
- begin
|
|
|
- if doread then
|
|
|
- emitcall('READ_TEXT_PCHAR_AS_POINTER',true)
|
|
|
- else
|
|
|
- emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true);
|
|
|
- end
|
|
|
- else
|
|
|
- Message(parser_e_illegal_parameter_list);
|
|
|
- end;
|
|
|
- arraydef : begin
|
|
|
- if (parraydef(pararesult)^.lowrange=0) and
|
|
|
- is_equal(parraydef(pararesult)^.definition,cchardef) then
|
|
|
- begin
|
|
|
- if doread then
|
|
|
- emitcall('READ_TEXT_PCHAR_AS_ARRAY',true)
|
|
|
- else
|
|
|
- emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true);
|
|
|
- end
|
|
|
- else
|
|
|
- Message(parser_e_illegal_parameter_list);
|
|
|
- end;
|
|
|
- floatdef : begin
|
|
|
- if doread then
|
|
|
- emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
|
|
|
- else
|
|
|
- emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
|
|
|
- end;
|
|
|
- orddef : begin
|
|
|
- case porddef(pararesult)^.typ of
|
|
|
- u8bit : if doread then
|
|
|
- emitcall('READ_TEXT_BYTE',true);
|
|
|
- s8bit : if doread then
|
|
|
- emitcall('READ_TEXT_SHORTINT',true);
|
|
|
- u16bit : if doread then
|
|
|
- emitcall('READ_TEXT_WORD',true);
|
|
|
- s16bit : if doread then
|
|
|
- emitcall('READ_TEXT_INTEGER',true);
|
|
|
- s32bit : if doread then
|
|
|
- emitcall('READ_TEXT_LONGINT',true)
|
|
|
- else
|
|
|
- emitcall('WRITE_TEXT_LONGINT',true);
|
|
|
- u32bit : if doread then
|
|
|
- emitcall('READ_TEXT_CARDINAL',true)
|
|
|
- else
|
|
|
- emitcall('WRITE_TEXT_CARDINAL',true);
|
|
|
- uchar : if doread then
|
|
|
- emitcall('READ_TEXT_CHAR',true)
|
|
|
- else
|
|
|
- emitcall('WRITE_TEXT_CHAR',true);
|
|
|
- bool8bit,
|
|
|
- bool16bit,
|
|
|
- bool32bit : if doread then
|
|
|
- { emitcall('READ_TEXT_BOOLEAN',true) }
|
|
|
- Message(parser_e_illegal_parameter_list)
|
|
|
- else
|
|
|
- emitcall('WRITE_TEXT_BOOLEAN',true);
|
|
|
- else
|
|
|
- Message(parser_e_illegal_parameter_list);
|
|
|
- end;
|
|
|
- end;
|
|
|
- else
|
|
|
- Message(parser_e_illegal_parameter_list);
|
|
|
- end;
|
|
|
- end;
|
|
|
- { load A5 in methods again }
|
|
|
- popusedregisters(pushed);
|
|
|
- maybe_loada5;
|
|
|
- end;
|
|
|
- end;
|
|
|
- { Insert end of writing for textfiles }
|
|
|
- if ft=ft_text then
|
|
|
- begin
|
|
|
- pushusedregisters(pushed,$ffff);
|
|
|
- emit_push_mem(aktfile);
|
|
|
- if doread then
|
|
|
- begin
|
|
|
- if doln then
|
|
|
- emitcall('READLN_END',true)
|
|
|
- else
|
|
|
- emitcall('READ_END',true);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if doln then
|
|
|
- emitcall('WRITELN_END',true)
|
|
|
- else
|
|
|
- emitcall('WRITE_END',true);
|
|
|
- end;
|
|
|
- popusedregisters(pushed);
|
|
|
- maybe_loada5;
|
|
|
- end;
|
|
|
- { Insert IOCheck if set }
|
|
|
- if iolabel<>nil then
|
|
|
- begin
|
|
|
- { registers are saved in the procedure }
|
|
|
- exprasmlist^.concat(new(pai68k,op_csymbol(A_PEA,S_L,newcsymbol(lab2str(iolabel),0))));
|
|
|
- emitcall('IOCHECK',true);
|
|
|
- end;
|
|
|
- { Freeup all used temps }
|
|
|
- ungetiftemp(aktfile);
|
|
|
- if assigned(p^.left) then
|
|
|
- begin
|
|
|
- p^.left:=reversparameter(p^.left);
|
|
|
- if npara<>nb_para then
|
|
|
- Message(cg_f_internal_error_in_secondinline);
|
|
|
- hp:=p^.left;
|
|
|
- while assigned(hp) do
|
|
|
- begin
|
|
|
- if assigned(hp^.left) then
|
|
|
- if (hp^.left^.location.loc=LOC_REFERENCE) or
|
|
|
- (hp^.left^.location.loc=LOC_MEM) then
|
|
|
- ungetiftemp(hp^.left^.location.reference);
|
|
|
- hp:=hp^.right;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure handle_str;
|
|
|
-
|
|
|
- var
|
|
|
- hp,node,lentree,paratree : ptree;
|
|
|
- dummycoll : tdefcoll;
|
|
|
- is_real,has_length : boolean;
|
|
|
- real_type : byte;
|
|
|
-
|
|
|
- begin
|
|
|
- pushusedregisters(pushed,$ffff);
|
|
|
- node:=p^.left;
|
|
|
- is_real:=false;
|
|
|
- has_length:=false;
|
|
|
- while assigned(node^.right) do node:=node^.right;
|
|
|
- { if a real parameter somewhere then call REALSTR }
|
|
|
- if (node^.left^.resulttype^.deftype=floatdef) then
|
|
|
- is_real:=true;
|
|
|
-
|
|
|
- node:=p^.left;
|
|
|
- { we have at least two args }
|
|
|
- { with at max 2 colon_para in between }
|
|
|
-
|
|
|
- { first arg longint or float }
|
|
|
- hp:=node;
|
|
|
- node:=node^.right;
|
|
|
- hp^.right:=nil;
|
|
|
- dummycoll.data:=hp^.resulttype;
|
|
|
- { string arg }
|
|
|
-
|
|
|
- dummycoll.paratyp:=vs_var;
|
|
|
- secondcallparan(hp,@dummycoll,false);
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
-
|
|
|
- dummycoll.paratyp:=vs_const;
|
|
|
- { second arg }
|
|
|
- hp:=node;
|
|
|
- node:=node^.right;
|
|
|
- hp^.right:=nil;
|
|
|
- { frac para }
|
|
|
- if hp^.is_colon_para and assigned(node) and
|
|
|
- node^.is_colon_para then
|
|
|
- begin
|
|
|
- dummycoll.data:=hp^.resulttype;
|
|
|
- secondcallparan(hp,@dummycoll,false);
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
- hp:=node;
|
|
|
- node:=node^.right;
|
|
|
- hp^.right:=nil;
|
|
|
- has_length:=true;
|
|
|
- end
|
|
|
- else
|
|
|
- if is_real then
|
|
|
- push_int(-1);
|
|
|
-
|
|
|
- { third arg, length only if is_real }
|
|
|
- if hp^.is_colon_para then
|
|
|
- begin
|
|
|
- dummycoll.data:=hp^.resulttype;
|
|
|
- secondcallparan(hp,@dummycoll,false);
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
- hp:=node;
|
|
|
- node:=node^.right;
|
|
|
- hp^.right:=nil;
|
|
|
- end
|
|
|
- else
|
|
|
- if is_real then
|
|
|
- push_int(-32767)
|
|
|
- else
|
|
|
- push_int(-1);
|
|
|
-
|
|
|
- { last arg longint or real }
|
|
|
- secondcallparan(hp,@dummycoll,false);
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
-
|
|
|
- if is_real then
|
|
|
- emitcall('STR_'+float_name[pfloatdef(hp^.resulttype)^.typ],true)
|
|
|
- else if porddef(hp^.resulttype)^.typ=u32bit then
|
|
|
- emitcall('STR_CARDINAL',true)
|
|
|
- else
|
|
|
- emitcall('STR_LONGINT',true);
|
|
|
- popusedregisters(pushed);
|
|
|
- end;
|
|
|
-
|
|
|
- var
|
|
|
- r : preference;
|
|
|
- {inc/dec}
|
|
|
- addconstant : boolean;
|
|
|
- addvalue : longint;
|
|
|
- hregister : tregister;
|
|
|
-
|
|
|
- begin
|
|
|
- case p^.inlinenumber of
|
|
|
- in_lo_word,
|
|
|
- in_hi_word : begin
|
|
|
- secondpass(p^.left);
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- if p^.left^.location.loc<>LOC_REGISTER then
|
|
|
- begin
|
|
|
- if p^.left^.location.loc=LOC_CREGISTER then
|
|
|
- begin
|
|
|
- p^.location.register:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_W,p^.left^.location.register,
|
|
|
- p^.location.register);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- p^.location.register:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
|
|
|
- newreference(p^.left^.location.reference),
|
|
|
- p^.location.register)));
|
|
|
- end;
|
|
|
- end
|
|
|
- else p^.location.register:=p^.left^.location.register;
|
|
|
- if p^.inlinenumber=in_hi_word then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_LSR,S_W,8,p^.location.register)));
|
|
|
- p^.location.register:=p^.location.register;
|
|
|
- end;
|
|
|
- in_high_x :
|
|
|
- begin
|
|
|
- if is_open_array(p^.left^.resulttype) then
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- p^.location.register:=getregister32;
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- r^.base:=highframepointer;
|
|
|
- r^.offset:=highoffset+4;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- r,p^.location.register)));
|
|
|
- end
|
|
|
- end;
|
|
|
- in_sizeof_x,
|
|
|
- in_typeof_x:
|
|
|
- begin
|
|
|
- { load vmt }
|
|
|
- if p^.left^.treetype=typen then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_LEA,
|
|
|
- S_L,newcsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,0),
|
|
|
- R_A0)));
|
|
|
- p^.location.register:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,R_A0,p^.location.register);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- p^.location.register:=getregister32;
|
|
|
- { load VMT pointer }
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(p^.left^.location.reference),
|
|
|
- p^.location.register)));
|
|
|
- end;
|
|
|
-
|
|
|
- { in sizeof load size }
|
|
|
- if p^.inlinenumber=in_sizeof_x then
|
|
|
- begin
|
|
|
- new(r);
|
|
|
- reset_reference(r^);
|
|
|
- { load the address in A0 }
|
|
|
- { because now supposedly p^.location.register is an }
|
|
|
- { address. }
|
|
|
- emit_reg_reg(A_MOVE, S_L, p^.location.register, R_A0);
|
|
|
- r^.base:=R_A0;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,
|
|
|
- p^.location.register)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- in_lo_long,
|
|
|
- in_hi_long : begin
|
|
|
- secondpass(p^.left);
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- if p^.left^.location.loc<>LOC_REGISTER then
|
|
|
- begin
|
|
|
- if p^.left^.location.loc=LOC_CREGISTER then
|
|
|
- begin
|
|
|
- p^.location.register:=getregister32;
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,
|
|
|
- p^.location.register);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- p^.location.register:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(p^.left^.location.reference),
|
|
|
- p^.location.register)));
|
|
|
- end;
|
|
|
- end
|
|
|
- else p^.location.register:=p^.left^.location.register;
|
|
|
- if p^.inlinenumber=in_hi_long then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVEQ, S_L, 16, R_D1)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_LSR,S_L,R_D1,p^.location.register)));
|
|
|
- end;
|
|
|
- p^.location.register:=p^.location.register;
|
|
|
- end;
|
|
|
- in_length_string :
|
|
|
-
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- set_location(p^.location,p^.left^.location);
|
|
|
- end;
|
|
|
- in_dec_x,
|
|
|
- in_inc_x :
|
|
|
- begin
|
|
|
- { set defaults }
|
|
|
- addvalue:=1;
|
|
|
- addconstant:=true;
|
|
|
- { load first parameter, must be a reference }
|
|
|
- secondpass(p^.left^.left);
|
|
|
- case p^.left^.left^.resulttype^.deftype of
|
|
|
- orddef,
|
|
|
- enumdef : begin
|
|
|
- case p^.left^.left^.resulttype^.size of
|
|
|
- 1 : opsize:=S_B;
|
|
|
- 2 : opsize:=S_W;
|
|
|
- 4 : opsize:=S_L;
|
|
|
- end;
|
|
|
- end;
|
|
|
- pointerdef : begin
|
|
|
- opsize:=S_L;
|
|
|
- addvalue:=ppointerdef(p^.left^.left^.resulttype)^.definition^.savesize;
|
|
|
- end;
|
|
|
- else
|
|
|
- internalerror(10081);
|
|
|
- end;
|
|
|
- { second argument specified?, must be a s32bit in register }
|
|
|
- if assigned(p^.left^.right) then
|
|
|
- begin
|
|
|
- secondpass(p^.left^.right^.left);
|
|
|
- { when constant, just multiply the addvalue }
|
|
|
- if is_constintnode(p^.left^.right^.left) then
|
|
|
- addvalue:=addvalue*get_ordinal_value(p^.left^.right^.left)
|
|
|
- else
|
|
|
- begin
|
|
|
- case p^.left^.right^.left^.location.loc of
|
|
|
- LOC_REGISTER,
|
|
|
- LOC_CREGISTER : hregister:=p^.left^.right^.left^.location.register;
|
|
|
- LOC_MEM,
|
|
|
- LOC_REFERENCE : begin
|
|
|
- hregister:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(p^.left^.right^.left^.location.reference),hregister)));
|
|
|
- end;
|
|
|
- else
|
|
|
- internalerror(10082);
|
|
|
- end;
|
|
|
- { insert multiply with addvalue if its >1 }
|
|
|
- if addvalue>1 then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MULS,opsize,
|
|
|
- addvalue,hregister)));
|
|
|
- addconstant:=false;
|
|
|
- end;
|
|
|
- end;
|
|
|
- { write the add instruction }
|
|
|
- if addconstant then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_ref(addsubop[p^.inlinenumber],opsize,
|
|
|
- addvalue,newreference(p^.left^.left^.location.reference))));
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_ref(addsubop[p^.inlinenumber],opsize,
|
|
|
- hregister,newreference(p^.left^.left^.location.reference))));
|
|
|
- ungetregister32(hregister);
|
|
|
- end;
|
|
|
- emitoverflowcheck(p^.left^.left);
|
|
|
- end;
|
|
|
-{$ifdef OLDINC}
|
|
|
-
|
|
|
- in_inc_byte..in_dec_dword:
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_ref(in2instr[p^.inlinenumber],
|
|
|
- in2size[p^.inlinenumber],1,newreference(p^.left^.location.reference))));
|
|
|
- emitoverflowcheck(p^.left);
|
|
|
- end;
|
|
|
-{$endif}
|
|
|
- in_pred_x,
|
|
|
- in_succ_x:
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- if p^.inlinenumber=in_pred_x then
|
|
|
- asmop:=A_SUB
|
|
|
- else
|
|
|
- asmop:=A_ADD;
|
|
|
- case p^.resulttype^.size of
|
|
|
- 4 : opsize:=S_L;
|
|
|
- 2 : opsize:=S_W;
|
|
|
- 1 : opsize:=S_B;
|
|
|
- else
|
|
|
- internalerror(10080);
|
|
|
- end;
|
|
|
- p^.location.loc:=LOC_REGISTER;
|
|
|
- if p^.left^.location.loc<>LOC_REGISTER then
|
|
|
- begin
|
|
|
- p^.location.register:=getregister32;
|
|
|
- if p^.left^.location.loc=LOC_CREGISTER then
|
|
|
- emit_reg_reg(A_MOVE,opsize,p^.left^.location.register,
|
|
|
- p^.location.register)
|
|
|
- else
|
|
|
- if p^.left^.location.loc=LOC_FLAGS then
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.left^.location.resflags],S_NO,
|
|
|
- p^.location.register)))
|
|
|
- else
|
|
|
- begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(p^.left^.location.reference),
|
|
|
- p^.location.register)));
|
|
|
- end;
|
|
|
- end
|
|
|
- else p^.location.register:=p^.left^.location.register;
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(asmop,opsize,1,
|
|
|
- p^.location.register)))
|
|
|
- { here we should insert bounds check ? }
|
|
|
- { and direct call to bounds will crash the program }
|
|
|
- { if we are at the limit }
|
|
|
- { we could also simply say that pred(first)=first and succ(last)=last }
|
|
|
- { could this be usefull I don't think so (PM)
|
|
|
- emitoverflowcheck;}
|
|
|
- end;
|
|
|
-
|
|
|
- in_assigned_x:
|
|
|
- begin
|
|
|
- secondpass(p^.left^.left);
|
|
|
- p^.location.loc:=LOC_FLAGS;
|
|
|
- if (p^.left^.left^.location.loc=LOC_REGISTER) or
|
|
|
- (p^.left^.left^.location.loc=LOC_CREGISTER) then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_L,
|
|
|
- p^.left^.left^.location.register)));
|
|
|
- ungetregister32(p^.left^.left^.location.register);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref(A_TST,S_L,
|
|
|
- newreference(p^.left^.left^.location.reference))));
|
|
|
- del_reference(p^.left^.left^.location.reference);
|
|
|
- end;
|
|
|
- p^.location.resflags:=F_NE;
|
|
|
- end;
|
|
|
- in_reset_typedfile,in_rewrite_typedfile :
|
|
|
- begin
|
|
|
- pushusedregisters(pushed,$ffff);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,
|
|
|
- pfiledef(p^.left^.resulttype)^.typed_as^.size,R_SPPUSH)));
|
|
|
- secondload(p^.left);
|
|
|
- emitpushreferenceaddr(p^.left^.location.reference);
|
|
|
- if p^.inlinenumber=in_reset_typedfile then
|
|
|
- emitcall('RESET_TYPED',true)
|
|
|
- else
|
|
|
- emitcall('REWRITE_TYPED',true);
|
|
|
- popusedregisters(pushed);
|
|
|
- end;
|
|
|
- in_write_x :
|
|
|
- handlereadwrite(false,false);
|
|
|
- in_writeln_x :
|
|
|
- handlereadwrite(false,true);
|
|
|
- in_read_x :
|
|
|
- handlereadwrite(true,false);
|
|
|
- in_readln_x :
|
|
|
- handlereadwrite(true,true);
|
|
|
- in_str_x_string : begin
|
|
|
- handle_str;
|
|
|
- maybe_loada5;
|
|
|
- end;
|
|
|
- else internalerror(9);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondsubscriptn(var p : ptree);
|
|
|
- var
|
|
|
- hr: tregister;
|
|
|
-
|
|
|
- begin
|
|
|
-
|
|
|
- secondpass(p^.left);
|
|
|
-
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
- { classes must be dereferenced implicit }
|
|
|
- if (p^.left^.resulttype^.deftype=objectdef) and
|
|
|
- pobjectdef(p^.left^.resulttype)^.isclass then
|
|
|
- begin
|
|
|
- clear_reference(p^.location.reference);
|
|
|
- case p^.left^.location.loc of
|
|
|
- LOC_REGISTER:
|
|
|
- begin
|
|
|
- { move it to an address register...}
|
|
|
- hr:=getaddressreg;
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
|
|
|
- p^.location.reference.base:=hr;
|
|
|
- { free register }
|
|
|
- ungetregister(p^.left^.location.register);
|
|
|
- end;
|
|
|
- LOC_CREGISTER:
|
|
|
- begin
|
|
|
- { ... and reserve one for the pointer }
|
|
|
- hr:=getaddressreg;
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,hr);
|
|
|
- p^.location.reference.base:=hr;
|
|
|
- end;
|
|
|
- else
|
|
|
- begin
|
|
|
- { free register }
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
-
|
|
|
- { ... and reserve one for the pointer }
|
|
|
- hr:=getaddressreg;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(
|
|
|
- A_MOVE,S_L,newreference(p^.left^.location.reference),
|
|
|
- hr)));
|
|
|
- p^.location.reference.base:=hr;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- set_location(p^.location,p^.left^.location);
|
|
|
-
|
|
|
- inc(p^.location.reference.offset,p^.vs^.address);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure secondselfn(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- clear_reference(p^.location.reference);
|
|
|
- p^.location.reference.base:=R_A5;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondhdisposen(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
-
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
- clear_reference(p^.location.reference);
|
|
|
- case p^.left^.location.loc of
|
|
|
- LOC_REGISTER,
|
|
|
- LOC_CREGISTER : begin
|
|
|
- p^.location.reference.base:=getaddressreg;
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
|
|
|
- p^.left^.location.register,
|
|
|
- p^.location.reference.base)));
|
|
|
- end;
|
|
|
- LOC_MEM,LOC_REFERENCE :
|
|
|
- begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- p^.location.reference.base:=getaddressreg;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.left^.location.reference),
|
|
|
- p^.location.reference.base)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondhnewn(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondnewn(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
-
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
-
|
|
|
- p^.location.register:=p^.left^.location.register;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondsimplenewdispose(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- pushed : tpushed;
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
-
|
|
|
- pushusedregisters(pushed,$ffff);
|
|
|
- { determines the size of the mem block }
|
|
|
- push_int(ppointerdef(p^.left^.resulttype)^.definition^.size);
|
|
|
-
|
|
|
- { push pointer adress }
|
|
|
- case p^.left^.location.loc of
|
|
|
- LOC_CREGISTER : exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
|
|
|
- p^.left^.location.register,R_SPPUSH)));
|
|
|
- LOC_REFERENCE : emitpushreferenceaddr(p^.left^.location.reference);
|
|
|
-
|
|
|
- end;
|
|
|
-
|
|
|
- { call the mem handling procedures }
|
|
|
- case p^.treetype of
|
|
|
- simpledisposen :
|
|
|
- emitcall('FREEMEM',true);
|
|
|
- simplenewn :
|
|
|
- emitcall('GETMEM',true);
|
|
|
- end;
|
|
|
-
|
|
|
- popusedregisters(pushed);
|
|
|
- { may be load ESI }
|
|
|
- maybe_loada5;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure secondsetcons(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- l : plabel;
|
|
|
- i,smallsetvalue : longint;
|
|
|
- hp : ptree;
|
|
|
- href,sref : treference;
|
|
|
- hl1,hl2: plabel;
|
|
|
- j: byte;
|
|
|
-
|
|
|
- begin
|
|
|
- { this should be reimplemented for smallsets }
|
|
|
- { differently (PM) }
|
|
|
- { produce constant part }
|
|
|
- j:=0;
|
|
|
- href.symbol := Nil;
|
|
|
- clear_reference(href);
|
|
|
- getlabel(l);
|
|
|
- href.symbol:=stringdup(lab2str(l));
|
|
|
- stringdispose(p^.location.reference.symbol);
|
|
|
- datasegment^.concat(new(pai_label,init(l)));
|
|
|
- {if psetdef(p^.resulttype)=smallset then
|
|
|
- begin
|
|
|
- smallsetvalue:=(p^.constset^[3]*256)+p^.constset^[2];
|
|
|
- smallsetvalue:=((smallset*256+p^.constset^[1])*256+p^.constset^[1];
|
|
|
- datasegment^.concat(new(pai_const,init_32bit(smallsetvalue)));
|
|
|
- hp:=p^.left;
|
|
|
- if assigned(hp) then
|
|
|
- begin
|
|
|
- sref.symbol:=nil;
|
|
|
- gettempofsizereference(32,sref);
|
|
|
- concatcopy(href,sref,32,false);
|
|
|
- while assigned(hp) do
|
|
|
- begin
|
|
|
- secondpass(hp^.left);
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
-
|
|
|
- pushsetelement(hp^.left);
|
|
|
- emitpushreferenceaddr(sref);
|
|
|
- register is save in subroutine
|
|
|
- emitcall('SET_SET_BYTE',true);
|
|
|
- hp:=hp^.right;
|
|
|
- end;
|
|
|
- p^.location.reference:=sref;
|
|
|
- end
|
|
|
- else p^.location.reference:=href;
|
|
|
- end
|
|
|
- else }
|
|
|
- begin
|
|
|
- for i:=0 to (31 div 4) do
|
|
|
- Begin
|
|
|
- { This is required because of the ENDIAN of m68k machines }
|
|
|
- datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j+3])));
|
|
|
- datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j+2])));
|
|
|
- datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j+1])));
|
|
|
- datasegment^.concat(new(pai_const,init_8bit(p^.constset^[j])));
|
|
|
- Inc(j,4);
|
|
|
-{ datasegment^.concat(new(pai_const,init_8bit(p^.constset^[i])));}
|
|
|
- end;
|
|
|
- hp:=p^.left;
|
|
|
- if assigned(hp) then
|
|
|
- begin
|
|
|
- sref.symbol:=nil;
|
|
|
- gettempofsizereference(32,sref);
|
|
|
- concatcopy(href,sref,32,false);
|
|
|
- while assigned(hp) do
|
|
|
- begin
|
|
|
- secondpass(hp^.left);
|
|
|
- if codegenerror then
|
|
|
- exit;
|
|
|
-
|
|
|
- loadsetelement(hp^.left);
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
|
|
|
- newreference(sref),R_A0)));;
|
|
|
-{ emitpushreferenceaddr(sref); }
|
|
|
- { register is save in subroutine }
|
|
|
- emitcall('SET_SET_BYTE',true);
|
|
|
- hp:=hp^.right;
|
|
|
- end;
|
|
|
- p^.location.reference:=sref;
|
|
|
- end
|
|
|
- else
|
|
|
- p^.location.reference:=href;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure secondcontinuen(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- if aktcontinuelabel<>nil then
|
|
|
- emitl(A_JMP,aktcontinuelabel)
|
|
|
- else
|
|
|
- Message(cg_e_continue_not_allowed);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
-{ var
|
|
|
- hs : string; }
|
|
|
-
|
|
|
- procedure secondexitn(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- is_mem : boolean;
|
|
|
- {op : tasmop;
|
|
|
- s : topsize;}
|
|
|
- otlabel,oflabel : plabel;
|
|
|
-
|
|
|
- label
|
|
|
- do_jmp;
|
|
|
-
|
|
|
- begin
|
|
|
- if assigned(p^.left) then
|
|
|
- begin
|
|
|
- otlabel:=truelabel;
|
|
|
- oflabel:=falselabel;
|
|
|
- getlabel(truelabel);
|
|
|
- getlabel(falselabel);
|
|
|
- secondpass(p^.left);
|
|
|
- case p^.left^.location.loc of
|
|
|
- LOC_FPU : goto do_jmp;
|
|
|
- LOC_MEM,LOC_REFERENCE : is_mem:=true;
|
|
|
- LOC_CREGISTER,
|
|
|
- LOC_REGISTER : is_mem:=false;
|
|
|
- LOC_FLAGS : begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(flag_2_set[p^.right^.location.resflags],S_B,R_D0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_NEG, S_B, R_D0)));
|
|
|
- goto do_jmp;
|
|
|
- end;
|
|
|
- LOC_JUMP : begin
|
|
|
- emitl(A_LABEL,truelabel);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_B,1,R_D0)));
|
|
|
- emitl(A_JMP,aktexit2label);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_B,R_D0)));
|
|
|
- goto do_jmp;
|
|
|
- end;
|
|
|
- else internalerror(2001);
|
|
|
- end;
|
|
|
- if (procinfo.retdef^.deftype=orddef) then
|
|
|
- begin
|
|
|
- case porddef(procinfo.retdef)^.typ of
|
|
|
- s32bit,u32bit : if is_mem then
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(p^.left^.location.reference),R_D0)))
|
|
|
- else
|
|
|
- emit_reg_reg(A_MOVE,S_L,
|
|
|
- p^.left^.location.register,R_D0);
|
|
|
- u8bit,s8bit,uchar,bool8bit : if is_mem then
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
|
|
|
- newreference(p^.left^.location.reference),R_D0)))
|
|
|
- else
|
|
|
- emit_reg_reg(A_MOVE,S_B,
|
|
|
- p^.left^.location.register,R_D0);
|
|
|
- s16bit,u16bit : if is_mem then
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_W,
|
|
|
- newreference(p^.left^.location.reference),R_D0)))
|
|
|
- else
|
|
|
- emit_reg_reg(A_MOVE,S_W,
|
|
|
- p^.left^.location.register,R_D0);
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- if (procinfo.retdef^.deftype in
|
|
|
- [pointerdef,enumdef,procvardef]) then
|
|
|
- begin
|
|
|
- if is_mem then
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(p^.left^.location.reference),R_D0)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
|
|
|
- p^.left^.location.register,R_D0)));
|
|
|
- end
|
|
|
- else
|
|
|
- if (procinfo.retdef^.deftype=floatdef) then
|
|
|
- { floating point return values .... }
|
|
|
- { single are returned in d0 }
|
|
|
- begin
|
|
|
- if (pfloatdef(procinfo.retdef)^.typ=f32bit) or
|
|
|
- (pfloatdef(procinfo.retdef)^.typ=s32real) then
|
|
|
- begin
|
|
|
- if is_mem then
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
|
|
- newreference(p^.left^.location.reference),R_D0)))
|
|
|
- else
|
|
|
- begin
|
|
|
- if pfloatdef(procinfo.retdef)^.typ=f32bit then
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.register,R_D0)
|
|
|
- else
|
|
|
- begin
|
|
|
- { single values are in the floating point registers }
|
|
|
- if cs_fp_emulation in aktmoduleswitches then
|
|
|
- emit_reg_reg(A_MOVE,S_L,p^.left^.location.fpureg,R_D0)
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,S_FS,
|
|
|
- p^.left^.location.fpureg,R_D0)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- Begin
|
|
|
- { this is only possible in real non emulation mode }
|
|
|
- { LOC_MEM,LOC_REFERENCE }
|
|
|
- if is_mem then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_FMOVE,
|
|
|
- getfloatsize(pfloatdef(procinfo.retdef)^.typ),
|
|
|
- newreference(p^.left^.location.reference),R_FP0)));
|
|
|
- end
|
|
|
- else
|
|
|
- { LOC_FPU }
|
|
|
- begin
|
|
|
- { convert from extended to correct type }
|
|
|
- { when storing }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_FMOVE,
|
|
|
- getfloatsize(pfloatdef(procinfo.retdef)^.typ),p^.left^.location.fpureg,R_FP0)));
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-do_jmp:
|
|
|
- truelabel:=otlabel;
|
|
|
- falselabel:=oflabel;
|
|
|
- emitl(A_JMP,aktexit2label);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- emitl(A_JMP,aktexitlabel);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondgoto(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- emitl(A_JMP,p^.labelnr);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondlabel(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- emitl(A_LABEL,p^.labelnr);
|
|
|
- cleartempgen;
|
|
|
- secondpass(p^.left);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondasm(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- exprasmlist^.concatlist(p^.p_asm);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondcase(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- with_sign : boolean;
|
|
|
- opsize : topsize;
|
|
|
- jmp_gt,jmp_le,jmp_lee : tasmop;
|
|
|
- hp : ptree;
|
|
|
- { register with case expression }
|
|
|
- hregister : tregister;
|
|
|
- endlabel,elselabel : plabel;
|
|
|
-
|
|
|
- { true, if we can omit the range check of the jump table }
|
|
|
- jumptable_no_range : boolean;
|
|
|
-
|
|
|
- procedure gentreejmp(p : pcaserecord);
|
|
|
-
|
|
|
- var
|
|
|
- lesslabel,greaterlabel : plabel;
|
|
|
-
|
|
|
- begin
|
|
|
- emitl(A_LABEL,p^._at);
|
|
|
- { calculate labels for left and right }
|
|
|
- if (p^.less=nil) then
|
|
|
- lesslabel:=elselabel
|
|
|
- else
|
|
|
- lesslabel:=p^.less^._at;
|
|
|
- if (p^.greater=nil) then
|
|
|
- greaterlabel:=elselabel
|
|
|
- else
|
|
|
- greaterlabel:=p^.greater^._at;
|
|
|
- { calculate labels for left and right }
|
|
|
- { no range label: }
|
|
|
- if p^._low=p^._high then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._low,hregister)));
|
|
|
- if greaterlabel=lesslabel then
|
|
|
- begin
|
|
|
- emitl(A_BNE,lesslabel);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- emitl(jmp_le,lesslabel);
|
|
|
- emitl(jmp_gt,greaterlabel);
|
|
|
- end;
|
|
|
- emitl(A_JMP,p^.statement);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._low,hregister)));
|
|
|
- emitl(jmp_le,lesslabel);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,p^._high,hregister)));
|
|
|
- emitl(jmp_gt,greaterlabel);
|
|
|
- emitl(A_JMP,p^.statement);
|
|
|
- end;
|
|
|
- if assigned(p^.less) then
|
|
|
- gentreejmp(p^.less);
|
|
|
- if assigned(p^.greater) then
|
|
|
- gentreejmp(p^.greater);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure genlinearlist(hp : pcaserecord);
|
|
|
-
|
|
|
- var
|
|
|
- first : boolean;
|
|
|
- last : longint;
|
|
|
-
|
|
|
- procedure genitem(t : pcaserecord);
|
|
|
-
|
|
|
- begin
|
|
|
- if assigned(t^.less) then
|
|
|
- genitem(t^.less);
|
|
|
- if t^._low=t^._high then
|
|
|
- begin
|
|
|
- if (t^._low-last > 0) and (t^._low-last < 9) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-last,hregister)))
|
|
|
- else
|
|
|
- if (t^._low-last = 0) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,hregister)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-last,hregister)));
|
|
|
- last:=t^._low;
|
|
|
-
|
|
|
- emitl(A_BEQ,t^.statement);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- { it begins with the smallest label, if the value }
|
|
|
- { is even smaller then jump immediately to the }
|
|
|
- { ELSE-label }
|
|
|
- if first then
|
|
|
- begin
|
|
|
- if (t^._low-1 > 0) and (t^._low < 9) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-1,hregister)))
|
|
|
- else
|
|
|
- if t^._low-1=0 then
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,hregister)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-1,hregister)));
|
|
|
- if t^._low = 0 then
|
|
|
- emitl(A_BLE,elselabel)
|
|
|
- else
|
|
|
- emitl(jmp_lee,elselabel);
|
|
|
- end
|
|
|
- { if there is no unused label between the last and the }
|
|
|
- { present label then the lower limit can be checked }
|
|
|
- { immediately. else check the range in between: }
|
|
|
- else if (t^._low-last>1)then
|
|
|
-
|
|
|
- begin
|
|
|
- if ((t^._low-last-1) > 0) and ((t^._low-last-1) < 9) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,opsize,t^._low-last-1,hregister)))
|
|
|
- else
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._low-last-1,hregister)));
|
|
|
- emitl(jmp_lee,elselabel);
|
|
|
- end;
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_SUB,opsize,t^._high-t^._low+1,hregister)));
|
|
|
- emitl(jmp_lee,t^.statement);
|
|
|
-
|
|
|
- last:=t^._high;
|
|
|
- end;
|
|
|
- first:=false;
|
|
|
- if assigned(t^.greater) then
|
|
|
- genitem(t^.greater);
|
|
|
- end;
|
|
|
-
|
|
|
- var
|
|
|
- hr : tregister;
|
|
|
-
|
|
|
- begin
|
|
|
- { case register is modified by the list evalution }
|
|
|
- if (p^.left^.location.loc=LOC_CREGISTER) then
|
|
|
- begin
|
|
|
- hr:=getregister32;
|
|
|
- end;
|
|
|
- last:=0;
|
|
|
- first:=true;
|
|
|
- genitem(hp);
|
|
|
- emitl(A_JMP,elselabel);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure genjumptable(hp : pcaserecord;min_,max_ : longint);
|
|
|
-
|
|
|
- var
|
|
|
- table : plabel;
|
|
|
- last : longint;
|
|
|
- hr : preference;
|
|
|
-
|
|
|
- procedure genitem(t : pcaserecord);
|
|
|
-
|
|
|
- var
|
|
|
- i : longint;
|
|
|
-
|
|
|
- begin
|
|
|
- if assigned(t^.less) then
|
|
|
- genitem(t^.less);
|
|
|
- { fill possible hole }
|
|
|
- for i:=last+1 to t^._low-1 do
|
|
|
- datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
|
|
|
- (elselabel)))));
|
|
|
- for i:=t^._low to t^._high do
|
|
|
- datasegment^.concat(new(pai_const,init_symbol(strpnew(lab2str
|
|
|
- (t^.statement)))));
|
|
|
- last:=t^._high;
|
|
|
- if assigned(t^.greater) then
|
|
|
- genitem(t^.greater);
|
|
|
- end;
|
|
|
-
|
|
|
- begin
|
|
|
- if not(jumptable_no_range) then
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,min_,hregister)));
|
|
|
- { case expr less than min_ => goto elselabel }
|
|
|
- emitl(jmp_le,elselabel);
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,opsize,max_,hregister)));
|
|
|
- emitl(jmp_gt,elselabel);
|
|
|
- end;
|
|
|
- getlabel(table);
|
|
|
- { extend with sign }
|
|
|
- if opsize=S_W then
|
|
|
- begin
|
|
|
- { word to long - unsigned }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ffff,hregister)));
|
|
|
- end
|
|
|
- else if opsize=S_B then
|
|
|
- begin
|
|
|
- { byte to long - unsigned }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,$ff,hregister)));
|
|
|
- end;
|
|
|
- new(hr);
|
|
|
- reset_reference(hr^);
|
|
|
- hr^.symbol:=stringdup(lab2str(table));
|
|
|
- hr^.offset:=(-min_)*4;
|
|
|
-
|
|
|
- { add scalefactor *4 to index }
|
|
|
- exprasmlist^.concat(new(pai68k,op_const_reg(A_LSL,S_L,2,hregister)));
|
|
|
-{ hr^.scalefactor:=4; }
|
|
|
- hr^.base:=getaddressreg;
|
|
|
- emit_reg_reg(A_MOVE,S_L,hregister,hr^.base);
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref(A_JMP,S_NO,hr)));
|
|
|
-{ if not(cs_littlesize in aktglobalswitches^ ) then
|
|
|
- datasegment^.concat(new(pai68k,op_const(A_ALIGN,S_NO,4))); }
|
|
|
- datasegment^.concat(new(pai_label,init(table)));
|
|
|
- last:=min_;
|
|
|
- genitem(hp);
|
|
|
- if hr^.base <> R_NO then ungetregister(hr^.base);
|
|
|
- { !!!!!!!
|
|
|
- if not(cs_littlesize in aktglobalswitches^ ) then
|
|
|
- exprasmlist^.concat(new(pai68k,op_const(A_ALIGN,S_NO,4)));
|
|
|
- }
|
|
|
- end;
|
|
|
-
|
|
|
- var
|
|
|
- lv,hv,min_label,max_label,labels : longint;
|
|
|
- max_linear_list : longint;
|
|
|
-
|
|
|
- begin
|
|
|
- getlabel(endlabel);
|
|
|
- getlabel(elselabel);
|
|
|
- with_sign:=is_signed(p^.left^.resulttype);
|
|
|
- if with_sign then
|
|
|
- begin
|
|
|
- jmp_gt:=A_BGT;
|
|
|
- jmp_le:=A_BLT;
|
|
|
- jmp_lee:=A_BLE;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- jmp_gt:=A_BHI;
|
|
|
- jmp_le:=A_BCS;
|
|
|
- jmp_lee:=A_BLS;
|
|
|
- end;
|
|
|
- cleartempgen;
|
|
|
- secondpass(p^.left);
|
|
|
- { determines the size of the operand }
|
|
|
- { determines the size of the operand }
|
|
|
- opsize:=bytes2Sxx[p^.left^.resulttype^.size];
|
|
|
- { copy the case expression to a register }
|
|
|
- { copy the case expression to a register }
|
|
|
- case p^.left^.location.loc of
|
|
|
- LOC_REGISTER,
|
|
|
- LOC_CREGISTER : hregister:=p^.left^.location.register;
|
|
|
- LOC_MEM,LOC_REFERENCE : begin
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- hregister:=getregister32;
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(
|
|
|
- p^.left^.location.reference),hregister)));
|
|
|
- end;
|
|
|
- else internalerror(2002);
|
|
|
- end;
|
|
|
- { now generate the jumps }
|
|
|
- if cs_optimize in aktglobalswitches then
|
|
|
- begin
|
|
|
- { procedures are empirically passed on }
|
|
|
- { consumption can also be calculated }
|
|
|
- { but does it pay on the different }
|
|
|
- { processors? }
|
|
|
- { moreover can the size only be appro- }
|
|
|
- { ximated as it is not known if rel8, }
|
|
|
- { rel16 or rel32 jumps are used }
|
|
|
- min_label:=case_get_min(p^.nodes);
|
|
|
- max_label:=case_get_max(p^.nodes);
|
|
|
- labels:=case_count_labels(p^.nodes);
|
|
|
- { can we omit the range check of the jump table }
|
|
|
- getrange(p^.left^.resulttype,lv,hv);
|
|
|
- jumptable_no_range:=(lv=min_label) and (hv=max_label);
|
|
|
-
|
|
|
- { optimize for size ? }
|
|
|
- if cs_littlesize in aktglobalswitches then
|
|
|
- begin
|
|
|
- if (labels<=2) or ((max_label-min_label)>3*labels) then
|
|
|
- { a linear list is always smaller than a jump tree }
|
|
|
- genlinearlist(p^.nodes)
|
|
|
- else
|
|
|
- { if the labels less or more a continuum then }
|
|
|
- genjumptable(p^.nodes,min_label,max_label);
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- if jumptable_no_range then
|
|
|
- max_linear_list:=4
|
|
|
- else
|
|
|
- max_linear_list:=2;
|
|
|
-
|
|
|
- if (labels<=max_linear_list) then
|
|
|
- genlinearlist(p^.nodes)
|
|
|
- else
|
|
|
- begin
|
|
|
- if ((max_label-min_label)>4*labels) then
|
|
|
- begin
|
|
|
- if labels>16 then
|
|
|
- gentreejmp(p^.nodes)
|
|
|
- else
|
|
|
- genlinearlist(p^.nodes);
|
|
|
- end
|
|
|
- else
|
|
|
- genjumptable(p^.nodes,min_label,max_label);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end
|
|
|
- else
|
|
|
- { it's always not bad }
|
|
|
- genlinearlist(p^.nodes);
|
|
|
-
|
|
|
- { now generate the instructions }
|
|
|
- hp:=p^.right;
|
|
|
- while assigned(hp) do
|
|
|
- begin
|
|
|
- cleartempgen;
|
|
|
- secondpass(hp^.right);
|
|
|
- emitl(A_JMP,endlabel);
|
|
|
- hp:=hp^.left;
|
|
|
- end;
|
|
|
- emitl(A_LABEL,elselabel);
|
|
|
- { ... and the else block }
|
|
|
- if assigned(p^.elseblock) then
|
|
|
- begin
|
|
|
- cleartempgen;
|
|
|
- secondpass(p^.elseblock);
|
|
|
- end;
|
|
|
- emitl(A_LABEL,endlabel);
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure secondtryexcept(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
-
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondtryfinally(var p : ptree);
|
|
|
-
|
|
|
- begin
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondfail(var p : ptree);
|
|
|
-
|
|
|
- var hp : preference;
|
|
|
-
|
|
|
- begin
|
|
|
- {if procinfo.exceptions then
|
|
|
- aktproccode.concat(gennasmrec(CALL,S_NO,'HELP_DESTRUCTOR_E'))
|
|
|
- else }
|
|
|
- { we should know if the constructor is called with a new or not,
|
|
|
- how can we do that ???
|
|
|
- exprasmlist^.concat(new(pai68k,op_csymbol(A_CALL,S_NO,newcsymbol('HELP_DESTRUCTOR',0))));
|
|
|
- }
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_A5)));
|
|
|
- { also reset to zero in the stack }
|
|
|
- new(hp);
|
|
|
- reset_reference(hp^);
|
|
|
- hp^.offset:=procinfo.ESI_offset;
|
|
|
- hp^.base:=procinfo.framepointer;
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,R_A5,hp)));
|
|
|
- exprasmlist^.concat(new(pai_labeled,init(A_JMP,quickexitlabel)));
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondon(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- nextonlabel,myendexceptlabel : plabel;
|
|
|
- ref : treference;
|
|
|
-
|
|
|
- begin
|
|
|
-{ !!!!!!!!!!!!!!! }
|
|
|
-(* getlabel(nextonlabel);
|
|
|
- { push the vmt }
|
|
|
- exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,
|
|
|
- newcsymbol(p^.excepttype^.vmt_mangledname,0))));
|
|
|
- maybe_concat_external(p^.excepttype^.owner,
|
|
|
- p^.excepttype^.vmt_mangledname);
|
|
|
-
|
|
|
- emitcall('FPC_CATCHES',true);
|
|
|
- exprasmlist^.concat(new(pai386,
|
|
|
- op_reg_reg(A_TEST,S_L,R_EAX,R_EAX)));
|
|
|
- emitl(A_JE,nextonlabel);
|
|
|
- ref.symbol:=nil;
|
|
|
- gettempofsizereference(4,ref);
|
|
|
-
|
|
|
- { what a hack ! }
|
|
|
- if assigned(p^.exceptsymtable) then
|
|
|
- pvarsym(p^.exceptsymtable^.root)^.address:=ref.offset;
|
|
|
-
|
|
|
- exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,
|
|
|
- R_EAX,newreference(ref))));
|
|
|
-
|
|
|
- if assigned(p^.right) then
|
|
|
- secondpass(p^.right);
|
|
|
- { clear some stuff }
|
|
|
- ungetiftemp(ref);
|
|
|
- emitl(A_JMP,endexceptlabel);
|
|
|
- emitl(A_LABEL,nextonlabel);
|
|
|
- { next on node }
|
|
|
- if assigned(p^.left) then
|
|
|
- secondpass(p^.left); *)
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure secondas(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- pushed : tpushed;
|
|
|
-
|
|
|
- begin
|
|
|
- set_location(p^.location,p^.left^.location);
|
|
|
- { save all used registers }
|
|
|
- pushusedregisters(pushed,$ffff);
|
|
|
- { push the vmt of the class }
|
|
|
- exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,
|
|
|
- S_L,newcsymbol(pobjectdef(p^.right^.resulttype)^.vmt_mangledname,0),R_SPPUSH)));
|
|
|
- concat_external(pobjectdef(p^.right^.resulttype)^.vmt_mangledname,EXT_NEAR);
|
|
|
- emitpushreferenceaddr(p^.location.reference);
|
|
|
- emitcall('DO_AS',true);
|
|
|
- popusedregisters(pushed);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondis(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- pushed : tpushed;
|
|
|
-
|
|
|
- begin
|
|
|
- { save all used registers }
|
|
|
- pushusedregisters(pushed,$ffff);
|
|
|
- secondpass(p^.left);
|
|
|
- p^.location.loc:=LOC_FLAGS;
|
|
|
- p^.location.resflags:=F_NE;
|
|
|
-
|
|
|
- { push instance to check: }
|
|
|
- case p^.left^.location.loc of
|
|
|
- LOC_REGISTER,LOC_CREGISTER:
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,
|
|
|
- S_L,p^.left^.location.register,R_SPPUSH)));
|
|
|
- ungetregister32(p^.left^.location.register);
|
|
|
- end;
|
|
|
- LOC_MEM,LOC_REFERENCE:
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,
|
|
|
- S_L,newreference(p^.left^.location.reference),R_SPPUSH)));
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- end;
|
|
|
- else internalerror(100);
|
|
|
- end;
|
|
|
-
|
|
|
- { generate type checking }
|
|
|
- secondpass(p^.right);
|
|
|
- case p^.right^.location.loc of
|
|
|
- LOC_REGISTER,LOC_CREGISTER:
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,
|
|
|
- S_L,p^.right^.location.register,R_SPPUSH)));
|
|
|
- ungetregister32(p^.right^.location.register);
|
|
|
- end;
|
|
|
- LOC_MEM,LOC_REFERENCE:
|
|
|
- begin
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,
|
|
|
- S_L,newreference(p^.right^.location.reference),R_SPPUSH)));
|
|
|
- del_reference(p^.right^.location.reference);
|
|
|
- end;
|
|
|
- else internalerror(100);
|
|
|
- end;
|
|
|
- emitcall('DO_IS',true);
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg(A_TST,S_B,R_D0)));
|
|
|
- popusedregisters(pushed);
|
|
|
- end;
|
|
|
-
|
|
|
- procedure secondwith(var p : ptree);
|
|
|
-
|
|
|
- var
|
|
|
- ref : treference;
|
|
|
- symtable : psymtable;
|
|
|
- i : longint;
|
|
|
-
|
|
|
- begin
|
|
|
- if assigned(p^.left) then
|
|
|
- begin
|
|
|
- secondpass(p^.left);
|
|
|
- ref.symbol:=nil;
|
|
|
- gettempofsizereference(4,ref);
|
|
|
- exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
|
|
|
- newreference(p^.left^.location.reference),R_A0)));
|
|
|
- exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,
|
|
|
- R_A0,newreference(ref))));
|
|
|
- del_reference(p^.left^.location.reference);
|
|
|
- { the offset relative to (%ebp) is only needed here! }
|
|
|
- symtable:=p^.withsymtable;
|
|
|
- for i:=1 to p^.tablecount do
|
|
|
- begin
|
|
|
- symtable^.datasize:=ref.offset;
|
|
|
- symtable:=symtable^.next;
|
|
|
- end;
|
|
|
-
|
|
|
- { p^.right can be optimize out !!! }
|
|
|
- if p^.right<>nil then
|
|
|
- secondpass(p^.right);
|
|
|
- { clear some stuff }
|
|
|
- ungetiftemp(ref);
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
-procedure secondprocinline(var p:ptree);
|
|
|
-begin
|
|
|
-end;
|
|
|
-
|
|
|
-
|
|
|
- procedure secondpass(var p : ptree);
|
|
|
- const
|
|
|
- procedures : array[ttreetyp] of secondpassproc =
|
|
|
- (secondadd,secondadd,secondadd,secondmoddiv,secondadd,
|
|
|
- secondmoddiv,secondassignment,secondload,secondnothing,
|
|
|
- secondadd,secondadd,secondadd,secondadd,
|
|
|
- secondadd,secondadd,secondin,secondadd,
|
|
|
- secondadd,secondshlshr,secondshlshr,secondadd,
|
|
|
- secondadd,secondsubscriptn,secondderef,secondaddr,
|
|
|
- seconddoubleaddr,
|
|
|
- secondordconst,secondtypeconv,secondcalln,secondnothing,
|
|
|
- secondrealconst,secondfixconst,secondumminus,
|
|
|
- secondasm,secondvecn,
|
|
|
- secondstringconst,secondfuncret,secondselfn,
|
|
|
- secondnot,secondinline,secondniln,seconderror,
|
|
|
- secondnothing,secondhnewn,secondhdisposen,secondnewn,
|
|
|
- secondsimplenewdispose,secondnothing,secondsetcons,secondblockn,
|
|
|
- secondstatement,secondnothing,secondifn,secondbreakn,
|
|
|
- secondcontinuen,second_while_repeatn,second_while_repeatn,secondfor,
|
|
|
- secondexitn,secondwith,secondcase,secondlabel,
|
|
|
- secondgoto,secondsimplenewdispose,secondtryexcept,
|
|
|
- secondraise,
|
|
|
- secondnothing,secondtryfinally,secondon,secondis,
|
|
|
- secondas,seconderror,
|
|
|
- secondfail,secondadd,secondprocinline,
|
|
|
- secondnothing,secondloadvmt);
|
|
|
- var
|
|
|
- oldcodegenerror : boolean;
|
|
|
- oldlocalswitches : tlocalswitches;
|
|
|
- oldpos : tfileposinfo;
|
|
|
- begin
|
|
|
- oldcodegenerror:=codegenerror;
|
|
|
- oldlocalswitches:=aktlocalswitches;
|
|
|
- oldpos:=aktfilepos;
|
|
|
-
|
|
|
- aktfilepos:=p^.fileinfo;
|
|
|
- aktlocalswitches:=p^.localswitches;
|
|
|
- if not(p^.error) then
|
|
|
- begin
|
|
|
- codegenerror:=false;
|
|
|
- procedures[p^.treetype](p);
|
|
|
- p^.error:=codegenerror;
|
|
|
- codegenerror:=codegenerror or oldcodegenerror;
|
|
|
- end
|
|
|
- else
|
|
|
- codegenerror:=true;
|
|
|
-
|
|
|
- aktlocalswitches:=oldlocalswitches;
|
|
|
- aktfilepos:=oldpos;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- function do_secondpass(var p : ptree) : boolean;
|
|
|
- begin
|
|
|
- codegenerror:=false;
|
|
|
- if not(p^.error) then
|
|
|
- secondpass(p);
|
|
|
- do_secondpass:=codegenerror;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- var
|
|
|
- regvars : array[1..maxvarregs] of pvarsym;
|
|
|
- regvars_para : array[1..maxvarregs] of boolean;
|
|
|
- regvars_refs : array[1..maxvarregs] of longint;
|
|
|
- parasym : boolean;
|
|
|
-
|
|
|
- procedure searchregvars(p : psym);
|
|
|
-
|
|
|
- var
|
|
|
- i,j,k : longint;
|
|
|
-
|
|
|
- begin
|
|
|
- if (p^.typ=varsym) and ((pvarsym(p)^.var_options and vo_regable)<>0) then
|
|
|
- begin
|
|
|
- { walk through all momentary register variables }
|
|
|
- for i:=1 to maxvarregs do
|
|
|
- begin
|
|
|
- { free register ? }
|
|
|
- if regvars[i]=nil then
|
|
|
- begin
|
|
|
- regvars[i]:=pvarsym(p);
|
|
|
- regvars_para[i]:=parasym;
|
|
|
- break;
|
|
|
- end;
|
|
|
- { else throw out a variable ? }
|
|
|
- j:=pvarsym(p)^.refs;
|
|
|
- { parameter get a less value }
|
|
|
- if parasym then
|
|
|
- begin
|
|
|
- if cs_littlesize in aktglobalswitches then
|
|
|
- dec(j,1)
|
|
|
- else
|
|
|
- dec(j,100);
|
|
|
- end;
|
|
|
- if (j>regvars_refs[i]) and (j>0) then
|
|
|
- begin
|
|
|
- for k:=maxvarregs-1 downto i do
|
|
|
- begin
|
|
|
- regvars[k+1]:=regvars[k];
|
|
|
- regvars_para[k+1]:=regvars_para[k];
|
|
|
- end;
|
|
|
- { calc the new refs
|
|
|
- pvarsym(p)^.refs:=j; }
|
|
|
- regvars[i]:=pvarsym(p);
|
|
|
- regvars_para[i]:=parasym;
|
|
|
- regvars_refs[i]:=j;
|
|
|
- break;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
-
|
|
|
-
|
|
|
- procedure generatecode(var p : ptree);
|
|
|
- var
|
|
|
- i : longint;
|
|
|
- regsize : topsize;
|
|
|
- regi : tregister;
|
|
|
- hr : preference;
|
|
|
- label
|
|
|
- nextreg;
|
|
|
- begin
|
|
|
- cleartempgen;
|
|
|
- { when size optimization only count occurrence }
|
|
|
- if cs_littlesize in aktglobalswitches then
|
|
|
- t_times:=1
|
|
|
- else
|
|
|
- { reference for repetition is 100 }
|
|
|
- t_times:=100;
|
|
|
- { clear register count }
|
|
|
- for regi:=R_D0 to R_A6 do
|
|
|
- begin
|
|
|
- reg_pushes[regi]:=0;
|
|
|
- is_reg_var[regi]:=false;
|
|
|
- end;
|
|
|
-
|
|
|
- use_esp_stackframe:=false;
|
|
|
-
|
|
|
- if not(do_firstpass(p)) then
|
|
|
- begin
|
|
|
- { max. optimizations }
|
|
|
- { only if no asm is used }
|
|
|
- if (cs_regalloc in aktglobalswitches) and
|
|
|
- ((procinfo.flags and pi_uses_asm)=0) then
|
|
|
- begin
|
|
|
- { can we omit the stack frame ? }
|
|
|
- { conditions:
|
|
|
- 1. procedure (not main block)
|
|
|
- 2. no constructor or destructor
|
|
|
- 3. no call to other procedures
|
|
|
- 4. no interrupt handler
|
|
|
- }
|
|
|
- if assigned(aktprocsym) then
|
|
|
- begin
|
|
|
- if (aktprocsym^.definition^.options and (poconstructor+podestructor+poinline+pointerrupt)=0) and
|
|
|
- ((procinfo.flags and pi_do_call)=0) and (lexlevel>1) then
|
|
|
- begin
|
|
|
- { use ESP as frame pointer }
|
|
|
- procinfo.framepointer:=R_SP;
|
|
|
- use_esp_stackframe:=true;
|
|
|
-
|
|
|
- { calc parameter distance new }
|
|
|
- dec(procinfo.framepointer_offset,4);
|
|
|
- dec(procinfo.ESI_offset,4);
|
|
|
-
|
|
|
- dec(procinfo.retoffset,4);
|
|
|
-
|
|
|
- dec(procinfo.call_offset,4);
|
|
|
- aktprocsym^.definition^.parast^.call_offset:=procinfo.call_offset;
|
|
|
- end;
|
|
|
- end; { endif assigned }
|
|
|
- if (p^.registers32<4) then
|
|
|
- begin
|
|
|
- for i:=1 to maxvarregs do
|
|
|
- regvars[i]:=nil;
|
|
|
- parasym:=false;
|
|
|
-{$ifdef tp}
|
|
|
- symtablestack^.foreach(searchregvars);
|
|
|
-{$else}
|
|
|
- symtablestack^.foreach(@searchregvars);
|
|
|
-{$endif}
|
|
|
- { copy parameter into a register ? }
|
|
|
- parasym:=true;
|
|
|
-{$ifdef tp}
|
|
|
- symtablestack^.next^.foreach(searchregvars);
|
|
|
-{$else}
|
|
|
- symtablestack^.next^.foreach(@searchregvars);
|
|
|
-{$endif}
|
|
|
-
|
|
|
- { hold needed registers free }
|
|
|
- for i:=maxvarregs downto maxvarregs-p^.registers32+1 do
|
|
|
- regvars[i]:=nil;
|
|
|
- { now assign register }
|
|
|
- for i:=1 to maxvarregs do
|
|
|
- begin
|
|
|
- if assigned(regvars[i]) then
|
|
|
- begin
|
|
|
- { it is nonsens, to copy the variable to }
|
|
|
- { a register because we need then much }
|
|
|
- { pushes ? }
|
|
|
- if reg_pushes[varregs[i]]>=regvars[i]^.refs then
|
|
|
- begin
|
|
|
- regvars[i]:=nil;
|
|
|
- goto nextreg;
|
|
|
- end;
|
|
|
-
|
|
|
- { register is no longer available for }
|
|
|
- { expressions }
|
|
|
- { search the register which is the most }
|
|
|
- { unused }
|
|
|
- usableregs:=usableregs-[varregs[i]];
|
|
|
- is_reg_var[varregs[i]]:=true;
|
|
|
- dec(c_usableregs);
|
|
|
-
|
|
|
- { possibly no 32 bit register are needed }
|
|
|
- if (regvars[i]^.definition^.deftype=orddef) and
|
|
|
- (
|
|
|
- (porddef(regvars[i]^.definition)^.typ=bool8bit) or
|
|
|
- (porddef(regvars[i]^.definition)^.typ=uchar) or
|
|
|
- (porddef(regvars[i]^.definition)^.typ=u8bit) or
|
|
|
- (porddef(regvars[i]^.definition)^.typ=s8bit)
|
|
|
- ) then
|
|
|
- begin
|
|
|
- regvars[i]^.reg:=varregs[i];
|
|
|
- regsize:=S_B;
|
|
|
- end
|
|
|
- else if (regvars[i]^.definition^.deftype=orddef) and
|
|
|
- (
|
|
|
- (porddef(regvars[i]^.definition)^.typ=u16bit) or
|
|
|
- (porddef(regvars[i]^.definition)^.typ=s16bit)
|
|
|
- ) then
|
|
|
- begin
|
|
|
- regvars[i]^.reg:=varregs[i];
|
|
|
- regsize:=S_W;
|
|
|
- end
|
|
|
- else
|
|
|
- begin
|
|
|
- regvars[i]^.reg:=varregs[i];
|
|
|
- regsize:=S_L;
|
|
|
- end;
|
|
|
- { parameter must be load }
|
|
|
- if regvars_para[i] then
|
|
|
- begin
|
|
|
- { procinfo is there actual, }
|
|
|
- { because we can't never be in a }
|
|
|
- { nested procedure }
|
|
|
- { when loading parameter to reg }
|
|
|
- new(hr);
|
|
|
- reset_reference(hr^);
|
|
|
- hr^.offset:=pvarsym(regvars[i])^.address+procinfo.call_offset;
|
|
|
- hr^.base:=procinfo.framepointer;
|
|
|
- procinfo.aktentrycode^.concat(new(pai68k,op_ref_reg(A_MOVE,regsize,
|
|
|
- hr,regvars[i]^.reg)));
|
|
|
- unused:=unused - [regvars[i]^.reg];
|
|
|
- end;
|
|
|
- { procedure uses this register }
|
|
|
- usedinproc:=usedinproc or ($800 shr word(varregs[i]));
|
|
|
- end;
|
|
|
- nextreg:
|
|
|
- { dummy }
|
|
|
- regsize:=S_W;
|
|
|
- end;
|
|
|
- if (status.verbosity and v_debug)=v_debug then
|
|
|
- begin
|
|
|
- for i:=1 to maxvarregs do
|
|
|
- begin
|
|
|
- if assigned(regvars[i]) then
|
|
|
- Message3(cg_d_register_weight,reg2str(regvars[i]^.reg),
|
|
|
- tostr(regvars[i]^.refs),regvars[i]^.name);
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- end;
|
|
|
- do_secondpass(p);
|
|
|
-
|
|
|
- { all registers can be used again }
|
|
|
- { contains both information on Address registers and data registers }
|
|
|
- { even if they are allocated separately. }
|
|
|
- usableregs:=[R_D0,R_D1,R_D2,R_D3,R_D4,R_D5,R_D6,R_D7,R_A0,R_A1,R_A2,R_A3,R_A4,
|
|
|
- R_FP0,R_FP1,R_FP2,R_FP3,R_FP4,R_FP5,R_FP6,R_FP7];
|
|
|
- c_usableregs:=4;
|
|
|
- usableaddress:=3;
|
|
|
- end;
|
|
|
- procinfo.aktproccode^.concatlist(exprasmlist);
|
|
|
- end;
|
|
|
-
|
|
|
-end.
|
|
|
-
|
|
|
-
|
|
|
-{
|
|
|
- $Log$
|
|
|
- Revision 1.16 1998-09-11 12:29:41 pierre
|
|
|
- * removed explicit range_checking as it is buggy
|
|
|
-
|
|
|
- Revision 1.15.2.1 1998/09/11 12:08:55 pierre
|
|
|
- * removed explicit range_check was buggy
|
|
|
-
|
|
|
- Revision 1.15 1998/08/31 12:26:21 peter
|
|
|
- * m68k and palmos updates from surebugfixes
|
|
|
-
|
|
|
- Revision 1.14 1998/08/19 16:07:39 jonas
|
|
|
- * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
|
|
|
-
|
|
|
- Revision 1.13 1998/08/10 14:43:14 peter
|
|
|
- * string type st_ fixed
|
|
|
-
|
|
|
- Revision 1.12 1998/07/15 16:41:01 jonas
|
|
|
- * fixed bug that caused the stackframe never to be omitted
|
|
|
-
|
|
|
- Revision 1.11 1998/07/14 14:46:43 peter
|
|
|
- * released NEWINPUT
|
|
|
-
|
|
|
- Revision 1.10 1998/07/10 10:50:57 peter
|
|
|
- * m68k updates
|
|
|
-
|
|
|
- Revision 1.9 1998/07/06 15:51:16 michael
|
|
|
- Added length checking for string reading
|
|
|
-
|
|
|
- Revision 1.8 1998/06/12 10:32:22 pierre
|
|
|
- * column problem hopefully solved
|
|
|
- + C vars declaration changed
|
|
|
-
|
|
|
- Revision 1.7 1998/06/09 16:01:36 pierre
|
|
|
- + added procedure directive parsing for procvars
|
|
|
- (accepted are popstack cdecl and pascal)
|
|
|
- + added C vars with the following syntax
|
|
|
- var C calias 'true_c_name';(can be followed by external)
|
|
|
- reason is that you must add the Cprefix
|
|
|
-
|
|
|
- which is target dependent
|
|
|
-
|
|
|
- Revision 1.6 1998/06/08 13:13:36 pierre
|
|
|
- + temporary variables now in temp_gen.pas unit
|
|
|
- because it is processor independent
|
|
|
- * mppc68k.bat modified to undefine i386 and support_mmx
|
|
|
- (which are defaults for i386)
|
|
|
-
|
|
|
- Revision 1.5 1998/06/04 23:51:34 peter
|
|
|
- * m68k compiles
|
|
|
- + .def file creation moved to gendef.pas so it could also be used
|
|
|
- for win32
|
|
|
-
|
|
|
- Revision 1.4 1998/04/29 10:33:44 pierre
|
|
|
- + added some code for ansistring (not complete nor working yet)
|
|
|
- * corrected operator overloading
|
|
|
- * corrected nasm output
|
|
|
- + started inline procedures
|
|
|
- + added starstarn : use ** for exponentiation (^ gave problems)
|
|
|
- + started UseTokenInfo cond to get accurate positions
|
|
|
-
|
|
|
- Revision 1.3 1998/04/07 22:45:03 florian
|
|
|
- * bug0092, bug0115 and bug0121 fixed
|
|
|
- + packed object/class/array
|
|
|
-}
|
|
|
-
|
peter