paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-09-12 21:49:12 +02:00
Code Issues Packages Projects Releases Wiki Activity

*** empty log message ***

Browse Source
This commit is contained in:
florian 2000-09-28 16:34:47 +00:00
parent 828ee99e2d
commit 1cef9ea3b3
1 changed files with 188 additions and 193 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

379
compiler/ninl.pas
View File

@ -50,7 +50,7 @@ implementation
cobjects,verbose,globals,systems, cobjects,verbose,globals,systems,
globtype, globtype,
symconst,symtable,aasm,types, symconst,symtable,aasm,types,
htypechk,pass_1, pass_1,htypechk,
ncal,ncon,ncnv,nadd,nld, ncal,ncon,ncnv,nadd,nld,
cpubase cpubase
{$ifdef newcg} {$ifdef newcg}
@ -193,7 +193,7 @@ implementation
tcallparanode(left).firstcallparan(nil,false) tcallparanode(left).firstcallparan(nil,false)
else else
firstpass(left); firstpass(left);
left_right_max; left_right_max(self);
set_location(location,left.location); set_location(location,left.location);
end; end;
inc(parsing_para_level); inc(parsing_para_level);
@ -388,11 +388,10 @@ implementation
internalerror(88); internalerror(88);
end; end;
end; end;
disposetree(p);
if hp=nil then if hp=nil then
hp:=tnode.create(errorn); hp:=tnode.create(errorn);
firstpass(hp); firstpass(hp);
p:=hp; pass_1:=hp;
end end
else else
begin begin
@ -405,7 +404,7 @@ implementation
in_hi_word: in_hi_word:
begin begin
set_varstate(left,true); left.set_varstate(true);
if registers32<1 then if registers32<1 then
registers32:=1; registers32:=1;
if inlinenumber in [in_lo_word,in_hi_word] then if inlinenumber in [in_lo_word,in_hi_word] then
@ -495,27 +494,27 @@ implementation
uchar: uchar:
begin begin
hp:=gentypeconvnode(left,u8bitdef); hp:=gentypeconvnode(left,u8bitdef);
putnode(p); left:=nil;
p:=hp; include(hp.flags,nf_explizit);
explizit:=true; firstpass(hp);
firstpass(p); pass_1:=hp;
end; end;
uwidechar: uwidechar:
begin begin
hp:=gentypeconvnode(left,u16bitdef); hp:=gentypeconvnode(left,u16bitdef);
putnode(p); left:=nil;
p:=hp; include(hp.flags,nf_explizit);
explizit:=true; firstpass(hp);
firstpass(p); pass_1:=hp;
end; end;
bool8bit: bool8bit:
begin begin
hp:=gentypeconvnode(left,u8bitdef); hp:=gentypeconvnode(left,u8bitdef);
putnode(p); left:=nil;
p:=hp; ttypeconvnode(hp).convtyp:=tc_bool_2_int;
convtyp:=tc_bool_2_int; include(hp.flags,nf_explizit);
explizit:=true; firstpass(hp);
firstpass(p); pass_1:=hp;
end end
end end
{ can this happen ? } { can this happen ? }
@ -525,16 +524,16 @@ implementation
{ all other orddef need no transformation } { all other orddef need no transformation }
begin begin
hp:=left; hp:=left;
putnode(p); left:=nil;
p:=hp; pass_1:=hp;
end end
else if (left.resulttype^.deftype=enumdef) then else if (left.resulttype^.deftype=enumdef) then
begin begin
hp:=gentypeconvnode(left,s32bitdef); hp:=gentypeconvnode(left,s32bitdef);
putnode(p); left:=nil;
p:=hp; include(hp.flags,nf_explizit);
explizit:=true; firstpass(hp);
firstpass(p); pass_1:=hp;
end end
else else
begin begin
@ -565,8 +564,9 @@ implementation
if (left.nodetype=typeconvn) and if (left.nodetype=typeconvn) and
(ttypeconvnode(left).left.resulttype^.deftype=stringdef) then (ttypeconvnode(left).left.resulttype^.deftype=stringdef) then
begin begin
hp:=left.left; hp:=ttypeconvnode(left).left;
putnode(left); ttypeconvnode(left).left:=nil;
left.free;
left:=hp; left:=hp;
end; end;
@ -655,31 +655,32 @@ implementation
if codegenerror then if codegenerror then
exit; exit;
{ first param must be var } { first param must be var }
valid_for_assign(left.left,false); valid_for_assign(tcallparanode(left).left,false);
{ check type } { check type }
if (left.resulttype^.deftype in [enumdef,pointerdef]) or if (left.resulttype^.deftype in [enumdef,pointerdef]) or
is_ordinal(left.resulttype) then is_ordinal(left.resulttype) then
begin begin
{ two paras ? } { two paras ? }
if assigned(left.right) then if assigned(tcallparanode(left).right) then
begin begin
{ insert a type conversion } { insert a type conversion }
{ the second param is always longint } { the second param is always longint }
left.right.left:=gentypeconvnode(left.right.left,s32bitdef); tcallparanode(tcallparanode(left).right).left:=
gentypeconvnode(tcallparanode(tcallparanode(left).right).left,s32bitdef);
{ check the type conversion } { check the type conversion }
firstpass(left.right.left); firstpass(tcallparanode(tcallparanode(left).right).left);
{ need we an additional register ? } { need we an additional register ? }
if not(is_constintnode(left.right.left)) and if not(is_constintnode(tcallparanode(tcallparanode(left).right).left)) and
(left.right.left.location.loc in [LOC_MEM,LOC_REFERENCE]) and (tcallparanode(tcallparanode(left).right).left.location.loc in [LOC_MEM,LOC_REFERENCE]) and
(left.right.left.registers32<=1) then (tcallparanode(tcallparanode(left).right).left.registers32<=1) then
inc(registers32); inc(registers32);
{ do we need an additional register to restore the first parameter? } { do we need an additional register to restore the first parameter? }
if left.right.left.registers32>=registers32 then if tcallparanode(tcallparanode(left).right).left.registers32>=registers32 then
inc(registers32); inc(registers32);
if assigned(left.right.right) then if assigned(tcallparanode(tcallparanode(left).right).right) then
CGMessage(cg_e_illegal_expression); CGMessage(cg_e_illegal_expression);
end; end;
end end
@ -706,12 +707,12 @@ implementation
if assigned(left) then if assigned(left) then
begin begin
dowrite:=(inlinenumber in [in_write_x,in_writeln_x]); dowrite:=(inlinenumber in [in_write_x,in_writeln_x]);
firstcallparan(left,nil,true); tcallparanode(left).firstcallparan(nil,true);
set_varstate(left,dowrite); left.set_varstate(dowrite);
{ now we can check } { now we can check }
hp:=left; hp:=left;
while assigned(hp.right) do while assigned(tcallparanode(hp).right) do
hp:=hp.right; hp:=tcallparanode(hp).right;
{ if resulttype is not assigned, then automatically } { if resulttype is not assigned, then automatically }
{ file is not typed. } { file is not typed. }
if assigned(hp) and assigned(hp.resulttype) then if assigned(hp) and assigned(hp.resulttype) then
@ -733,18 +734,18 @@ implementation
hpp:=left; hpp:=left;
while (hpp<>hp) do while (hpp<>hp) do
begin begin
if (hpp.left.nodetype=typen) then if (tcallparanode(hpp).left.nodetype=typen) then
CGMessage(type_e_cant_read_write_type); CGMessage(type_e_cant_read_write_type);
if not is_equal(hpp.resulttype,pfiledef(hp.resulttype)^.typedfiletype.def) then if not is_equal(hpp.resulttype,pfiledef(hp.resulttype)^.typedfiletype.def) then
CGMessage(type_e_mismatch); CGMessage(type_e_mismatch);
{ generate the high() value for the shortstring } { generate the high() value for the shortstring }
if ((not dowrite) and is_shortstring(hpp.left.resulttype)) or if ((not dowrite) and is_shortstring(tcallparanode(hpp).left.resulttype)) or
(is_chararray(hpp.left.resulttype)) then (is_chararray(tcallparanode(hpp).left.resulttype)) then
gen_high_tree(hpp,true); tcallparanode(hpp).gen_high_tree(true);
{ read(ln) is call by reference (JM) } { read(ln) is call by reference (JM) }
if not dowrite then if not dowrite then
make_not_regable(hpp.left); make_not_regable(tcallparanode(hpp).left);
hpp:=hpp.right; hpp:=tcallparanode(hpp).right;
end; end;
end; end;
end; { endif assigned(hp) } end; { endif assigned(hp) }
@ -756,37 +757,37 @@ implementation
while assigned(hp) do while assigned(hp) do
begin begin
incrementregisterpushed($ff); incrementregisterpushed($ff);
if (hp.left.nodetype=typen) then if (tcallparanode(hp).left.nodetype=typen) then
CGMessage(type_e_cant_read_write_type); CGMessage(type_e_cant_read_write_type);
if assigned(hp.left.resulttype) then if assigned(tcallparanode(hp).left.resulttype) then
begin begin
isreal:=false; isreal:=false;
{ support writeln(procvar) } { support writeln(procvar) }
if (hp.left.resulttype^.deftype=procvardef) then if (tcallparanode(hp).left.resulttype^.deftype=procvardef) then
begin begin
p1:=gencallnode(nil,nil); p1:=gencallnode(nil,nil);
p1^.right:=hp.left; tcallnode(p1).right:=tcallparanode(hp).left;
p1^.resulttype:=pprocvardef(hp.left.resulttype)^.rettype.def; p1.resulttype:=pprocvardef(tcallparanode(hp).left.resulttype)^.rettype.def;
firstpass(p1); firstpass(p1);
hp.left:=p1; tcallparanode(hp).left:=p1;
end; end;
case hp.left.resulttype^.deftype of case tcallparanode(hp).left.resulttype^.deftype of
filedef : filedef :
begin begin
{ only allowed as first parameter } { only allowed as first parameter }
if assigned(hp.right) then if assigned(tcallparanode(hp).right) then
CGMessage(type_e_cant_read_write_type); CGMessage(type_e_cant_read_write_type);
end; end;
stringdef : stringdef :
begin begin
{ generate the high() value for the shortstring } { generate the high() value for the shortstring }
if (not dowrite) and if (not dowrite) and
is_shortstring(hp.left.resulttype) then is_shortstring(tcallparanode(hp).left.resulttype) then
gen_high_tree(hp,true); tcallparanode(hp).gen_high_tree(true);
end; end;
pointerdef : pointerdef :
begin begin
if not is_pchar(hp.left.resulttype) then if not is_pchar(tcallparanode(hp).left.resulttype) then
CGMessage(type_e_cant_read_write_type); CGMessage(type_e_cant_read_write_type);
end; end;
floatdef : floatdef :
@ -795,7 +796,7 @@ implementation
end; end;
orddef : orddef :
begin begin
case porddef(hp.left.resulttype)^.typ of case porddef(tcallparanode(hp).left.resulttype)^.typ of
uchar, uchar,
u32bit,s32bit, u32bit,s32bit,
u64bit,s64bit: u64bit,s64bit:
@ -803,25 +804,25 @@ implementation
u8bit,s8bit, u8bit,s8bit,
u16bit,s16bit : u16bit,s16bit :
if dowrite then if dowrite then
hp.left:=gentypeconvnode(hp.left,s32bitdef); tcallparanode(hp).left:=gentypeconvnode(tcallparanode(hp).left,s32bitdef);
bool8bit, bool8bit,
bool16bit, bool16bit,
bool32bit : bool32bit :
if dowrite then if dowrite then
hp.left:=gentypeconvnode(hp.left,booldef) tcallparanode(hp).left:=gentypeconvnode(tcallparanode(hp).left,booldef)
else else
CGMessage(type_e_cant_read_write_type); CGMessage(type_e_cant_read_write_type);
else else
CGMessage(type_e_cant_read_write_type); CGMessage(type_e_cant_read_write_type);
end; end;
if not(dowrite) and if not(dowrite) and
not(is_64bitint(hp.left.resulttype)) then not(is_64bitint(tcallparanode(hp).left.resulttype)) then
extra_register:=true; extra_register:=true;
end; end;
arraydef : arraydef :
begin begin
if is_chararray(hp.left.resulttype) then if is_chararray(tcallparanode(hp).left.resulttype) then
gen_high_tree(hp,true) tcallparanode(hp).gen_high_tree(true)
else else
CGMessage(type_e_cant_read_write_type); CGMessage(type_e_cant_read_write_type);
end; end;
@ -830,37 +831,37 @@ implementation
end; end;
{ some format options ? } { some format options ? }
if hp.is_colon_para then if nf_is_colon_para in hp.flags then
begin begin
if hp.right.is_colon_para then if nf_is_colon_para in tcallparanode(hp).right.flags then
begin begin
frac_para:=hp; frac_para:=hp;
length_para:=hp.right; length_para:=tcallparanode(hp).right;
hp:=hp.right; hp:=tcallparanode(hp).right;
hpp:=hp.right; hpp:=tcallparanode(hp).right;
end end
else else
begin begin
length_para:=hp; length_para:=hp;
frac_para:=nil; frac_para:=nil;
hpp:=hp.right; hpp:=tcallparanode(hp).right;
end; end;
{ can be nil if you use "write(e:0:6)" while e is undeclared (JM) } { can be nil if you use "write(e:0:6)" while e is undeclared (JM) }
if assigned(hpp.left.resulttype) then if assigned(tcallparanode(hpp).left.resulttype) then
isreal:=(hpp.left.resulttype^.deftype=floatdef) isreal:=(tcallparanode(hpp).left.resulttype^.deftype=floatdef)
else exit; else exit;
if (not is_integer(length_para^.left.resulttype)) then if (not is_integer(tcallparanode(length_para).left.resulttype)) then
CGMessage1(type_e_integer_expr_expected,length_para^.left.resulttype^.typename) CGMessage1(type_e_integer_expr_expected,tcallparanode(length_para).left.resulttype^.typename)
else else
length_para^.left:=gentypeconvnode(length_para^.left,s32bitdef); tcallparanode(length_para).left:=gentypeconvnode(tcallparanode(length_para).left,s32bitdef);
if assigned(frac_para) then if assigned(frac_para) then
begin begin
if isreal then if isreal then
begin begin
if (not is_integer(frac_para^.left.resulttype)) then if (not is_integer(tcallparanode(frac_para).left.resulttype)) then
CGMessage1(type_e_integer_expr_expected,frac_para^.left.resulttype^.typename) CGMessage1(type_e_integer_expr_expected,tcallparanode(frac_para).left.resulttype^.typename)
else else
frac_para^.left:=gentypeconvnode(frac_para^.left,s32bitdef); tcallparanode(frac_para).left:=gentypeconvnode(tcallparanode(frac_para).left,s32bitdef);
end end
else else
CGMessage(parser_e_illegal_colon_qualifier); CGMessage(parser_e_illegal_colon_qualifier);
@ -869,16 +870,16 @@ implementation
hp:=length_para; hp:=length_para;
end; end;
end; end;
hp:=hp.right; hp:=tcallparanode(hp).right;
end; end;
end; end;
{ pass all parameters again for the typeconversions } { pass all parameters again for the typeconversions }
if codegenerror then if codegenerror then
exit; exit;
firstcallparan(left,nil,true); tcallparanode(left).firstcallparan(nil,true);
set_varstate(left,true); left.set_varstate(true);
{ calc registers } { calc registers }
left_right_max(p); left_right_max(self);
if extra_register then if extra_register then
inc(registers32); inc(registers32);
end; end;
@ -895,11 +896,11 @@ implementation
{ now we know the type of buffer } { now we know the type of buffer }
getsymonlyin(systemunit,'SETTEXTBUF'); getsymonlyin(systemunit,'SETTEXTBUF');
hp:=gencallnode(pprocsym(srsym),systemunit); hp:=gencallnode(pprocsym(srsym),systemunit);
hp.left:=gencallparanode( tcallnode(hp).left:=gencallparanode(
genordinalconstnode(left.left.resulttype^.size,s32bitdef),left); genordinalconstnode(tcallparanode(left).left.resulttype^.size,s32bitdef),left);
putnode(p); left:=nil;
p:=hp; firstpass(hp);
firstpass(p); pass_1:=hp;
end; end;
{ the firstpass of the arg has been done in firstcalln ? } { the firstpass of the arg has been done in firstcalln ? }
@ -908,7 +909,7 @@ implementation
begin begin
procinfo^.flags:=procinfo^.flags or pi_do_call; procinfo^.flags:=procinfo^.flags or pi_do_call;
firstpass(left); firstpass(left);
set_varstate(left,true); left.set_varstate(true);
resulttype:=voiddef; resulttype:=voiddef;
end; end;
@ -918,42 +919,42 @@ implementation
resulttype:=voiddef; resulttype:=voiddef;
{ check the amount of parameters } { check the amount of parameters }
if not(assigned(left)) or if not(assigned(left)) or
not(assigned(left.right)) then not(assigned(tcallparanode(left).right)) then
begin begin
CGMessage(parser_e_wrong_parameter_size); CGMessage(parser_e_wrong_parameter_size);
exit; exit;
end; end;
{ first pass just the string for first local use } { first pass just the string for first local use }
hp:=left.right; hp:=tcallparanode(left).right;
left.right:=nil; tcallparanode(left).right:=nil;
firstcallparan(left,nil,true); tcallparanode(left).firstcallparan(nil,true);
set_varstate(left,false); left.set_varstate(false);
{ remove warning when result is passed } { remove warning when result is passed }
set_funcret_is_valid(left.left); set_funcret_is_valid(tcallparanode(left).left);
left.right:=hp; tcallparanode(left).right:=hp;
firstcallparan(left.right,nil,true); tcallparanode(tcallparanode(left).right).firstcallparan(nil,true);
set_varstate(left.right,true); tcallparanode(left).right.set_varstate(true);
hp:=left; hp:=left;
{ valid string ? } { valid string ? }
if not assigned(hp) or if not assigned(hp) or
(hp.left.resulttype^.deftype<>stringdef) or (tcallparanode(hp).left.resulttype^.deftype<>stringdef) or
(hp.right=nil) then (tcallparanode(hp).right=nil) then
CGMessage(cg_e_illegal_expression); CGMessage(cg_e_illegal_expression);
{ we need a var parameter } { we need a var parameter }
valid_for_assign(hp.left,false); valid_for_assign(tcallparanode(hp).left,false);
{ generate the high() value for the shortstring } { generate the high() value for the shortstring }
if is_shortstring(hp.left.resulttype) then if is_shortstring(tcallparanode(hp).left.resulttype) then
gen_high_tree(hp,true); tcallparanode(hp).gen_high_tree(true);
{ !!!! check length of string } { !!!! check length of string }
while assigned(hp.right) do while assigned(tcallparanode(hp).right) do
hp:=hp.right; hp:=tcallparanode(hp).right;
if not assigned(hp.resulttype) then if not assigned(tcallparanode(hp).resulttype) then
exit; exit;
{ check and convert the first param } { check and convert the first param }
if (hp.is_colon_para) or if (nf_is_colon_para in hp.flags) or
not assigned(hp.resulttype) then not assigned(hp.resulttype) then
CGMessage(cg_e_illegal_expression); CGMessage(cg_e_illegal_expression);
@ -961,13 +962,13 @@ implementation
case hp.resulttype^.deftype of case hp.resulttype^.deftype of
orddef : orddef :
begin begin
case porddef(hp.left.resulttype)^.typ of case porddef(tcallparanode(hp).left.resulttype)^.typ of
u32bit,s32bit, u32bit,s32bit,
s64bit,u64bit: s64bit,u64bit:
; ;
u8bit,s8bit, u8bit,s8bit,
u16bit,s16bit: u16bit,s16bit:
hp.left:=gentypeconvnode(hp.left,s32bitdef); tcallparanode(hp).left:=gentypeconvnode(tcallparanode(hp).left,s32bitdef);
else else
CGMessage(type_e_integer_or_real_expr_expected); CGMessage(type_e_integer_or_real_expr_expected);
end; end;
@ -981,27 +982,27 @@ implementation
end; end;
{ some format options ? } { some format options ? }
hpp:=left.right; hpp:=tcallparanode(left).right;
if assigned(hpp) and hpp.is_colon_para then if assigned(hpp) and (nf_is_colon_para in hpp.flags) then
begin begin
firstpass(hpp.left); firstpass(tcallparanode(hpp).left);
set_varstate(hpp.left,true); tcallparanode(hpp).left.set_varstate(true);
if (not is_integer(hpp.left.resulttype)) then if (not is_integer(tcallparanode(hpp).left.resulttype)) then
CGMessage1(type_e_integer_expr_expected,hpp.left.resulttype^.typename) CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype^.typename)
else else
hpp.left:=gentypeconvnode(hpp.left,s32bitdef); tcallparanode(hpp).left:=gentypeconvnode(tcallparanode(hpp).left,s32bitdef);
hpp:=hpp.right; hpp:=tcallparanode(hpp).right;
if assigned(hpp) and hpp.is_colon_para then if assigned(hpp) and (nf_is_colon_para in hpp.flags) then
begin begin
if isreal then if isreal then
begin begin
if (not is_integer(hpp.left.resulttype)) then if (not is_integer(tcallparanode(hpp).left.resulttype)) then
CGMessage1(type_e_integer_expr_expected,hpp.left.resulttype^.typename) CGMessage1(type_e_integer_expr_expected,tcallparanode(hpp).left.resulttype^.typename)
else else
begin begin
firstpass(hpp.left); firstpass(tcallparanode(hpp).left);
hpp.left.set_varstate(true); tcallparanode(hpp).left.set_varstate(true);
hpp.left:=gentypeconvnode(hpp.left,s32bitdef); tcallparanode(hpp).left:=gentypeconvnode(tcallparanode(hpp).left,s32bitdef);
end; end;
end end
else else
@ -1014,7 +1015,7 @@ implementation
exit; exit;
tcallparanode(left).firstcallparan(nil,true); tcallparanode(left).firstcallparan(nil,true);
{ calc registers } { calc registers }
left_right_max(p); left_right_max(self);
end; end;
in_val_x : in_val_x :
@ -1023,75 +1024,75 @@ implementation
resulttype:=voiddef; resulttype:=voiddef;
{ check the amount of parameters } { check the amount of parameters }
if not(assigned(left)) or if not(assigned(left)) or
not(assigned(left.right)) then not(assigned(tcallparanode(left).right)) then
begin begin
CGMessage(parser_e_wrong_parameter_size); CGMessage(parser_e_wrong_parameter_size);
exit; exit;
end; end;
If Assigned(left.right.right) Then If Assigned(tcallparanode(tcallparanode(left).right).right) Then
{there is a "code" parameter} {there is a "code" parameter}
Begin Begin
{ first pass just the code parameter for first local use} { first pass just the code parameter for first local use}
hp := left.right; hp := tcallparanode(left).right;
left.right := nil; tcallparanode(left).right := nil;
make_not_regable(left.left); make_not_regable(tcallparanode(left).left);
firstcallparan(left, nil,true); tcallparanode(left).firstcallparan(nil,true);
set_varstate(left,false); tcallparanode(left).set_varstate(false);
if codegenerror then exit; if codegenerror then exit;
left.right := hp; tcallparanode(left).right := hp;
{code has to be a var parameter} {code has to be a var parameter}
if valid_for_assign(left.left,false) then if valid_for_assign(tcallparanode(left).left,false) then
begin begin
if (left.left.resulttype^.deftype <> orddef) or if (tcallparanode(left).left.resulttype^.deftype <> orddef) or
not(porddef(left.left.resulttype)^.typ in not(porddef(tcallparanode(left).left.resulttype)^.typ in
[u16bit,s16bit,u32bit,s32bit]) then [u16bit,s16bit,u32bit,s32bit]) then
CGMessage(type_e_mismatch); CGMessage(type_e_mismatch);
end; end;
hpp := left.right hpp := tcallparanode(left).right
End End
Else hpp := left; Else hpp := left;
{now hpp = the destination value tree} {now hpp = the destination value tree}
{ first pass just the destination parameter for first local use} { first pass just the destination parameter for first local use}
hp:=hpp.right; hp:=tcallparanode(hpp).right;
hpp.right:=nil; tcallparanode(hpp).right:=nil;
{hpp = destination} {hpp = destination}
make_not_regable(hpp.left); make_not_regable(tcallparanode(hpp).left);
firstcallparan(hpp,nil,true); tcallparanode(hpp).firstcallparan(nil,true);
set_varstate(hpp,false); hpp.set_varstate(false);
if codegenerror then if codegenerror then
exit; exit;
{ remove warning when result is passed } { remove warning when result is passed }
set_funcret_is_valid(hpp.left); set_funcret_is_valid(tcallparanode(hpp).left);
hpp.right := hp; tcallparanode(hpp).right := hp;
if valid_for_assign(hpp.left,false) then if valid_for_assign(tcallparanode(hpp).left,false) then
begin begin
If Not((hpp.left.resulttype^.deftype = floatdef) or If Not((tcallparanode(hpp).left.resulttype^.deftype = floatdef) or
((hpp.left.resulttype^.deftype = orddef) And ((tcallparanode(hpp).left.resulttype^.deftype = orddef) And
(POrdDef(hpp.left.resulttype)^.typ in (POrdDef(tcallparanode(hpp).left.resulttype)^.typ in
[u32bit,s32bit, [u32bit,s32bit,
u8bit,s8bit,u16bit,s16bit,s64bit,u64bit]))) Then u8bit,s8bit,u16bit,s16bit,s64bit,u64bit]))) Then
CGMessage(type_e_mismatch); CGMessage(type_e_mismatch);
end; end;
{hp = source (String)} {hp = source (String)}
{ count_ref := false; WHY ?? } { count_ref := false; WHY ?? }
firstcallparan(hp,nil,true); tcallparanode(hp).firstcallparan(nil,true);
set_varstate(hp,true); hp.set_varstate(true);
if codegenerror then if codegenerror then
exit; exit;
{ if not a stringdef then insert a type conv which { if not a stringdef then insert a type conv which
does the other type checking } does the other type checking }
If (hp.left.resulttype^.deftype<>stringdef) then If (tcallparanode(hp).left.resulttype^.deftype<>stringdef) then
begin begin
hp.left:=gentypeconvnode(hp.left,cshortstringdef); tcallparanode(hp).left:=gentypeconvnode(tcallparanode(hp).left,cshortstringdef);
firstpass(hp); firstpass(hp);
end; end;
{ calc registers } { calc registers }
left_right_max(p); left_right_max(self);
{ val doesn't calculate the registers really } { val doesn't calculate the registers really }
{ correct, we need one register extra (FK) } { correct, we need one register extra (FK) }
if is_64bitint(hpp.left.resulttype) then if is_64bitint(tcallparanode(hpp).left.resulttype) then
inc(registers32,2) inc(registers32,2)
else else
inc(registers32,1); inc(registers32,1);
@ -1103,33 +1104,33 @@ implementation
resulttype:=voiddef; resulttype:=voiddef;
if assigned(left) then if assigned(left) then
begin begin
firstcallparan(left,nil,true); tcallparanode(left).firstcallparan(nil,true);
set_varstate(left,true); left.set_varstate(true);
registers32:=left.registers32; registers32:=left.registers32;
registersfpu:=left.registersfpu; registersfpu:=left.registersfpu;
{$ifdef SUPPORT_MMX} {$ifdef SUPPORT_MMX}
registersmmx:=left.registersmmx; registersmmx:=left.registersmmx;
{$endif SUPPORT_MMX} {$endif SUPPORT_MMX}
{ remove warning when result is passed } { remove warning when result is passed }
set_funcret_is_valid(left.left); set_funcret_is_valid(tcallparanode(left).left);
{ first param must be var } { first param must be var }
valid_for_assign(left.left,false); valid_for_assign(tcallparanode(left).left,false);
{ check type } { check type }
if assigned(left.resulttype) and if assigned(left.resulttype) and
(left.resulttype^.deftype=setdef) then (left.resulttype^.deftype=setdef) then
begin begin
{ two paras ? } { two paras ? }
if assigned(left.right) then if assigned(tcallparanode(left).right) then
begin begin
{ insert a type conversion } { insert a type conversion }
{ to the type of the set elements } { to the type of the set elements }
left.right.left:=gentypeconvnode( tcallparanode(tcallparanode(left).right).left:=gentypeconvnode(
left.right.left, tcallparanode(tcallparanode(left).right).left,
psetdef(left.resulttype)^.elementtype.def); psetdef(left.resulttype)^.elementtype.def);
{ check the type conversion } { check the type conversion }
firstpass(left.right.left); firstpass(tcallparanode(tcallparanode(left).right).left);
{ only three parameters are allowed } { only three parameters are allowed }
if assigned(left.right.right) then if assigned(tcallparanode(tcallparanode(left).right).right) then
CGMessage(cg_e_illegal_expression); CGMessage(cg_e_illegal_expression);
end; end;
end end
@ -1143,7 +1144,7 @@ implementation
in_low_x, in_low_x,
in_high_x: in_high_x:
begin begin
set_varstate(left,false); left.set_varstate(false);
{ this fixes tests\webtbs\tbug879.pp (FK) { this fixes tests\webtbs\tbug879.pp (FK)
if left.nodetype in [typen,loadn,subscriptn] then if left.nodetype in [typen,loadn,subscriptn] then
begin begin
@ -1165,28 +1166,25 @@ implementation
begin begin
hp:=genordinalconstnode(Parraydef(left.resulttype)^.lowrange, hp:=genordinalconstnode(Parraydef(left.resulttype)^.lowrange,
Parraydef(left.resulttype)^.rangetype.def); Parraydef(left.resulttype)^.rangetype.def);
disposetree(p); firstpass(hp);
p:=hp; pass_1:=hp;
firstpass(p);
end end
else else
begin begin
if is_open_array(left.resulttype) or if is_open_array(left.resulttype) or
is_array_of_const(left.resulttype) then is_array_of_const(left.resulttype) then
begin begin
getsymonlyin(left.symtable,'high'+pvarsym(left.symtableentry)^.name); getsymonlyin(tloadnode(left).symtable,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
hp:=genloadnode(pvarsym(srsym),left.symtable); hp:=genloadnode(pvarsym(srsym),tloadnode(left).symtable);
disposetree(p); firstpass(hp);
p:=hp; pass_1:=hp;
firstpass(p);
end end
else else
begin begin
hp:=genordinalconstnode(Parraydef(left.resulttype)^.highrange, hp:=genordinalconstnode(Parraydef(left.resulttype)^.highrange,
Parraydef(left.resulttype)^.rangetype.def); Parraydef(left.resulttype)^.rangetype.def);
disposetree(p); firstpass(hp);
p:=hp; pass_1:=hp;
firstpass(p);
end; end;
end; end;
end; end;
@ -1195,26 +1193,23 @@ implementation
if inlinenumber=in_low_x then if inlinenumber=in_low_x then
begin begin
hp:=genordinalconstnode(0,u8bitdef); hp:=genordinalconstnode(0,u8bitdef);
disposetree(p); firstpass(hp);
p:=hp; pass_1:=hp;
firstpass(p);
end end
else else
begin begin
if is_open_string(left.resulttype) then if is_open_string(left.resulttype) then
begin begin
getsymonlyin(left.symtable,'high'+pvarsym(left.symtableentry)^.name); getsymonlyin(tloadnode(left).symtable,'high'+pvarsym(tloadnode(left).symtableentry)^.name);
hp:=genloadnode(pvarsym(srsym),left.symtable); hp:=genloadnode(pvarsym(srsym),tloadnode(left).symtable);
disposetree(p); firstpass(hp);
p:=hp; pass_1:=hp;
firstpass(p);
end end
else else
begin begin
hp:=genordinalconstnode(Pstringdef(left.resulttype)^.len,u8bitdef); hp:=genordinalconstnode(Pstringdef(left.resulttype)^.len,u8bitdef);
disposetree(p); firstpass(hp);
p:=hp; pass_1:=hp;
firstpass(p);
end; end;
end; end;
end; end;
@ -1321,8 +1316,8 @@ implementation
resulttype:=voiddef; resulttype:=voiddef;
if assigned(left) then if assigned(left) then
begin begin
firstcallparan(left,nil,true); tcallparanode(left).firstcallparan(nil,true);
set_varstate(left,true); left.set_varstate(true);
registers32:=left.registers32; registers32:=left.registers32;
registersfpu:=left.registersfpu; registersfpu:=left.registersfpu;
{$ifdef SUPPORT_MMX} {$ifdef SUPPORT_MMX}
@ -1332,8 +1327,9 @@ implementation
if is_boolean(left.resulttype) then if is_boolean(left.resulttype) then
begin begin
{ must always be a string } { must always be a string }
left.right.left:=gentypeconvnode(left.right.left,cshortstringdef); tcallparanode(tcallparanode(left).right).left:=
firstpass(left.right.left); gentypeconvnode(tcallparanode(tcallparanode(left).right).left,cshortstringdef);
firstpass(tcallparanode(tcallparanode(left).right).left);
end end
else else
CGMessage(type_e_mismatch); CGMessage(type_e_mismatch);
@ -1343,12 +1339,8 @@ implementation
{ We've checked the whole statement for correctness, now we { We've checked the whole statement for correctness, now we
can remove it if assertions are off } can remove it if assertions are off }
if not(cs_do_assertion in aktlocalswitches) then if not(cs_do_assertion in aktlocalswitches) then
begin
disposetree(left);
putnode(p);
{ we need a valid node, so insert a nothingn } { we need a valid node, so insert a nothingn }
p:=genzeronode(nothingn); pass_1:=cnothingnode.create;
end;
end; end;
else else
@ -1372,7 +1364,10 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.3 2000-09-27 21:33:22 florian Revision 1.4 2000-09-28 16:34:47 florian
*** empty log message ***
Revision 1.3 2000/09/27 21:33:22 florian
* finally nadd.pas compiles * finally nadd.pas compiles
Revision 1.2 2000/09/27 20:25:44 florian Revision 1.2 2000/09/27 20:25:44 florian