mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-18 11:30:31 +02:00
* m68k and palmos updates from surebugfixes
This commit is contained in:
peter
parent
0eb6dd34aa
commit
35a8d2e4fd
@ -147,6 +147,7 @@ unit ag68kgas;
|
||||
getreferencestring:=s;
|
||||
end;
|
||||
|
||||
|
||||
function getopstr(t : byte;o : pointer) : string;
|
||||
|
||||
var
|
||||
@ -155,7 +156,10 @@ unit ag68kgas;
|
||||
|
||||
begin
|
||||
case t of
|
||||
top_reg : getopstr:=gas_reg2str[tregister(o)];
|
||||
top_reg : if target_info.target=target_PalmOS then
|
||||
getopstr:=gasPalmOS_reg2str[tregister(o)]
|
||||
else
|
||||
getopstr:=gas_reg2str[tregister(o)];
|
||||
top_ref : getopstr:=getreferencestring(preference(o)^);
|
||||
top_reglist: begin
|
||||
hs:='';
|
||||
@ -476,7 +480,10 @@ ait_labeled_instruction : begin
|
||||
A_SNE,A_SPL,A_ST,A_SVC,A_SVS,A_SF]) then
|
||||
s:=#9+mot_op2str[pai68k(hp)^._operator]
|
||||
else
|
||||
s:=#9+mot_op2str[pai68k(hp)^._operator]+mit_opsize2str[pai68k(hp)^.size];
|
||||
if target_info.target=target_PalmOS then
|
||||
s:=#9+mot_op2str[pai68k(hp)^._operator]+gas_opsize2str[pai68k(hp)^.size]
|
||||
else
|
||||
s:=#9+mot_op2str[pai68k(hp)^._operator]+mit_opsize2str[pai68k(hp)^.size];
|
||||
if pai68k(hp)^.op1t<>top_none then
|
||||
begin
|
||||
{ call and jmp need an extra handling }
|
||||
@ -605,7 +612,10 @@ ait_stab_function_name : funcname:=pai_stab_function_name(hp)^.str;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.8 1998-08-10 14:49:36 peter
|
||||
Revision 1.9 1998-08-31 12:26:20 peter
|
||||
* m68k and palmos updates from surebugfixes
|
||||
|
||||
Revision 1.8 1998/08/10 14:49:36 peter
|
||||
+ localswitches, moduleswitches, globalswitches splitting
|
||||
|
||||
Revision 1.7 1998/07/14 14:46:38 peter
|
||||
|
||||
@ -386,10 +386,10 @@ implementation
|
||||
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)));
|
||||
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
|
||||
@ -956,7 +956,7 @@ implementation
|
||||
{ but to few are free then LEA }
|
||||
if (p^.left^.location.reference.base<>R_NO) and
|
||||
(p^.left^.location.reference.index<>R_NO) and
|
||||
(usablereg32<p^.right^.registers32) then
|
||||
(usableaddress<p^.right^.registers32) then
|
||||
begin
|
||||
del_reference(p^.left^.location.reference);
|
||||
hregister:=getaddressreg;
|
||||
@ -2326,6 +2326,26 @@ implementation
|
||||
|
||||
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;
|
||||
@ -2333,8 +2353,7 @@ implementation
|
||||
if (p^.left^.location.loc=LOC_REGISTER) or
|
||||
(p^.left^.location.loc=LOC_CREGISTER) then
|
||||
begin
|
||||
{ handled by secondpas by called routine ??? }
|
||||
{ p^.location.loc:=p^.left^.location.loc; }
|
||||
{ handled by secondpas by called routine ??? }
|
||||
p^.location.register:=p^.left^.location.register;
|
||||
end;
|
||||
end;
|
||||
@ -2858,7 +2877,7 @@ implementation
|
||||
getlabel(hlabel);
|
||||
inc(pushedparasize,2);
|
||||
emitl(A_LABEL,truelabel);
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_W,1,R_SPPUSH)));
|
||||
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)));
|
||||
@ -2870,6 +2889,10 @@ implementation
|
||||
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;
|
||||
@ -3319,6 +3342,11 @@ implementation
|
||||
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);
|
||||
@ -3465,7 +3493,7 @@ implementation
|
||||
if cs_fp_emulation in aktmoduleswitches then
|
||||
begin
|
||||
p^.location.loc:=LOC_FPU;
|
||||
hregister:=getregister32;
|
||||
hregister:=getregister32;
|
||||
emit_reg_reg(A_MOVE,S_L,R_D0,hregister);
|
||||
p^.location.fpureg:=hregister;
|
||||
end
|
||||
@ -4058,10 +4086,11 @@ implementation
|
||||
{ load vmt }
|
||||
if p^.left^.treetype=typen then
|
||||
begin
|
||||
p^.location.register:=getregister32;
|
||||
exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_MOVE,
|
||||
exprasmlist^.concat(new(pai68k,op_csymbol_reg(A_LEA,
|
||||
S_L,newcsymbol(pobjectdef(p^.left^.resulttype)^.vmt_mangledname,0),
|
||||
p^.location.register)));
|
||||
R_A0)));
|
||||
p^.location.register:=getregister32;
|
||||
emit_reg_reg(A_MOVE,S_L,R_A0,p^.location.register);
|
||||
end
|
||||
else
|
||||
begin
|
||||
@ -4084,7 +4113,7 @@ implementation
|
||||
{ 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;
|
||||
r^.base:=R_A0;
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,
|
||||
p^.location.register)));
|
||||
end;
|
||||
@ -4613,40 +4642,40 @@ implementation
|
||||
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
|
||||
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
|
||||
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,
|
||||
{ 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
|
||||
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;
|
||||
@ -5466,6 +5495,7 @@ end;
|
||||
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;
|
||||
@ -5475,7 +5505,10 @@ end.
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.14 1998-08-19 16:07:39 jonas
|
||||
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
|
||||
|
||||
@ -486,24 +486,22 @@ Implementation
|
||||
begin
|
||||
if (p^.right^.treetype=ordconstn) and (op=A_CMP) and
|
||||
(p^.right^.value=0) then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,p^.location.register)));
|
||||
end
|
||||
else if (p^.right^.treetype=ordconstn) and (op=A_MULS) and
|
||||
(ispowerof2(p^.right^.value,power)) then
|
||||
begin
|
||||
if (power <= 8) then
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_ASL,opsize,power,
|
||||
p^.location.register)))
|
||||
else
|
||||
begin
|
||||
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,power,
|
||||
R_D6)));
|
||||
exprasmlist^.concat(new(pai68k,op_reg_reg(A_ASL,opsize,R_D6,
|
||||
p^.location.register)))
|
||||
end;
|
||||
end
|
||||
exprasmlist^.concat(new(pai68k,op_reg(A_TST,opsize,p^.location.register)))
|
||||
else
|
||||
if (p^.right^.treetype=ordconstn) and (op=A_MULS) and
|
||||
(ispowerof2(p^.right^.value,power)) then
|
||||
begin
|
||||
if (power <= 8) then
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_ASL,opsize,power,
|
||||
p^.location.register)))
|
||||
else
|
||||
begin
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,power,
|
||||
R_D6)));
|
||||
exprasmlist^.concat(new(pai68k,op_reg_reg(A_ASL,opsize,R_D6,
|
||||
p^.location.register)))
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (p^.right^.location.loc=LOC_CREGISTER) then
|
||||
@ -558,6 +556,18 @@ Implementation
|
||||
else
|
||||
if (op=A_MULU) and (opsize = S_L) and (aktoptprocessor=MC68000) then
|
||||
Message(cg_f_32bit_not_supported_in_68000)
|
||||
else
|
||||
{ When one of the source/destination is a memory reference }
|
||||
{ and the operator is EOR, the we must load it into the }
|
||||
{ value into a register first since only EOR reg,reg exists }
|
||||
{ on the m68k }
|
||||
if (op=A_EOR) then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,newreference(
|
||||
p^.right^.location.reference),R_D0)));
|
||||
exprasmlist^.concat(new(pai68k,op_reg_reg(op,opsize,R_D0,
|
||||
p^.location.register)));
|
||||
end
|
||||
else
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(op,opsize,newreference(
|
||||
p^.right^.location.reference),p^.location.register)));
|
||||
@ -615,6 +625,7 @@ Implementation
|
||||
if mboverflow then
|
||||
emitoverflowcheck(p);
|
||||
end
|
||||
{*********************************************************************}
|
||||
else if ((p^.left^.resulttype^.deftype=orddef) and
|
||||
(porddef(p^.left^.resulttype)^.typ=uchar)) then
|
||||
begin
|
||||
@ -1411,15 +1422,17 @@ Implementation
|
||||
|
||||
|
||||
|
||||
|
||||
{ This routine needs to be further checked to see if it works correctly }
|
||||
{ because contrary to the intel version, all large set elements are read }
|
||||
{ as 32-bit values, and then decomposed to find the correct byte. }
|
||||
{ CHECKED -> Requires 32-bit read. }
|
||||
|
||||
{ CHECKED : Depending on the result size, if reference, a load may be }
|
||||
{ required on word, long or byte. }
|
||||
procedure loadsetelement(var p : ptree);
|
||||
|
||||
var
|
||||
hr : tregister;
|
||||
opsize : topsize;
|
||||
|
||||
begin
|
||||
{ copy the element in the d0.b register, slightly complicated }
|
||||
@ -1432,8 +1445,23 @@ Implementation
|
||||
end;
|
||||
else
|
||||
begin
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
||||
{ This is quite complicated, because of the endian on }
|
||||
{ the m68k! }
|
||||
opsize:=S_NO;
|
||||
case integer(p^.resulttype^.savesize) of
|
||||
1 : opsize:=S_B;
|
||||
2 : opsize:=S_W;
|
||||
4 : opsize:=S_L;
|
||||
else
|
||||
internalerror(19);
|
||||
end;
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
|
||||
newreference(p^.location.reference),R_D0)));
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
|
||||
255,R_D0)));
|
||||
{
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
||||
newreference(p^.location.reference),R_D0))); }
|
||||
{ exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
|
||||
$ff,R_D0))); }
|
||||
del_reference(p^.location.reference);
|
||||
@ -1459,15 +1487,29 @@ Implementation
|
||||
i,numparts:byte;
|
||||
href,href2:Treference;
|
||||
l,l2 : plabel;
|
||||
hl,hl1 : plabel;
|
||||
hl2, hl3: plabel;
|
||||
hl,hl1 : plabel;
|
||||
hl2, hl3: plabel;
|
||||
opsize : topsize;
|
||||
|
||||
|
||||
function swaplongint(l : longint): longint;
|
||||
var
|
||||
w1: word;
|
||||
w2: word;
|
||||
begin
|
||||
w1:=l and $ffff;
|
||||
w2:=l shr 16;
|
||||
l:=swap(w2)+(longint(swap(w1)) shl 16);
|
||||
swaplongint:=l;
|
||||
end;
|
||||
|
||||
function analizeset(Aset:Pconstset):boolean;
|
||||
|
||||
var compares,maxcompares:word;
|
||||
i:byte;
|
||||
type byteset=set of byte;
|
||||
tlongset = array[0..7] of longint;
|
||||
var compares,maxcompares:word;
|
||||
someset : tlongset;
|
||||
i:byte;
|
||||
|
||||
begin
|
||||
analizeset:=false;
|
||||
@ -1480,8 +1522,16 @@ Implementation
|
||||
maxcompares:=5;
|
||||
if cs_littlesize in aktglobalswitches then
|
||||
maxcompares:=8;
|
||||
move(ASet^,someset,32);
|
||||
{ On Big endian machines sets are stored }
|
||||
{ as INTEL Little-endian format, therefore }
|
||||
{ we must convert it to the correct format }
|
||||
{$IFDEF BIG_ENDIAN}
|
||||
for I:=0 to 7 do
|
||||
someset[i]:=swaplongint(someset[i]);
|
||||
{$ENDIF}
|
||||
for i:=0 to 255 do
|
||||
if i in byteset(Aset^) then
|
||||
if i in byteset(someset) then
|
||||
begin
|
||||
if (numparts=0) or
|
||||
(i<>setparts[numparts].stop+1) then
|
||||
@ -1528,25 +1578,25 @@ Implementation
|
||||
begin
|
||||
{ only compulsory }
|
||||
secondpass(p^.left);
|
||||
secondpass(p^.right);
|
||||
secondpass(p^.right);
|
||||
if codegenerror then
|
||||
exit;
|
||||
p^.location.resflags:=F_NE;
|
||||
{ Because of the Endian of the m68k, we have to consider this as a }
|
||||
{ normal set and load it byte per byte, otherwise we will never get }
|
||||
{ the correct result. }
|
||||
case p^.right^.location.loc of
|
||||
case p^.right^.location.loc of
|
||||
LOC_REGISTER,LOC_CREGISTER :
|
||||
begin
|
||||
emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
|
||||
exprasmlist^.concat(new(pai68k,
|
||||
emit_reg_reg(A_MOVE,S_L,p^.right^.location.register,R_D1);
|
||||
exprasmlist^.concat(new(pai68k,
|
||||
op_const_reg(A_AND,S_L, 1 shl (p^.left^.value and 31),R_D1)));
|
||||
end;
|
||||
else
|
||||
end;
|
||||
else
|
||||
begin
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
|
||||
p^.right^.location.reference),R_D1)));
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(
|
||||
p^.right^.location.reference),R_D1)));
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(
|
||||
A_AND,S_L,1 shl (p^.left^.value and 31) ,R_D1)));
|
||||
end;
|
||||
end;
|
||||
@ -1566,16 +1616,15 @@ Implementation
|
||||
{ of course not commutative }
|
||||
if p^.swaped then
|
||||
swaptree(p);
|
||||
{ load index into register }
|
||||
{ load index into register }
|
||||
case p^.left^.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER :
|
||||
hr:=p^.left^.location.register;
|
||||
hr:=p^.left^.location.register;
|
||||
else
|
||||
begin
|
||||
{ the set element isn't never samller than a byte }
|
||||
{ and because it's a small set we need only 5 bits }
|
||||
{ but 8 bits are eaiser to load }
|
||||
{ Small sets are always 32 bit values, there is no }
|
||||
{ way they can be anything else, so no problems here}
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,
|
||||
newreference(p^.left^.location.reference),R_D1)));
|
||||
hr:=R_D1;
|
||||
@ -1587,9 +1636,8 @@ Implementation
|
||||
LOC_CREGISTER : exprasmlist^.concat(new(pai68k, op_reg_reg(A_BTST,S_L,hr,p^.right^.location.register)));
|
||||
else
|
||||
begin
|
||||
{ OOPS ... bug here thanks Florian!! }
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),
|
||||
R_D0)));
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(p^.right^.location.reference),
|
||||
R_D0)));
|
||||
exprasmlist^.concat(new(pai68k,op_reg_reg(A_BTST,S_L,hr,R_D0)));
|
||||
del_reference(p^.right^.location.reference);
|
||||
end;
|
||||
@ -1612,7 +1660,7 @@ Implementation
|
||||
p^.location.resflags:=F_C;
|
||||
end;
|
||||
end
|
||||
else { NOT a small set }
|
||||
else { //// NOT a small set //// }
|
||||
begin
|
||||
if p^.left^.treetype=ordconstn then
|
||||
begin
|
||||
@ -1627,19 +1675,19 @@ Implementation
|
||||
newreference(p^.right^.location.reference), R_D1)));
|
||||
exprasmlist^.concat(new(pai68k, op_const_reg(A_AND, S_L,
|
||||
1 shl (p^.left^.value mod 32),R_D1)));
|
||||
del_reference(p^.right^.location.reference);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (p^.right^.treetype=setconstrn) and
|
||||
analizeset(p^.right^.constset) then
|
||||
del_reference(p^.right^.location.reference);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (p^.right^.treetype=setconstrn) and
|
||||
analizeset(p^.right^.constset) then
|
||||
begin
|
||||
{It gives us advantage to check for the set elements
|
||||
separately instead of using the SET_IN_BYTE procedure.
|
||||
To do: Build in support for LOC_JUMP.}
|
||||
secondpass(p^.left);
|
||||
{We won't do a second pass on p^.right, because
|
||||
this will emit the constant set.}
|
||||
{It gives us advantage to check for the set elements
|
||||
separately instead of using the SET_IN_BYTE procedure.
|
||||
To do: Build in support for LOC_JUMP.}
|
||||
secondpass(p^.left);
|
||||
{We won't do a second pass on p^.right, because
|
||||
this will emit the constant set.}
|
||||
case p^.left^.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER :
|
||||
@ -1647,133 +1695,149 @@ Implementation
|
||||
255,p^.left^.location.register)));
|
||||
else
|
||||
Begin
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,
|
||||
{ Because of the m68k endian, then we must LOAD normally the }
|
||||
{ value into a register first, all depending on the source }
|
||||
{ size! }
|
||||
opsize:=S_NO;
|
||||
case integer(p^.left^.resulttype^.savesize) of
|
||||
1 : opsize:=S_B;
|
||||
2 : opsize:=S_W;
|
||||
4 : opsize:=S_L;
|
||||
else
|
||||
internalerror(19);
|
||||
end;
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,opsize,
|
||||
newreference(p^.left^.location.reference),R_D0)));
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_L,
|
||||
255,R_D0)));
|
||||
end;
|
||||
end;
|
||||
{Get a label to jump to the end.}
|
||||
p^.location.loc:=LOC_FLAGS;
|
||||
{Get a label to jump to the end.}
|
||||
p^.location.loc:=LOC_FLAGS;
|
||||
{It's better to use the zero flag when there are no ranges.}
|
||||
if ranges then
|
||||
p^.location.resflags:=F_C
|
||||
else
|
||||
p^.location.resflags:=F_E;
|
||||
href.symbol := nil;
|
||||
clear_reference(href);
|
||||
getlabel(l);
|
||||
href.symbol:=stringdup(lab2str(l));
|
||||
for i:=1 to numparts do
|
||||
if setparts[i].range then
|
||||
begin
|
||||
{Check if left is in a range.}
|
||||
{Get a label to jump over the check.}
|
||||
href2.symbol := nil;
|
||||
clear_reference(href2);
|
||||
getlabel(l2);
|
||||
href.symbol:=stringdup(lab2str(l2));
|
||||
if setparts[i].start=setparts[i].stop-1 then
|
||||
begin
|
||||
case p^.left^.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER :
|
||||
if ranges then
|
||||
p^.location.resflags:=F_C
|
||||
else
|
||||
p^.location.resflags:=F_E;
|
||||
href.symbol := nil;
|
||||
clear_reference(href);
|
||||
getlabel(l);
|
||||
href.symbol:=stringdup(lab2str(l));
|
||||
for i:=1 to numparts do
|
||||
if setparts[i].range then
|
||||
begin
|
||||
{Check if left is in a range.}
|
||||
{Get a label to jump over the check.}
|
||||
href2.symbol := nil;
|
||||
clear_reference(href2);
|
||||
getlabel(l2);
|
||||
href.symbol:=stringdup(lab2str(l2));
|
||||
if setparts[i].start=setparts[i].stop-1 then
|
||||
begin
|
||||
case p^.left^.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER :
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
|
||||
setparts[i].start,p^.left^.location.register)));
|
||||
else
|
||||
setparts[i].start,p^.left^.location.register)));
|
||||
else
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
|
||||
setparts[i].start,R_D0)));
|
||||
{ exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
|
||||
setparts[i].start,newreference(p^.left^.location.reference))));}
|
||||
end;
|
||||
{Result should be in carry flag when ranges are used.}
|
||||
{ Here the m68k does not affect any flag except the }
|
||||
{ flag which is OR'ed }
|
||||
if ranges then
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
|
||||
{If found, jump to end.}
|
||||
emitl(A_BEQ,l);
|
||||
case p^.left^.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER :
|
||||
end;
|
||||
{Result should be in carry flag when ranges are used.}
|
||||
{ Here the m68k does not affect any flag except the }
|
||||
{ flag which is OR'ed }
|
||||
if ranges then
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
|
||||
{If found, jump to end.}
|
||||
emitl(A_BEQ,l);
|
||||
case p^.left^.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER :
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
|
||||
setparts[i].stop,p^.left^.location.register)));
|
||||
else
|
||||
setparts[i].stop,p^.left^.location.register)));
|
||||
else
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
|
||||
setparts[i].stop,R_D0)));
|
||||
{ exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
|
||||
setparts[i].stop,newreference(p^.left^.location.reference))));}
|
||||
end;
|
||||
{Result should be in carry flag when ranges are used.}
|
||||
{ Here the m68k does not affect any flag except the }
|
||||
{ flag which is OR'ed }
|
||||
if ranges then
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
|
||||
{If found, jump to end.}
|
||||
emitl(A_BEQ,l);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if setparts[i].start<>0 then
|
||||
begin
|
||||
{We only check for the lower bound if it is > 0, because
|
||||
set elements lower than 0 do nt exist.}
|
||||
case p^.left^.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER :
|
||||
end;
|
||||
{Result should be in carry flag when ranges are used.}
|
||||
{ Here the m68k does not affect any flag except the }
|
||||
{ flag which is OR'ed }
|
||||
if ranges then
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
|
||||
{If found, jump to end.}
|
||||
emitl(A_BEQ,l);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if setparts[i].start<>0 then
|
||||
begin
|
||||
{We only check for the lower bound if it is > 0, because
|
||||
set elements lower than 0 do nt exist.}
|
||||
case p^.left^.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER :
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
|
||||
setparts[i].start,p^.left^.location.register)));
|
||||
else
|
||||
setparts[i].start,p^.left^.location.register)));
|
||||
else
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
|
||||
setparts[i].start,R_D0)));
|
||||
{ exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
|
||||
setparts[i].start,newreference(p^.left^.location.reference)))); }
|
||||
end;
|
||||
{If lower, jump to next check.}
|
||||
emitl(A_BCS,l2);
|
||||
end;
|
||||
if setparts[i].stop<>255 then
|
||||
begin
|
||||
{We only check for the high bound if it is < 255, because
|
||||
set elements higher than 255 do nt exist.}
|
||||
case p^.left^.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER :
|
||||
end;
|
||||
{If lower, jump to next check.}
|
||||
emitl(A_BCS,l2);
|
||||
end;
|
||||
if setparts[i].stop<>255 then
|
||||
begin
|
||||
{We only check for the high bound if it is < 255, because
|
||||
set elements higher than 255 do nt exist.}
|
||||
case p^.left^.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER :
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
|
||||
setparts[i].stop+1,p^.left^.location.register)));
|
||||
setparts[i].stop+1,p^.left^.location.register)));
|
||||
else
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
|
||||
setparts[i].stop+1,R_D0)));
|
||||
{ exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
|
||||
setparts[i].stop+1,newreference(p^.left^.location.reference))));}
|
||||
end; { end case }
|
||||
{If higher, element is in set.}
|
||||
emitl(A_BCS,l);
|
||||
end;
|
||||
end;
|
||||
{Emit the jump over label.}
|
||||
exprasmlist^.concat(new(pai_label,init(l2)));
|
||||
end
|
||||
else
|
||||
begin
|
||||
{Emit code to check if left is an element.}
|
||||
case p^.left^.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER :
|
||||
{If higher, element is in set.}
|
||||
emitl(A_BCS,l);
|
||||
end
|
||||
else
|
||||
begin
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_B,$01,R_CCR)));
|
||||
emitl(A_JMP,l);
|
||||
end;
|
||||
end;
|
||||
{Emit the jump over label.}
|
||||
exprasmlist^.concat(new(pai_label,init(l2)));
|
||||
end
|
||||
else
|
||||
begin
|
||||
{Emit code to check if left is an element.}
|
||||
case p^.left^.location.loc of
|
||||
LOC_REGISTER,
|
||||
LOC_CREGISTER :
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
|
||||
setparts[i].stop,p^.left^.location.register)));
|
||||
else
|
||||
setparts[i].stop,p^.left^.location.register)));
|
||||
else
|
||||
{ exprasmlist^.concat(new(pai68k,op_const_ref(A_CMP,S_B,
|
||||
setparts[i].stop,newreference(p^.left^.location.reference))));}
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_CMP,S_W,
|
||||
setparts[i].stop,R_D0)));
|
||||
end;
|
||||
{Result should be in carry flag when ranges are used.}
|
||||
if ranges then
|
||||
exprasmlist^.concat(new(pai68k, op_const_reg(A_OR,S_B,$01,R_CCR)));
|
||||
{If found, jump to end.}
|
||||
emitl(A_BEQ,l);
|
||||
end;
|
||||
end;
|
||||
{Result should be in carry flag when ranges are used.}
|
||||
if ranges then
|
||||
exprasmlist^.concat(new(pai68k, op_const_reg(A_OR,S_B,$01,R_CCR)));
|
||||
{If found, jump to end.}
|
||||
emitl(A_BEQ,l);
|
||||
end;
|
||||
if ranges then
|
||||
{ clear carry flag }
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_AND,S_B,$FE,R_CCR)));
|
||||
@ -1807,18 +1871,17 @@ Implementation
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,
|
||||
newreference(p^.right^.location.reference),R_A0)));;
|
||||
{ emitpushreferenceaddr(p^.right^.location.reference);}
|
||||
del_reference(p^.right^.location.reference);
|
||||
emitcall('SET_IN_BYTE',true);
|
||||
{ ungetiftemp(p^.right^.location.reference); }
|
||||
p^.location.loc:=LOC_FLAGS;
|
||||
p^.location.resflags:=F_C;
|
||||
del_reference(p^.right^.location.reference);
|
||||
emitcall('SET_IN_BYTE',true);
|
||||
{ ungetiftemp(p^.right^.location.reference); }
|
||||
p^.location.loc:=LOC_FLAGS;
|
||||
p^.location.resflags:=F_C;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
procedure secondexpr(var p : ptree);
|
||||
|
||||
begin
|
||||
@ -1875,7 +1938,7 @@ Implementation
|
||||
truelabel:=otlabel;
|
||||
falselabel:=oflabel;
|
||||
end
|
||||
else
|
||||
else { //// NOT a small set //// }
|
||||
begin
|
||||
{ handling code at the end as it is much more efficient }
|
||||
emitl(A_JMP,l2);
|
||||
@ -1884,7 +1947,7 @@ Implementation
|
||||
cleartempgen;
|
||||
|
||||
getlabel(l3);
|
||||
aktcontinuelabel:=l1;
|
||||
aktcontinuelabel:=l2;
|
||||
aktbreaklabel:=l3;
|
||||
|
||||
if assigned(p^.right) then
|
||||
@ -1960,7 +2023,10 @@ Implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.7 1998-08-10 14:43:17 peter
|
||||
Revision 1.8 1998-08-31 12:26:23 peter
|
||||
* m68k and palmos updates from surebugfixes
|
||||
|
||||
Revision 1.7 1998/08/10 14:43:17 peter
|
||||
* string type st_ fixed
|
||||
|
||||
Revision 1.6 1998/07/10 10:51:00 peter
|
||||
|
||||
@ -102,9 +102,14 @@ unit cga68k;
|
||||
|
||||
begin
|
||||
pushusedregisters(pushed,$ffff);
|
||||
emitpushreferenceaddr(dref);
|
||||
emitpushreferenceaddr(sref);
|
||||
push_int(len);
|
||||
{ emitpushreferenceaddr(dref); }
|
||||
{ emitpushreferenceaddr(sref); }
|
||||
{ push_int(len); }
|
||||
{ This speeds up from 116 cycles to 24 cycles on the 68000 }
|
||||
{ when passing register parameters! }
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(dref),R_A1)));
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(sref),R_A0)));
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,len,R_D0)));
|
||||
emitcall('STRCOPY',true);
|
||||
maybe_loada5;
|
||||
popusedregisters(pushed);
|
||||
@ -130,7 +135,9 @@ unit cga68k;
|
||||
orddef : begin
|
||||
if p^.right^.treetype=ordconstn then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_W,p^.right^.value*256+1,
|
||||
{ offset 0: length of string }
|
||||
{ offset 1: character }
|
||||
exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_W,1*256+p^.right^.value,
|
||||
newreference(p^.left^.location.reference))))
|
||||
end
|
||||
else
|
||||
@ -139,45 +146,33 @@ unit cga68k;
|
||||
if (p^.right^.location.loc in [LOC_REGISTER,LOC_CREGISTER]) then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai68k,op_reg_reg(
|
||||
A_MOVE,S_L,p^.right^.location.register,R_D0)));
|
||||
A_MOVE,S_B,p^.right^.location.register,R_D0)));
|
||||
ungetregister32(p^.right^.location.register);
|
||||
end
|
||||
else
|
||||
begin
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(
|
||||
A_MOVE,S_L,newreference(p^.right^.location.reference),R_D0)));
|
||||
A_MOVE,S_B,newreference(p^.right^.location.reference),R_D0)));
|
||||
del_reference(p^.right^.location.reference);
|
||||
end;
|
||||
if (aktoptprocessor = MC68020) then
|
||||
{ alignment is not a problem on the 68020 and higher processors }
|
||||
{ alignment can cause problems }
|
||||
{ add length of string to ref }
|
||||
exprasmlist^.concat(new(pai68k,op_const_ref(A_MOVE,S_B,1,
|
||||
newreference(p^.left^.location.reference))));
|
||||
(* if abs(p^.left^.location.reference.offset) >= 1 then
|
||||
Begin *)
|
||||
{ temporarily decrease offset }
|
||||
Inc(p^.left^.location.reference.offset);
|
||||
exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_B,R_D0,
|
||||
newreference(p^.left^.location.reference))));
|
||||
Dec(p^.left^.location.reference.offset);
|
||||
{ restore offset }
|
||||
(* end
|
||||
else
|
||||
Begin
|
||||
{ add length of string to word }
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_OR,S_W,$0100,R_D0)));
|
||||
{ put back into mem ... }
|
||||
exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_W,R_D0,
|
||||
newreference(p^.left^.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^.left^.location.reference))));
|
||||
if abs(p^.left^.location.reference.offset) >= 1 then
|
||||
Begin
|
||||
{ temporarily decrease offset }
|
||||
Inc(p^.left^.location.reference.offset);
|
||||
exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_B,R_D0,
|
||||
newreference(p^.left^.location.reference))));
|
||||
Dec(p^.left^.location.reference.offset);
|
||||
{ restore offset }
|
||||
end
|
||||
else
|
||||
Begin
|
||||
Comment(V_Debug,'SecondChar2String() internal error.');
|
||||
internalerror(34);
|
||||
end;
|
||||
end;
|
||||
Comment(V_Debug,'SecondChar2String() internal error.');
|
||||
internalerror(34);
|
||||
end; *)
|
||||
end;
|
||||
end;
|
||||
else
|
||||
@ -195,7 +190,11 @@ unit cga68k;
|
||||
hregister : tregister;
|
||||
|
||||
begin
|
||||
hregister:=getregister32;
|
||||
if (p^.location.loc=LOC_REGISTER) or (p^.location.loc=LOC_CREGISTER) then
|
||||
hregister:=getregister32
|
||||
else
|
||||
hregister:=getaddressreg;
|
||||
|
||||
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_SPPULL,hregister)));
|
||||
if (p^.location.loc=LOC_REGISTER) or (p^.location.loc=LOC_CREGISTER) then
|
||||
begin
|
||||
@ -204,7 +203,7 @@ unit cga68k;
|
||||
else
|
||||
begin
|
||||
reset_reference(p^.location.reference);
|
||||
p^.location.reference.index:=hregister;
|
||||
p^.location.reference.base:=hregister;
|
||||
set_location(p^.left^.location,p^.location);
|
||||
end;
|
||||
end;
|
||||
@ -214,7 +213,7 @@ unit cga68k;
|
||||
var
|
||||
pushed : boolean;
|
||||
begin
|
||||
if needed>usablereg32 then
|
||||
if (needed>usablereg32) or (needed > usableaddress) then
|
||||
begin
|
||||
if (p^.location.loc=LOC_REGISTER) or
|
||||
(p^.location.loc=LOC_CREGISTER) then
|
||||
@ -223,17 +222,15 @@ unit cga68k;
|
||||
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,p^.location.register,R_SPPUSH)));
|
||||
ungetregister32(p^.location.register);
|
||||
end
|
||||
else if ((p^.location.loc=LOC_MEM) or
|
||||
(p^.location.loc=LOC_REFERENCE)
|
||||
) and
|
||||
((p^.location.reference.base<>R_NO) or
|
||||
(p^.location.reference.index<>R_NO)
|
||||
) then
|
||||
else
|
||||
if ((p^.location.loc=LOC_MEM) or(p^.location.loc=LOC_REFERENCE)) and
|
||||
((p^.location.reference.base<>R_NO) or
|
||||
(p^.location.reference.index<>R_NO)) then
|
||||
begin
|
||||
del_reference(p^.location.reference);
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(p^.location.reference),
|
||||
R_A0)));
|
||||
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A0,R_SPPUSH)));
|
||||
R_A0)));
|
||||
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,R_A0,R_SPPUSH)));
|
||||
pushed:=true;
|
||||
end
|
||||
else pushed:=false;
|
||||
@ -381,7 +378,7 @@ unit cga68k;
|
||||
begin
|
||||
exprasmlist^.concat(new(pai68k,op_reg(A_CLR,S_L,R_D6)));
|
||||
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,
|
||||
R_D6, R_SPPUSH)));
|
||||
R_D6, R_SPPUSH)));
|
||||
end
|
||||
else
|
||||
if not(cs_littlesize in aktglobalswitches) and (l >= -128) and (l <= 127) then
|
||||
@ -394,18 +391,18 @@ unit cga68k;
|
||||
end;
|
||||
|
||||
procedure emit_push_mem(const ref : treference);
|
||||
|
||||
{ Push a value on to the stack }
|
||||
begin
|
||||
if ref.isintvalue then
|
||||
push_int(ref.offset)
|
||||
else
|
||||
exprasmlist^.concat(new(pai68k,op_ref(A_PEA,S_L,newreference(ref))));
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,newreference(ref),R_SPPUSH)));
|
||||
end;
|
||||
|
||||
|
||||
{ USES REGISTER R_A1 }
|
||||
procedure emitpushreferenceaddr(const ref : treference);
|
||||
|
||||
{ Push a pointer to a value on the stack }
|
||||
begin
|
||||
if ref.isintvalue then
|
||||
push_int(ref.offset)
|
||||
@ -465,8 +462,20 @@ begin
|
||||
begin
|
||||
procinfo.aktentrycode^.insert(new(pai68k,
|
||||
op_csymbol(A_JSR,S_NO,newcsymbol('INIT_STACK_CHECK',0))));
|
||||
end
|
||||
else
|
||||
{ The main program has already allocated its stack - so we simply compare }
|
||||
{ with a value of ZERO, and the comparison will directly check! }
|
||||
if (cs_check_stack in aktlocalswitches) then
|
||||
begin
|
||||
procinfo.aktentrycode^.insert(new(pai68k,op_csymbol(A_JSR,S_NO,
|
||||
newcsymbol('STACKCHECK',0))));
|
||||
procinfo.aktentrycode^.insert(new(pai68k,op_const_reg(A_MOVE,S_L,
|
||||
0,R_D0)));
|
||||
concat_external('STACKCHECK',EXT_NEAR);
|
||||
end;
|
||||
|
||||
|
||||
unitinits.init;
|
||||
|
||||
{Call the unit init procedures.}
|
||||
@ -529,9 +538,14 @@ begin
|
||||
if (cs_check_stack in aktlocalswitches) and
|
||||
(target_info.target<>target_linux) then
|
||||
begin
|
||||
procinfo.aktentrycode^.insert(new(pai68k,
|
||||
op_csymbol(A_JSR,S_NO,newcsymbol('STACKCHECK',0))));
|
||||
procinfo.aktentrycode^.insert(new(pai68k,op_const_reg(A_MOVE,S_L,stackframe,R_SPPUSH)));
|
||||
{ If only not in main program, do we setup stack checking }
|
||||
if (aktprocsym^.definition^.options and poproginit=0) then
|
||||
Begin
|
||||
procinfo.aktentrycode^.insert(new(pai68k,
|
||||
op_csymbol(A_JSR,S_NO,newcsymbol('STACKCHECK',0))));
|
||||
procinfo.aktentrycode^.insert(new(pai68k,op_const_reg(A_MOVE,S_L,stackframe,R_D0)));
|
||||
concat_external('STACKCHECK',EXT_NEAR);
|
||||
end;
|
||||
end;
|
||||
{ to allocate stack space }
|
||||
{ here we allocate space using link signed 16-bit version }
|
||||
@ -549,12 +563,14 @@ begin
|
||||
if (stackframe > -32767) and (stackframe < 32769) then
|
||||
begin
|
||||
procinfo.aktentrycode^.insert(new(pai68k,op_const_reg(A_SUB,S_L,stackframe,R_SP)));
|
||||
if (cs_check_stack in aktlocalswitches) then
|
||||
{ IF only NOT in main program do we check the stack normally }
|
||||
if (cs_check_stack in aktlocalswitches)
|
||||
and (aktprocsym^.definition^.options and poproginit=0) then
|
||||
begin
|
||||
procinfo.aktentrycode^.insert(new(pai68k,
|
||||
op_csymbol(A_JSR,S_NO,newcsymbol('STACKCHECK',0))));
|
||||
procinfo.aktentrycode^.insert(new(pai68k,op_const_reg(A_MOVE,S_L,
|
||||
stackframe,R_SPPUSH)));
|
||||
stackframe,R_D0)));
|
||||
concat_external('STACKCHECK',EXT_NEAR);
|
||||
end;
|
||||
procinfo.aktentrycode^.insert(new(pai68k,op_reg_reg(A_MOVE,S_L,R_SP,R_A6)));
|
||||
@ -571,6 +587,7 @@ begin
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
if (aktprocsym^.definition^.options and pointerrupt)<>0 then
|
||||
generate_interrupt_stackframe_entry;
|
||||
|
||||
@ -616,13 +633,6 @@ begin
|
||||
procinfo.aktentrycode^.insert(stab_function_name);
|
||||
if make_global or ((procinfo.flags and pi_is_global) <> 0) then
|
||||
aktprocsym^.is_global := True;
|
||||
{This is dead code! Because lexlevel is increased at the
|
||||
start of compile_proc_body it can never be zero.}
|
||||
{ if (lexlevel > 0) and (oldprocsym^.definition^.localst^.name = nil) then
|
||||
if oldprocsym^.owner^.symtabletype = objectsymtable then
|
||||
oldprocsym^.definition^.localst^.name := stringdup(oldprocsym^.owner^.name^+'_'+oldprocsym^.name)
|
||||
else
|
||||
oldprocsym^.definition^.localst^.name := stringdup(oldprocsym^.name);}
|
||||
aktprocsym^.isstabwritten:=true;
|
||||
end;
|
||||
{$endif GDB}
|
||||
@ -660,7 +670,8 @@ begin
|
||||
|
||||
{ call __EXIT for main program }
|
||||
{ ????????? }
|
||||
if (aktprocsym^.definition^.options and poproginit)<>0 then
|
||||
if ((aktprocsym^.definition^.options and poproginit)<>0) and
|
||||
(target_info.target<>target_PalmOS) then
|
||||
begin
|
||||
procinfo.aktexitcode^.concat(new(pai68k,op_csymbol(A_JSR,S_NO,newcsymbol('__EXIT',0))));
|
||||
externals^.concat(new(pai_external,init('__EXIT',EXT_NEAR)));
|
||||
@ -705,9 +716,9 @@ begin
|
||||
else
|
||||
begin
|
||||
{ how the return value is handled }
|
||||
{ if in FPU mode, return in FP0 }
|
||||
if (pfloatdef(procinfo.retdef)^.typ = s32real)
|
||||
and (cs_fp_emulation in aktmoduleswitches) then
|
||||
{ if single value, then return in d0, otherwise return in }
|
||||
{ TRUE FPU register (does not apply in emulation mode) }
|
||||
if (pfloatdef(procinfo.retdef)^.typ = s32real) then
|
||||
begin
|
||||
procinfo.aktexitcode^.concat(new(pai68k,op_ref_reg(A_MOVE,
|
||||
S_L,hr,R_D0)))
|
||||
@ -806,6 +817,7 @@ end;
|
||||
|
||||
|
||||
{ USES REGISTERS R_A0 AND R_A1 }
|
||||
{ maximum size of copy is 65535 bytes }
|
||||
procedure concatcopy(source,dest : treference;size : longint;delsource : boolean);
|
||||
|
||||
var
|
||||
@ -820,7 +832,11 @@ end;
|
||||
hp1 : treference;
|
||||
hp2 : treference;
|
||||
hl : plabel;
|
||||
hl2: plabel;
|
||||
begin
|
||||
{ this should never occur }
|
||||
if size > 65535 then
|
||||
internalerror(0);
|
||||
hregister := getregister32;
|
||||
if delsource then
|
||||
del_reference(source);
|
||||
@ -879,35 +895,58 @@ end;
|
||||
hp1.direction := dir_inc;
|
||||
reset_reference(hp2);
|
||||
hp2.base := jregister;
|
||||
hp1.direction := dir_inc;
|
||||
hp2.direction := dir_inc;
|
||||
{ iregister = source }
|
||||
{ jregister = destination }
|
||||
|
||||
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(source),iregister)));
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_LEA,S_L,newreference(dest),jregister)));
|
||||
|
||||
{ double word move }
|
||||
helpsize := size - size mod 4;
|
||||
size := size mod 4;
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,helpsize div 4,hregister)));
|
||||
getlabel(hl);
|
||||
emitl(A_LABEL,hl);
|
||||
exprasmlist^.concat(new(pai68k,op_ref_ref(A_MOVE,S_L,newreference(hp1),newreference(hp2))));
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_SUBQ,S_L,4,hregister)));
|
||||
emitl(A_BNE,hl);
|
||||
if size > 1 then
|
||||
{ double word move only on 68020+ machines }
|
||||
{ because of possible alignment problems }
|
||||
{ use fast loop mode }
|
||||
if (aktoptprocessor=MC68020) then
|
||||
begin
|
||||
dec(size,2);
|
||||
exprasmlist^.concat(new(pai68k,op_ref_ref(A_MOVE,S_W,newreference(hp1), newreference(hp2))));
|
||||
end;
|
||||
if size = 1 then
|
||||
helpsize := size - size mod 4;
|
||||
size := size mod 4;
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,helpsize div 4,hregister)));
|
||||
getlabel(hl2);
|
||||
emitl(A_BRA,hl2);
|
||||
getlabel(hl);
|
||||
emitl(A_LABEL,hl);
|
||||
exprasmlist^.concat(new(pai68k,op_ref_ref(A_MOVE,S_L,newreference(hp1),newreference(hp2))));
|
||||
emitl(A_LABEL,hl2);
|
||||
exprasmlist^.concat(new(pai_labeled, init_reg(A_DBRA,hl,hregister)));
|
||||
if size > 1 then
|
||||
begin
|
||||
dec(size,2);
|
||||
exprasmlist^.concat(new(pai68k,op_ref_ref(A_MOVE,S_W,newreference(hp1), newreference(hp2))));
|
||||
end;
|
||||
if size = 1 then
|
||||
exprasmlist^.concat(new(pai68k,op_ref_ref(A_MOVE,S_B,newreference(hp1), newreference(hp2))));
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Fast 68010 loop mode with no possible alignment problems }
|
||||
helpsize := size;
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_MOVE,S_L,helpsize,hregister)));
|
||||
getlabel(hl2);
|
||||
emitl(A_BRA,hl2);
|
||||
getlabel(hl);
|
||||
emitl(A_LABEL,hl);
|
||||
exprasmlist^.concat(new(pai68k,op_ref_ref(A_MOVE,S_B,newreference(hp1),newreference(hp2))));
|
||||
emitl(A_LABEL,hl2);
|
||||
exprasmlist^.concat(new(pai_labeled, init_reg(A_DBRA,hl,hregister)));
|
||||
end;
|
||||
|
||||
{ restore the registers that we have just used olny if they are used! }
|
||||
if jregister = R_A1 then
|
||||
hp2.base := R_NO;
|
||||
if iregister = R_A0 then
|
||||
hp1.base := R_NO;
|
||||
del_reference(hp1);
|
||||
del_reference(hp2);
|
||||
if jregister = R_A1 then
|
||||
hp2.base := R_NO;
|
||||
if iregister = R_A0 then
|
||||
hp1.base := R_NO;
|
||||
del_reference(hp1);
|
||||
del_reference(hp2);
|
||||
end;
|
||||
|
||||
{ loading SELF-reference again }
|
||||
@ -934,7 +973,7 @@ end;
|
||||
begin
|
||||
case orddef^.typ of
|
||||
u8bit: begin
|
||||
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_L,location.register,destreg)));
|
||||
exprasmlist^.concat(new(pai68k,op_reg_reg(A_MOVE,S_B,location.register,destreg)));
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_ANDI,S_L,$FF,destreg)));
|
||||
end;
|
||||
s8bit: begin
|
||||
@ -971,7 +1010,7 @@ end;
|
||||
r:=newreference(location.reference);
|
||||
case orddef^.typ of
|
||||
u8bit: begin
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_L,r,destreg)));
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVE,S_B,r,destreg)));
|
||||
exprasmlist^.concat(new(pai68k,op_const_reg(A_ANDI,S_L,$FF,destreg)));
|
||||
end;
|
||||
s8bit: begin
|
||||
@ -1149,7 +1188,17 @@ end;
|
||||
end; { end case }
|
||||
if not ((cs_fp_emulation) in aktmoduleswitches) then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai68k,op_reg_ref(A_FMOVE,s,location.fpureg,newreference(ref))));
|
||||
{ This permits the mixing of emulation and non-emulation routines }
|
||||
{ only possible for REAL = SINGLE values }
|
||||
if not (location.fpureg in [R_FP0..R_FP7]) then
|
||||
Begin
|
||||
if s = S_FS then
|
||||
exprasmlist^.concat(new(pai68k,op_reg_ref(A_MOVE,S_L,location.fpureg,newreference(ref))))
|
||||
else
|
||||
internalerror(255);
|
||||
end
|
||||
else
|
||||
exprasmlist^.concat(new(pai68k,op_reg_ref(A_FMOVE,s,location.fpureg,newreference(ref))));
|
||||
ungetregister(location.fpureg);
|
||||
end
|
||||
else
|
||||
@ -1194,42 +1243,20 @@ end;
|
||||
else p^.swaped:=false;
|
||||
end;
|
||||
|
||||
|
||||
procedure secondfuncret(var p : ptree);
|
||||
var
|
||||
hr : tregister;
|
||||
hp : preference;
|
||||
pp : pprocinfo;
|
||||
hr_valid : boolean;
|
||||
hregister : tregister;
|
||||
|
||||
begin
|
||||
clear_reference(p^.location.reference);
|
||||
hr_valid:=false;
|
||||
if @procinfo<>pprocinfo(p^.funcretprocinfo) then
|
||||
begin
|
||||
hr:=getaddressreg;
|
||||
hr_valid:=true;
|
||||
hp:=new_reference(procinfo.framepointer,
|
||||
procinfo.framepointer_offset);
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVEA,S_L,hp,hr)));
|
||||
pp:=procinfo.parent;
|
||||
{ walk up the stack frame }
|
||||
while pp<>pprocinfo(p^.funcretprocinfo) do
|
||||
begin
|
||||
hp:=new_reference(hr,
|
||||
pp^.framepointer_offset);
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVEA,S_L,hp,hr)));
|
||||
pp:=pp^.parent;
|
||||
end;
|
||||
p^.location.reference.base:=hr;
|
||||
end
|
||||
else
|
||||
p^.location.reference.base:=procinfo.framepointer;
|
||||
p^.location.reference.base:=procinfo.framepointer;
|
||||
p^.location.reference.offset:=procinfo.retoffset;
|
||||
if ret_in_param(p^.retdef) then
|
||||
if ret_in_param(procinfo.retdef) then
|
||||
begin
|
||||
if not hr_valid then
|
||||
hr:=getaddressreg;
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVEA,S_L,newreference(p^.location.reference),hr)));
|
||||
p^.location.reference.base:=hr;
|
||||
hregister:=getaddressreg;
|
||||
exprasmlist^.concat(new(pai68k,op_ref_reg(A_MOVEA,S_L,newreference(p^.location.reference),hregister)));
|
||||
p^.location.reference.base:=hregister;
|
||||
p^.location.reference.offset:=0;
|
||||
end;
|
||||
end;
|
||||
@ -1237,7 +1264,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 1998-08-21 14:08:41 pierre
|
||||
Revision 1.11 1998-08-31 12:26:24 peter
|
||||
* m68k and palmos updates from surebugfixes
|
||||
|
||||
Revision 1.10 1998/08/21 14:08:41 pierre
|
||||
+ TEST_FUNCRET now default (old code removed)
|
||||
works also for m68k (at least compiles)
|
||||
|
||||
|
||||
@ -286,6 +286,7 @@ begin
|
||||
end;
|
||||
{$endif i386}
|
||||
{$ifdef m68k}
|
||||
target_Palmos : prtobj:='';
|
||||
target_linux : begin
|
||||
if cs_profile in aktmoduleswitches then
|
||||
begin
|
||||
@ -488,7 +489,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.20 1998-08-19 10:06:14 peter
|
||||
Revision 1.21 1998-08-31 12:26:26 peter
|
||||
* m68k and palmos updates from surebugfixes
|
||||
|
||||
Revision 1.20 1998/08/19 10:06:14 peter
|
||||
* fixed filenames and removedir which supports slash at the end
|
||||
|
||||
Revision 1.19 1998/08/17 09:17:47 peter
|
||||
|
||||
@ -359,8 +359,6 @@ type
|
||||
|
||||
function newreference(const r : treference) : preference;
|
||||
|
||||
function new_reference(base : tregister;offset : longint) : preference;
|
||||
|
||||
function reg2str(r : tregister) : string;
|
||||
|
||||
{ generates an help record for constants }
|
||||
@ -849,6 +847,14 @@ type
|
||||
'fp6','fp7','fpcr','sr','ssp','dfc',
|
||||
'sfc','vbr','fpsr');
|
||||
|
||||
gasPalmOS_reg2str : array[R_NO..R_FPSR] of string[6] =
|
||||
('', '%d0','%d1','%d2','%d3','%d4','%d5','%d6','%d7',
|
||||
'%a0','%a1','%a2','%a3','%a4','%a5','%a6','%sp',
|
||||
'-(%sp)','(%sp)+',
|
||||
'%ccr','%fp0','%fp1','%fp2','%fp3','%fp4','%fp5',
|
||||
'%fp6','%fp7','%fpcr','%sr','%ssp','%dfc',
|
||||
'%sfc','%vbr','%fpsr');
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
@ -899,18 +905,6 @@ type
|
||||
end;
|
||||
end;
|
||||
|
||||
function new_reference(base : tregister;offset : longint) : preference;
|
||||
|
||||
var
|
||||
r : preference;
|
||||
begin
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.base:=base;
|
||||
r^.offset:=offset;
|
||||
new_reference:=r;
|
||||
end;
|
||||
|
||||
procedure clear_reference(var ref : treference);
|
||||
|
||||
begin
|
||||
@ -1579,7 +1573,10 @@ type
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 1998-08-21 14:08:44 pierre
|
||||
Revision 1.7 1998-08-31 12:26:27 peter
|
||||
* m68k and palmos updates from surebugfixes
|
||||
|
||||
Revision 1.6 1998/08/21 14:08:44 pierre
|
||||
+ TEST_FUNCRET now default (old code removed)
|
||||
works also for m68k (at least compiles)
|
||||
|
||||
|
||||
@ -146,8 +146,8 @@ unit pmodules;
|
||||
|
||||
procedure inserttargetspecific;
|
||||
begin
|
||||
{$ifdef i386}
|
||||
case target_info.target of
|
||||
{$ifdef i386}
|
||||
target_GO32V2 : begin
|
||||
{ stacksize can be specified }
|
||||
datasegment^.concat(new(pai_symbol,init_global('__stklen')));
|
||||
@ -159,8 +159,16 @@ unit pmodules;
|
||||
asw (PFV) }
|
||||
datasegment^.concat(new(pai_const,init_symbol('_mainCRTStartup')));
|
||||
end;
|
||||
end;
|
||||
{$endif i386}
|
||||
{$ifdef m68k}
|
||||
target_Atari : begin
|
||||
{ stacksize can be specified }
|
||||
datasegment^.concat(new(pai_symbol,init_global('__stklen')));
|
||||
datasegment^.concat(new(pai_const,init_32bit(stacksize)));
|
||||
end;
|
||||
{$endif m68k}
|
||||
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -857,6 +865,12 @@ unit pmodules;
|
||||
names.insert('program_init');
|
||||
names.insert('PASCALMAIN');
|
||||
names.insert(target_os.cprefix+'main');
|
||||
{$ifdef m68k}
|
||||
|
||||
if target_info.target=target_PalmOS then
|
||||
names.insert('PilotMain');
|
||||
{$endif}
|
||||
|
||||
compile_proc_body(names,true,false);
|
||||
names.done;
|
||||
|
||||
@ -901,7 +915,10 @@ unit pmodules;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.44 1998-08-26 15:35:33 peter
|
||||
Revision 1.45 1998-08-31 12:26:28 peter
|
||||
* m68k and palmos updates from surebugfixes
|
||||
|
||||
Revision 1.44 1998/08/26 15:35:33 peter
|
||||
* fixed scannerfiles for macros
|
||||
+ $I %<environment>%
|
||||
|
||||
|
||||
@ -518,7 +518,11 @@ begin
|
||||
exit;
|
||||
end;
|
||||
readdata(w,2);
|
||||
getword:=w;
|
||||
if change_endian then
|
||||
getword:=swap(w)
|
||||
else
|
||||
|
||||
getword:=w;
|
||||
inc(entryidx,2);
|
||||
end;
|
||||
|
||||
@ -536,7 +540,11 @@ begin
|
||||
exit;
|
||||
end;
|
||||
readdata(l,4);
|
||||
getlongint:=l;
|
||||
if change_endian then
|
||||
getlongint:=swap(l shr 16) or (longint(swap(l and $ffff)) shl 16)
|
||||
else
|
||||
|
||||
getlongint:=l;
|
||||
inc(entryidx,4);
|
||||
end;
|
||||
|
||||
@ -762,7 +770,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 1998-08-17 09:17:51 peter
|
||||
Revision 1.10 1998-08-31 12:26:30 peter
|
||||
* m68k and palmos updates from surebugfixes
|
||||
|
||||
Revision 1.9 1998/08/17 09:17:51 peter
|
||||
* static/shared linking updates
|
||||
|
||||
Revision 1.8 1998/08/11 15:31:40 peter
|
||||
|
||||
@ -51,22 +51,21 @@ unit ptconst;
|
||||
procedure readtypedconst(def : pdef;sym : ptypedconstsym);
|
||||
|
||||
var
|
||||
p : ptree;
|
||||
i,l,strlength : longint;
|
||||
ll : plabel;
|
||||
s : string;
|
||||
ca : pchar;
|
||||
aktpos : longint;
|
||||
pd : pprocdef;
|
||||
hp1,hp2 : pdefcoll;
|
||||
|
||||
value : bestreal;
|
||||
{problem with fldt !!
|
||||
anyway .valued is not extended !!
|
||||
value : double; }
|
||||
{$ifdef m68k}
|
||||
j : longint;
|
||||
{$endif m68k}
|
||||
p : ptree;
|
||||
i,l,
|
||||
strlength : longint;
|
||||
ll : plabel;
|
||||
s : string;
|
||||
ca : pchar;
|
||||
aktpos : longint;
|
||||
pd : pprocdef;
|
||||
hp1,hp2 : pdefcoll;
|
||||
value : bestreal;
|
||||
|
||||
procedure check_range;
|
||||
|
||||
begin
|
||||
if ((p^.value>porddef(def)^.high) or
|
||||
(p^.value<porddef(def)^.low)) then
|
||||
@ -218,8 +217,23 @@ unit ptconst;
|
||||
Message(cg_e_illegal_expression)
|
||||
else
|
||||
begin
|
||||
for l:=0 to def^.savesize-1 do
|
||||
datasegment^.concat(new(pai_const,init_8bit(p^.constset^[l])));
|
||||
{$ifdef i386}
|
||||
for l:=0 to def^.savesize-1 do
|
||||
datasegment^.concat(new(pai_const,init_8bit(p^.constset^[l])));
|
||||
{$endif}
|
||||
{$ifdef m68k}
|
||||
j:=0;
|
||||
for l:=0 to ((def^.savesize-1) div 4) do
|
||||
{ HORRIBLE HACK because of endian }
|
||||
{ now use intel endian for constant sets }
|
||||
begin
|
||||
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);
|
||||
end;
|
||||
{$endif}
|
||||
end;
|
||||
end
|
||||
else
|
||||
@ -492,7 +506,10 @@ unit ptconst;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 1998-08-10 14:50:20 peter
|
||||
Revision 1.12 1998-08-31 12:26:32 peter
|
||||
* m68k and palmos updates from surebugfixes
|
||||
|
||||
Revision 1.11 1998/08/10 14:50:20 peter
|
||||
+ localswitches, moduleswitches, globalswitches splitting
|
||||
|
||||
Revision 1.10 1998/07/21 11:16:25 florian
|
||||
|
||||
@ -56,7 +56,7 @@ unit systems;
|
||||
target_GO32V1,target_GO32V2,target_LINUX,target_OS2,target_WIN32
|
||||
{$endif i386}
|
||||
{$ifdef m68k}
|
||||
target_Amiga,target_Atari,target_Mac68k,target_Linux
|
||||
target_Amiga,target_Atari,target_Mac68k,target_Linux,target_PalmOS
|
||||
{$endif}
|
||||
);
|
||||
|
||||
@ -95,7 +95,7 @@ unit systems;
|
||||
os_GO32V1, os_GO32V2, os_Linux, os_OS2, os_WIN32
|
||||
{$endif i386}
|
||||
{$ifdef m68k}
|
||||
os_Amiga, os_Atari, os_Mac68k, os_Linux
|
||||
os_Amiga, os_Atari, os_Mac68k, os_Linux, os_PalmOS
|
||||
{$endif}
|
||||
);
|
||||
|
||||
@ -279,7 +279,7 @@ implementation
|
||||
exeext : '';
|
||||
scriptext : '';
|
||||
libprefix : '';
|
||||
Cprefix : '';
|
||||
Cprefix : '_';
|
||||
newline : #10;
|
||||
endian : en_big_endian;
|
||||
use_function_relative_addresses : false
|
||||
@ -293,7 +293,7 @@ implementation
|
||||
exeext : '.tpp';
|
||||
scriptext : '';
|
||||
libprefix : '';
|
||||
Cprefix : '';
|
||||
Cprefix : '_';
|
||||
newline : #10;
|
||||
endian : en_big_endian;
|
||||
use_function_relative_addresses : false
|
||||
@ -307,7 +307,7 @@ implementation
|
||||
exeext : '.tpp';
|
||||
scriptext : '';
|
||||
libprefix : '';
|
||||
Cprefix : '';
|
||||
Cprefix : '_';
|
||||
newline : #13;
|
||||
endian : en_big_endian;
|
||||
use_function_relative_addresses : false
|
||||
@ -325,6 +325,20 @@ implementation
|
||||
newline : #10;
|
||||
endian : en_big_endian;
|
||||
use_function_relative_addresses : true
|
||||
),
|
||||
(
|
||||
name : 'PalmOS';
|
||||
sharedlibext : '.so';
|
||||
staticlibext : '.a';
|
||||
sourceext : '.pp';
|
||||
pasext : '.pas';
|
||||
exeext : '';
|
||||
scriptext : '';
|
||||
libprefix : '';
|
||||
Cprefix : '_';
|
||||
newline : #10;
|
||||
endian : en_big_endian;
|
||||
use_function_relative_addresses : false
|
||||
)
|
||||
{$endif m68k}
|
||||
);
|
||||
@ -677,7 +691,7 @@ implementation
|
||||
link : link_ld;
|
||||
assem : as_o;
|
||||
ar : ar_ar;
|
||||
heapsize : 512*1024;
|
||||
heapsize : 128*1024;
|
||||
stacksize : 8192
|
||||
),
|
||||
(
|
||||
@ -695,7 +709,7 @@ implementation
|
||||
link : link_ld;
|
||||
assem : as_o;
|
||||
ar : ar_ar;
|
||||
heapsize : 512*1024;
|
||||
heapsize : 16*1024;
|
||||
stacksize : 8192
|
||||
),
|
||||
(
|
||||
@ -713,7 +727,7 @@ implementation
|
||||
link : link_ld;
|
||||
assem : as_o;
|
||||
ar : ar_ar;
|
||||
heapsize : 512*1024;
|
||||
heapsize : 128*1024;
|
||||
stacksize : 8192
|
||||
),
|
||||
(
|
||||
@ -731,7 +745,25 @@ implementation
|
||||
link : link_ld;
|
||||
assem : as_o;
|
||||
ar : ar_ar;
|
||||
heapsize : 512*1024;
|
||||
heapsize : 128*1024;
|
||||
stacksize : 8192
|
||||
),
|
||||
(
|
||||
target : target_PalmOS;
|
||||
short_name : 'PALMOS';
|
||||
unit_env : 'PALMUNITS';
|
||||
system_unit : 'syspalm';
|
||||
smartext : '.sl';
|
||||
unitext : '.ppu';
|
||||
unitlibext : '.ppl';
|
||||
asmext : '.s';
|
||||
objext : '.o';
|
||||
exeext : '';
|
||||
os : os_PalmOS;
|
||||
link : link_ld;
|
||||
assem : as_o;
|
||||
ar : ar_ar;
|
||||
heapsize : 128*1024;
|
||||
stacksize : 8192
|
||||
)
|
||||
{$endif m68k}
|
||||
@ -876,7 +908,10 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.29 1998-08-26 10:09:21 peter
|
||||
Revision 1.30 1998-08-31 12:26:34 peter
|
||||
* m68k and palmos updates from surebugfixes
|
||||
|
||||
Revision 1.29 1998/08/26 10:09:21 peter
|
||||
* more lowercase extensions
|
||||
|
||||
Revision 1.28 1998/08/25 12:42:47 pierre
|
||||
|
||||
@ -78,6 +78,24 @@ unit tgen68k;
|
||||
|
||||
implementation
|
||||
|
||||
|
||||
function getusableaddr: byte;
|
||||
{ Since address registers are different then data registers }
|
||||
{ we check the unused register list to determine the number }
|
||||
{ of address registers which are available. }
|
||||
var
|
||||
i: byte;
|
||||
Begin
|
||||
i:=0;
|
||||
if R_A2 in unused then
|
||||
Inc(i);
|
||||
if R_A3 in unused then
|
||||
Inc(i);
|
||||
if R_A4 in unused then
|
||||
Inc(i);
|
||||
getusableaddr:=i;
|
||||
end;
|
||||
|
||||
procedure pushusedregisters(var pushed : tpushed;b : word);
|
||||
|
||||
var
|
||||
@ -169,22 +187,12 @@ unit tgen68k;
|
||||
inc(usablefloatreg);
|
||||
end
|
||||
else
|
||||
if r in [R_A2,R_A3,R_A4,R_A6,R_SP] then
|
||||
if r in [R_A2,R_A3,R_A4] then
|
||||
begin
|
||||
unused:=unused+[r];
|
||||
inc(usableaddress);
|
||||
{$ifdef EXTDEBUG}
|
||||
end
|
||||
else
|
||||
begin
|
||||
if not (r in [R_NO]) then
|
||||
begin
|
||||
Comment(V_Debug,'ungetregister32() deallocation of reserved register.');
|
||||
end;
|
||||
end;
|
||||
{$ELSE}
|
||||
end;
|
||||
{$ENDIF}
|
||||
{ other registers are RESERVED and should not be freed }
|
||||
end;
|
||||
|
||||
|
||||
@ -287,6 +295,7 @@ unit tgen68k;
|
||||
begin
|
||||
unused:=usableregs;
|
||||
usablereg32:=c_usableregs;
|
||||
usableaddress:=getusableaddr;
|
||||
end;
|
||||
|
||||
begin
|
||||
@ -298,86 +307,12 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 1998-06-08 13:13:46 pierre
|
||||
Revision 1.3 1998-08-31 12:26:35 peter
|
||||
* m68k and palmos updates from surebugfixes
|
||||
|
||||
Revision 1.2 1998/06/08 13:13:46 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.1.1.1 1998/03/25 11:18:15 root
|
||||
* Restored version
|
||||
|
||||
Revision 1.12 1998/03/22 12:45:38 florian
|
||||
* changes of Carl-Eric to m68k target commit:
|
||||
- wrong nodes because of the new string cg in intel, I had to create
|
||||
this under m68k also ... had to work it out to fix potential alignment
|
||||
problems --> this removes the crash of the m68k compiler.
|
||||
- added absolute addressing in m68k assembler (required for Amiga startup)
|
||||
- fixed alignment problems (because of byte return values, alignment
|
||||
would not be always valid) -- is this ok if i change the offset if odd in
|
||||
setfirsttemp ?? -- it seems ok...
|
||||
|
||||
Revision 1.11 1998/03/10 04:21:15 carl
|
||||
* fixed extdebug problems
|
||||
|
||||
Revision 1.10 1998/03/10 01:17:30 peter
|
||||
* all files have the same header
|
||||
* messages are fully implemented, EXTDEBUG uses Comment()
|
||||
+ AG... files for the Assembler generation
|
||||
|
||||
Revision 1.9 1998/03/06 00:53:00 peter
|
||||
* replaced all old messages from errore.msg, only ExtDebug and some
|
||||
Comment() calls are left
|
||||
* fixed options.pas
|
||||
|
||||
Revision 1.8 1998/03/02 01:49:35 peter
|
||||
* renamed target_DOS to target_GO32V1
|
||||
+ new verbose system, merged old errors and verbose units into one new
|
||||
verbose.pas, so errors.pas is obsolete
|
||||
|
||||
Revision 1.7 1998/02/13 10:35:51 daniel
|
||||
* Made Motorola version compilable.
|
||||
* Fixed optimizer
|
||||
|
||||
Revision 1.6 1998/01/11 03:40:16 carl
|
||||
+ added fpu register allocation
|
||||
|
||||
Revision 1.3 1997/12/09 14:13:07 carl
|
||||
* bugfix of free register list.
|
||||
|
||||
Revision 1.2 1997/11/28 18:14:49 pierre
|
||||
working version with several bug fixes
|
||||
|
||||
Revision 1.1.1.1 1997/11/27 08:33:03 michael
|
||||
FPC Compiler CVS start
|
||||
|
||||
Pre-CVS log:
|
||||
|
||||
+ feature added
|
||||
- removed
|
||||
* bug fixed or changed
|
||||
|
||||
History (started with version 0.9.0):
|
||||
7th december 1996:
|
||||
* some code from Pierre Muller inserted
|
||||
makes the use of the stack more efficient
|
||||
5th september 1997:
|
||||
+ Converted for Motorola MC68000 output (C. E. Codere)
|
||||
24nd september 1997:
|
||||
+ Reserved register list modified. (CEC)
|
||||
26 september 1997:
|
||||
+ Converted to work with v093 (CEC)
|
||||
* Knowing that base is in address register, modified routines
|
||||
accordingly. (CEC)
|
||||
27 september 1997:
|
||||
+ pushusedregisters now pushes only non-scratch registers.
|
||||
2nd october 1997:
|
||||
+ added strict error checking when extdebug defined.
|
||||
23 october 1997:
|
||||
- it seems that sp, and the base pointer can be freed in ungetregister,
|
||||
removed warning accordingly. (CEC).
|
||||
* bugfix of address register in usableregs set. (They were not defined...) (CEC).
|
||||
* other stupid bug! When I changed the register conventions, I forgot to change
|
||||
getaddressreg to reflect those changes!! (CEC).
|
||||
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user