mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-09-04 03:50:23 +02:00
+ better support for switch $H
+ index access to ansi strings added + assigment of data (records/arrays) containing ansi strings
This commit is contained in:
florian
parent
2ce11f772a
commit
9af86a2bf0
@ -249,6 +249,8 @@ implementation
|
||||
otlabel,hlabel,oflabel : plabel;
|
||||
hregister : tregister;
|
||||
loc : tloc;
|
||||
r : preference;
|
||||
|
||||
begin
|
||||
otlabel:=truelabel;
|
||||
oflabel:=falselabel;
|
||||
@ -362,7 +364,7 @@ implementation
|
||||
else case p^.right^.location.loc of
|
||||
LOC_REFERENCE,
|
||||
LOC_MEM : begin
|
||||
{ handle ordinal constants trimmed }
|
||||
{ extra handling for ordinal constants }
|
||||
if (p^.right^.treetype in [ordconstn,fixconstn]) or
|
||||
(loc=LOC_CREGISTER) then
|
||||
begin
|
||||
@ -385,6 +387,39 @@ implementation
|
||||
end
|
||||
else
|
||||
begin
|
||||
if p^.right^.resulttype^.needs_rtti then
|
||||
begin
|
||||
{ this would be a problem }
|
||||
if not(p^.left^.resulttype^.needs_rtti) then
|
||||
internalerror(3457);
|
||||
|
||||
{ increment source reference counter }
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.symbol:=stringdup(lab2str(p^.right^.resulttype^.get_rtti_label));
|
||||
emitpushreferenceaddr(exprasmlist,r^);
|
||||
|
||||
emitpushreferenceaddr(exprasmlist,p^.right^.location.reference);
|
||||
exprasmlist^.concat(new(pai386,
|
||||
op_csymbol(A_CALL,S_NO,newcsymbol('ADDREF',0))));
|
||||
|
||||
if not (cs_compilesystem in aktswitches) then
|
||||
concat_external('ADDREF',EXT_NEAR);
|
||||
|
||||
{ decrement destination reference counter }
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
r^.symbol:=stringdup(lab2str(p^.left^.resulttype^.get_rtti_label));
|
||||
emitpushreferenceaddr(exprasmlist,r^);
|
||||
|
||||
emitpushreferenceaddr(exprasmlist,p^.left^.location.reference);
|
||||
exprasmlist^.concat(new(pai386,
|
||||
op_csymbol(A_CALL,S_NO,newcsymbol('DECREF',0))));
|
||||
|
||||
if not (cs_compilesystem in aktswitches) then
|
||||
concat_external('DECREF',EXT_NEAR);
|
||||
|
||||
end;
|
||||
concatcopy(p^.right^.location.reference,
|
||||
p^.left^.location.reference,p^.left^.resulttype^.size,false);
|
||||
ungetiftemp(p^.right^.location.reference);
|
||||
@ -524,7 +559,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.5 1998-07-24 22:16:54 florian
|
||||
Revision 1.6 1998-07-26 21:58:57 florian
|
||||
+ better support for switch $H
|
||||
+ index access to ansi strings added
|
||||
+ assigment of data (records/arrays) containing ansi strings
|
||||
|
||||
Revision 1.5 1998/07/24 22:16:54 florian
|
||||
* internal error 10 together with array access fixed. I hope
|
||||
that's the final fix.
|
||||
|
||||
|
||||
@ -325,11 +325,40 @@ implementation
|
||||
|
||||
begin
|
||||
secondpass(p^.left);
|
||||
set_location(p^.location,p^.left^.location);
|
||||
|
||||
{ in ansistrings S[1] is pchar(S)[0] !! }
|
||||
if is_ansistring(p^.left^.resulttype) then
|
||||
dec(p^.location.reference.offset);
|
||||
{ we load the array reference to p^.location }
|
||||
|
||||
{ an ansistring needs to be dereferenced }
|
||||
if is_ansistring(p^.left^.resulttype) or
|
||||
is_widestring(p^.left^.resulttype) then
|
||||
begin
|
||||
reset_reference(p^.location.reference);
|
||||
p^.location.loc:=LOC_REFERENCE;
|
||||
del_reference(p^.left^.location.reference);
|
||||
p^.location.reference.base:=getregister32;
|
||||
exprasmlist^.concat(new(pai386,op_ref_reg(A_MOV,S_L,
|
||||
newreference(p^.left^.location.reference),
|
||||
p^.location.reference.base)));
|
||||
if is_ansistring(p^.left^.resulttype) then
|
||||
begin
|
||||
{ in ansistrings S[1] is pchar(S)[0] !! }
|
||||
dec(p^.location.reference.offset);
|
||||
{ this is necessary for ansistrings with constant index }
|
||||
dec(p^.left^.location.reference.offset);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ in widestrings S[1] is pwchar(S)[0] !! }
|
||||
dec(p^.location.reference.offset,2);
|
||||
{ this is necessary for ansistrings with constant index }
|
||||
dec(p^.left^.location.reference.offset,2);
|
||||
exprasmlist^.concat(new(pai386,op_const_reg(A_SHL,S_L,
|
||||
2,p^.location.reference.base)));
|
||||
end;
|
||||
end
|
||||
else
|
||||
set_location(p^.location,p^.left^.location);
|
||||
|
||||
{ offset can only differ from 0 if arraydef }
|
||||
if p^.left^.resulttype^.deftype=arraydef then
|
||||
dec(p^.location.reference.offset,
|
||||
@ -340,14 +369,14 @@ implementation
|
||||
if (p^.left^.resulttype^.deftype=arraydef) then
|
||||
begin
|
||||
if not(is_open_array(p^.left^.resulttype)) then
|
||||
begin
|
||||
begin
|
||||
if (p^.right^.value>parraydef(p^.left^.resulttype)^.highrange) or
|
||||
(p^.right^.value<parraydef(p^.left^.resulttype)^.lowrange) then
|
||||
Message(parser_e_range_check_error);
|
||||
|
||||
dec(p^.left^.location.reference.offset,
|
||||
get_mul_size*parraydef(p^.left^.resulttype)^.lowrange);
|
||||
end
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ range checking for open arrays }
|
||||
@ -579,7 +608,12 @@ implementation
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.4 1998-07-24 22:16:55 florian
|
||||
Revision 1.5 1998-07-26 21:58:58 florian
|
||||
+ better support for switch $H
|
||||
+ index access to ansi strings added
|
||||
+ assigment of data (records/arrays) containing ansi strings
|
||||
|
||||
Revision 1.4 1998/07/24 22:16:55 florian
|
||||
* internal error 10 together with array access fixed. I hope
|
||||
that's the final fix.
|
||||
|
||||
|
||||
@ -2040,16 +2040,24 @@ unit pass_1;
|
||||
{ the register calculation is easy if a const index is used }
|
||||
if p^.right^.treetype=ordconstn then
|
||||
begin
|
||||
p^.registers32:=p^.left^.registers32
|
||||
{
|
||||
if is_ansistring(p^.left^.
|
||||
}
|
||||
p^.registers32:=p^.left^.registers32;
|
||||
|
||||
{ for ansi/wide strings, we need at least one register }
|
||||
if is_ansistring(p^.left^.resulttype) or
|
||||
is_widestring(p^.left^.resulttype) then
|
||||
p^.registers32:=max(p^.registers32,1);
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ this rules are suboptimal, but they should give }
|
||||
{ good results }
|
||||
p^.registers32:=max(p^.left^.registers32,p^.right^.registers32);
|
||||
|
||||
{ for ansi/wide strings, we need at least one register }
|
||||
if is_ansistring(p^.left^.resulttype) or
|
||||
is_widestring(p^.left^.resulttype) then
|
||||
p^.registers32:=max(p^.registers32,1);
|
||||
|
||||
{ need we an extra register when doing the restore ? }
|
||||
if (p^.left^.registers32<=p^.right^.registers32) and
|
||||
{ only if the node needs less than 3 registers }
|
||||
@ -5092,7 +5100,12 @@ unit pass_1;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.44 1998-07-24 22:16:59 florian
|
||||
Revision 1.45 1998-07-26 21:58:59 florian
|
||||
+ better support for switch $H
|
||||
+ index access to ansi strings added
|
||||
+ assigment of data (records/arrays) containing ansi strings
|
||||
|
||||
Revision 1.44 1998/07/24 22:16:59 florian
|
||||
* internal error 10 together with array access fixed. I hope
|
||||
that's the final fix.
|
||||
|
||||
|
||||
@ -486,14 +486,20 @@ unit pdecl;
|
||||
disposetree(p);
|
||||
end
|
||||
{ should string without suffix be an ansistring also
|
||||
in ansistring mode ?? (PM) }
|
||||
in ansistring mode ?? (PM) Yes!!! (FK) }
|
||||
else
|
||||
begin
|
||||
if cs_ansistrings in aktswitches then
|
||||
d:=new(pstringdef,ansiinit(0))
|
||||
else
|
||||
{$ifndef GDB}
|
||||
else d:=new(pstringdef,init(255));
|
||||
d:=new(pstringdef,init(255));
|
||||
{$else GDB}
|
||||
else d:=globaldef('STRING');
|
||||
d:=globaldef('STRING');
|
||||
{$endif GDB}
|
||||
stringtype:=d;
|
||||
end;
|
||||
end;
|
||||
stringtype:=d;
|
||||
end;
|
||||
|
||||
|
||||
function id_type(var s : string) : pdef;
|
||||
@ -518,20 +524,20 @@ unit pdecl;
|
||||
getsym(s,true);
|
||||
if assigned(srsym) then
|
||||
begin
|
||||
if srsym^.typ=unitsym then
|
||||
begin
|
||||
consume(POINT);
|
||||
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
|
||||
s:=pattern;
|
||||
consume(ID);
|
||||
end;
|
||||
if srsym^.typ<>typesym then
|
||||
begin
|
||||
Message(sym_e_type_id_expected);
|
||||
lasttypesym:=ptypesym(srsym);
|
||||
id_type:=generrordef;
|
||||
exit;
|
||||
end;
|
||||
if srsym^.typ=unitsym then
|
||||
begin
|
||||
consume(POINT);
|
||||
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
|
||||
s:=pattern;
|
||||
consume(ID);
|
||||
end;
|
||||
if srsym^.typ<>typesym then
|
||||
begin
|
||||
Message(sym_e_type_id_expected);
|
||||
lasttypesym:=ptypesym(srsym);
|
||||
id_type:=generrordef;
|
||||
exit;
|
||||
end;
|
||||
end;
|
||||
lasttypesym:=ptypesym(srsym);
|
||||
id_type:=ptypesym(srsym)^.definition;
|
||||
@ -1875,7 +1881,12 @@ unit pdecl;
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.34 1998-07-20 22:17:15 florian
|
||||
Revision 1.35 1998-07-26 21:59:00 florian
|
||||
+ better support for switch $H
|
||||
+ index access to ansi strings added
|
||||
+ assigment of data (records/arrays) containing ansi strings
|
||||
|
||||
Revision 1.34 1998/07/20 22:17:15 florian
|
||||
* hex constants in numeric char (#$54#$43 ...) are now allowed
|
||||
* there was a bug in record_var_dec which prevents the used
|
||||
of nested variant records (for example drivers.tevent of tv)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user