summaryrefslogtreecommitdiff
path: root/compiler/m68k
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/m68k')
-rw-r--r--compiler/m68k/aasmcpu.pas28
-rw-r--r--compiler/m68k/cgcpu.pas232
-rw-r--r--compiler/m68k/cpubase.pas9
-rw-r--r--compiler/m68k/cpuinfo.pas35
-rw-r--r--compiler/m68k/itcpugas.pas2
-rw-r--r--compiler/m68k/n68kadd.pas762
-rw-r--r--compiler/m68k/n68kcnv.pas8
-rw-r--r--compiler/m68k/n68kmat.pas9
-rw-r--r--compiler/m68k/ra68k.pas1
-rw-r--r--compiler/m68k/ra68kmot.pas4
-rw-r--r--compiler/m68k/rgcpu.pas140
-rw-r--r--compiler/m68k/symcpu.pas14
12 files changed, 660 insertions, 584 deletions
diff --git a/compiler/m68k/aasmcpu.pas b/compiler/m68k/aasmcpu.pas
index c9689eea24..f2d0f34104 100644
--- a/compiler/m68k/aasmcpu.pas
+++ b/compiler/m68k/aasmcpu.pas
@@ -464,6 +464,7 @@ type
result:=operand_read;
case opcode of
+ // CPU opcodes
A_MOVE, A_MOVEQ, A_MOVEA, A_MVZ, A_MVS, A_MOV3Q, A_LEA:
if opnr=1 then
result:=operand_write;
@@ -479,10 +480,21 @@ type
A_CLR, A_SXX, A_SEQ, A_SNE, A_SLT, A_SLE, A_SGT, A_SGE, A_SCS, A_SCC,
A_SMI, A_SPL, A_SF, A_ST, A_SVS, A_SVC, A_SHI, A_SLS:
result:=operand_write;
- A_NEG, A_NEGX, A_EXT, A_EXTB, A_NOT:
+ A_NEG, A_NEGX, A_EXT, A_EXTB, A_NOT, A_SWAP:
result:=operand_readwrite;
A_TST,A_CMP,A_CMPI:
begin end; { Do nothing, default operand_read is fine here. }
+
+ // FPU opcodes
+ A_FMOVE:
+ if opnr=1 then
+ result:=operand_write;
+ A_FADD, A_FSUB, A_FMUL, A_FDIV:
+ if opnr=1 then
+ result:=operand_readwrite;
+ A_FCMP:
+ begin end; { operand_read }
+
else begin
internalerror(2004040903);
end;
@@ -508,17 +520,17 @@ type
function spilling_create_store(r:tregister; const ref:treference):Taicpu;
begin
- case getregtype(r) of
- R_INTREGISTER :
- result:=taicpu.op_reg_ref(A_MOVE,S_L,r,ref);
- R_ADDRESSREGISTER :
- result:=taicpu.op_reg_ref(A_MOVE,S_L,r,ref);
- R_FPUREGISTER :
+ case getregtype(r) of
+ R_INTREGISTER :
+ result:=taicpu.op_reg_ref(A_MOVE,S_L,r,ref);
+ R_ADDRESSREGISTER :
+ result:=taicpu.op_reg_ref(A_MOVE,S_L,r,ref);
+ R_FPUREGISTER :
// no need to handle sizes here
result:=taicpu.op_reg_ref(A_FMOVE,S_FS,r,ref);
else
internalerror(200602012);
- end;
+ end;
end;
diff --git a/compiler/m68k/cgcpu.pas b/compiler/m68k/cgcpu.pas
index 39b38ceaf0..2d0220c16a 100644
--- a/compiler/m68k/cgcpu.pas
+++ b/compiler/m68k/cgcpu.pas
@@ -108,6 +108,7 @@ unit cgcpu;
tcg64f68k = class(tcg64f32)
procedure a_op64_reg_reg(list : TAsmList;op:TOpCG; size: tcgsize; regsrc,regdst : tregister64);override;
procedure a_op64_const_reg(list : TAsmList;op:TOpCG; size: tcgsize; value : int64;regdst : tregister64);override;
+ procedure a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);override;
end;
{ This function returns true if the reference+offset is valid.
@@ -377,8 +378,9 @@ unit cgcpu;
if use_push(cgpara) then
begin
{ Record copy? }
- if (cgpara.size in [OS_NO,OS_F64]) or (size=OS_NO) then
+ if (cgpara.size in [OS_NO,OS_F64]) or (size in [OS_NO,OS_F64]) then
begin
+ //list.concat(tai_comment.create(strpnew('a_load_ref_cgpara: g_concatcopy')));
cgpara.check_simple_location;
len:=align(cgpara.intsize,cgpara.alignment);
g_stackpointer_alloc(list,len);
@@ -751,7 +753,11 @@ unit cgcpu;
list.concat(taicpu.op_reg(A_CLR,S_L,register))
else
begin
- if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then
+ { Prefer MOV3Q if applicable, it allows replacement spilling for register }
+ if (current_settings.cputype in [cpu_isa_b,cpu_isa_c]) and
+ ((longint(a)=-1) or ((longint(a)>0) and (longint(a)<8))) then
+ list.concat(taicpu.op_const_reg(A_MOV3Q,S_L,longint(a),register))
+ else if (longint(a) >= low(shortint)) and (longint(a) <= high(shortint)) then
list.concat(taicpu.op_const_reg(A_MOVEQ,S_L,longint(a),register))
else
begin
@@ -786,11 +792,18 @@ unit cgcpu;
hreg : tregister;
href : treference;
begin
+ a:=longint(a);
href:=ref;
fixref(list,href);
+ if (a=0) and not (current_settings.cputype = cpu_mc68000) then
+ list.concat(taicpu.op_ref(A_CLR,tcgsize2opsize[tosize],href))
+ else if (tcgsize2opsize[tosize]=S_L) and
+ (current_settings.cputype in [cpu_isa_b,cpu_isa_c]) and
+ ((a=-1) or ((a>0) and (a<8))) then
+ list.concat(taicpu.op_const_ref(A_MOV3Q,S_L,a,href))
{ for coldfire we need to go through a temporary register if we have a
offset, index or symbol given }
- if (current_settings.cputype in cpu_coldfire) and
+ else if (current_settings.cputype in cpu_coldfire) and
(
(href.offset<>0) or
{ TODO : check whether we really need this second condition }
@@ -902,10 +915,13 @@ unit cgcpu;
var
instr : taicpu;
begin
- { move to destination register }
- instr:=taicpu.op_reg_reg(A_MOVE,TCGSize2OpSize[fromsize],reg1,reg2);
- add_move_instruction(instr);
- list.concat(instr);
+ { move to destination register }
+ if (reg1<>reg2) then
+ begin
+ instr:=taicpu.op_reg_reg(A_MOVE,TCGSize2OpSize[fromsize],reg1,reg2);
+ add_move_instruction(instr);
+ list.concat(instr);
+ end;
sign_extend(list, fromsize, reg2);
end;
@@ -923,17 +939,25 @@ unit cgcpu;
size:=tosize;
list.concat(taicpu.op_ref_reg(A_MOVE,TCGSize2OpSize[size],href,register));
{ extend the value in the register }
- sign_extend(list, fromsize, register);
+ sign_extend(list, size, register);
end;
procedure tcg68k.a_loadaddr_ref_reg(list : TAsmList;const ref : treference;r : tregister);
var
href : treference;
+ hreg : tregister;
begin
href:=ref;
fixref(list, href);
- list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r));
+ if not isaddressregister(r) then
+ begin
+ hreg:=getaddressregister(list);
+ list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,hreg));
+ a_load_reg_reg(list, OS_ADDR, OS_ADDR, hreg, r);
+ end
+ else
+ list.concat(taicpu.op_ref_reg(A_LEA,S_L,href,r));
end;
@@ -941,20 +965,16 @@ unit cgcpu;
var
instr : taicpu;
begin
- { in emulation mode, only 32-bit single is supported }
- if (cs_fp_emulation in current_settings.moduleswitches) or (current_settings.fputype=fpu_soft) then
- instr:=taicpu.op_reg_reg(A_MOVE,S_L,reg1,reg2)
- else
- instr:=taicpu.op_reg_reg(A_FMOVE,tcgsize2opsize[tosize],reg1,reg2);
- add_move_instruction(instr);
- list.concat(instr);
+ instr:=taicpu.op_reg_reg(A_FMOVE,S_FX,reg1,reg2);
+ add_move_instruction(instr);
+ list.concat(instr);
end;
procedure tcg68k.a_loadfpu_ref_reg(list: TAsmList; fromsize, tosize: tcgsize; const ref: treference; reg: tregister);
- var
- opsize : topsize;
- href : treference;
+ var
+ opsize : topsize;
+ href : treference;
begin
opsize := tcgsize2opsize[fromsize];
{ extended is not supported, since it is not available on Coldfire }
@@ -962,50 +982,44 @@ unit cgcpu;
internalerror(20020729);
href := ref;
fixref(list,href);
- { in emulation mode, only 32-bit single is supported }
- if (cs_fp_emulation in current_settings.moduleswitches) or (current_settings.fputype=fpu_soft) then
- list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,reg))
- else
- begin
- list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
- if (tosize < fromsize) then
- a_loadfpu_reg_reg(list,fromsize,tosize,reg,reg);
- end;
+ list.concat(taicpu.op_ref_reg(A_FMOVE,opsize,href,reg));
end;
procedure tcg68k.a_loadfpu_reg_ref(list: TAsmList; fromsize,tosize: tcgsize; reg: tregister; const ref: treference);
var
- opsize : topsize;
+ opsize : topsize;
+ href : treference;
begin
opsize := tcgsize2opsize[tosize];
{ extended is not supported, since it is not available on Coldfire }
if opsize = S_FX then
internalerror(20020729);
- { in emulation mode, only 32-bit single is supported }
- if (cs_fp_emulation in current_settings.moduleswitches) or (current_settings.fputype=fpu_soft) then
- list.concat(taicpu.op_reg_ref(A_MOVE,S_L,reg, ref))
- else
- list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg, ref));
+ href := ref;
+ fixref(list,href);
+ list.concat(taicpu.op_reg_ref(A_FMOVE,opsize,reg,href));
end;
procedure tcg68k.a_loadfpu_ref_cgpara(list : TAsmList; size : tcgsize;const ref : treference;const cgpara : TCGPara);
begin
- case cgpara.location^.loc of
- LOC_REFERENCE,LOC_CREFERENCE:
- begin
- case size of
- OS_F64:
- cg64.a_load64_ref_cgpara(list,ref,cgpara);
- OS_F32:
- a_load_ref_cgpara(list,size,ref,cgpara);
- else
- internalerror(2013021201);
+ if current_settings.fputype = fpu_soft then
+ case cgpara.location^.loc of
+ LOC_REFERENCE,LOC_CREFERENCE:
+ begin
+ case size of
+ OS_F64:
+ cg64.a_load64_ref_cgpara(list,ref,cgpara);
+ OS_F32:
+ a_load_ref_cgpara(list,size,ref,cgpara);
+ else
+ internalerror(2013021201);
+ end;
end;
- end;
- else
- inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara);
- end;
+ else
+ inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara);
+ end
+ else
+ inherited a_loadfpu_ref_cgpara(list,size,ref,cgpara);
end;
@@ -1100,10 +1114,41 @@ unit cgcpu;
begin
scratch_reg := force_to_dataregister(list, size, reg);
sign_extend(list, size, scratch_reg);
- if (a >= 1) and (a <= 8) then
+
+ { some special cases which can generate smarter code
+ using the SWAP instruction }
+ if (a = 16) then
+ begin
+ if (op = OP_SHL) then
+ begin
+ list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg));
+ list.concat(taicpu.op_reg(A_CLR,S_W,scratch_reg));
+ end
+ else if (op = OP_SHR) then
+ begin
+ list.concat(taicpu.op_reg(A_CLR,S_W,scratch_reg));
+ list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg));
+ end
+ else if (op = OP_SAR) then
+ begin
+ list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg));
+ list.concat(taicpu.op_reg(A_EXT,S_L,scratch_reg));
+ end
+ else if (op = OP_ROR) or (op = OP_ROL) then
+ list.concat(taicpu.op_reg(A_SWAP,S_NO,scratch_reg))
+ end
+ else if (a >= 1) and (a <= 8) then
begin
list.concat(taicpu.op_const_reg(opcode, S_L, a, scratch_reg));
end
+ else if (a >= 9) and (a < 16) then
+ begin
+ { Use two ops instead of const -> reg + shift with reg, because
+ this way is the same in length and speed but has less register
+ pressure }
+ list.concat(taicpu.op_const_reg(opcode, S_L, 8, scratch_reg));
+ list.concat(taicpu.op_const_reg(opcode, S_L, a-8, scratch_reg));
+ end
else
begin
{ move const to a register first }
@@ -1398,6 +1443,13 @@ unit cgcpu;
procedure tcg68k.a_cmp_reg_reg_label(list : TAsmList;size : tcgsize;cmp_op : topcmp;reg1,reg2 : tregister;l : tasmlabel);
begin
+ if (current_settings.cputype in cpu_coldfire-[cpu_isa_b,cpu_isa_c]) then
+ begin
+ sign_extend(list,size,reg1);
+ sign_extend(list,size,reg2);
+ size:=OS_INT;
+ end;
+
list.concat(taicpu.op_reg_reg(A_CMP,tcgsize2opsize[size],reg1,reg2));
{ emit the actual jump to the label }
a_jmp_cond(list,cmp_op,l);
@@ -1473,10 +1525,8 @@ unit cgcpu;
hp2 : treference;
hl : tasmlabel;
srcref,dstref : treference;
- orglen : tcgint;
begin
hregister := getintregister(list,OS_INT);
- orglen:=len;
{ from 12 bytes movs is being used }
if ((len<=8) or (not(cs_opt_size in current_settings.optimizerswitches) and (len<=12))) then
@@ -1568,7 +1618,28 @@ unit cgcpu;
end;
procedure tcg68k.g_overflowcheck(list: TAsmList; const l:tlocation; def:tdef);
+ var
+ hl : tasmlabel;
+ ai : taicpu;
+ cond : TAsmCond;
begin
+ if not(cs_check_overflow in current_settings.localswitches) then
+ exit;
+ current_asmdata.getjumplabel(hl);
+ if not ((def.typ=pointerdef) or
+ ((def.typ=orddef) and
+ (torddef(def).ordtype in [u64bit,u16bit,u32bit,u8bit,uchar,
+ pasbool8,pasbool16,pasbool32,pasbool64]))) then
+ cond:=C_VC
+ else
+ cond:=C_CC;
+ ai:=Taicpu.Op_Sym(A_Bxx,S_NO,hl);
+ ai.SetCondition(cond);
+ ai.is_jmp:=true;
+ list.concat(ai);
+
+ a_call_name(list,'FPC_OVERFLOW',false);
+ a_label(list,hl);
end;
procedure tcg68k.g_proc_entry(list: TAsmList; localsize: longint; nostackframe:boolean);
@@ -1582,13 +1653,13 @@ unit cgcpu;
if (localsize < 0) then
internalerror(2006122601);
- { Not to complicate the code generator too much, and since some }
- { of the systems only support this format, the localsize cannot }
- { exceed 32K in size. }
if (localsize > high(smallint)) then
- CGMessage(cg_e_localsize_too_big);
-
- list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,-localsize));
+ begin
+ list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,0));
+ list.concat(taicpu.op_const_reg(A_SUBA,S_L,localsize,NR_STACK_POINTER_REG));
+ end
+ else
+ list.concat(taicpu.op_reg_const(A_LINK,S_W,NR_FRAME_POINTER_REG,-localsize));
end;
end;
@@ -1698,6 +1769,7 @@ unit cgcpu;
{ calculate temp. size }
size:=0;
+ hreg:=NR_NO;
for r:=low(saved_standard_registers) to high(saved_standard_registers) do
if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
begin
@@ -1724,9 +1796,16 @@ unit cgcpu;
include(current_procinfo.flags,pi_has_saved_regs);
{ Copy registers to temp }
+ { NOTE: virtual registers allocated here won't be translated --> no higher-level stuff. }
href:=current_procinfo.save_regs_ref;
+ if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire) then
+ begin
+ list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0));
+ list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0));
+ reference_reset_base(href,NR_A0,0,sizeof(pint));
+ end;
if size = sizeof(aint) then
- a_load_reg_ref(list, OS_32, OS_32, hreg, href)
+ list.concat(taicpu.op_reg_ref(A_MOVE,S_L,hreg,href))
else
list.concat(taicpu.op_regset_ref(A_MOVEM,S_L,dataregs,addrregs,href));
end;
@@ -1750,6 +1829,7 @@ unit cgcpu;
exit;
{ Copy registers from temp }
size:=0;
+ hreg:=NR_NO;
for r:=low(saved_standard_registers) to high(saved_standard_registers) do
if saved_standard_registers[r] in rg[R_INTREGISTER].used_in_proc then
begin
@@ -1777,8 +1857,14 @@ unit cgcpu;
{ Restore registers from temp }
href:=current_procinfo.save_regs_ref;
+ if (href.offset<low(smallint)) and (current_settings.cputype in cpu_coldfire) then
+ begin
+ list.concat(taicpu.op_reg_reg(A_MOVE,S_L,href.base,NR_A0));
+ list.concat(taicpu.op_const_reg(A_ADDA,S_L,href.offset,NR_A0));
+ reference_reset_base(href,NR_A0,0,sizeof(pint));
+ end;
if size = sizeof(aint) then
- a_load_ref_reg(list, OS_32, OS_32, href, hreg)
+ list.concat(taicpu.op_ref_reg(A_MOVE,S_L,href,hreg))
else
list.concat(taicpu.op_ref_regset(A_MOVEM,S_L,href,dataregs,addrregs));
@@ -2097,6 +2183,34 @@ unit cgcpu;
end;
+ procedure tcg64f68k.a_op64_ref_reg(list : TAsmList;op:TOpCG;size : tcgsize;const ref : treference;reg : tregister64);
+ var
+ tempref : treference;
+ begin
+ case op of
+ OP_NEG,OP_NOT:
+ begin
+ a_load64_ref_reg(list,ref,reg);
+ a_op64_reg_reg(list,op,size,reg,reg);
+ end;
+
+ OP_AND,OP_OR:
+ begin
+ tempref:=ref;
+ tcg68k(cg).fixref(list,tempref);
+ inc(tempref.offset,4);
+ list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,tempref,reg.reglo));
+ dec(tempref.offset,4);
+ list.concat(taicpu.op_ref_reg(topcg2tasmop[op],S_L,tempref,reg.reghi));
+ end;
+ else
+ { XOR does not allow reference for source; ADD/SUB do not allow reference for
+ high dword, although low dword can still be handled directly. }
+ inherited a_op64_ref_reg(list,op,size,ref,reg);
+ end;
+ end;
+
+
procedure tcg64f68k.a_op64_const_reg(list : TAsmList;op:TOpCG;size: tcgsize; value : int64;regdst : tregister64);
var
lowvalue : cardinal;
diff --git a/compiler/m68k/cpubase.pas b/compiler/m68k/cpubase.pas
index 0d777f32ea..021e7d32fd 100644
--- a/compiler/m68k/cpubase.pas
+++ b/compiler/m68k/cpubase.pas
@@ -67,7 +67,7 @@ unit cpubase;
{ mc64040 instructions }
a_move16,
{ coldfire v4 instructions }
- a_mov3q,a_mvz,a_mvs,a_sats,
+ a_mov3q,a_mvz,a_mvs,a_sats,a_byterev,a_ff1,
{ fpu processor instructions - directly supported only. }
{ ieee aware and misc. condition codes not supported }
a_fabs,a_fadd,
@@ -153,7 +153,7 @@ unit cpubase;
{ registers which may be destroyed by calls }
VOLATILE_INTREGISTERS = [RS_D0,RS_D1];
- VOLATILE_FPUREGISTERS = [];
+ VOLATILE_FPUREGISTERS = [RS_FP0,RS_FP1];
VOLATILE_ADDRESSREGISTERS = [RS_A0,RS_A1];
type
@@ -311,6 +311,7 @@ unit cpubase;
}
saved_standard_registers : array[0..5] of tsuperregister = (RS_D2,RS_D3,RS_D4,RS_D5,RS_D6,RS_D7);
saved_address_registers : array[0..4] of tsuperregister = (RS_A2,RS_A3,RS_A4,RS_A5,RS_A6);
+ saved_fpu_registers : array[0..5] of tsuperregister = (RS_FP2,RS_FP3,RS_FP4,RS_FP5,RS_FP6,RS_FP7);
{ this is only for the generic code which is not used for this architecture }
saved_mm_registers : array[0..0] of tsuperregister = (RS_INVALID);
@@ -471,7 +472,9 @@ implementation
R_INTREGISTER :
result:=OS_32;
R_FPUREGISTER :
- result:=OS_F64;
+ { 68881 & compatibles -> 80 bit }
+ { CF FPU -> 64 bit, but that's unsupported for now }
+ result:=OS_F80;
else
internalerror(200303181);
end;
diff --git a/compiler/m68k/cpuinfo.pas b/compiler/m68k/cpuinfo.pas
index 38f6f79a49..80f09b4f29 100644
--- a/compiler/m68k/cpuinfo.pas
+++ b/compiler/m68k/cpuinfo.pas
@@ -21,6 +21,9 @@ Interface
Type
bestreal = double;
+{$if FPC_FULLVERSION>20700}
+ bestrealrec = TDoubleRec;
+{$endif FPC_FULLVERSION>20700}
ts32real = single;
ts64real = double;
ts80real = extended;
@@ -48,7 +51,25 @@ Type
fpu_68881
);
+ tcontrollertype =
+ (ct_none
+ );
+
+
Const
+ { Is there support for dealing with multiple microcontrollers available }
+ { for this platform? }
+ ControllerSupport = false;
+
+ { We know that there are fields after sramsize
+ but we don't care about this warning }
+ {$PUSH}
+ {$WARN 3177 OFF}
+ embedded_controllers : array [tcontrollertype] of tcontrollerdatatype =
+ (
+ (controllertypestr:''; controllerunitstr:''; flashbase:0; flashsize:0; srambase:0; sramsize:0));
+ {$POP}
+
{ calling conventions supported by the code generator }
supported_calling_conventions : tproccalloptions = [
pocall_internproc,
@@ -107,19 +128,21 @@ type
(CPUM68K_HAS_DBRA, { CPU supports the DBRA instruction }
CPUM68K_HAS_CAS, { CPU supports the CAS instruction }
CPUM68K_HAS_TAS, { CPU supports the TAS instruction }
- CPUM68K_HAS_BRAL { CPU supports the BRA.L/Bcc.L instructions }
+ CPUM68K_HAS_BRAL, { CPU supports the BRA.L/Bcc.L instructions }
+ CPUM68K_HAS_ROLROR, { CPU supports the ROL/ROR and ROXL/ROXR instructions }
+ CPUM68K_HAS_BYTEREV { CPU supports the BYTEREV instruction }
);
const
cpu_capabilities : array[tcputype] of set of tcpuflags =
( { cpu_none } [],
- { cpu_68000 } [CPUM68K_HAS_DBRA,CPUM68K_HAS_TAS],
- { cpu_68020 } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL],
- { cpu_68040 } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL],
+ { cpu_68000 } [CPUM68K_HAS_DBRA,CPUM68K_HAS_TAS,CPUM68K_HAS_ROLROR],
+ { cpu_68020 } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR],
+ { cpu_68040 } [CPUM68K_HAS_DBRA,CPUM68K_HAS_CAS,CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL,CPUM68K_HAS_ROLROR],
{ cpu_isaa } [],
- { cpu_isaap } [CPUM68K_HAS_BRAL],
+ { cpu_isaap } [CPUM68K_HAS_BRAL,CPUM68K_HAS_BYTEREV],
{ cpu_isab } [CPUM68K_HAS_TAS,CPUM68K_HAS_BRAL],
- { cpu_isac } [CPUM68K_HAS_TAS]
+ { cpu_isac } [CPUM68K_HAS_TAS,CPUM68K_HAS_BYTEREV]
);
{ all CPUs commonly called "coldfire" }
diff --git a/compiler/m68k/itcpugas.pas b/compiler/m68k/itcpugas.pas
index cfe77aae22..4e134a3e70 100644
--- a/compiler/m68k/itcpugas.pas
+++ b/compiler/m68k/itcpugas.pas
@@ -61,7 +61,7 @@ interface
{ mc64040 instructions }
'move16',
{ coldfire v4 instructions }
- 'mov3q','mvz','mvs','sats',
+ 'mov3q','mvz','mvs','sats','byterev','ff1',
{ fpu processor instructions - directly supported only. }
{ ieee aware and misc. condition codes not supported }
'fabs','fadd',
diff --git a/compiler/m68k/n68kadd.pas b/compiler/m68k/n68kadd.pas
index a812a2ee5e..84c88e3202 100644
--- a/compiler/m68k/n68kadd.pas
+++ b/compiler/m68k/n68kadd.pas
@@ -32,23 +32,13 @@ interface
type
t68kaddnode = class(tcgaddnode)
private
- function cmp64_lt(left_reg,right_reg:tregister64):tregister;
- function cmp64_le(left_reg,right_reg:tregister64):tregister;
- function cmp64_eq(left_reg,right_reg:tregister64):tregister;
- function cmp64_ne(left_reg,right_reg:tregister64):tregister;
- function cmp64_ltu(left_reg,right_reg:tregister64):tregister;
- function cmp64_leu(left_reg,right_reg:tregister64):tregister;
-
function getresflags(unsigned: boolean) : tresflags;
- function getres64_register(unsigned:boolean;left_reg,right_reg:tregister64):tregister;
protected
procedure second_addfloat;override;
procedure second_cmpfloat;override;
procedure second_cmpordinal;override;
procedure second_cmpsmallset;override;
procedure second_cmp64bit;override;
- public
- function pass_1:tnode;override;
end;
@@ -62,198 +52,12 @@ implementation
cpuinfo,pass_1,pass_2,regvars,
cpupara,cgutils,procinfo,
ncon,nset,
- ncgutil,tgobj,rgobj,rgcpu,cgobj,hlcgobj,cg64f32;
+ ncgutil,tgobj,rgobj,rgcpu,cgobj,cgcpu,hlcgobj,cg64f32;
{*****************************************************************************
Helpers
*****************************************************************************}
- function t68kaddnode.cmp64_lt(left_reg,right_reg:tregister64):tregister;
- var
- labelcmp64_1,labelcmp64_2 : tasmlabel;
- tmpreg : tregister;
- begin
- tmpreg:=cg.getintregister(current_asmdata.currasmlist,OS_INT);
-
- { load the value for "false" }
- cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,0,tmpreg);
-
- current_asmdata.getjumplabel(labelcmp64_1);
- current_asmdata.getjumplabel(labelcmp64_2);
-
- { check whether left_reg.reghi is less than right_reg.reghi }
- current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,right_reg.reghi,left_reg.reghi));
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_LT,S_NO,labelcmp64_2));
-
- { are left_reg.reghi and right_reg.reghi equal? }
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64_1));
-
- { is left_reg.reglo less than right_reg.reglo? }
- current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,right_reg.reglo,left_reg.reglo));
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_CS,S_NO,labelcmp64_2));
-
- current_asmdata.currasmlist.concat(Taicpu.op_sym(A_BRA,S_NO,labelcmp64_1));
- cg.a_label(current_asmdata.currasmlist,labelcmp64_2);
-
- { load the value for "true" }
- cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,1,tmpreg);
-
- cg.a_label(current_asmdata.currasmlist,labelcmp64_1);
- result:=tmpreg;
- end;
-
- function t68kaddnode.cmp64_le(left_reg,right_reg:tregister64):tregister;
- var
- labelcmp64_1,labelcmp64_2 : tasmlabel;
- tmpreg : tregister;
- begin
- tmpreg:=cg.getintregister(current_asmdata.currasmlist,OS_INT);
-
- { load the value for "false" }
- cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,0,tmpreg);
-
- current_asmdata.getjumplabel(labelcmp64_1);
- current_asmdata.getjumplabel(labelcmp64_2);
-
- { check whether right_reg.reghi is less than left_reg.reghi }
- current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reghi,right_reg.reghi));
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_LT,S_NO,labelcmp64_1));
-
- { are left_reg.reghi and right_reg.reghi equal? }
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64_2));
-
- { is right_reg.reglo less than left_reg.reglo? }
- current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reglo,right_reg.reglo));
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_CS,S_NO,labelcmp64_1));
-
- cg.a_label(current_asmdata.currasmlist,labelcmp64_2);
-
- { load the value for "true" }
- cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,1,tmpreg);
-
- cg.a_label(current_asmdata.currasmlist,labelcmp64_1);
- result:=tmpreg;
- end;
-
- function t68kaddnode.cmp64_eq(left_reg,right_reg:tregister64):tregister;
- var
- labelcmp64 : tasmlabel;
- tmpreg : tregister;
- begin
- tmpreg:=cg.getintregister(current_asmdata.currasmlist,OS_INT);
- current_asmdata.getjumplabel(labelcmp64);
-
- { load the value for "false" }
- cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,0,tmpreg);
-
- { is the high order longword equal? }
- current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reghi,right_reg.reghi));
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64));
-
- { is the low order longword equal? }
- current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reglo,right_reg.reglo));
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64));
-
- { load the value for "true" }
- cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,1,tmpreg);
-
- cg.a_label(current_asmdata.currasmlist,labelcmp64);
- result:=tmpreg;
- end;
-
- function t68kaddnode.cmp64_ne(left_reg,right_reg:tregister64):tregister;
- var
- labelcmp64 : tasmlabel;
- tmpreg : tregister;
- begin
- tmpreg:=cg.getintregister(current_asmdata.currasmlist,OS_INT);
- current_asmdata.getjumplabel(labelcmp64);
-
- { load the value for "true" }
- cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,1,tmpreg);
-
- { is the high order longword equal? }
- current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reghi,right_reg.reghi));
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64));
-
- { is the low order longword equal? }
- current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reglo,right_reg.reglo));
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64));
-
- { load the value for "false" }
- cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,0,tmpreg);
-
- cg.a_label(current_asmdata.currasmlist,labelcmp64);
- result:=tmpreg;
- end;
-
- function t68kaddnode.cmp64_ltu(left_reg,right_reg:tregister64):tregister;
- var
- labelcmp64_1,labelcmp64_2 : tasmlabel;
- tmpreg : tregister;
- begin
- tmpreg:=cg.getintregister(current_asmdata.currasmlist,OS_INT);
-
- { load the value for "false" }
- cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,0,tmpreg);
-
- current_asmdata.getjumplabel(labelcmp64_1);
- current_asmdata.getjumplabel(labelcmp64_2);
-
- { check whether left_reg.reghi is less than right_reg.reghi }
- current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,right_reg.reghi,left_reg.reghi));
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_CS,S_NO,labelcmp64_2));
-
- { are left_reg.reghi and right_reg.reghi equal? }
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64_1));
-
- { is left_reg.reglo less than right_reg.reglo? }
- current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,right_reg.reglo,left_reg.reglo));
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_CS,S_NO,labelcmp64_2));
-
- current_asmdata.currasmlist.concat(Taicpu.op_sym(A_BRA,S_NO,labelcmp64_1));
- cg.a_label(current_asmdata.currasmlist,labelcmp64_2);
-
- { load the value for "true" }
- cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,1,tmpreg);
-
- cg.a_label(current_asmdata.currasmlist,labelcmp64_1);
- result:=tmpreg;
- end;
-
- function t68kaddnode.cmp64_leu(left_reg,right_reg:tregister64):tregister;
- var
- labelcmp64_1,labelcmp64_2 : tasmlabel;
- tmpreg : tregister;
- begin
- tmpreg:=cg.getintregister(current_asmdata.currasmlist,OS_INT);
-
- { load the value for "false" }
- cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,0,tmpreg);
-
- current_asmdata.getjumplabel(labelcmp64_1);
- current_asmdata.getjumplabel(labelcmp64_2);
-
- { check whether right_reg.reghi is less than left_reg.reghi }
- current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reghi,right_reg.reghi));
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_CS,S_NO,labelcmp64_1));
-
- { are left_reg.reghi and right_reg.reghi equal? }
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_NE,S_NO,labelcmp64_2));
-
- { is right_reg.reglo less than left_reg.reglo? }
- current_asmdata.currasmlist.concat(taicpu.op_reg_reg(A_CMP,S_L,left_reg.reglo,right_reg.reglo));
- current_asmdata.currasmlist.concat(taicpu.op_cond_sym(A_BXX,C_CS,S_NO,labelcmp64_1));
-
- cg.a_label(current_asmdata.currasmlist,labelcmp64_2);
-
- { load the value for "true" }
- cg.a_load_const_reg(current_asmdata.currasmlist,OS_INT,1,tmpreg);
-
- cg.a_label(current_asmdata.currasmlist,labelcmp64_1);
- result:=tmpreg;
- end;
-
function t68kaddnode.getresflags(unsigned : boolean) : tresflags;
begin
case nodetype of
@@ -268,6 +72,8 @@ implementation
lten : getresflags:=F_GE;
gtn : getresflags:=F_L;
gten : getresflags:=F_LE;
+ else
+ internalerror(2014082030);
end
else
case nodetype of
@@ -275,6 +81,8 @@ implementation
lten : getresflags:=F_LE;
gtn : getresflags:=F_G;
gten : getresflags:=F_GE;
+ else
+ internalerror(2014082031);
end;
end
else
@@ -285,6 +93,8 @@ implementation
lten : getresflags:=F_AE;
gtn : getresflags:=F_B;
gten : getresflags:=F_BE;
+ else
+ internalerror(2014082032);
end
else
case nodetype of
@@ -292,71 +102,13 @@ implementation
lten : getresflags:=F_BE;
gtn : getresflags:=F_A;
gten : getresflags:=F_AE;
+ else
+ internalerror(2014082033);
end;
end;
end;
end;
- function t68kaddnode.getres64_register(unsigned:boolean;left_reg,right_reg:tregister64):tregister;
- begin
- case nodetype of
- equaln:
- result:=cmp64_eq(left_reg,right_reg);
- unequaln:
- result:=cmp64_ne(left_reg,right_reg);
- else
- if not unsigned then
- begin
- if nf_swapped in flags then
- case nodetype of
- ltn:
- result:=cmp64_lt(right_reg,left_reg);
- lten:
- result:=cmp64_le(right_reg,left_reg);
- gtn:
- result:=cmp64_lt(left_reg,right_reg);
- gten:
- result:=cmp64_le(left_reg,right_reg);
- end
- else
- case nodetype of
- ltn:
- result:=cmp64_lt(left_reg,right_reg);
- lten:
- result:=cmp64_le(left_reg,right_reg);
- gtn:
- result:=cmp64_lt(right_reg,left_reg);
- gten:
- result:=cmp64_le(right_reg,left_reg);
- end;
- end
- else
- begin
- if nf_swapped in Flags then
- case nodetype of
- ltn:
- result:=cmp64_ltu(right_reg,left_reg);
- lten:
- result:=cmp64_leu(right_reg,left_reg);
- gtn:
- result:=cmp64_ltu(left_reg,right_reg);
- gten:
- result:=cmp64_leu(left_reg,right_reg);
- end
- else
- case nodetype of
- ltn:
- result:=cmp64_ltu(left_reg,right_reg);
- lten:
- result:=cmp64_leu(left_reg,right_reg);
- gtn:
- result:=cmp64_ltu(right_reg,left_reg);
- gten:
- result:=cmp64_leu(right_reg,left_reg);
- end;
- end;
- end;
- end;
{*****************************************************************************
AddFloat
@@ -386,56 +138,53 @@ implementation
if nf_swapped in flags then
swapleftright;
- // put both operands in a register
- hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true);
- hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
+ case current_settings.fputype of
+ fpu_68881:
+ begin
+ // put both operands in a register
+ hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true);
+ hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
- // initialize de result
- location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
- if left.location.loc = LOC_FPUREGISTER then
- location.register := left.location.register
- else if right.location.loc = LOC_FPUREGISTER then
- location.register := right.location.register
- else
- location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
-
- // emit the actual operation
- {
- current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(op,
- location.register,left.location.register,
- right.location.register))
- }
+ // initialize the result
+ location_reset(location,LOC_FPUREGISTER,def_cgsize(resultdef));
+ location.register := cg.getfpuregister(current_asmdata.CurrAsmList,location.size);
+
+ // emit the actual operation
+ current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FMOVE,S_FX,left.location.register,location.register));
+ current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(op,S_FX,right.location.register,location.register));
+ end;
+ else
+ // softfpu should be handled in pass1, others are not yet supported...
+ internalerror(2015010201);
+ end;
end;
procedure t68kaddnode.second_cmpfloat;
begin
pass_left_right;
-
-{
if (nf_swapped in flags) then
swapleftright;
-}
- { force fpureg as location, left right doesn't matter
- as both will be in a fpureg }
- hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
- hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true);
- location_reset(location,LOC_FLAGS,OS_NO);
- location.resflags:=getresflags(true);
-{
- if nodetype in [equaln,unequaln] then
- current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMF,
- left.location.register,right.location.register),
- cgsize2fpuoppostfix[def_cgsize(resultdef)]))
- else
- current_asmdata.CurrAsmList.concat(setoppostfix(taicpu.op_reg_reg(A_CMFE,
- left.location.register,right.location.register),
- cgsize2fpuoppostfix[def_cgsize(resultdef)]));
+ case current_settings.fputype of
+ fpu_68881:
+ begin
+ location_reset(location,LOC_FLAGS,OS_NO);
- location_reset(location,LOC_FLAGS,OS_NO);
- location.resflags:=getresflags(false);
-}
+ { force fpureg as location, left right doesn't matter
+ as both will be in a fpureg }
+ hlcg.location_force_fpureg(current_asmdata.CurrAsmList,left.location,left.resultdef,true);
+ hlcg.location_force_fpureg(current_asmdata.CurrAsmList,right.location,right.resultdef,true);
+
+ // emit compare
+ current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_FCMP,S_FX,right.location.register,left.location.register));
+
+ location.resflags:=getresflags(false);
+ end;
+ else
+ // softfpu should be handled in pass1, others are not yet supported...
+ internalerror(2015010201);
+ end;
end;
@@ -500,111 +249,92 @@ implementation
procedure t68kaddnode.second_cmpordinal;
var
unsigned : boolean;
- useconst : boolean;
tmpreg : tregister;
opsize : topsize;
cmpsize : tcgsize;
+ href: treference;
begin
- pass_left_right;
- { set result location }
- location_reset(location,LOC_JUMP,OS_NO);
-
- { ToDo : set "allowconstants" to True, but this seems to upset Coldfire
- a bit for the CMP instruction => check manual and implement
- exception accordingly below }
- { load values into registers (except constants) }
- force_reg_left_right(true, false);
-
{ determine if the comparison will be unsigned }
unsigned:=not(is_signed(left.resultdef)) or
not(is_signed(right.resultdef));
+ { this puts constant operand (if any) to the right }
+ pass_left_right;
+ { tentatively assume left size (correct for possible TST, will fix later) }
+ cmpsize:=def_cgsize(left.resultdef);
+ opsize:=tcgsize2opsize[cmpsize];
- // get the constant on the right if there is one
- if (left.location.loc = LOC_CONSTANT) then
- swapleftright;
- // can we use an immediate, or do we have to load the
- // constant in a register first?
- if (right.location.loc = LOC_CONSTANT) then
- begin
-{$ifdef extdebug}
- if (right.location.size in [OS_64,OS_S64]) and (hi(right.location.value64)<>0) and ((hi(right.location.value64)<>-1) or unsigned) then
- internalerror(2002080301);
-{$endif extdebug}
- if (nodetype in [equaln,unequaln]) then
- if (unsigned and
- (right.location.value > high(word))) or
- (not unsigned and
- (longint(right.location.value) < low(smallint)) or
- (longint(right.location.value) > high(smallint))) then
- { we can then maybe use a constant in the 'othersigned' case
- (the sign doesn't matter for // equal/unequal)}
- unsigned := not unsigned;
-
- if (unsigned and
- ((right.location.value) <= high(word))) or
- (not(unsigned) and
- (longint(right.location.value) >= low(smallint)) and
- (longint(right.location.value) <= high(smallint))) then
- useconst := true
- else
- begin
- useconst := false;
- tmpreg := cg.getintregister(current_asmdata.CurrAsmList,OS_INT);
- cg.a_load_const_reg(current_asmdata.CurrAsmList,OS_INT,
- aword(right.location.value),tmpreg);
- end
- end
- else
- useconst := false;
- location.loc := LOC_FLAGS;
- location.resflags := getresflags(unsigned);
- if tcgsize2size[right.location.size]=tcgsize2size[left.location.size] then
- cmpsize:=left.location.size
- else
- { ToDo : zero/sign extend??? }
- if tcgsize2size[right.location.size]<tcgsize2size[left.location.size] then
- cmpsize:=left.location.size
- else
- cmpsize:=right.location.size;
- opsize:=tcgsize2opsize[cmpsize];
- if opsize=S_NO then
- internalerror(2013090301);
- { Attention: The RIGHT(!) operand is substracted from and must be a
- register! }
- if (right.location.loc = LOC_CONSTANT) then
- if useconst then
- current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,opsize,
- longint(right.location.value),left.location.register))
- else
- begin
- current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,opsize,
- tmpreg,left.location.register));
- end
- else
- current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,opsize,
- right.location.register,left.location.register));
- end;
+ { set result location }
+ location_reset(location,LOC_FLAGS,OS_NO);
+ { see if we can optimize into TST }
+ if (right.location.loc=LOC_CONSTANT) and (right.location.value=0) then
+ begin
+ { Unsigned <0 or >=0 should not reach pass2, most likely }
+ case left.location.loc of
+ LOC_REFERENCE,
+ LOC_CREFERENCE:
+ begin
+ href:=left.location.reference;
+ tcg68k(cg).fixref(current_asmdata.CurrAsmList,href);
+ current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,opsize,href));
+ location_freetemp(current_asmdata.CurrAsmList,left.location);
+ end;
+ else
+ hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+ current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,opsize,left.location.register));
+ end;
+ location.resflags := getresflags(unsigned);
+ exit;
+ end;
- function t68kaddnode.pass_1:tnode;
- var
- ld,rd : tdef;
- begin
- result:=inherited pass_1;
+ { Coldfire supports byte/word compares only starting with ISA_B,
+ !!see remark about Qemu weirdness in tcg68k.a_cmp_const_reg_label }
+ if (opsize<>S_L) and (current_settings.cputype in cpu_coldfire{-[cpu_isa_b,cpu_isa_c]}) then
+ begin
+ { 1) Extension is needed for LOC_REFERENCE, but what about LOC_REGISTER ? Perhaps after fixing cg we can assume
+ that high bits of registers are correct.
+ 2) Assuming that extension depends only on source signedness --> destination OS_32 is acceptable. }
+ hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,cgsize_orddef(OS_32),false);
+ if (right.location.loc<>LOC_CONSTANT) then
+ hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,cgsize_orddef(OS_32),false);
+ opsize:=S_L;
+ end
+ else if not (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+ begin
+ if not (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+ hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true)
+ else
+ begin
+ location_swap(left.location,right.location);
+ toggleflag(nf_swapped);
+ end;
+ end;
+ { left is now in register }
+ case right.location.loc of
+ LOC_CONSTANT:
+ current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,opsize,
+ longint(right.location.value),left.location.register));
+ LOC_REFERENCE,
+ LOC_CREFERENCE:
+ begin
+ href:=right.location.reference;
+ tcg68k(cg).fixref(current_asmdata.CurrAsmList,href);
+ current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_CMP,opsize,href,
+ left.location.register));
+ end;
+ LOC_REGISTER,
+ LOC_CREGISTER:
+ current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,opsize,
+ right.location.register,left.location.register));
+ else
+ hlcg.location_force_reg(current_asmdata.CurrAsmList,right.location,right.resultdef,right.resultdef,true);
+ current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,opsize,
+ right.location.register,left.location.register));
+ end;
- { for 64 bit operations we return the resulting value in a register }
- if not assigned(result) then
- begin
- rd:=right.resultdef;
- ld:=left.resultdef;
- if (nodetype in [ltn,lten,gtn,gten,equaln,unequaln]) and
- (
- ((ld.typ=orddef) and (torddef(ld).ordtype in [u64bit,s64bit,scurrency])) or
- ((rd.typ=orddef) and (torddef(rd).ordtype in [u64bit,s64bit,scurrency]))
- ) then
- expectloc:=LOC_REGISTER;
- end;
- end;
+ { update location because sides could have been swapped }
+ location.resflags:=getresflags(unsigned);
+ end;
{*****************************************************************************
@@ -613,123 +343,167 @@ implementation
procedure t68kaddnode.second_cmp64bit;
var
+ hlab: tasmlabel;
unsigned : boolean;
- tmp_left_reg : tregister;
+ href: treference;
+
+ procedure firstjmp64bitcmp;
+ var
+ oldnodetype : tnodetype;
+ begin
+ case nodetype of
+ ltn,gtn:
+ begin
+ if (hlab<>current_procinfo.CurrTrueLabel) then
+ cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel);
+ { cheat a little bit for the negative test }
+ toggleflag(nf_swapped);
+ if (hlab<>current_procinfo.CurrFalseLabel) then
+ cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel);
+ toggleflag(nf_swapped);
+ end;
+ lten,gten:
+ begin
+ oldnodetype:=nodetype;
+ if nodetype=lten then
+ nodetype:=ltn
+ else
+ nodetype:=gtn;
+ if (hlab<>current_procinfo.CurrTrueLabel) then
+ cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrTrueLabel);
+ { cheat for the negative test }
+ if nodetype=ltn then
+ nodetype:=gtn
+ else
+ nodetype:=ltn;
+ if (hlab<>current_procinfo.CurrFalseLabel) then
+ cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(unsigned),current_procinfo.CurrFalseLabel);
+ nodetype:=oldnodetype;
+ end;
+ equaln:
+ cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrFalseLabel);
+ unequaln:
+ cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrTrueLabel);
+ end;
+ end;
+
+ procedure secondjmp64bitcmp;
+ begin
+ case nodetype of
+ ltn,gtn,lten,gten:
+ begin
+ cg.a_jmp_flags(current_asmdata.CurrAsmList,getresflags(true),current_procinfo.CurrTrueLabel);
+ cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
+ end;
+ equaln:
+ begin
+ cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrFalseLabel);
+ cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrTrueLabel);
+ end;
+ unequaln:
+ begin
+ cg.a_jmp_flags(current_asmdata.CurrAsmList,F_NE,current_procinfo.CurrTrueLabel);
+ cg.a_jmp_always(current_asmdata.CurrAsmList,current_procinfo.CurrFalseLabel);
+ end;
+ end;
+ end;
+
begin
+ { This puts constant operand (if any) to the right }
pass_left_right;
- force_reg_left_right(false,false);
unsigned:=not(is_signed(left.resultdef)) or
not(is_signed(right.resultdef));
- location_reset(location,LOC_REGISTER,OS_INT);
- location.register:=getres64_register(unsigned,left.location.register64,right.location.register64);
-
- { keep the below code for now, as we could optimize the =/<> code later
- on based on it }
-
- // writeln('second_cmp64bit');
-// pass_left_right;
+ location_reset(location,LOC_JUMP,OS_NO);
+ { Relational compares against constants having low dword=0 can omit the
+ second compare based on the fact that any unsigned value is >=0 }
+ hlab:=nil;
+ if (right.location.loc=LOC_CONSTANT) and
+ (lo(right.location.value64)=0) then
+ begin
+ case getresflags(true) of
+ F_AE: hlab:=current_procinfo.CurrTrueLabel;
+ F_B: hlab:=current_procinfo.CurrFalseLabel;
+ end;
+ end;
-// load_left_right(true,false);
-(*
- case nodetype of
- ltn,lten,
- gtn,gten:
- begin
- emit_cmp64_hi;
- firstjmp64bitcmp;
- emit_cmp64_lo;
- secondjmp64bitcmp;
- end;
- equaln,unequaln:
- begin
- // instead of doing a complicated compare, do
- // (left.hi xor right.hi) or (left.lo xor right.lo)
- // (somewhate optimized so that no superfluous 'mr's are
- // generated)
- if (left.location.loc = LOC_CONSTANT) then
- swapleftright;
- if (right.location.loc = LOC_CONSTANT) then
- begin
- if left.location.loc = LOC_REGISTER then
- begin
- tempreg64.reglo := left.location.register64.reglo;
- tempreg64.reghi := left.location.register64.reghi;
- end
- else
- begin
- if (aword(right.location.valueqword) <> 0) then
- tempreg64.reglo := cg.getintregister(current_asmdata.CurrAsmList)
- else
- tempreg64.reglo := left.location.register64.reglo;
- if ((right.location.valueqword shr 32) <> 0) then
- tempreg64.reghi := cg.getintregister(current_asmdata.CurrAsmList)
- else
- tempreg64.reghi := left.location.register64.reghi;
- end;
-
- if (aword(right.location.valueqword) <> 0) then
- { negative values can be handled using SUB, }
- { positive values < 65535 using XOR. }
- if (longint(right.location.valueqword) >= -32767) and
- (longint(right.location.valueqword) < 0) then
- cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,
- aword(right.location.valueqword),
- left.location.register64.reglo,tempreg64.reglo)
- else
- cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_INT,
- aword(right.location.valueqword),
- left.location.register64.reglo,tempreg64.reglo);
-
- if ((right.location.valueqword shr 32) <> 0) then
- if (longint(right.location.valueqword shr 32) >= -32767) and
- (longint(right.location.valueqword shr 32) < 0) then
- cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_SUB,OS_INT,
- aword(right.location.valueqword shr 32),
- left.location.register64.reghi,tempreg64.reghi)
- else
- cg.a_op_const_reg_reg(current_asmdata.CurrAsmList,OP_XOR,OS_INT,
- aword(right.location.valueqword shr 32),
- left.location.register64.reghi,tempreg64.reghi);
- end
- else
- begin
- tempreg64.reglo := cg.getintregister(current_asmdata.CurrAsmList);
- tempreg64.reghi := cg.getintregister(current_asmdata.CurrAsmList);
- cg64.a_op64_reg_reg_reg(current_asmdata.CurrAsmList,OP_XOR,
- left.location.register64,right.location.register64,
- tempreg64);
- end;
-
- cg.a_reg_alloc(current_asmdata.CurrAsmList,R_0);
- current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg_reg(A_OR_,R_0,
- tempreg64.reglo,tempreg64.reghi));
- cg.a_reg_dealloc(current_asmdata.CurrAsmList,R_0);
- if (tempreg64.reglo <> left.location.register64.reglo) then
- cg.ungetregister(current_asmdata.CurrAsmList,tempreg64.reglo);
- if (tempreg64.reghi <> left.location.register64.reghi) then
- cg.ungetregister(current_asmdata.CurrAsmList,tempreg64.reghi);
-
- location_reset(location,LOC_FLAGS,OS_NO);
- location.resflags := getresflags;
+ if (right.location.loc=LOC_CONSTANT) and (right.location.value64=0) and
+ (nodetype in [equaln,unequaln]) then
+ begin
+ case left.location.loc of
+ LOC_REFERENCE,
+ LOC_CREFERENCE:
+ begin
+ href:=left.location.reference;
+ tcg68k(cg).fixref(current_asmdata.CurrAsmList,href);
+ current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,S_L,href));
+ firstjmp64bitcmp;
+ inc(href.offset,4);
+ current_asmdata.CurrAsmList.concat(taicpu.op_ref(A_TST,S_L,href));
+ secondjmp64bitcmp;
+ location_freetemp(current_asmdata.CurrAsmList,left.location);
end;
- else
- internalerror(2002072803);
+ else
+ hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true);
+ current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,left.location.register64.reglo));
+ firstjmp64bitcmp;
+ current_asmdata.CurrAsmList.concat(taicpu.op_reg(A_TST,S_L,left.location.register64.reghi));
+ secondjmp64bitcmp;
end;
+ exit;
+ end;
+ { left and right no register? }
+ { then one must be demanded }
+ if not (left.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+ begin
+ if not (right.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
+ hlcg.location_force_reg(current_asmdata.CurrAsmList,left.location,left.resultdef,left.resultdef,true)
+ else
+ begin
+ location_swap(left.location,right.location);
+ toggleflag(nf_swapped);
+ end;
+ end;
- { set result location }
- { (emit_compare sets it to LOC_FLAGS for compares, so set the }
- { real location only now) (JM) }
- if cmpop and
- not(nodetype in [equaln,unequaln]) then
- location_reset(location,LOC_JUMP,OS_NO);
-*)
- // location_reset(location,LOC_JUMP,OS_NO);
- // writeln('second_cmp64_exit');
- end;
+ { left is now in register }
+ case right.location.loc of
+ LOC_REGISTER,LOC_CREGISTER:
+ begin
+ current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,S_L,right.location.register64.reghi,left.location.register64.reghi));
+ firstjmp64bitcmp;
+ current_asmdata.CurrAsmList.concat(taicpu.op_reg_reg(A_CMP,S_L,right.location.register64.reglo,left.location.register64.reglo));
+ secondjmp64bitcmp;
+ end;
+ LOC_REFERENCE,LOC_CREFERENCE:
+ begin
+ href:=right.location.reference;
+ tcg68k(cg).fixref(current_asmdata.CurrAsmList,href);
+ current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_CMP,S_L,href,left.location.register64.reghi));
+ firstjmp64bitcmp;
+ inc(href.offset,4);
+ current_asmdata.CurrAsmList.concat(taicpu.op_ref_reg(A_CMP,S_L,href,left.location.register64.reglo));
+ secondjmp64bitcmp;
+ location_freetemp(current_asmdata.CurrAsmList,right.location);
+ end;
+ LOC_CONSTANT:
+ begin
+ current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_L,aint(hi(right.location.value64)),left.location.register64.reghi));
+ firstjmp64bitcmp;
+ if assigned(hlab) then
+ cg.a_jmp_always(current_asmdata.CurrAsmList,hlab)
+ else
+ begin
+ current_asmdata.CurrAsmList.concat(taicpu.op_const_reg(A_CMP,S_L,aint(lo(right.location.value64)),left.location.register64.reglo));
+ secondjmp64bitcmp;
+ end;
+ end;
+ else
+ InternalError(2014072501);
+ end;
+ end;
begin
diff --git a/compiler/m68k/n68kcnv.pas b/compiler/m68k/n68kcnv.pas
index f49769e169..0158536efe 100644
--- a/compiler/m68k/n68kcnv.pas
+++ b/compiler/m68k/n68kcnv.pas
@@ -68,8 +68,14 @@ implementation
end
else
{ converting a 64bit integer to a float requires a helper }
- if is_64bitint(left.resultdef) then
+ if is_64bitint(left.resultdef) or
+ is_currency(left.resultdef) then
begin
+ { hack to avoid double division by 10000, as it's
+ already done by typecheckpass.resultdef_int_to_real }
+ if is_currency(left.resultdef) then
+ left.resultdef := s64inttype;
+
if is_signed(left.resultdef) then
fname := 'fpc_int64_to_double'
else
diff --git a/compiler/m68k/n68kmat.pas b/compiler/m68k/n68kmat.pas
index 8314498f9b..623e5f18a6 100644
--- a/compiler/m68k/n68kmat.pas
+++ b/compiler/m68k/n68kmat.pas
@@ -70,8 +70,7 @@ implementation
procedure tm68knotnode.second_boolean;
var
hreg: tregister;
- opsize : tcgsize;
- loc : tcgloc;
+ opsize : tcgsize;
begin
if not handle_locjump then
begin
@@ -154,10 +153,8 @@ implementation
procedure tm68kmoddivnode.emit_mod_reg_reg(signed: boolean;denum,num : tregister);
- var tmpreg : tregister;
- continuelabel : tasmlabel;
- signlabel : tasmlabel;
- reg_d0,reg_d1 : tregister;
+ var
+ tmpreg : tregister;
begin
if current_settings.cputype=cpu_MC68020 then
begin
diff --git a/compiler/m68k/ra68k.pas b/compiler/m68k/ra68k.pas
index 7dff294853..a28cf942af 100644
--- a/compiler/m68k/ra68k.pas
+++ b/compiler/m68k/ra68k.pas
@@ -328,6 +328,7 @@ unit ra68k;
function TM68kInstruction.ConcatLabeledInstr(p : TAsmList):tai;
begin
+ result:=nil;
if ((opcode >= A_BCC) and (opcode <= A_BVS)) or
(opcode = A_BRA) or (opcode = A_BSR) or
(opcode = A_JMP) or (opcode = A_JSR) or
diff --git a/compiler/m68k/ra68kmot.pas b/compiler/m68k/ra68kmot.pas
index 01d775ca7a..aedfed306a 100644
--- a/compiler/m68k/ra68kmot.pas
+++ b/compiler/m68k/ra68kmot.pas
@@ -616,6 +616,7 @@ const
l : longint;
errorflag: boolean;
begin
+ BuildExpression:=0;
errorflag := FALSE;
expr := '';
tempstr := '';
@@ -986,6 +987,7 @@ const
l: longint;
code: integer;
begin
+ str:='';
Consume(AS_STAR);
if (oper.opr.ref.scalefactor <> 0)
and (oper.opr.ref.scalefactor <> 1) then
@@ -1180,6 +1182,7 @@ const
code: integer;
str: string;
begin
+ str:='';
Consume(AS_LPAREN);
case actasmtoken of
{ // (reg ... // }
@@ -1309,6 +1312,7 @@ const
dataregset := [];
addrregset := [];
tempstr := '';
+ r:=NR_NO;
case actasmtoken of
{ // Memory reference // }
AS_LPAREN:
diff --git a/compiler/m68k/rgcpu.pas b/compiler/m68k/rgcpu.pas
index a981d73a75..0c0ab7957c 100644
--- a/compiler/m68k/rgcpu.pas
+++ b/compiler/m68k/rgcpu.pas
@@ -27,14 +27,150 @@ unit rgcpu;
interface
uses
- aasmbase,aasmtai,aasmdata,
- cpubase,
+ aasmbase,aasmtai,aasmdata,aasmcpu,
+ cgbase,cgutils,cpubase,
rgobj;
type
trgcpu = class(trgobj)
+ procedure do_spill_read(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);override;
+ procedure do_spill_written(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);override;
+ function do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean;override;
end;
implementation
+ uses
+ cutils,cgobj,verbose,globtype,globals,cpuinfo;
+
+ { returns True if source operand of MOVE can be replaced with spilltemp when its destination is ref^. }
+ function isvalidmovedest(ref: preference): boolean; inline;
+ begin
+ { The following is for Coldfire, for other CPUs it maybe can be relaxed. }
+ result:=(ref^.symbol=nil) and (ref^.scalefactor<=1) and
+ (ref^.index=NR_NO) and (ref^.base<>NR_NO) and (ref^.offset>=low(smallint)) and
+ (ref^.offset<=high(smallint));
+ end;
+
+
+ procedure trgcpu.do_spill_read(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);
+ var
+ helpins : tai;
+ tmpref : treference;
+ helplist : tasmlist;
+ hreg : tregister;
+ begin
+ if (abs(spilltemp.offset)>32767) and (current_settings.cputype in (cpu_coldfire + [cpu_mc68000])) then
+ begin
+ helplist:=tasmlist.create;
+
+ if getregtype(tempreg)=R_INTREGISTER then
+ hreg:=tempreg
+ else
+ hreg:=cg.getintregister(helplist,OS_ADDR);
+{$ifdef DEBUG_SPILLING}
+ helplist.concat(tai_comment.Create(strpnew('Spilling: Read, large offset')));
+{$endif}
+
+ helplist.concat(taicpu.op_const_reg(A_MOVE,S_L,spilltemp.offset,hreg));
+ reference_reset_base(tmpref,spilltemp.base,0,sizeof(aint));
+ tmpref.index:=hreg;
+
+ helpins:=spilling_create_load(tmpref,tempreg);
+ helplist.concat(helpins);
+ list.insertlistafter(pos,helplist);
+ helplist.free;
+ end
+ else
+ inherited do_spill_read(list,pos,spilltemp,tempreg);
+ end;
+
+
+ procedure trgcpu.do_spill_written(list:tasmlist;pos:tai;const spilltemp:treference;tempreg:tregister);
+ var
+ tmpref : treference;
+ helplist : tasmlist;
+ hreg : tregister;
+ begin
+ if (abs(spilltemp.offset)>32767) and (current_settings.cputype in (cpu_coldfire + [cpu_mc68000])) then
+ begin
+ helplist:=tasmlist.create;
+
+ if getregtype(tempreg)=R_INTREGISTER then
+ hreg:=getregisterinline(helplist,[R_SUBWHOLE])
+ else
+ hreg:=cg.getintregister(helplist,OS_ADDR);
+{$ifdef DEBUG_SPILLING}
+ helplist.concat(tai_comment.Create(strpnew('Spilling: Write, large offset')));
+{$endif}
+
+ helplist.concat(taicpu.op_const_reg(A_MOVE,S_L,spilltemp.offset,hreg));
+ reference_reset_base(tmpref,spilltemp.base,0,sizeof(aint));
+ tmpref.index:=hreg;
+
+ helplist.concat(spilling_create_store(tempreg,tmpref));
+ if getregtype(tempreg)=R_INTREGISTER then
+ ungetregisterinline(helplist,hreg);
+
+ list.insertlistafter(pos,helplist);
+ helplist.free;
+ end
+ else
+ inherited do_spill_written(list,pos,spilltemp,tempreg);
+ end;
+
+
+ function trgcpu.do_spill_replace(list:TAsmList;instr:taicpu;orgreg:tsuperregister;const spilltemp:treference):boolean;
+ var
+ opidx: longint;
+ begin
+ result:=false;
+ opidx:=-1;
+ if (abs(spilltemp.offset)>32767) and (current_settings.cputype in cpu_coldfire) then
+ exit;
+ case instr.ops of
+ 1:
+ begin
+ if (instr.oper[0]^.typ=top_reg) and (getregtype(instr.oper[0]^.reg)=regtype) and
+ ((instr.opcode=A_TST) or (instr.opcode=A_CLR)) then
+ begin
+ if get_alias(getsupreg(instr.oper[0]^.reg))<>orgreg then
+ InternalError(2014080101);
+ opidx:=0;
+ end;
+ end;
+ 2:
+ begin
+ if (instr.oper[0]^.typ=top_reg) and (getregtype(instr.oper[0]^.reg)=regtype) and
+ (get_alias(getsupreg(instr.oper[0]^.reg))=orgreg) then
+ begin
+ { source can be replaced if dest is register... }
+ if ((instr.oper[1]^.typ=top_reg) and (instr.opcode in [A_MOVE,A_ADD,A_SUB,A_AND,A_OR,A_CMP])) or
+ {... or a "simple" reference in case of MOVE }
+ ((instr.opcode=A_MOVE) and (instr.oper[1]^.typ=top_ref) and isvalidmovedest(instr.oper[1]^.ref)) then
+ opidx:=0;
+ end
+ else if (instr.oper[1]^.typ=top_reg) and (getregtype(instr.oper[1]^.reg)=regtype) and
+ (get_alias(getsupreg(instr.oper[1]^.reg))=orgreg) and
+ (
+ (instr.opcode in [A_MOVE,A_ADD,A_SUB,A_AND,A_OR]) and
+ (instr.oper[0]^.typ=top_reg)
+ ) or
+ (instr.opcode in [A_ADDQ,A_SUBQ,A_MOV3Q]) then
+ opidx:=1;
+ end;
+ end;
+
+ if (opidx<0) then
+ exit;
+ instr.oper[opidx]^.typ:=top_ref;
+ new(instr.oper[opidx]^.ref);
+ instr.oper[opidx]^.ref^:=spilltemp;
+ case instr.opsize of
+ S_B: inc(instr.oper[opidx]^.ref^.offset,3);
+ S_W: inc(instr.oper[opidx]^.ref^.offset,2);
+ end;
+ result:=true;
+ end;
+
end.
diff --git a/compiler/m68k/symcpu.pas b/compiler/m68k/symcpu.pas
index 93702598cb..cb467ba937 100644
--- a/compiler/m68k/symcpu.pas
+++ b/compiler/m68k/symcpu.pas
@@ -186,14 +186,16 @@ implementation
procedure tcpuprocdef.ppuload_platform(ppufile: tcompilerppufile);
begin
inherited;
- ppufile.getderef(libsymderef);
+ if po_syscall_has_libsym in procoptions then
+ ppufile.getderef(libsymderef);
end;
procedure tcpuprocdef.ppuwrite_platform(ppufile: tcompilerppufile);
begin
inherited;
- ppufile.putderef(libsymderef);
+ if po_syscall_has_libsym in procoptions then
+ ppufile.putderef(libsymderef);
end;
@@ -208,14 +210,18 @@ implementation
procedure tcpuprocdef.buildderef;
begin
inherited;
- libsymderef.build(libsym);
+ if po_syscall_has_libsym in procoptions then
+ libsymderef.build(libsym);
end;
procedure tcpuprocdef.deref;
begin
inherited;
- libsym:=tsym(libsymderef.resolve);
+ if po_syscall_has_libsym in procoptions then
+ libsym:=tsym(libsymderef.resolve)
+ else
+ libsym:=nil;
end;
begin
View Lorry Controller Status