mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-27 23:23:44 +02:00
+ basic operations with int64/qord (compiler with -dint64)
+ rtti of enumerations extended: names are now written
This commit is contained in:
florian
parent
4b73dda508
commit
4244dda54b
@ -1075,7 +1075,267 @@ implementation
|
||||
ungetregister32(reg8toreg32(p^.location.register));
|
||||
end
|
||||
else
|
||||
{ 64 bit types }
|
||||
if is_64bitint(p^.left^.resulttype) then
|
||||
begin
|
||||
mboverflow:=false;
|
||||
cmpop:=false;
|
||||
unsigned:=((p^.left^.resulttype^.deftype=orddef) and
|
||||
(porddef(p^.left^.resulttype)^.typ=u64bit)) or
|
||||
((p^.right^.resulttype^.deftype=orddef) and
|
||||
(porddef(p^.right^.resulttype)^.typ=u64bit));
|
||||
case p^.treetype of
|
||||
addn : begin
|
||||
begin
|
||||
op:=A_ADD;
|
||||
mboverflow:=true;
|
||||
end;
|
||||
end;
|
||||
muln : begin
|
||||
begin
|
||||
if unsigned then
|
||||
op:=A_MUL
|
||||
else
|
||||
op:=A_IMUL;
|
||||
mboverflow:=true;
|
||||
end;
|
||||
end;
|
||||
subn : begin
|
||||
op:=A_SUB;
|
||||
mboverflow:=true;
|
||||
end;
|
||||
ltn,lten,
|
||||
gtn,gten,
|
||||
equaln,unequaln : begin
|
||||
op:=A_CMP;
|
||||
cmpop:=true;
|
||||
end;
|
||||
xorn : op:=A_XOR;
|
||||
orn : op:=A_OR;
|
||||
andn : op:=A_AND;
|
||||
else
|
||||
CGMessage(type_e_mismatch);
|
||||
end;
|
||||
|
||||
|
||||
{ left and right no register? }
|
||||
{ then one must be demanded }
|
||||
if (p^.left^.location.loc<>LOC_REGISTER) and
|
||||
(p^.right^.location.loc<>LOC_REGISTER) then
|
||||
begin
|
||||
{ register variable ? }
|
||||
if (p^.left^.location.loc=LOC_CREGISTER) then
|
||||
begin
|
||||
{ it is OK if this is the destination }
|
||||
if is_in_dest then
|
||||
begin
|
||||
hregister:=p^.location.register;
|
||||
emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
|
||||
hregister);
|
||||
end
|
||||
else
|
||||
if cmpop then
|
||||
begin
|
||||
{ do not disturb the register }
|
||||
hregister:=p^.location.register;
|
||||
end
|
||||
else
|
||||
begin
|
||||
case opsize of
|
||||
S_L : hregister:=getregister32;
|
||||
S_B : hregister:=reg32toreg8(getregister32);
|
||||
end;
|
||||
emit_reg_reg(A_MOV,opsize,p^.left^.location.register,
|
||||
hregister);
|
||||
end
|
||||
end
|
||||
else
|
||||
begin
|
||||
ungetiftemp(p^.left^.location.reference);
|
||||
del_reference(p^.left^.location.reference);
|
||||
if is_in_dest then
|
||||
begin
|
||||
hregister:=p^.location.register;
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
|
||||
newreference(p^.left^.location.reference),hregister)));
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ first give free, then demand new register }
|
||||
case opsize of
|
||||
S_L : hregister:=getregister32;
|
||||
S_W : hregister:=reg32toreg16(getregister32);
|
||||
S_B : hregister:=reg32toreg8(getregister32);
|
||||
end;
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
|
||||
newreference(p^.left^.location.reference),hregister)));
|
||||
end;
|
||||
end;
|
||||
clear_location(p^.location);
|
||||
p^.location.loc:=LOC_REGISTER;
|
||||
p^.location.register:=hregister;
|
||||
end
|
||||
else
|
||||
{ if on the right the register then swap }
|
||||
if not(noswap) and (p^.right^.location.loc=LOC_REGISTER) then
|
||||
begin
|
||||
swap_location(p^.location,p^.right^.location);
|
||||
|
||||
{ newly swapped also set swapped flag }
|
||||
p^.swaped:=not(p^.swaped);
|
||||
end;
|
||||
{ at this point, p^.location.loc should be LOC_REGISTER }
|
||||
{ and p^.location.register should be a valid register }
|
||||
{ containing the left result }
|
||||
|
||||
if p^.right^.location.loc<>LOC_REGISTER then
|
||||
begin
|
||||
if (p^.treetype=subn) and p^.swaped then
|
||||
begin
|
||||
if p^.right^.location.loc=LOC_CREGISTER then
|
||||
begin
|
||||
if extra_not then
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_NOT,opsize,p^.location.register)));
|
||||
|
||||
emit_reg_reg(A_MOV,opsize,p^.right^.location.register,R_EDI);
|
||||
emit_reg_reg(op,opsize,p^.location.register,R_EDI);
|
||||
emit_reg_reg(A_MOV,opsize,R_EDI,p^.location.register);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if extra_not then
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_NOT,opsize,p^.location.register)));
|
||||
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,opsize,
|
||||
newreference(p^.right^.location.reference),R_EDI)));
|
||||
exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,p^.location.register,R_EDI)));
|
||||
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,R_EDI,p^.location.register)));
|
||||
ungetiftemp(p^.right^.location.reference);
|
||||
del_reference(p^.right^.location.reference);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (p^.right^.treetype=ordconstn) and
|
||||
(op=A_CMP) and
|
||||
(p^.right^.value=0) then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_reg_reg(A_TEST,opsize,p^.location.register,
|
||||
p^.location.register)));
|
||||
end
|
||||
else if (p^.right^.treetype=ordconstn) and
|
||||
(op=A_ADD) and
|
||||
(p^.right^.value=1) then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_INC,opsize,
|
||||
p^.location.register)));
|
||||
end
|
||||
else if (p^.right^.treetype=ordconstn) and
|
||||
(op=A_SUB) and
|
||||
(p^.right^.value=1) then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_DEC,opsize,
|
||||
p^.location.register)));
|
||||
end
|
||||
else if (p^.right^.treetype=ordconstn) and
|
||||
(op=A_IMUL) and
|
||||
(ispowerof2(p^.right^.value,power)) then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,opsize,power,
|
||||
p^.location.register)));
|
||||
end
|
||||
else
|
||||
begin
|
||||
if (p^.right^.location.loc=LOC_CREGISTER) then
|
||||
begin
|
||||
if extra_not then
|
||||
begin
|
||||
emit_reg_reg(A_MOV,S_L,p^.right^.location.register,R_EDI);
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,R_EDI)));
|
||||
emit_reg_reg(A_AND,S_L,R_EDI,
|
||||
p^.location.register);
|
||||
end
|
||||
else
|
||||
begin
|
||||
emit_reg_reg(op,opsize,p^.right^.location.register,
|
||||
p^.location.register);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if extra_not then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,newreference(
|
||||
p^.right^.location.reference),R_EDI)));
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,R_EDI)));
|
||||
emit_reg_reg(A_AND,S_L,R_EDI,
|
||||
p^.location.register);
|
||||
end
|
||||
else
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(op,opsize,newreference(
|
||||
p^.right^.location.reference),p^.location.register)));
|
||||
end;
|
||||
ungetiftemp(p^.right^.location.reference);
|
||||
del_reference(p^.right^.location.reference);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ when swapped another result register }
|
||||
if (p^.treetype=subn) and p^.swaped then
|
||||
begin
|
||||
if extra_not then
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,p^.location.register)));
|
||||
|
||||
exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,
|
||||
p^.location.register,p^.right^.location.register)));
|
||||
swap_location(p^.location,p^.right^.location);
|
||||
{ newly swapped also set swapped flag }
|
||||
{ just to maintain ordering }
|
||||
p^.swaped:=not(p^.swaped);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if extra_not then
|
||||
exprasmlist^.concat(new(pai386,op_reg(A_NOT,S_L,p^.right^.location.register)));
|
||||
exprasmlist^.concat(new(pai386,op_reg_reg(op,opsize,
|
||||
p^.right^.location.register,
|
||||
p^.location.register)));
|
||||
end;
|
||||
case opsize of
|
||||
S_L : ungetregister32(p^.right^.location.register);
|
||||
S_B : ungetregister32(reg8toreg32(p^.right^.location.register));
|
||||
end;
|
||||
end;
|
||||
|
||||
if cmpop then
|
||||
case opsize of
|
||||
S_L : ungetregister32(p^.location.register);
|
||||
S_B : ungetregister32(reg8toreg32(p^.location.register));
|
||||
end;
|
||||
|
||||
{ only in case of overflow operations }
|
||||
{ produce overflow code }
|
||||
{ we must put it here directly, because sign of operation }
|
||||
{ is in unsigned VAR!! }
|
||||
if mboverflow then
|
||||
begin
|
||||
if cs_check_overflow in aktlocalswitches then
|
||||
begin
|
||||
getlabel(hl4);
|
||||
if unsigned then
|
||||
emitl(A_JNB,hl4)
|
||||
else
|
||||
emitl(A_JNO,hl4);
|
||||
emitcall('FPC_OVERFLOW',true);
|
||||
emitl(A_LABEL,hl4);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
{ Floating point }
|
||||
if (p^.left^.resulttype^.deftype=floatdef) and
|
||||
(pfloatdef(p^.left^.resulttype)^.typ<>f32bit) then
|
||||
@ -1387,7 +1647,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.31 1998-11-30 09:42:59 pierre
|
||||
Revision 1.32 1998-12-10 09:47:13 florian
|
||||
+ basic operations with int64/qord (compiler with -dint64)
|
||||
+ rtti of enumerations extended: names are now written
|
||||
|
||||
Revision 1.31 1998/11/30 09:42:59 pierre
|
||||
* some range check bugs fixed (still not working !)
|
||||
+ added DLL writing support for win32 (also accepts variables)
|
||||
+ TempAnsi for code that could be used for Temporary ansi strings
|
||||
|
||||
@ -370,7 +370,29 @@ implementation
|
||||
orddef :
|
||||
begin
|
||||
case p^.resulttype^.size of
|
||||
4 : begin
|
||||
8 : begin
|
||||
inc(pushedparasize,8);
|
||||
if inlined then
|
||||
begin
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
||||
newreference(tempreference),R_EDI)));
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
|
||||
inc(tempreference.offset,4);
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
||||
newreference(tempreference),R_EDI)));
|
||||
r:=new_reference(procinfo.framepointer,para_offset-pushedparasize+4);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,r)));
|
||||
end
|
||||
else
|
||||
begin
|
||||
inc(tempreference.offset,4);
|
||||
emit_push_mem(tempreference);
|
||||
dec(tempreference.offset,4);
|
||||
emit_push_mem(tempreference);
|
||||
end;
|
||||
end;
|
||||
4 : begin
|
||||
inc(pushedparasize,4);
|
||||
if inlined then
|
||||
begin
|
||||
@ -715,7 +737,7 @@ implementation
|
||||
unusedregisters : tregisterset;
|
||||
pushed : tpushed;
|
||||
hr,funcretref : treference;
|
||||
hregister : tregister;
|
||||
hregister,hregister2 : tregister;
|
||||
oldpushedparasize : longint;
|
||||
{ true if ESI must be loaded again after the subroutine }
|
||||
loadesi : boolean;
|
||||
@ -1385,6 +1407,18 @@ implementation
|
||||
p^.location.register:=reg32toreg16(hregister);
|
||||
end;
|
||||
end;
|
||||
s64bitint,u64bit:
|
||||
begin
|
||||
{$ifdef test_dest_loc}
|
||||
{$error Don't know what to do here}
|
||||
{$endif test_dest_loc}
|
||||
hregister:=getexplicitregister32(R_EAX);
|
||||
hregister2:=getexplicitregister32(R_EDX);
|
||||
emit_reg_reg(A_MOV,S_L,R_EAX,hregister);
|
||||
emit_reg_reg(A_MOV,S_L,R_EDX,hregister2);
|
||||
p^.location.registerlow:=hregister;
|
||||
p^.location.registerhigh:=hregister2;
|
||||
end;
|
||||
else internalerror(7);
|
||||
end
|
||||
|
||||
@ -1592,7 +1626,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.50 1998-12-06 13:12:44 florian
|
||||
Revision 1.51 1998-12-10 09:47:15 florian
|
||||
+ basic operations with int64/qord (compiler with -dint64)
|
||||
+ rtti of enumerations extended: names are now written
|
||||
|
||||
Revision 1.50 1998/12/06 13:12:44 florian
|
||||
* better code generation for classes which are passed as parameters to
|
||||
subroutines
|
||||
|
||||
|
||||
@ -480,6 +480,7 @@ implementation
|
||||
1 : opsize:=S_B;
|
||||
2 : opsize:=S_W;
|
||||
4 : opsize:=S_L;
|
||||
8 : opsize:=S_L;
|
||||
end;
|
||||
{ simplified with op_reg_loc }
|
||||
if loc=LOC_CREGISTER then
|
||||
@ -490,6 +491,22 @@ implementation
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,
|
||||
p^.right^.location.register,
|
||||
newreference(p^.left^.location.reference))));
|
||||
|
||||
if is_64bitint(p^.right^.resulttype) then
|
||||
begin
|
||||
{ simplified with op_reg_loc }
|
||||
if loc=LOC_CREGISTER then
|
||||
exprasmlist^.concat(new(pai386,op_reg_reg(A_MOV,opsize,
|
||||
p^.right^.location.registerhigh,
|
||||
p^.left^.location.registerhigh)))
|
||||
else
|
||||
begin
|
||||
r:=newreference(p^.left^.location.reference);
|
||||
inc(r^.offset,4);
|
||||
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,opsize,
|
||||
p^.right^.location.registerhigh,r)));
|
||||
end;
|
||||
end;
|
||||
{exprasmlist^.concat(new(pai386,op_reg_loc(A_MOV,opsize,
|
||||
p^.right^.location.register,
|
||||
p^.left^.location))); }
|
||||
@ -709,7 +726,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.36 1998-12-04 10:18:06 florian
|
||||
Revision 1.37 1998-12-10 09:47:17 florian
|
||||
+ basic operations with int64/qord (compiler with -dint64)
|
||||
+ rtti of enumerations extended: names are now written
|
||||
|
||||
Revision 1.36 1998/12/04 10:18:06 florian
|
||||
* some stuff for procedures of object added
|
||||
* bug with overridden virtual constructors fixed (reported by Italo Gomes)
|
||||
|
||||
|
||||
@ -724,7 +724,10 @@ implementation
|
||||
symtable:=p^.withsymtable;
|
||||
for i:=1 to p^.tablecount do
|
||||
begin
|
||||
{$ifdef WITHTEST}
|
||||
{$else WITHTEST}
|
||||
symtable^.datasize:=ref.offset;
|
||||
{$endif WITHTEST}
|
||||
symtable:=symtable^.next;
|
||||
end;
|
||||
|
||||
@ -740,7 +743,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.20 1998-11-25 19:12:54 pierre
|
||||
Revision 1.21 1998-12-10 09:47:18 florian
|
||||
+ basic operations with int64/qord (compiler with -dint64)
|
||||
+ rtti of enumerations extended: names are now written
|
||||
|
||||
Revision 1.20 1998/11/25 19:12:54 pierre
|
||||
* var:=new(pointer_type) support added
|
||||
|
||||
Revision 1.19 1998/11/20 15:35:55 florian
|
||||
|
||||
@ -68,7 +68,8 @@ implementation
|
||||
{ Tbasetype: uauto,uvoid,uchar,
|
||||
u8bit,u16bit,u32bit,
|
||||
s8bit,s16bit,s32,
|
||||
bool8bit,bool16bit,boot32bit }
|
||||
bool8bit,bool16bit,bool32bit,
|
||||
u64bit,s64bitint }
|
||||
type
|
||||
tbasedef=(bvoid,bchar,bint,bbool);
|
||||
const
|
||||
@ -76,7 +77,8 @@ implementation
|
||||
(bvoid,bvoid,bchar,
|
||||
bint,bint,bint,
|
||||
bint,bint,bint,
|
||||
bbool,bbool,bbool);
|
||||
bbool,bbool,bbool,bint,bint);
|
||||
|
||||
basedefconverts : array[tbasedef,tbasedef] of tconverttype =
|
||||
((tc_not_possible,tc_not_possible,tc_not_possible,tc_not_possible),
|
||||
(tc_not_possible,tc_equal,tc_not_possible,tc_not_possible),
|
||||
@ -710,7 +712,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.10 1998-11-29 12:40:23 peter
|
||||
Revision 1.11 1998-12-10 09:47:21 florian
|
||||
+ basic operations with int64/qord (compiler with -dint64)
|
||||
+ rtti of enumerations extended: names are now written
|
||||
|
||||
Revision 1.10 1998/11/29 12:40:23 peter
|
||||
* newcnv -> not oldcnv
|
||||
|
||||
Revision 1.9 1998/11/26 13:10:42 peter
|
||||
|
||||
@ -162,8 +162,6 @@ unit i386;
|
||||
|
||||
tlocation = record
|
||||
case loc : tloc of
|
||||
{ segment in reference at the same place as in loc_register }
|
||||
LOC_REGISTER,LOC_CREGISTER : (register,segment : tregister);
|
||||
LOC_MEM,LOC_REFERENCE : (reference : treference);
|
||||
LOC_FPU : ();
|
||||
LOC_JUMP : ();
|
||||
@ -172,6 +170,13 @@ unit i386;
|
||||
|
||||
{ it's only for better handling }
|
||||
LOC_MMXREGISTER : (mmxreg : tregister);
|
||||
{ segment in reference at the same place as in loc_register }
|
||||
LOC_REGISTER,LOC_CREGISTER : (
|
||||
case longint of
|
||||
1 : (register,segment,registerhigh : tregister);
|
||||
{ overlay a registerlow }
|
||||
2 : (registerlow : tregister);
|
||||
);
|
||||
end;
|
||||
|
||||
pcsymbol = ^tcsymbol;
|
||||
@ -1731,7 +1736,11 @@ unit i386;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.18 1998-11-26 21:45:30 jonas
|
||||
Revision 1.19 1998-12-10 09:47:22 florian
|
||||
+ basic operations with int64/qord (compiler with -dint64)
|
||||
+ rtti of enumerations extended: names are now written
|
||||
|
||||
Revision 1.18 1998/11/26 21:45:30 jonas
|
||||
- removed A_CLTD opcode (use A_CDQ instead)
|
||||
* changed cbw, cwde and cwd to cbtw, cwtl and cwtd in att_op2str array
|
||||
* in daopt386: adapted AsmInstr array to reflect changes + fixed line too long
|
||||
|
||||
@ -1117,10 +1117,16 @@ unit pstatmnt;
|
||||
opsym^.address:=-procinfo.retoffset;
|
||||
{ eax is modified by a function }
|
||||
{$ifdef i386}
|
||||
usedinproc:=usedinproc or ($80 shr byte(R_EAX))
|
||||
usedinproc:=usedinproc or ($80 shr byte(R_EAX));
|
||||
|
||||
if is_64bitint(procinfo.retdef) then
|
||||
usedinproc:=usedinproc or ($80 shr byte(R_EDX))
|
||||
{$endif}
|
||||
{$ifdef m68k}
|
||||
usedinproc:=usedinproc or ($800 shr word(R_D0))
|
||||
|
||||
if is_64bitint(procinfo.retdef) then
|
||||
usedinproc:=usedinproc or ($800 shr byte(R_D1))
|
||||
{$endif}
|
||||
end;
|
||||
end;
|
||||
@ -1218,7 +1224,11 @@ unit pstatmnt;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.50 1998-11-13 15:40:25 pierre
|
||||
Revision 1.51 1998-12-10 09:47:24 florian
|
||||
+ basic operations with int64/qord (compiler with -dint64)
|
||||
+ rtti of enumerations extended: names are now written
|
||||
|
||||
Revision 1.50 1998/11/13 15:40:25 pierre
|
||||
+ added -Se in Makefile cvstest target
|
||||
+ lexlevel cleanup
|
||||
normal_function_level main_program_level and unit_init_level defined
|
||||
|
||||
@ -82,6 +82,10 @@ begin
|
||||
p^.insert(new(ptypesym,init('ulong',u32bitdef)));
|
||||
p^.insert(new(ptypesym,init('void',voiddef)));
|
||||
p^.insert(new(ptypesym,init('char',cchardef)));
|
||||
{$ifdef INT64}
|
||||
p^.insert(new(ptypesym,init('qword',cu64bitdef)));
|
||||
p^.insert(new(ptypesym,init('int64',cs64bitintdef)));
|
||||
{$endif INT64}
|
||||
{$ifdef i386}
|
||||
p^.insert(new(ptypesym,init('s64real',c64floatdef)));
|
||||
{$endif i386}
|
||||
@ -135,6 +139,10 @@ begin
|
||||
p^.insert(new(ptypesym,init('CARDINAL',u32bitdef)));
|
||||
p^.insert(new(ptypesym,init('FIXED',new(pfloatdef,init(f32bit)))));
|
||||
p^.insert(new(ptypesym,init('FIXED16',new(pfloatdef,init(f16bit)))));
|
||||
{$ifdef INT64}
|
||||
p^.insert(new(ptypesym,init('QWORD',cu64bitdef)));
|
||||
p^.insert(new(ptypesym,init('INT64',cs64bitintdef)));
|
||||
{$endif INT64}
|
||||
p^.insert(new(ptypesym,init('TYPEDFILE',new(pfiledef,init(ft_typed,voiddef)))));
|
||||
{$ifdef GDB}
|
||||
{ Add a type for virtual method tables in lowercase }
|
||||
@ -165,6 +173,10 @@ procedure readconstdefs;
|
||||
begin
|
||||
s32bitdef:=porddef(globaldef('longint'));
|
||||
u32bitdef:=porddef(globaldef('ulong'));
|
||||
{$ifdef INT64}
|
||||
cu64bitdef:=porddef(globaldef('qword'));
|
||||
cs64bitintdef:=porddef(globaldef('int64'));
|
||||
{$endif INT64}
|
||||
cshortstringdef:=pstringdef(globaldef('shortstring'));
|
||||
clongstringdef:=pstringdef(globaldef('longstring'));
|
||||
cansistringdef:=pstringdef(globaldef('ansistring'));
|
||||
@ -204,6 +216,10 @@ begin
|
||||
u16bitdef:=new(porddef,init(u16bit,0,65535));
|
||||
u32bitdef:=new(porddef,init(u32bit,0,$ffffffff));
|
||||
s32bitdef:=new(porddef,init(s32bit,$80000000,$7fffffff));
|
||||
{$ifdef INT64}
|
||||
cu64bitdef:=new(porddef,init(u64bit,0,0));
|
||||
cs64bitintdef:=new(porddef,init(s64bitint,0,0));
|
||||
{$endif INT64}
|
||||
booldef:=new(porddef,init(bool8bit,0,1));
|
||||
cchardef:=new(porddef,init(uchar,0,255));
|
||||
cshortstringdef:=new(pstringdef,shortinit(255));
|
||||
@ -236,7 +252,11 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.12 1998-11-27 14:50:45 peter
|
||||
Revision 1.13 1998-12-10 09:47:25 florian
|
||||
+ basic operations with int64/qord (compiler with -dint64)
|
||||
+ rtti of enumerations extended: names are now written
|
||||
|
||||
Revision 1.12 1998/11/27 14:50:45 peter
|
||||
+ open strings, $P switch support
|
||||
|
||||
Revision 1.11 1998/11/16 10:18:09 peter
|
||||
|
||||
@ -785,6 +785,10 @@
|
||||
|
||||
|
||||
procedure tenumdef.write_rtti_data;
|
||||
|
||||
var
|
||||
hp : penumsym;
|
||||
|
||||
begin
|
||||
rttilist^.concat(new(pai_const,init_8bit(tkEnumeration)));
|
||||
case savesize of
|
||||
@ -801,7 +805,14 @@
|
||||
rttilist^.concat(new(pai_const,init_symbol(strpnew(basedef^.get_rtti_label))))
|
||||
else
|
||||
rttilist^.concat(new(pai_const,init_32bit(0)));
|
||||
{!!!!!!! Name list }
|
||||
hp:=first;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
rttilist^.concat(new(pai_const,init_8bit(length(hp^.name))));
|
||||
rttilist^.concat(new(pai_string,init(hp^.name)));
|
||||
hp:=hp^.next;
|
||||
end;
|
||||
rttilist^.concat(new(pai_const,init_8bit(0)));
|
||||
end;
|
||||
|
||||
|
||||
@ -878,12 +889,20 @@
|
||||
else
|
||||
begin
|
||||
case typ of
|
||||
u8bit,s8bit,
|
||||
uchar,bool8bit : savesize:=1;
|
||||
u16bit,s16bit,
|
||||
bool16bit : savesize:=2;
|
||||
s32bit,u32bit,
|
||||
bool32bit : savesize:=4;
|
||||
u8bit,s8bit,
|
||||
uchar,bool8bit:
|
||||
savesize:=1;
|
||||
|
||||
u16bit,s16bit,
|
||||
bool16bit:
|
||||
savesize:=2;
|
||||
|
||||
s32bit,u32bit,
|
||||
bool32bit:
|
||||
savesize:=4;
|
||||
|
||||
u64bit,s64bitint:
|
||||
savesize:=8;
|
||||
else
|
||||
savesize:=0;
|
||||
end;
|
||||
@ -3232,7 +3251,11 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.79 1998-12-08 10:18:12 peter
|
||||
Revision 1.80 1998-12-10 09:47:26 florian
|
||||
+ basic operations with int64/qord (compiler with -dint64)
|
||||
+ rtti of enumerations extended: names are now written
|
||||
|
||||
Revision 1.79 1998/12/08 10:18:12 peter
|
||||
+ -gh for heaptrc unit
|
||||
|
||||
Revision 1.78 1998/12/08 09:06:30 pierre
|
||||
|
||||
@ -268,7 +268,8 @@
|
||||
tbasetype = (uauto,uvoid,uchar,
|
||||
u8bit,u16bit,u32bit,
|
||||
s8bit,s16bit,s32bit,
|
||||
bool8bit,bool16bit,bool32bit { uwchar,bool1bit,bitfield});
|
||||
bool8bit,bool16bit,bool32bit { uwchar,bool1bit,bitfield},
|
||||
u64bit,s64bitint);
|
||||
|
||||
porddef = ^torddef;
|
||||
torddef = object(tdef)
|
||||
@ -484,7 +485,11 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.11 1998-11-29 21:45:49 florian
|
||||
Revision 1.12 1998-12-10 09:47:28 florian
|
||||
+ basic operations with int64/qord (compiler with -dint64)
|
||||
+ rtti of enumerations extended: names are now written
|
||||
|
||||
Revision 1.11 1998/11/29 21:45:49 florian
|
||||
* problem with arrays with init tables fixed
|
||||
|
||||
Revision 1.10 1998/11/20 15:36:00 florian
|
||||
|
||||
@ -414,7 +414,37 @@ implementation
|
||||
end;
|
||||
calcregisters(p,1,0,0);
|
||||
convdone:=true;
|
||||
end;
|
||||
end
|
||||
else if (porddef(rd)^.typ=s64bitint) or (porddef(ld)^.typ=s64bitint) then
|
||||
begin
|
||||
if (porddef(ld)^.typ<>s64bitint) then
|
||||
begin
|
||||
p^.left:=gentypeconvnode(p^.left,cs64bitintdef);
|
||||
firstpass(p^.left);
|
||||
end;
|
||||
if (porddef(rd)^.typ<>s64bitint) then
|
||||
begin
|
||||
p^.right:=gentypeconvnode(p^.right,cs64bitintdef);
|
||||
firstpass(p^.right);
|
||||
end;
|
||||
calcregisters(p,2,0,0);
|
||||
convdone:=true;
|
||||
end
|
||||
else if (porddef(rd)^.typ=u64bit) or (porddef(ld)^.typ=u64bit) then
|
||||
begin
|
||||
if (porddef(ld)^.typ<>u64bit) then
|
||||
begin
|
||||
p^.left:=gentypeconvnode(p^.left,cu64bitdef);
|
||||
firstpass(p^.left);
|
||||
end;
|
||||
if (porddef(rd)^.typ<>u64bit) then
|
||||
begin
|
||||
p^.right:=gentypeconvnode(p^.right,cu64bitdef);
|
||||
firstpass(p^.right);
|
||||
end;
|
||||
calcregisters(p,2,0,0);
|
||||
convdone:=true;
|
||||
end;
|
||||
end
|
||||
else
|
||||
|
||||
@ -889,7 +919,10 @@ implementation
|
||||
if (not assigned(p^.resulttype)) or
|
||||
(p^.resulttype^.deftype=stringdef) then
|
||||
p^.resulttype:=booldef;
|
||||
p^.location.loc:=LOC_FLAGS;
|
||||
if is_64bitint(p^.left^.resulttype) then
|
||||
p^.location.loc:=LOC_JUMP
|
||||
else
|
||||
p^.location.loc:=LOC_FLAGS;
|
||||
end;
|
||||
xorn:
|
||||
begin
|
||||
@ -917,7 +950,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.15 1998-11-24 22:59:05 peter
|
||||
Revision 1.16 1998-12-10 09:47:31 florian
|
||||
+ basic operations with int64/qord (compiler with -dint64)
|
||||
+ rtti of enumerations extended: names are now written
|
||||
|
||||
Revision 1.15 1998/11/24 22:59:05 peter
|
||||
* handle array of char the same as strings
|
||||
|
||||
Revision 1.14 1998/11/17 00:36:47 peter
|
||||
|
||||
@ -896,7 +896,10 @@ implementation
|
||||
if ret_in_acc(p^.resulttype) then
|
||||
begin
|
||||
p^.location.loc:=LOC_REGISTER;
|
||||
p^.registers32:=1;
|
||||
if is_64bitint(p^.resulttype) then
|
||||
p^.registers32:=2
|
||||
else
|
||||
p^.registers32:=1;
|
||||
end
|
||||
else if (p^.resulttype^.deftype=floatdef) then
|
||||
begin
|
||||
@ -980,7 +983,11 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.14 1998-11-27 14:50:52 peter
|
||||
Revision 1.15 1998-12-10 09:47:32 florian
|
||||
+ basic operations with int64/qord (compiler with -dint64)
|
||||
+ rtti of enumerations extended: names are now written
|
||||
|
||||
Revision 1.14 1998/11/27 14:50:52 peter
|
||||
+ open strings, $P switch support
|
||||
|
||||
Revision 1.13 1998/11/24 17:03:51 peter
|
||||
|
||||
@ -88,6 +88,9 @@ unit types;
|
||||
{ true if uses a parameter as return value }
|
||||
function ret_in_param(def : pdef) : boolean;
|
||||
|
||||
{ true, if def is a 64 bit int type }
|
||||
function is_64bitint(def : pdef) : boolean;
|
||||
|
||||
{$ifndef VALUEPARA}
|
||||
{ true if a const parameter is too large to copy }
|
||||
function dont_copy_const_param(def : pdef) : boolean;
|
||||
@ -200,7 +203,8 @@ unit types;
|
||||
case def^.deftype of
|
||||
orddef : begin
|
||||
dt:=porddef(def)^.typ;
|
||||
is_ordinal:=dt in [uchar,u8bit,u16bit,u32bit,s8bit,s16bit,s32bit,bool8bit,bool16bit,bool32bit];
|
||||
is_ordinal:=dt in [uchar,u8bit,u16bit,u32bit,u64bit,s8bit,s16bit,s32bit,
|
||||
s64bitint,bool8bit,bool16bit,bool32bit];
|
||||
end;
|
||||
enumdef : is_ordinal:=true;
|
||||
else
|
||||
@ -358,6 +362,12 @@ unit types;
|
||||
((def^.deftype=floatdef) and (pfloatdef(def)^.typ=f32bit));
|
||||
end;
|
||||
|
||||
{ true, if def is a 64 bit int type }
|
||||
function is_64bitint(def : pdef) : boolean;
|
||||
|
||||
begin
|
||||
is_64bitint:=(def^.deftype=orddef) and (porddef(def)^.typ in [u64bit,s64bitint])
|
||||
end;
|
||||
|
||||
{ true if uses a parameter as return value }
|
||||
function ret_in_param(def : pdef) : boolean;
|
||||
@ -1037,7 +1047,11 @@ unit types;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.40 1998-12-04 10:18:14 florian
|
||||
Revision 1.41 1998-12-10 09:47:33 florian
|
||||
+ basic operations with int64/qord (compiler with -dint64)
|
||||
+ rtti of enumerations extended: names are now written
|
||||
|
||||
Revision 1.40 1998/12/04 10:18:14 florian
|
||||
* some stuff for procedures of object added
|
||||
* bug with overridden virtual constructors fixed (reported by Italo Gomes)
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user