mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-16 20:39:28 +02:00
+ support of 64 bit integer constants
This commit is contained in:
florian
parent
f53823cb77
commit
244fc53520
@ -79,7 +79,7 @@ implementation
|
||||
{ const already used ? }
|
||||
if not assigned(p^.lab_real) then
|
||||
begin
|
||||
{ tries to found an old entry }
|
||||
{ tries to find an old entry }
|
||||
hp1:=pai(consts^.first);
|
||||
while assigned(hp1) do
|
||||
begin
|
||||
@ -152,11 +152,29 @@ implementation
|
||||
*****************************************************************************}
|
||||
|
||||
procedure secondordconst(var p : ptree);
|
||||
|
||||
var
|
||||
l : pasmlabel;
|
||||
|
||||
begin
|
||||
{ an integer const. behaves as a memory reference }
|
||||
p^.location.loc:=LOC_MEM;
|
||||
p^.location.reference.is_immediate:=true;
|
||||
p^.location.reference.offset:=p^.value;
|
||||
if is_64bitint(p^.resulttype) then
|
||||
begin
|
||||
getdatalabel(l);
|
||||
if (cs_create_smart in aktmoduleswitches) then
|
||||
consts^.concat(new(pai_cut,init));
|
||||
consts^.concat(new(pai_label,init(l)));
|
||||
consts^.concat(new(pai_const,init_32bit(lo(p^.value))));
|
||||
consts^.concat(new(pai_const,init_32bit(hi(p^.value))));
|
||||
reset_reference(p^.location.reference);
|
||||
p^.location.reference.symbol:=l;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ non int64 const. behaves as a memory reference }
|
||||
p^.location.reference.is_immediate:=true;
|
||||
p^.location.reference.offset:=p^.value;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
@ -440,7 +458,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-07-13 11:32:33 michael
|
||||
Revision 1.3 2000-08-16 13:06:06 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:33 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
}
|
||||
@ -1293,6 +1293,15 @@ implementation
|
||||
emitoverflowcheck(p^.left^.left);
|
||||
emitrangecheck(p^.left^.left,p^.left^.left^.resulttype);
|
||||
end;
|
||||
in_typeinfo_x:
|
||||
begin
|
||||
p^.left^.left^.typenodetype^.generate_rtti;
|
||||
p^.location.register:=getregister32;
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.symbol:=p^.left^.left^.typenodetype^.rtti_label;
|
||||
emit_ref_reg(A_MOV,S_L,r,p^.location.register);
|
||||
end;
|
||||
in_assigned_x :
|
||||
begin
|
||||
secondpass(p^.left^.left);
|
||||
@ -1528,7 +1537,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2000-08-04 22:00:50 peter
|
||||
Revision 1.6 2000-08-16 13:06:06 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.5 2000/08/04 22:00:50 peter
|
||||
* merges from fixes
|
||||
|
||||
Revision 1.4 2000/07/29 18:27:53 sg
|
||||
@ -1543,4 +1555,4 @@ end.
|
||||
Revision 1.2 2000/07/13 11:32:34 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
}
|
||||
@ -536,15 +536,21 @@ implementation
|
||||
end
|
||||
else
|
||||
begin
|
||||
emit_const_ref(A_MOV,opsize,
|
||||
p^.right^.location.reference.offset,
|
||||
newreference(p^.left^.location.reference));
|
||||
if is_64bitint(p^.right^.resulttype) then
|
||||
begin
|
||||
emit_const_ref(A_MOV,opsize,
|
||||
lo(p^.right^.value),
|
||||
newreference(p^.left^.location.reference));
|
||||
r:=newreference(p^.left^.location.reference);
|
||||
inc(r^.offset,4);
|
||||
emit_const_ref(A_MOV,opsize,
|
||||
0,r);
|
||||
hi(p^.right^.value),r);
|
||||
end
|
||||
else
|
||||
begin
|
||||
emit_const_ref(A_MOV,opsize,
|
||||
p^.right^.location.reference.offset,
|
||||
newreference(p^.left^.location.reference));
|
||||
end;
|
||||
{$IfDef regallocfix}
|
||||
del_reference(p^.left^.location.reference);
|
||||
@ -1002,10 +1008,13 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-07-13 12:08:25 michael
|
||||
Revision 1.4 2000-08-16 13:06:06 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.3 2000/07/13 12:08:25 michael
|
||||
+ patched to 1.1.0 with former 1.09patch from peter
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:34 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
}
|
||||
@ -186,7 +186,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
||||
2 : def_opsize:=S_W;
|
||||
4 : def_opsize:=S_L;
|
||||
else
|
||||
internalerror(78);
|
||||
internalerror(130820001);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -202,7 +202,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
||||
{ I don't know if we need it (FK) }
|
||||
8 : o1:=S_L;
|
||||
else
|
||||
internalerror(78);
|
||||
internalerror(130820002);
|
||||
end;
|
||||
if assigned(p2) then
|
||||
begin
|
||||
@ -234,7 +234,7 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
||||
2 : def_getreg:=reg32toreg16(getregister32);
|
||||
4 : def_getreg:=getregister32;
|
||||
else
|
||||
internalerror(78);
|
||||
internalerror(130820003);
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -4067,7 +4067,10 @@ procedure mov_reg_to_dest(p : ptree; s : topsize; reg : tregister);
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 2000-08-10 18:42:03 peter
|
||||
Revision 1.10 2000-08-16 13:06:06 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.9 2000/08/10 18:42:03 peter
|
||||
* fixed for constants in emit_push_mem_size for go32v2 (merged)
|
||||
|
||||
Revision 1.8 2000/08/07 11:29:40 jonas
|
||||
@ -4109,4 +4112,4 @@ end.
|
||||
Revision 1.2 2000/07/13 11:32:37 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
}
|
||||
@ -30,8 +30,14 @@ Type
|
||||
{$else FPC}
|
||||
AWord = Longint;
|
||||
{$endif FPC}
|
||||
TConstExprInt = longint;
|
||||
TConstExprUInt = dword;
|
||||
{ the ordinal type used when evaluating constant integer expressions }
|
||||
TConstExprInt = int64;
|
||||
{ ... the same unsigned }
|
||||
TConstExprUInt = qword;
|
||||
{ this must be an ordinal type with the same size as a pointer }
|
||||
{ to allow some dirty type casts for example when using }
|
||||
{ tconstsym.value }
|
||||
TPointerOrd = longint;
|
||||
|
||||
Const
|
||||
{ Size of native extended type }
|
||||
@ -42,7 +48,10 @@ Implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-08-12 06:45:08 florian
|
||||
Revision 1.4 2000-08-16 13:06:06 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.3 2000/08/12 06:45:08 florian
|
||||
+ type TConstExprInt added
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:39 michael
|
||||
|
||||
@ -52,6 +52,7 @@ const
|
||||
in_continue = 40;
|
||||
in_assert_x_y = 41;
|
||||
in_addr_x = 42;
|
||||
in_typeinfo_x = 43;
|
||||
|
||||
{ Internal constant functions }
|
||||
in_const_trunc = 100;
|
||||
@ -99,7 +100,10 @@ const
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-07-13 11:32:43 michael
|
||||
Revision 1.3 2000-08-16 13:06:06 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:43 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
@ -270,6 +270,27 @@ unit pexpr;
|
||||
end;
|
||||
end;
|
||||
|
||||
in_typeinfo_x :
|
||||
begin
|
||||
consume(_LKLAMMER);
|
||||
in_args:=true;
|
||||
{allow_type:=true;}
|
||||
p1:=comp_expr(true);
|
||||
do_firstpass(p1);
|
||||
{allow_type:=false; }
|
||||
if p1^.treetype<>typen then
|
||||
begin
|
||||
disposetree(p1);
|
||||
p1:=genzeronode(errorn);
|
||||
Message(parser_e_illegal_parameter_list);
|
||||
end;
|
||||
consume(_RKLAMMER);
|
||||
p2:=gencallparanode(p1,nil);
|
||||
p2:=geninlinenode(in_typeinfo_x,false,p2);
|
||||
pd:=voidpointerdef;
|
||||
statement_syssym:=p2;
|
||||
end;
|
||||
|
||||
in_assigned_x :
|
||||
begin
|
||||
consume(_LKLAMMER);
|
||||
@ -894,6 +915,7 @@ unit pexpr;
|
||||
function factor(getaddr : boolean) : ptree;
|
||||
var
|
||||
l : longint;
|
||||
ic : TConstExprInt;
|
||||
oldp1,
|
||||
p1,p2,p3 : ptree;
|
||||
code : integer;
|
||||
@ -1172,25 +1194,29 @@ unit pexpr;
|
||||
constsym : begin
|
||||
case pconstsym(srsym)^.consttyp of
|
||||
constint :
|
||||
p1:=genordinalconstnode(pconstsym(srsym)^.value,s32bitdef);
|
||||
{ do a very dirty trick to bootstrap this code }
|
||||
if (pconstsym(srsym)^.value>=-(int64(2147483647)+int64(1))) and (pconstsym(srsym)^.value<=2147483647) then
|
||||
p1:=genordinalconstnode(pconstsym(srsym)^.value,s32bitdef)
|
||||
else
|
||||
p1:=genordinalconstnode(pconstsym(srsym)^.value,cs64bitdef);
|
||||
conststring :
|
||||
begin
|
||||
len:=pconstsym(srsym)^.len;
|
||||
if not(cs_ansistrings in aktlocalswitches) and (len>255) then
|
||||
len:=255;
|
||||
getmem(pc,len+1);
|
||||
move(pchar(pconstsym(srsym)^.value)^,pc^,len);
|
||||
move(pchar(tpointerord(pconstsym(srsym)^.value))^,pc^,len);
|
||||
pc[len]:=#0;
|
||||
p1:=genpcharconstnode(pc,len);
|
||||
end;
|
||||
constchar :
|
||||
p1:=genordinalconstnode(pconstsym(srsym)^.value,cchardef);
|
||||
constreal :
|
||||
p1:=genrealconstnode(pbestreal(pconstsym(srsym)^.value)^,bestrealdef^);
|
||||
p1:=genrealconstnode(pbestreal(tpointerord(pconstsym(srsym)^.value))^,bestrealdef^);
|
||||
constbool :
|
||||
p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef);
|
||||
constset :
|
||||
p1:=gensetconstnode(pconstset(pconstsym(srsym)^.value),
|
||||
p1:=gensetconstnode(pconstset(tpointerord(pconstsym(srsym)^.value)),
|
||||
psetdef(pconstsym(srsym)^.consttype.def));
|
||||
constord :
|
||||
p1:=genordinalconstnode(pconstsym(srsym)^.value,
|
||||
@ -1812,24 +1838,36 @@ unit pexpr;
|
||||
valint(pattern,l,code);
|
||||
if code<>0 then
|
||||
begin
|
||||
val(pattern,d,code);
|
||||
if code<>0 then
|
||||
begin
|
||||
Message(cg_e_invalid_integer);
|
||||
consume(_INTCONST);
|
||||
l:=1;
|
||||
p1:=genordinalconstnode(l,s32bitdef);
|
||||
end
|
||||
else
|
||||
begin
|
||||
consume(_INTCONST);
|
||||
p1:=genrealconstnode(d,bestrealdef^);
|
||||
end;
|
||||
{ try int64 if available }
|
||||
{ if no int64 available longint is tried a second }
|
||||
{ time which doesn't hurt }
|
||||
val(pattern,ic,code);
|
||||
if code<>0 then
|
||||
begin
|
||||
val(pattern,d,code);
|
||||
if code<>0 then
|
||||
begin
|
||||
Message(cg_e_invalid_integer);
|
||||
consume(_INTCONST);
|
||||
l:=1;
|
||||
p1:=genordinalconstnode(l,s32bitdef);
|
||||
end
|
||||
else
|
||||
begin
|
||||
consume(_INTCONST);
|
||||
p1:=genrealconstnode(d,bestrealdef^);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
consume(_INTCONST);
|
||||
p1:=genordinalconstnode(ic,cs64bitdef);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
consume(_INTCONST);
|
||||
p1:=genordinalconstnode(l,s32bitdef);
|
||||
consume(_INTCONST);
|
||||
p1:=genordinalconstnode(l,s32bitdef)
|
||||
end;
|
||||
end;
|
||||
_REALNUMBER : begin
|
||||
@ -2170,9 +2208,12 @@ _LECKKLAMMER : begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-08-04 22:00:52 peter
|
||||
Revision 1.4 2000-08-16 13:06:06 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.3 2000/08/04 22:00:52 peter
|
||||
* merges from fixes
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:44 michael
|
||||
+ removed logs
|
||||
}
|
||||
}
|
||||
@ -65,6 +65,7 @@ begin
|
||||
p^.insert(new(psyssym,init('ASSERT',in_assert_x_y)));
|
||||
p^.insert(new(psyssym,init('VAL',in_val_x)));
|
||||
p^.insert(new(psyssym,init('ADDR',in_addr_x)));
|
||||
p^.insert(new(psyssym,init('TYPEINFO',in_typeinfo_x)));
|
||||
end;
|
||||
|
||||
|
||||
@ -249,7 +250,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-07-13 11:32:47 michael
|
||||
Revision 1.3 2000-08-16 13:06:06 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:47 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
}
|
||||
@ -39,7 +39,7 @@ unit ptconst;
|
||||
{$else}
|
||||
strings,
|
||||
{$endif Delphi}
|
||||
globtype,systems,tokens,
|
||||
globtype,systems,tokens,cpuinfo,
|
||||
cobjects,globals,scanner,
|
||||
symconst,aasm,types,verbose,
|
||||
tree,pass_1,
|
||||
@ -435,7 +435,7 @@ unit ptconst;
|
||||
end
|
||||
else if is_constresourcestringnode(p) then
|
||||
begin
|
||||
strval:=pchar(pconstsym(p^.symtableentry)^.value);
|
||||
strval:=pchar(tpointerord(pconstsym(p^.symtableentry)^.value));
|
||||
strlength:=pconstsym(p^.symtableentry)^.len;
|
||||
end
|
||||
else
|
||||
@ -800,10 +800,13 @@ unit ptconst;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-08-05 13:25:06 peter
|
||||
Revision 1.4 2000-08-16 13:06:06 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.3 2000/08/05 13:25:06 peter
|
||||
* packenum 1 fixes (merged)
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:47 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
}
|
||||
@ -2502,9 +2502,9 @@
|
||||
case hpc^.consttyp of
|
||||
conststring,
|
||||
constresourcestring :
|
||||
hs:=+strpas(pchar(hpc^.value));
|
||||
hs:=+strpas(pchar(tpointerord(hpc^.value)));
|
||||
constreal :
|
||||
str(pbestreal(hpc^.value)^,hs);
|
||||
str(pbestreal(tpointerord(hpc^.value))^,hs);
|
||||
constord,
|
||||
constpointer :
|
||||
hs:=tostr(hpc^.value);
|
||||
@ -2520,8 +2520,8 @@
|
||||
constchar :
|
||||
hs:=chr(hpc^.value);
|
||||
constset :
|
||||
hs:='<set>';
|
||||
end;
|
||||
hs:='<set>';
|
||||
end;
|
||||
if hs<>'' then
|
||||
s:=s+'="'+hs+'"';
|
||||
end;
|
||||
@ -2682,7 +2682,7 @@
|
||||
localst^.defowner:=@self;
|
||||
parast^.next:=localst;
|
||||
localst^.next:=owner;}
|
||||
|
||||
|
||||
forwarddef:=false;
|
||||
interfacedef:=false;
|
||||
hasforward:=false;
|
||||
@ -2940,7 +2940,7 @@ Const local_symtable_index : longint = $8001;
|
||||
}
|
||||
end;
|
||||
current_ppu^.writeentry(ibprocdef);
|
||||
|
||||
|
||||
{ Save the para and local symtable, for easier reading
|
||||
save both always, they don't influence the interface crc }
|
||||
oldintfcrc:=current_ppu^.do_interface_crc;
|
||||
@ -2955,7 +2955,7 @@ Const local_symtable_index : longint = $8001;
|
||||
begin
|
||||
localst:=new(psymtable,init(localsymtable));
|
||||
localst^.defowner:=@self;
|
||||
end;
|
||||
end;
|
||||
localst^.writeas;}
|
||||
current_ppu^.do_interface_crc:=oldintfcrc;
|
||||
end;
|
||||
@ -3030,7 +3030,7 @@ Const local_symtable_index : longint = $8001;
|
||||
resolvedef(pdef(nextoverloaded));
|
||||
resolvedef(pdef(_class));
|
||||
{ parast }
|
||||
oldsymtablestack:=symtablestack;
|
||||
oldsymtablestack:=symtablestack;
|
||||
oldlocalsymtable:=aktlocalsymtable;
|
||||
aktlocalsymtable:=parast;
|
||||
parast^.deref;
|
||||
@ -3038,7 +3038,7 @@ Const local_symtable_index : longint = $8001;
|
||||
aktlocalsymtable:=localst;
|
||||
localst^.deref;}
|
||||
aktlocalsymtable:=oldlocalsymtable;
|
||||
symtablestack:=oldsymtablestack;
|
||||
symtablestack:=oldsymtablestack;
|
||||
end;
|
||||
|
||||
|
||||
@ -4252,7 +4252,10 @@ Const local_symtable_index : longint = $8001;
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.9 2000-08-13 13:06:37 peter
|
||||
Revision 1.10 2000-08-16 13:06:06 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.9 2000/08/13 13:06:37 peter
|
||||
* store parast always for procdef (browser needs still update)
|
||||
* add default parameter value to demangledpara
|
||||
|
||||
@ -4285,4 +4288,4 @@ Const local_symtable_index : longint = $8001;
|
||||
Revision 1.2 2000/07/13 11:32:49 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
}
|
||||
@ -1639,7 +1639,7 @@
|
||||
TCONSTSYM
|
||||
****************************************************************************}
|
||||
|
||||
constructor tconstsym.init(const n : string;t : tconsttyp;v : longint);
|
||||
constructor tconstsym.init(const n : string;t : tconsttyp;v : TConstExprInt);
|
||||
begin
|
||||
inherited init(n);
|
||||
typ:=constsym;
|
||||
@ -1651,7 +1651,7 @@
|
||||
end;
|
||||
|
||||
|
||||
constructor tconstsym.init_def(const n : string;t : tconsttyp;v : longint;def : pdef);
|
||||
constructor tconstsym.init_def(const n : string;t : tconsttyp;v : TConstExprInt;def : pdef);
|
||||
begin
|
||||
inherited init(n);
|
||||
typ:=constsym;
|
||||
@ -1671,20 +1671,31 @@
|
||||
consttype.reset;
|
||||
len:=l;
|
||||
if t=constresourcestring then
|
||||
ResStrIndex:=ResourceStrings^.Register(name,pchar(value),len);
|
||||
ResStrIndex:=ResourceStrings^.Register(name,
|
||||
pchar(tpointerord(value)),len);
|
||||
end;
|
||||
|
||||
constructor tconstsym.load;
|
||||
var
|
||||
pd : pbestreal;
|
||||
ps : pnormalset;
|
||||
l1,l2 : longint;
|
||||
|
||||
begin
|
||||
tsym.load;
|
||||
typ:=constsym;
|
||||
consttype.reset;
|
||||
consttyp:=tconsttyp(readbyte);
|
||||
case consttyp of
|
||||
constint,
|
||||
constint:
|
||||
if sizeof(tconstexprint)=8 then
|
||||
begin
|
||||
l1:=readlong;
|
||||
l2:=readlong;
|
||||
value:=int64(l1)+(int64(l2) shl 32);
|
||||
end
|
||||
else
|
||||
value:=readlong;
|
||||
constbool,
|
||||
constchar :
|
||||
value:=readlong;
|
||||
@ -1692,13 +1703,20 @@
|
||||
constord :
|
||||
begin
|
||||
consttype.load;
|
||||
value:=readlong;
|
||||
if sizeof(TConstExprInt)=8 then
|
||||
begin
|
||||
l1:=readlong;
|
||||
l2:=readlong;
|
||||
value:=int64(l1)+(int64(l2) shl 32);
|
||||
end
|
||||
else
|
||||
value:=readlong;
|
||||
end;
|
||||
conststring,constresourcestring :
|
||||
begin
|
||||
len:=readlong;
|
||||
getmem(pchar(value),len+1);
|
||||
current_ppu^.getdata(pchar(value)^,len);
|
||||
getmem(pchar(tpointerord(value)),len+1);
|
||||
current_ppu^.getdata(pchar(tpointerord(value))^,len);
|
||||
if consttyp=constresourcestring then
|
||||
ResStrIndex:=readlong;
|
||||
end;
|
||||
@ -1726,11 +1744,11 @@
|
||||
begin
|
||||
case consttyp of
|
||||
conststring,constresourcestring :
|
||||
freemem(pchar(value),len+1);
|
||||
freemem(pchar(tpointerord(value)),len+1);
|
||||
constreal :
|
||||
dispose(pbestreal(value));
|
||||
dispose(pbestreal(tpointerord(value)));
|
||||
constset :
|
||||
dispose(pnormalset(value));
|
||||
dispose(pnormalset(tpointerord(value)));
|
||||
end;
|
||||
inherited done;
|
||||
end;
|
||||
@ -1755,7 +1773,15 @@
|
||||
writebyte(byte(consttyp));
|
||||
case consttyp of
|
||||
constnil : ;
|
||||
constint,
|
||||
constint:
|
||||
if sizeof(TConstExprInt)=8 then
|
||||
begin
|
||||
writelong(lo(value));
|
||||
writelong(hi(value));
|
||||
end
|
||||
else
|
||||
writelong(value);
|
||||
|
||||
constbool,
|
||||
constchar :
|
||||
writelong(value);
|
||||
@ -1763,21 +1789,27 @@
|
||||
constord :
|
||||
begin
|
||||
consttype.write;
|
||||
writelong(value);
|
||||
if sizeof(TConstExprInt)=8 then
|
||||
begin
|
||||
writelong(lo(value));
|
||||
writelong(hi(value));
|
||||
end
|
||||
else
|
||||
writelong(value);
|
||||
end;
|
||||
conststring,constresourcestring :
|
||||
begin
|
||||
writelong(len);
|
||||
current_ppu^.putdata(pchar(value)^,len);
|
||||
current_ppu^.putdata(pchar(TPointerOrd(value))^,len);
|
||||
if consttyp=constresourcestring then
|
||||
writelong(ResStrIndex);
|
||||
end;
|
||||
constreal :
|
||||
writereal(pbestreal(value)^);
|
||||
writereal(pbestreal(TPointerOrd(value))^);
|
||||
constset :
|
||||
begin
|
||||
consttype.write;
|
||||
writenormalset(pointer(value)^);
|
||||
writenormalset(pointer(TPointerOrd(value))^);
|
||||
end;
|
||||
else
|
||||
internalerror(13);
|
||||
@ -1793,7 +1825,7 @@
|
||||
case consttyp of
|
||||
conststring : begin
|
||||
{ I had to remove ibm2ascii !! }
|
||||
st := pstring(value)^;
|
||||
st := pstring(TPointerOrd(value))^;
|
||||
{st := ibm2ascii(pstring(value)^);}
|
||||
st := 's'''+st+'''';
|
||||
end;
|
||||
@ -1803,7 +1835,7 @@
|
||||
constord,
|
||||
constchar : st := 'i'+tostr(value);
|
||||
constreal : begin
|
||||
system.str(pbestreal(value)^,st);
|
||||
system.str(pbestreal(TPointerOrd(value))^,st);
|
||||
st := 'r'+st;
|
||||
end;
|
||||
{ if we don't know just put zero !! }
|
||||
@ -2157,7 +2189,10 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2000-08-13 12:54:56 peter
|
||||
Revision 1.5 2000-08-16 13:06:07 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.4 2000/08/13 12:54:56 peter
|
||||
* class member decl wrong then no other error after it
|
||||
* -vb has now also line numbering
|
||||
* -vb is also used for interface/implementation different decls and
|
||||
@ -2168,5 +2203,5 @@
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:49 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
@ -270,10 +270,10 @@
|
||||
consttype : ttype;
|
||||
consttyp : tconsttyp;
|
||||
resstrindex, { needed for resource strings }
|
||||
value,
|
||||
value : tconstexprint;
|
||||
len : longint; { len is needed for string length }
|
||||
constructor init(const n : string;t : tconsttyp;v : longint);
|
||||
constructor init_def(const n : string;t : tconsttyp;v : longint;def : pdef);
|
||||
constructor init(const n : string;t : tconsttyp;v : tconstexprint);
|
||||
constructor init_def(const n : string;t : tconsttyp;v : tconstexprint;def : pdef);
|
||||
constructor init_string(const n : string;t : tconsttyp;str:pchar;l:longint);
|
||||
constructor load;
|
||||
destructor done;virtual;
|
||||
@ -319,7 +319,10 @@
|
||||
|
||||
{
|
||||
$Log$
|
||||
Revision 1.3 2000-08-13 12:54:56 peter
|
||||
Revision 1.4 2000-08-16 13:06:07 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.3 2000/08/13 12:54:56 peter
|
||||
* class member decl wrong then no other error after it
|
||||
* -vb has now also line numbering
|
||||
* -vb is also used for interface/implementation different decls and
|
||||
@ -327,5 +330,5 @@
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:50 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
|
||||
}
|
||||
@ -32,6 +32,7 @@ unit t_go32v2;
|
||||
tlinkergo32v2=object(tlinker)
|
||||
private
|
||||
Function WriteResponseFile(isdll:boolean) : Boolean;
|
||||
Function WriteScript(isdll:boolean) : Boolean;
|
||||
public
|
||||
constructor Init;
|
||||
procedure SetDefaultInfo;virtual;
|
||||
@ -62,7 +63,14 @@ procedure TLinkerGo32v2.SetDefaultInfo;
|
||||
begin
|
||||
with Info do
|
||||
begin
|
||||
ExeCmd[1]:='ld -oformat coff-go32-exe $OPT $STRIP -o $EXE @$RES';
|
||||
{$ifdef OPTALIGN}
|
||||
if cs_align in aktglobalswitches then
|
||||
ExeCmd[1]:='ld $SCRIPT $OPT $STRIP -o $EXE'
|
||||
else
|
||||
ExeCmd[1]:='ld -oformat coff-go32-exe $OPT $STRIP -o $EXE @$RES'
|
||||
{$else OPTALIGN}
|
||||
ExeCmd[1]:='ld -oformat coff-go32-exe $OPT $STRIP -o $EXE @$RES';
|
||||
{$endif OPTALIGN}
|
||||
end;
|
||||
end;
|
||||
|
||||
@ -152,6 +160,131 @@ begin
|
||||
WriteResponseFile:=True;
|
||||
end;
|
||||
|
||||
Function TLinkerGo32v2.WriteScript(isdll:boolean) : Boolean;
|
||||
Var
|
||||
scriptres : TLinkRes;
|
||||
i : longint;
|
||||
{$IFDEF NEWST}
|
||||
HPath : PStringItem;
|
||||
{$ELSE}
|
||||
HPath : PStringQueueItem;
|
||||
{$ENDIF NEWST}
|
||||
s : string;
|
||||
linklibc : boolean;
|
||||
begin
|
||||
WriteScript:=False;
|
||||
|
||||
{ Open link.res file }
|
||||
ScriptRes.Init(outputexedir+Info.ResName);
|
||||
ScriptRes.Add('OUTPUT_FORMAT("coff-go32-exe")');
|
||||
ScriptRes.Add('ENTRY(start)');
|
||||
|
||||
{$ifdef dummy}
|
||||
{ Write path to search libraries }
|
||||
HPath:=current_module^.locallibrarysearchpath.First;
|
||||
while assigned(HPath) do
|
||||
begin
|
||||
ScriptRes.Add('SEARCH_PATH("'+GetShortName(HPath^.Data^)+'")');
|
||||
HPath:=HPath^.Next;
|
||||
end;
|
||||
HPath:=LibrarySearchPath.First;
|
||||
while assigned(HPath) do
|
||||
begin
|
||||
ScriptRes.Add('SEARCH_PATH("'+GetShortName(HPath^.Data^)+'")');
|
||||
HPath:=HPath^.Next;
|
||||
end;
|
||||
{$endif dummy}
|
||||
|
||||
ScriptRes.Add('SECTIONS');
|
||||
ScriptRes.Add('{');
|
||||
ScriptRes.Add(' .text 0x1000+SIZEOF_HEADERS : {');
|
||||
ScriptRes.Add(' . = ALIGN(16);');
|
||||
{ add objectfiles, start with prt0 always }
|
||||
ScriptRes.Add(' '+GetShortName(FindObjectFile('prt0',''))+'(.text)');
|
||||
while not ObjectFiles.Empty do
|
||||
begin
|
||||
s:=ObjectFiles.Get;
|
||||
if s<>'' then
|
||||
begin
|
||||
ScriptRes.Add(' . = ALIGN(16);');
|
||||
ScriptRes.Add(' '+GetShortName(s)+'(.text)');
|
||||
end;
|
||||
end;
|
||||
ScriptRes.Add(' *(.text)');
|
||||
ScriptRes.Add(' etext = . ; _etext = .;');
|
||||
ScriptRes.Add(' . = ALIGN(0x200);');
|
||||
ScriptRes.Add(' }');
|
||||
ScriptRes.Add(' .data ALIGN(0x200) : {');
|
||||
ScriptRes.Add(' djgpp_first_ctor = . ;');
|
||||
ScriptRes.Add(' *(.ctor)');
|
||||
ScriptRes.Add(' djgpp_last_ctor = . ;');
|
||||
ScriptRes.Add(' djgpp_first_dtor = . ;');
|
||||
ScriptRes.Add(' *(.dtor)');
|
||||
ScriptRes.Add(' djgpp_last_dtor = . ;');
|
||||
ScriptRes.Add(' *(.data)');
|
||||
ScriptRes.Add(' *(.gcc_exc)');
|
||||
ScriptRes.Add(' ___EH_FRAME_BEGIN__ = . ;');
|
||||
ScriptRes.Add(' *(.eh_fram)');
|
||||
ScriptRes.Add(' ___EH_FRAME_END__ = . ;');
|
||||
ScriptRes.Add(' LONG(0)');
|
||||
ScriptRes.Add(' edata = . ; _edata = .;');
|
||||
ScriptRes.Add(' . = ALIGN(0x200);');
|
||||
ScriptRes.Add(' }');
|
||||
ScriptRes.Add(' .bss SIZEOF(.data) + ADDR(.data) :');
|
||||
ScriptRes.Add(' {');
|
||||
ScriptRes.Add(' _object.2 = . ;');
|
||||
ScriptRes.Add(' . += 24 ;');
|
||||
ScriptRes.Add(' *(.bss)');
|
||||
ScriptRes.Add(' *(COMMON)');
|
||||
ScriptRes.Add(' end = . ; _end = .;');
|
||||
ScriptRes.Add(' . = ALIGN(0x200);');
|
||||
ScriptRes.Add(' }');
|
||||
ScriptRes.Add(' }');
|
||||
|
||||
{ Write staticlibraries }
|
||||
if not StaticLibFiles.Empty then
|
||||
begin
|
||||
ScriptRes.Add('-(');
|
||||
While not StaticLibFiles.Empty do
|
||||
begin
|
||||
S:=StaticLibFiles.Get;
|
||||
ScriptRes.AddFileName(GetShortName(s))
|
||||
end;
|
||||
ScriptRes.Add('-)');
|
||||
end;
|
||||
|
||||
{ Write sharedlibraries like -l<lib>, also add the needed dynamic linker
|
||||
here to be sure that it gets linked this is needed for glibc2 systems (PFV) }
|
||||
linklibc:=false;
|
||||
While not SharedLibFiles.Empty do
|
||||
begin
|
||||
S:=SharedLibFiles.Get;
|
||||
if s<>'c' then
|
||||
begin
|
||||
i:=Pos(target_os.sharedlibext,S);
|
||||
if i>0 then
|
||||
Delete(S,i,255);
|
||||
ScriptRes.Add('-l'+s);
|
||||
end
|
||||
else
|
||||
begin
|
||||
ScriptRes.Add('-l'+s);
|
||||
linklibc:=true;
|
||||
end;
|
||||
end;
|
||||
{ be sure that libc&libgcc is the last lib }
|
||||
if linklibc then
|
||||
begin
|
||||
ScriptRes.Add('-lc');
|
||||
ScriptRes.Add('-lgcc');
|
||||
end;
|
||||
|
||||
{ Write and Close response }
|
||||
ScriptRes.WriteToDisk;
|
||||
ScriptRes.done;
|
||||
|
||||
WriteScript:=True;
|
||||
end;
|
||||
|
||||
function TLinkerGo32v2.MakeExecutable:boolean;
|
||||
var
|
||||
@ -168,8 +301,15 @@ begin
|
||||
if (cs_link_strip in aktglobalswitches) then
|
||||
StripStr:='-s';
|
||||
|
||||
{$ifdef OPTALIGN}
|
||||
if cs_align in aktglobalswitches then
|
||||
WriteScript(false)
|
||||
else
|
||||
WriteResponseFile(false);
|
||||
{$else OPTALIGN}
|
||||
{ Write used files and libraries }
|
||||
WriteResponseFile(false);
|
||||
{$endif OPTALIGN}
|
||||
|
||||
{ Call linker }
|
||||
SplitBinCmd(Info.ExeCmd[1],binstr,cmdstr);
|
||||
@ -177,6 +317,9 @@ begin
|
||||
Replace(cmdstr,'$OPT',Info.ExtraOptions);
|
||||
Replace(cmdstr,'$RES',outputexedir+Info.ResName);
|
||||
Replace(cmdstr,'$STRIP',StripStr);
|
||||
{$ifdef OPTALIGN}
|
||||
Replace(cmdstr,'$SCRIPT','--script='+outputexedir+Info.ResName);
|
||||
{$endif OPTALIGN}
|
||||
success:=DoExec(FindUtil(BinStr),cmdstr,true,false);
|
||||
|
||||
{ Remove ReponseFile }
|
||||
@ -292,7 +435,10 @@ end;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-07-13 11:32:50 michael
|
||||
Revision 1.3 2000-08-16 13:06:07 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:50 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
}
|
||||
@ -559,6 +559,13 @@ implementation
|
||||
end;
|
||||
end;
|
||||
|
||||
in_typeinfo_x:
|
||||
begin
|
||||
p^.resulttype:=voidpointerdef;
|
||||
p^.location.loc:=LOC_REGISTER;
|
||||
p^.registers32:=1;
|
||||
end;
|
||||
|
||||
in_assigned_x:
|
||||
begin
|
||||
set_varstate(p^.left,true);
|
||||
@ -1328,7 +1335,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 2000-08-01 14:07:49 jonas
|
||||
Revision 1.5 2000-08-16 13:06:07 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.4 2000/08/01 14:07:49 jonas
|
||||
* fixed crash when passing undeclared identifiers to str() (merged from
|
||||
fixes branch)
|
||||
|
||||
@ -1338,4 +1348,4 @@ end.
|
||||
Revision 1.2 2000/07/13 11:32:52 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
}
|
||||
@ -378,7 +378,9 @@ implementation
|
||||
if (p^.left^.treetype=ordconstn) then
|
||||
begin
|
||||
if is_boolean(p^.left^.resulttype) then
|
||||
t:=genordinalconstnode(byte(not(boolean(p^.left^.value))),p^.left^.resulttype)
|
||||
{ here we do a boolena(byte(..)) type cast because }
|
||||
{ boolean(<int64>) is buggy in 1.00 }
|
||||
t:=genordinalconstnode(byte(not(boolean(byte(p^.left^.value)))),p^.left^.resulttype)
|
||||
else
|
||||
t:=genordinalconstnode(not(p^.left^.value),p^.left^.resulttype);
|
||||
disposetree(p);
|
||||
@ -477,7 +479,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.2 2000-07-13 11:32:52 michael
|
||||
Revision 1.3 2000-08-16 13:06:07 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:52 michael
|
||||
+ removed logs
|
||||
|
||||
}
|
||||
}
|
||||
@ -229,7 +229,7 @@ unit tree;
|
||||
no_check,unit_specific,
|
||||
return_value_used,static_call : boolean);
|
||||
addrn : (procvarload:boolean);
|
||||
ordconstn : (value : longint);
|
||||
ordconstn : (value : TConstExprInt);
|
||||
realconstn : (value_real : bestreal;lab_real : pasmlabel);
|
||||
fixconstn : (value_fix: longint);
|
||||
funcretn : (funcretprocinfo : pointer;
|
||||
@ -273,8 +273,8 @@ unit tree;
|
||||
function genloadmethodcallnode(v: pprocsym;st: psymtable; mp:ptree): ptree;
|
||||
function gensinglenode(t : ttreetyp;l : ptree) : ptree;
|
||||
function gensubscriptnode(varsym : pvarsym;l : ptree) : ptree;
|
||||
function genordinalconstnode(v : longint;def : pdef) : ptree;
|
||||
function genpointerconstnode(v : longint;def : pdef) : ptree;
|
||||
function genordinalconstnode(v : TConstExprInt;def : pdef) : ptree;
|
||||
function genpointerconstnode(v : tpointerord;def : pdef) : ptree;
|
||||
function genfixconstnode(v : longint;def : pdef) : ptree;
|
||||
function gentypeconvnode(node : ptree;t : pdef) : ptree;
|
||||
function gentypenode(t : pdef;sym:ptypesym) : ptree;
|
||||
@ -848,7 +848,7 @@ unit tree;
|
||||
genloopnode:=p;
|
||||
end;
|
||||
|
||||
function genordinalconstnode(v : longint;def : pdef) : ptree;
|
||||
function genordinalconstnode(v : tconstexprint;def : pdef) : ptree;
|
||||
|
||||
var
|
||||
p : ptree;
|
||||
@ -876,7 +876,7 @@ unit tree;
|
||||
genordinalconstnode:=p;
|
||||
end;
|
||||
|
||||
function genpointerconstnode(v : longint;def : pdef) : ptree;
|
||||
function genpointerconstnode(v : tpointerord;def : pdef) : ptree;
|
||||
|
||||
var
|
||||
p : ptree;
|
||||
@ -1470,18 +1470,18 @@ unit tree;
|
||||
if not(cs_ansistrings in aktlocalswitches) and (len>255) then
|
||||
len:=255;
|
||||
getmem(pc,len+1);
|
||||
move(pchar(p^.value)^,pc^,len);
|
||||
move(pchar(tpointerord(p^.value))^,pc^,len);
|
||||
pc[len]:=#0;
|
||||
p1:=genpcharconstnode(pc,len);
|
||||
end;
|
||||
constchar :
|
||||
p1:=genordinalconstnode(p^.value,cchardef);
|
||||
constreal :
|
||||
p1:=genrealconstnode(pbestreal(p^.value)^,bestrealdef^);
|
||||
p1:=genrealconstnode(pbestreal(tpointerord(p^.value))^,bestrealdef^);
|
||||
constbool :
|
||||
p1:=genordinalconstnode(p^.value,booldef);
|
||||
constset :
|
||||
p1:=gensetconstnode(pconstset(p^.value),psetdef(p^.consttype.def));
|
||||
p1:=gensetconstnode(pconstset(tpointerord(p^.value)),psetdef(p^.consttype.def));
|
||||
constord :
|
||||
p1:=genordinalconstnode(p^.value,p^.consttype.def);
|
||||
constpointer :
|
||||
@ -2133,7 +2133,10 @@ unit tree;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 2000-08-12 06:46:51 florian
|
||||
Revision 1.6 2000-08-16 13:06:07 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.5 2000/08/12 06:46:51 florian
|
||||
+ case statement for int64/qword implemented
|
||||
|
||||
Revision 1.4 2000/08/06 19:39:28 peter
|
||||
@ -2144,4 +2147,4 @@ end.
|
||||
|
||||
Revision 1.2 2000/07/13 11:32:52 michael
|
||||
+ removed logs
|
||||
}
|
||||
}
|
||||
@ -24,7 +24,7 @@ unit types;
|
||||
interface
|
||||
|
||||
uses
|
||||
cobjects,symtable
|
||||
cobjects,symtable,cpuinfo
|
||||
{$IFDEF NEWST}
|
||||
,defs
|
||||
{$ENDIF NEWST};
|
||||
@ -168,7 +168,7 @@ interface
|
||||
|
||||
{ if l isn't in the range of def a range check error is generated and
|
||||
the value is placed within the range }
|
||||
procedure testrange(def : pdef;var l : longint);
|
||||
procedure testrange(def : pdef;var l : tconstexprint);
|
||||
|
||||
{ returns the range of def }
|
||||
procedure getrange(def : pdef;var l : longint;var h : longint);
|
||||
@ -241,8 +241,8 @@ implementation
|
||||
begin
|
||||
if sym1^.len=sym2^.len then
|
||||
begin
|
||||
p1:=pchar(sym1^.value);
|
||||
p2:=pchar(sym2^.value);
|
||||
p1:=pchar(tpointerord(sym1^.value));
|
||||
p2:=pchar(tpointerord(sym2^.value));
|
||||
pend:=p1+sym1^.len;
|
||||
while (p1<pend) do
|
||||
begin
|
||||
@ -256,9 +256,9 @@ implementation
|
||||
end;
|
||||
end;
|
||||
constreal :
|
||||
equal_constsym:=(pbestreal(sym1^.value)^=pbestreal(sym2^.value)^);
|
||||
equal_constsym:=(pbestreal(tpointerord(sym1^.value))^=pbestreal(tpointerord(sym2^.value))^);
|
||||
constset :
|
||||
equal_constsym:=(pnormalset(sym1^.value)^=pnormalset(sym2^.value)^);
|
||||
equal_constsym:=(pnormalset(tpointerord(sym1^.value))^=pnormalset(tpointerord(sym2^.value))^);
|
||||
constnil :
|
||||
equal_constsym:=true;
|
||||
end;
|
||||
@ -705,7 +705,7 @@ implementation
|
||||
end;
|
||||
|
||||
{ test if l is in the range of def, outputs error if out of range }
|
||||
procedure testrange(def : pdef;var l : longint);
|
||||
procedure testrange(def : pdef;var l : tconstexprint);
|
||||
var
|
||||
lv,hv: longint;
|
||||
|
||||
@ -1140,7 +1140,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.6 2000-08-13 13:07:18 peter
|
||||
Revision 1.7 2000-08-16 13:06:07 florian
|
||||
+ support of 64 bit integer constants
|
||||
|
||||
Revision 1.6 2000/08/13 13:07:18 peter
|
||||
* equal_paras now also checks default parameter value
|
||||
|
||||
Revision 1.5 2000/08/12 06:49:22 florian
|
||||
|
||||
Loading…
Reference in New Issue
Block a user