mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-28 21:40:34 +02:00
* moved code from firstpass to det_resulttype and remove extraneous
calls to firstcallparan for in_str,in_write,in_val
This commit is contained in:
peter
parent
a786029a13
commit
e84d1fadf1
@ -173,11 +173,16 @@ implementation
|
||||
counter : longint;
|
||||
ppn : tcallparanode;
|
||||
dummycoll : tparaitem;
|
||||
isreal : boolean;
|
||||
vl,vl2 : longint;
|
||||
vr : bestreal;
|
||||
hp : tnode;
|
||||
hp : tnode;
|
||||
srsym : tsym;
|
||||
p1,hpp : tnode;
|
||||
frac_para,
|
||||
length_para : tnode;
|
||||
isreal,
|
||||
iswrite,
|
||||
file_is_typed : boolean;
|
||||
label
|
||||
myexit;
|
||||
begin
|
||||
@ -725,11 +730,189 @@ implementation
|
||||
in_writeln_x :
|
||||
begin
|
||||
resulttype:=voidtype;
|
||||
{ we must know if it is a typed file or not }
|
||||
{ but we must first do the firstpass for it }
|
||||
file_is_typed:=false;
|
||||
if assigned(left) then
|
||||
begin
|
||||
iswrite:=(inlinenumber in [in_write_x,in_writeln_x]);
|
||||
set_varstate(left,iswrite);
|
||||
{ now we can check }
|
||||
hp:=left;
|
||||
while assigned(tcallparanode(hp).right) do
|
||||
hp:=tcallparanode(hp).right;
|
||||
{ if resulttype.def is not assigned, then automatically }
|
||||
{ file is not typed. }
|
||||
if assigned(hp) and assigned(hp.resulttype.def) then
|
||||
Begin
|
||||
if (hp.resulttype.def.deftype=filedef) then
|
||||
if (tfiledef(hp.resulttype.def).filetyp=ft_untyped) then
|
||||
begin
|
||||
if (inlinenumber in [in_readln_x,in_writeln_x]) then
|
||||
CGMessage(type_e_no_readln_writeln_for_typed_file)
|
||||
else
|
||||
CGMessage(type_e_no_read_write_for_untyped_file);
|
||||
end
|
||||
else if (tfiledef(hp.resulttype.def).filetyp=ft_typed) then
|
||||
begin
|
||||
file_is_typed:=true;
|
||||
{ test the type }
|
||||
if (inlinenumber in [in_readln_x,in_writeln_x]) then
|
||||
CGMessage(type_e_no_readln_writeln_for_typed_file);
|
||||
hpp:=left;
|
||||
while (hpp<>hp) do
|
||||
begin
|
||||
if (tcallparanode(hpp).left.nodetype=typen) then
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
if not is_equal(hpp.resulttype.def,tfiledef(hp.resulttype.def).typedfiletype.def) then
|
||||
CGMessage(type_e_mismatch);
|
||||
{ generate the high() value for the shortstring }
|
||||
if ((not iswrite) and is_shortstring(tcallparanode(hpp).left.resulttype.def)) or
|
||||
(is_chararray(tcallparanode(hpp).left.resulttype.def)) then
|
||||
tcallparanode(hpp).gen_high_tree(true);
|
||||
{ read(ln) is call by reference (JM) }
|
||||
if not iswrite then
|
||||
make_not_regable(tcallparanode(hpp).left);
|
||||
hpp:=tcallparanode(hpp).right;
|
||||
end;
|
||||
end;
|
||||
end; { endif assigned(hp) }
|
||||
|
||||
{ insert type conversions for write(ln) }
|
||||
if (not file_is_typed) then
|
||||
begin
|
||||
hp:=left;
|
||||
while assigned(hp) do
|
||||
begin
|
||||
if (tcallparanode(hp).left.nodetype=typen) then
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
if assigned(tcallparanode(hp).left.resulttype.def) then
|
||||
begin
|
||||
isreal:=false;
|
||||
{ support writeln(procvar) }
|
||||
if (tcallparanode(hp).left.resulttype.def.deftype=procvardef) then
|
||||
begin
|
||||
p1:=ccallnode.create(nil,nil,nil,nil);
|
||||
tcallnode(p1).set_procvar(tcallparanode(hp).left);
|
||||
resulttypepass(p1);
|
||||
tcallparanode(hp).left:=p1;
|
||||
end;
|
||||
case tcallparanode(hp).left.resulttype.def.deftype of
|
||||
filedef :
|
||||
begin
|
||||
{ only allowed as first parameter }
|
||||
if assigned(tcallparanode(hp).right) then
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
end;
|
||||
stringdef :
|
||||
begin
|
||||
{ generate the high() value for the shortstring }
|
||||
if (not iswrite) and
|
||||
is_shortstring(tcallparanode(hp).left.resulttype.def) then
|
||||
tcallparanode(hp).gen_high_tree(true);
|
||||
end;
|
||||
pointerdef :
|
||||
begin
|
||||
if not is_pchar(tcallparanode(hp).left.resulttype.def) then
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
end;
|
||||
floatdef :
|
||||
begin
|
||||
isreal:=true;
|
||||
end;
|
||||
orddef :
|
||||
begin
|
||||
case torddef(tcallparanode(hp).left.resulttype.def).typ of
|
||||
uchar,
|
||||
u32bit,s32bit,
|
||||
u64bit,s64bit:
|
||||
;
|
||||
u8bit,s8bit,
|
||||
u16bit,s16bit :
|
||||
if iswrite then
|
||||
inserttypeconv(tcallparanode(hp).left,s32bittype);
|
||||
bool8bit,
|
||||
bool16bit,
|
||||
bool32bit :
|
||||
if iswrite then
|
||||
inserttypeconv(tcallparanode(hp).left,booltype)
|
||||
else
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
else
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
end;
|
||||
end;
|
||||
arraydef :
|
||||
begin
|
||||
if is_chararray(tcallparanode(hp).left.resulttype.def) then
|
||||
tcallparanode(hp).gen_high_tree(true)
|
||||
else
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
end;
|
||||
else
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
end;
|
||||
|
||||
{ some format options ? }
|
||||
if cpf_is_colon_para in tcallparanode(hp).callparaflags then
|
||||
begin
|
||||
if cpf_is_colon_para in tcallparanode(tcallparanode(hp).right).callparaflags then
|
||||
begin
|
||||
frac_para:=hp;
|
||||
length_para:=tcallparanode(hp).right;
|
||||
hp:=tcallparanode(hp).right;
|
||||
hpp:=tcallparanode(hp).right;
|
||||
end
|
||||
else
|
||||
begin
|
||||
length_para:=hp;
|
||||
frac_para:=nil;
|
||||
hpp:=tcallparanode(hp).right;
|
||||
end;
|
||||
{ can be nil if you use "write(e:0:6)" while e is undeclared (JM) }
|
||||
if assigned(tcallparanode(hpp).left.resulttype.def) then
|
||||
isreal:=(tcallparanode(hpp).left.resulttype.def.deftype=floatdef)
|
||||
else
|
||||
exit;
|
||||
if (not is_integer(tcallparanode(length_para).left.resulttype.def)) then
|
||||
CGMessage1(type_e_integer_expr_expected,tcallparanode(length_para).left.resulttype.def.typename)
|
||||
else
|
||||
inserttypeconv(tcallparanode(length_para).left,s32bittype);
|
||||
if assigned(frac_para) then
|
||||
begin
|
||||
if isreal then
|
||||
begin
|
||||
if (not is_integer(tcallparanode(frac_para).left.resulttype.def)) then
|
||||
CGMessage1(type_e_integer_expr_expected,tcallparanode(frac_para).left.resulttype.def.typename)
|
||||
else
|
||||
inserttypeconv(tcallparanode(frac_para).left,s32bittype);
|
||||
end
|
||||
else
|
||||
CGMessage(parser_e_illegal_colon_qualifier);
|
||||
end;
|
||||
{ do the checking for the colon'd arg }
|
||||
hp:=length_para;
|
||||
end;
|
||||
end;
|
||||
hp:=tcallparanode(hp).right;
|
||||
end;
|
||||
end;
|
||||
if codegenerror then
|
||||
exit;
|
||||
set_varstate(left,true);
|
||||
end;
|
||||
end;
|
||||
|
||||
in_settextbuf_file_x :
|
||||
begin
|
||||
resulttype:=voidtype;
|
||||
{ now we know the type of buffer }
|
||||
srsym:=searchsymonlyin(systemunit,'SETTEXTBUF');
|
||||
hp:=ccallparanode.create(cordconstnode.create(tcallparanode(left).left.resulttype.def.size,s32bittype),left);
|
||||
hp:=ccallnode.create(hp,tprocsym(srsym),systemunit,nil);
|
||||
left:=nil;
|
||||
resulttypepass(hp);
|
||||
result:=hp;
|
||||
end;
|
||||
|
||||
{ the firstpass of the arg has been done in firstcalln ? }
|
||||
@ -744,11 +927,137 @@ implementation
|
||||
begin
|
||||
resulttype:=voidtype;
|
||||
set_varstate(left,false);
|
||||
{ remove warning when result is passed }
|
||||
set_funcret_is_valid(tcallparanode(left).left);
|
||||
set_varstate(tcallparanode(tcallparanode(left).right).left,true);
|
||||
hp:=left;
|
||||
{ valid string ? }
|
||||
if not assigned(hp) or
|
||||
(tcallparanode(hp).left.resulttype.def.deftype<>stringdef) or
|
||||
(tcallparanode(hp).right=nil) then
|
||||
CGMessage(cg_e_illegal_expression);
|
||||
{ we need a var parameter }
|
||||
valid_for_assign(tcallparanode(hp).left,false);
|
||||
{ generate the high() value for the shortstring }
|
||||
if is_shortstring(tcallparanode(hp).left.resulttype.def) then
|
||||
tcallparanode(hp).gen_high_tree(true);
|
||||
{ !!!! check length of string }
|
||||
while assigned(tcallparanode(hp).right) do
|
||||
hp:=tcallparanode(hp).right;
|
||||
if not assigned(tcallparanode(hp).resulttype.def) then
|
||||
exit;
|
||||
{ check and convert the first param }
|
||||
if (cpf_is_colon_para in tcallparanode(hp).callparaflags) or
|
||||
not assigned(hp.resulttype.def) then
|
||||
CGMessage(cg_e_illegal_expression);
|
||||
|
||||
isreal:=false;
|
||||
case hp.resulttype.def.deftype of
|
||||
orddef :
|
||||
begin
|
||||
case torddef(tcallparanode(hp).left.resulttype.def).typ of
|
||||
u32bit,s32bit,
|
||||
s64bit,u64bit:
|
||||
;
|
||||
u8bit,s8bit,
|
||||
u16bit,s16bit:
|
||||
inserttypeconv(tcallparanode(hp).left,s32bittype);
|
||||
else
|
||||
CGMessage(type_e_integer_or_real_expr_expected);
|
||||
end;
|
||||
end;
|
||||
floatdef :
|
||||
begin
|
||||
isreal:=true;
|
||||
end;
|
||||
else
|
||||
CGMessage(type_e_integer_or_real_expr_expected);
|
||||
end;
|
||||
|
||||
{ some format options ? }
|
||||
hpp:=tcallparanode(left).right;
|
||||
if assigned(hpp) and (cpf_is_colon_para in tcallparanode(hpp).callparaflags) then
|
||||
begin
|
||||
set_varstate(tcallparanode(hpp).left,true);
|
||||
if (not is_integer(tcallparanode(hpp).left.resulttype.def)) then
|
||||
CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype.def.typename)
|
||||
else
|
||||
inserttypeconv(tcallparanode(hpp).left,s32bittype);
|
||||
hpp:=tcallparanode(hpp).right;
|
||||
if assigned(hpp) and (cpf_is_colon_para in tcallparanode(hpp).callparaflags) then
|
||||
begin
|
||||
if isreal then
|
||||
begin
|
||||
if (not is_integer(tcallparanode(hpp).left.resulttype.def)) then
|
||||
CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype.def.typename)
|
||||
else
|
||||
begin
|
||||
set_varstate(tcallparanode(hpp).left,true);
|
||||
inserttypeconv(tcallparanode(hpp).left,s32bittype);
|
||||
end;
|
||||
end
|
||||
else
|
||||
CGMessage(parser_e_illegal_colon_qualifier);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
in_val_x :
|
||||
begin
|
||||
resulttype:=voidtype;
|
||||
{ check the amount of parameters }
|
||||
if not(assigned(left)) or
|
||||
not(assigned(tcallparanode(left).right)) then
|
||||
begin
|
||||
CGMessage(parser_e_wrong_parameter_size);
|
||||
exit;
|
||||
end;
|
||||
{ there is a "code" parameter }
|
||||
If Assigned(tcallparanode(tcallparanode(left).right).right) Then
|
||||
Begin
|
||||
{ first pass just the code parameter for first local use}
|
||||
hp := tcallparanode(left).right;
|
||||
tcallparanode(left).right := nil;
|
||||
make_not_regable(tcallparanode(left).left);
|
||||
set_varstate(left,false);
|
||||
if codegenerror then
|
||||
exit;
|
||||
tcallparanode(left).right := hp;
|
||||
{ code has to be a var parameter }
|
||||
if valid_for_assign(tcallparanode(left).left,false) then
|
||||
begin
|
||||
if (tcallparanode(left).left.resulttype.def.deftype <> orddef) or
|
||||
not(torddef(tcallparanode(left).left.resulttype.def).typ in [u16bit,s16bit,u32bit,s32bit]) then
|
||||
CGMessage(type_e_mismatch);
|
||||
end;
|
||||
hpp := tcallparanode(left).right
|
||||
End
|
||||
Else
|
||||
hpp := left;
|
||||
{ now hpp = the destination value tree }
|
||||
{ first pass just the destination parameter for first local use }
|
||||
hp:=tcallparanode(hpp).right;
|
||||
tcallparanode(hpp).right:=nil;
|
||||
{ hpp = destination }
|
||||
make_not_regable(tcallparanode(hpp).left);
|
||||
set_varstate(hpp,false);
|
||||
if codegenerror then
|
||||
exit;
|
||||
{ remove warning when result is passed }
|
||||
set_funcret_is_valid(tcallparanode(hpp).left);
|
||||
tcallparanode(hpp).right := hp;
|
||||
if valid_for_assign(tcallparanode(hpp).left,false) then
|
||||
begin
|
||||
If Not((tcallparanode(hpp).left.resulttype.def.deftype = floatdef) or
|
||||
is_integer(tcallparanode(hpp).left.resulttype.def)) then
|
||||
CGMessage(type_e_mismatch);
|
||||
end;
|
||||
{ hp = source (String) }
|
||||
{ if not a stringdef then insert a type conv which
|
||||
does the other type checking }
|
||||
If (tcallparanode(hp).left.resulttype.def.deftype<>stringdef) then
|
||||
inserttypeconv(tcallparanode(hp).left,cshortstringtype);
|
||||
set_varstate(hp,true);
|
||||
end;
|
||||
|
||||
in_include_x_y,
|
||||
@ -1000,6 +1309,13 @@ implementation
|
||||
end;
|
||||
|
||||
myexit:
|
||||
{ Run get_paratype again to update maybe inserted typeconvs }
|
||||
if not codegenerror then
|
||||
begin
|
||||
if assigned(left) and
|
||||
(left.nodetype=callparan) then
|
||||
tcallparanode(left).get_paratype;
|
||||
end;
|
||||
dec(parsing_para_level);
|
||||
end;
|
||||
|
||||
@ -1009,13 +1325,9 @@ implementation
|
||||
{$endif fpc}
|
||||
function tinlinenode.pass_1 : tnode;
|
||||
var
|
||||
p1,hp,hpp : tnode;
|
||||
srsym : tsym;
|
||||
{$ifndef NOCOLONCHECK}
|
||||
frac_para,length_para : tnode;
|
||||
{$endif ndef NOCOLONCHECK}
|
||||
srsym : tsym;
|
||||
hp,hpp : tnode;
|
||||
extra_register,
|
||||
isreal,
|
||||
iswrite,
|
||||
file_is_typed : boolean;
|
||||
|
||||
@ -1202,50 +1514,18 @@ implementation
|
||||
if assigned(left) then
|
||||
begin
|
||||
iswrite:=(inlinenumber in [in_write_x,in_writeln_x]);
|
||||
tcallparanode(left).firstcallparan(nil,true);
|
||||
set_varstate(left,iswrite);
|
||||
{ now we can check }
|
||||
hp:=left;
|
||||
while assigned(tcallparanode(hp).right) do
|
||||
hp:=tcallparanode(hp).right;
|
||||
{ if resulttype.def is not assigned, then automatically }
|
||||
{ file is not typed. }
|
||||
if assigned(hp) and assigned(hp.resulttype.def) then
|
||||
if assigned(hp) then
|
||||
Begin
|
||||
if (hp.resulttype.def.deftype=filedef) then
|
||||
if (tfiledef(hp.resulttype.def).filetyp=ft_untyped) then
|
||||
begin
|
||||
if (inlinenumber in [in_readln_x,in_writeln_x]) then
|
||||
CGMessage(type_e_no_readln_writeln_for_typed_file)
|
||||
else
|
||||
CGMessage(type_e_no_read_write_for_untyped_file);
|
||||
end
|
||||
else if (tfiledef(hp.resulttype.def).filetyp=ft_typed) then
|
||||
begin
|
||||
file_is_typed:=true;
|
||||
{ test the type }
|
||||
if (inlinenumber in [in_readln_x,in_writeln_x]) then
|
||||
CGMessage(type_e_no_readln_writeln_for_typed_file);
|
||||
hpp:=left;
|
||||
while (hpp<>hp) do
|
||||
begin
|
||||
if (tcallparanode(hpp).left.nodetype=typen) then
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
if not is_equal(hpp.resulttype.def,tfiledef(hp.resulttype.def).typedfiletype.def) then
|
||||
CGMessage(type_e_mismatch);
|
||||
{ generate the high() value for the shortstring }
|
||||
if ((not iswrite) and is_shortstring(tcallparanode(hpp).left.resulttype.def)) or
|
||||
(is_chararray(tcallparanode(hpp).left.resulttype.def)) then
|
||||
tcallparanode(hpp).gen_high_tree(true);
|
||||
{ read(ln) is call by reference (JM) }
|
||||
if not iswrite then
|
||||
make_not_regable(tcallparanode(hpp).left);
|
||||
hpp:=tcallparanode(hpp).right;
|
||||
end;
|
||||
end;
|
||||
if (hp.resulttype.def.deftype=filedef) and
|
||||
(tfiledef(hp.resulttype.def).filetyp=ft_typed) then
|
||||
file_is_typed:=true;
|
||||
end; { endif assigned(hp) }
|
||||
|
||||
{ insert type conversions for write(ln) }
|
||||
if (not file_is_typed) then
|
||||
begin
|
||||
hp:=left;
|
||||
@ -1256,126 +1536,20 @@ implementation
|
||||
{$else}
|
||||
incrementregisterpushed(ALL_REGISTERS);
|
||||
{$endif}
|
||||
if (tcallparanode(hp).left.nodetype=typen) then
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
if assigned(tcallparanode(hp).left.resulttype.def) then
|
||||
begin
|
||||
isreal:=false;
|
||||
{ support writeln(procvar) }
|
||||
if (tcallparanode(hp).left.resulttype.def.deftype=procvardef) then
|
||||
begin
|
||||
p1:=ccallnode.create(nil,nil,nil,nil);
|
||||
tcallnode(p1).set_procvar(tcallparanode(hp).left);
|
||||
firstpass(p1);
|
||||
tcallparanode(hp).left:=p1;
|
||||
end;
|
||||
case tcallparanode(hp).left.resulttype.def.deftype of
|
||||
filedef :
|
||||
begin
|
||||
{ only allowed as first parameter }
|
||||
if assigned(tcallparanode(hp).right) then
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
end;
|
||||
stringdef :
|
||||
begin
|
||||
{ generate the high() value for the shortstring }
|
||||
if (not iswrite) and
|
||||
is_shortstring(tcallparanode(hp).left.resulttype.def) then
|
||||
tcallparanode(hp).gen_high_tree(true);
|
||||
end;
|
||||
pointerdef :
|
||||
begin
|
||||
if not is_pchar(tcallparanode(hp).left.resulttype.def) then
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
end;
|
||||
floatdef :
|
||||
begin
|
||||
isreal:=true;
|
||||
end;
|
||||
orddef :
|
||||
begin
|
||||
case torddef(tcallparanode(hp).left.resulttype.def).typ of
|
||||
uchar,
|
||||
u32bit,s32bit,
|
||||
u64bit,s64bit:
|
||||
;
|
||||
u8bit,s8bit,
|
||||
u16bit,s16bit :
|
||||
if iswrite then
|
||||
tcallparanode(hp).left:=ctypeconvnode.create(tcallparanode(hp).left,s32bittype);
|
||||
bool8bit,
|
||||
bool16bit,
|
||||
bool32bit :
|
||||
if iswrite then
|
||||
tcallparanode(hp).left:=ctypeconvnode.create(tcallparanode(hp).left,booltype)
|
||||
else
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
else
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
end;
|
||||
if not(iswrite) and
|
||||
not(is_64bitint(tcallparanode(hp).left.resulttype.def)) then
|
||||
not(is_64bitint(tcallparanode(hp).left.resulttype.def)) then
|
||||
extra_register:=true;
|
||||
end;
|
||||
arraydef :
|
||||
begin
|
||||
if is_chararray(tcallparanode(hp).left.resulttype.def) then
|
||||
tcallparanode(hp).gen_high_tree(true)
|
||||
else
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
end;
|
||||
else
|
||||
CGMessage(type_e_cant_read_write_type);
|
||||
end;
|
||||
|
||||
{ some format options ? }
|
||||
if cpf_is_colon_para in tcallparanode(hp).callparaflags then
|
||||
begin
|
||||
if cpf_is_colon_para in tcallparanode(tcallparanode(hp).right).callparaflags then
|
||||
begin
|
||||
frac_para:=hp;
|
||||
length_para:=tcallparanode(hp).right;
|
||||
hp:=tcallparanode(hp).right;
|
||||
hpp:=tcallparanode(hp).right;
|
||||
end
|
||||
else
|
||||
begin
|
||||
length_para:=hp;
|
||||
frac_para:=nil;
|
||||
hpp:=tcallparanode(hp).right;
|
||||
end;
|
||||
{ can be nil if you use "write(e:0:6)" while e is undeclared (JM) }
|
||||
if assigned(tcallparanode(hpp).left.resulttype.def) then
|
||||
isreal:=(tcallparanode(hpp).left.resulttype.def.deftype=floatdef)
|
||||
else exit;
|
||||
if (not is_integer(tcallparanode(length_para).left.resulttype.def)) then
|
||||
CGMessage1(type_e_integer_expr_expected,tcallparanode(length_para).left.resulttype.def.typename)
|
||||
else
|
||||
tcallparanode(length_para).left:=ctypeconvnode.create(tcallparanode(length_para).left,s32bittype);
|
||||
if assigned(frac_para) then
|
||||
begin
|
||||
if isreal then
|
||||
begin
|
||||
if (not is_integer(tcallparanode(frac_para).left.resulttype.def)) then
|
||||
CGMessage1(type_e_integer_expr_expected,tcallparanode(frac_para).left.resulttype.def.typename)
|
||||
else
|
||||
tcallparanode(frac_para).left:=ctypeconvnode.create(tcallparanode(frac_para).left,s32bittype);
|
||||
end
|
||||
else
|
||||
CGMessage(parser_e_illegal_colon_qualifier);
|
||||
end;
|
||||
{ do the checking for the colon'd arg }
|
||||
hp:=length_para;
|
||||
end;
|
||||
end;
|
||||
hp:=tcallparanode(hp).right;
|
||||
end;
|
||||
end;
|
||||
{ pass all parameters again for the typeconversions }
|
||||
if codegenerror then
|
||||
exit;
|
||||
tcallparanode(left).firstcallparan(nil,true);
|
||||
set_varstate(left,true);
|
||||
{ calc registers }
|
||||
left_max;
|
||||
if extra_register then
|
||||
@ -1384,21 +1558,7 @@ implementation
|
||||
end;
|
||||
|
||||
in_settextbuf_file_x :
|
||||
begin
|
||||
{ warning here left is the callparannode
|
||||
not the argument directly }
|
||||
{ left.left is text var }
|
||||
{ left.right.left is the buffer var }
|
||||
{ firstcallparan(left,nil);
|
||||
already done in firstcalln }
|
||||
{ now we know the type of buffer }
|
||||
srsym:=searchsymonlyin(systemunit,'SETTEXTBUF');
|
||||
hp:=ccallparanode.create(cordconstnode.create(tcallparanode(left).left.resulttype.def.size,s32bittype),left);
|
||||
hp:=ccallnode.create(hp,tprocsym(srsym),systemunit,nil);
|
||||
left:=nil;
|
||||
firstpass(hp);
|
||||
result:=hp;
|
||||
end;
|
||||
internalerror(200104262);
|
||||
|
||||
in_reset_typedfile,
|
||||
in_rewrite_typedfile :
|
||||
@ -1409,95 +1569,6 @@ implementation
|
||||
in_str_x_string :
|
||||
begin
|
||||
procinfo^.flags:=procinfo^.flags or pi_do_call;
|
||||
{ first pass just the string for first local use }
|
||||
hp:=tcallparanode(left).right;
|
||||
tcallparanode(left).right:=nil;
|
||||
tcallparanode(left).firstcallparan(nil,true);
|
||||
{ remove warning when result is passed }
|
||||
set_funcret_is_valid(tcallparanode(left).left);
|
||||
tcallparanode(left).right:=hp;
|
||||
tcallparanode(tcallparanode(left).right).firstcallparan(nil,true);
|
||||
set_varstate(tcallparanode(left).right,true);
|
||||
hp:=left;
|
||||
{ valid string ? }
|
||||
if not assigned(hp) or
|
||||
(tcallparanode(hp).left.resulttype.def.deftype<>stringdef) or
|
||||
(tcallparanode(hp).right=nil) then
|
||||
CGMessage(cg_e_illegal_expression);
|
||||
{ we need a var parameter }
|
||||
valid_for_assign(tcallparanode(hp).left,false);
|
||||
{ generate the high() value for the shortstring }
|
||||
if is_shortstring(tcallparanode(hp).left.resulttype.def) then
|
||||
tcallparanode(hp).gen_high_tree(true);
|
||||
|
||||
{ !!!! check length of string }
|
||||
|
||||
while assigned(tcallparanode(hp).right) do
|
||||
hp:=tcallparanode(hp).right;
|
||||
|
||||
if not assigned(tcallparanode(hp).resulttype.def) then
|
||||
exit;
|
||||
{ check and convert the first param }
|
||||
if (cpf_is_colon_para in tcallparanode(hp).callparaflags) or
|
||||
not assigned(hp.resulttype.def) then
|
||||
CGMessage(cg_e_illegal_expression);
|
||||
|
||||
isreal:=false;
|
||||
case hp.resulttype.def.deftype of
|
||||
orddef :
|
||||
begin
|
||||
case torddef(tcallparanode(hp).left.resulttype.def).typ of
|
||||
u32bit,s32bit,
|
||||
s64bit,u64bit:
|
||||
;
|
||||
u8bit,s8bit,
|
||||
u16bit,s16bit:
|
||||
tcallparanode(hp).left:=ctypeconvnode.create(tcallparanode(hp).left,s32bittype);
|
||||
else
|
||||
CGMessage(type_e_integer_or_real_expr_expected);
|
||||
end;
|
||||
end;
|
||||
floatdef :
|
||||
begin
|
||||
isreal:=true;
|
||||
end;
|
||||
else
|
||||
CGMessage(type_e_integer_or_real_expr_expected);
|
||||
end;
|
||||
|
||||
{ some format options ? }
|
||||
hpp:=tcallparanode(left).right;
|
||||
if assigned(hpp) and (cpf_is_colon_para in tcallparanode(hpp).callparaflags) then
|
||||
begin
|
||||
firstpass(tcallparanode(hpp).left);
|
||||
set_varstate(tcallparanode(hpp).left,true);
|
||||
if (not is_integer(tcallparanode(hpp).left.resulttype.def)) then
|
||||
CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype.def.typename)
|
||||
else
|
||||
tcallparanode(hpp).left:=ctypeconvnode.create(tcallparanode(hpp).left,s32bittype);
|
||||
hpp:=tcallparanode(hpp).right;
|
||||
if assigned(hpp) and (cpf_is_colon_para in tcallparanode(hpp).callparaflags) then
|
||||
begin
|
||||
if isreal then
|
||||
begin
|
||||
if (not is_integer(tcallparanode(hpp).left.resulttype.def)) then
|
||||
CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype.def.typename)
|
||||
else
|
||||
begin
|
||||
firstpass(tcallparanode(hpp).left);
|
||||
set_varstate(tcallparanode(hpp).left,true);
|
||||
tcallparanode(hpp).left:=ctypeconvnode.create(tcallparanode(hpp).left,s32bittype);
|
||||
end;
|
||||
end
|
||||
else
|
||||
CGMessage(parser_e_illegal_colon_qualifier);
|
||||
end;
|
||||
end;
|
||||
|
||||
{ pass all parameters again for the typeconversions }
|
||||
if codegenerror then
|
||||
exit;
|
||||
tcallparanode(left).firstcallparan(nil,true);
|
||||
{ calc registers }
|
||||
left_max;
|
||||
end;
|
||||
@ -1505,77 +1576,16 @@ implementation
|
||||
in_val_x :
|
||||
begin
|
||||
procinfo^.flags:=procinfo^.flags or pi_do_call;
|
||||
resulttype:=voidtype;
|
||||
{ check the amount of parameters }
|
||||
if not(assigned(left)) or
|
||||
not(assigned(tcallparanode(left).right)) then
|
||||
begin
|
||||
CGMessage(parser_e_wrong_parameter_size);
|
||||
exit;
|
||||
end;
|
||||
If Assigned(tcallparanode(tcallparanode(left).right).right) Then
|
||||
{there is a "code" parameter}
|
||||
Begin
|
||||
{ first pass just the code parameter for first local use}
|
||||
hp := tcallparanode(left).right;
|
||||
tcallparanode(left).right := nil;
|
||||
make_not_regable(tcallparanode(left).left);
|
||||
tcallparanode(left).firstcallparan(nil,true);
|
||||
set_varstate(left,false);
|
||||
if codegenerror then exit;
|
||||
tcallparanode(left).right := hp;
|
||||
{code has to be a var parameter}
|
||||
if valid_for_assign(tcallparanode(left).left,false) then
|
||||
begin
|
||||
if (tcallparanode(left).left.resulttype.def.deftype <> orddef) or
|
||||
not(torddef(tcallparanode(left).left.resulttype.def).typ in
|
||||
[u16bit,s16bit,u32bit,s32bit]) then
|
||||
CGMessage(type_e_mismatch);
|
||||
end;
|
||||
hpp := tcallparanode(left).right
|
||||
End
|
||||
Else hpp := left;
|
||||
{now hpp = the destination value tree}
|
||||
{ first pass just the destination parameter for first local use}
|
||||
hp:=tcallparanode(hpp).right;
|
||||
tcallparanode(hpp).right:=nil;
|
||||
{hpp = destination}
|
||||
make_not_regable(tcallparanode(hpp).left);
|
||||
tcallparanode(hpp).firstcallparan(nil,true);
|
||||
set_varstate(hpp,false);
|
||||
|
||||
if codegenerror then
|
||||
exit;
|
||||
{ remove warning when result is passed }
|
||||
set_funcret_is_valid(tcallparanode(hpp).left);
|
||||
tcallparanode(hpp).right := hp;
|
||||
if valid_for_assign(tcallparanode(hpp).left,false) then
|
||||
begin
|
||||
If Not((tcallparanode(hpp).left.resulttype.def.deftype = floatdef) or
|
||||
((tcallparanode(hpp).left.resulttype.def.deftype = orddef) And
|
||||
(torddef(tcallparanode(hpp).left.resulttype.def).typ in
|
||||
[u32bit,s32bit,
|
||||
u8bit,s8bit,u16bit,s16bit,s64bit,u64bit]))) Then
|
||||
CGMessage(type_e_mismatch);
|
||||
end;
|
||||
{hp = source (String)}
|
||||
{ count_ref := false; WHY ?? }
|
||||
tcallparanode(hp).firstcallparan(nil,true);
|
||||
set_varstate(hp,true);
|
||||
if codegenerror then
|
||||
exit;
|
||||
{ if not a stringdef then insert a type conv which
|
||||
does the other type checking }
|
||||
If (tcallparanode(hp).left.resulttype.def.deftype<>stringdef) then
|
||||
begin
|
||||
tcallparanode(hp).left:=ctypeconvnode.create(tcallparanode(hp).left,cshortstringtype);
|
||||
firstpass(tcallparanode(hp).left);
|
||||
end;
|
||||
{ calc registers }
|
||||
left_max;
|
||||
|
||||
{ val doesn't calculate the registers really }
|
||||
{ correct, we need one register extra (FK) }
|
||||
{ there is a "code" parameter }
|
||||
If Assigned(tcallparanode(tcallparanode(left).right).right) Then
|
||||
hpp := tcallparanode(left).right
|
||||
Else
|
||||
hpp := left;
|
||||
{ now hpp = the destination value tree }
|
||||
if is_64bitint(tcallparanode(hpp).left.resulttype.def) then
|
||||
inc(registers32,2)
|
||||
else
|
||||
@ -1719,7 +1729,11 @@ begin
|
||||
end.
|
||||
{
|
||||
$Log$
|
||||
Revision 1.38 2001-04-21 12:03:11 peter
|
||||
Revision 1.39 2001-04-26 21:57:05 peter
|
||||
* moved code from firstpass to det_resulttype and remove extraneous
|
||||
calls to firstcallparan for in_str,in_write,in_val
|
||||
|
||||
Revision 1.38 2001/04/21 12:03:11 peter
|
||||
* m68k updates merged from fixes branch
|
||||
|
||||
Revision 1.37 2001/04/13 22:22:30 peter
|
||||
|
||||
Loading…
Reference in New Issue
Block a user