paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-07-05 15:38:47 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ better writeln/readln handling, now 100% like tp7

Browse Source
This commit is contained in:
peter 1998-07-01 15:28:48 +00:00
parent 97f61a43f4
commit 4d36bc1cc3
1 changed files with 170 additions and 186 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
compiler/cg386cal.pas
View File

@ -1378,7 +1378,7 @@ implementation
addvalue : longint; addvalue : longint;
procedure handlereadwrite(doread,callwriteln : boolean); procedure handlereadwrite(doread,doln : boolean);
{ produces code for READ(LN) and WRITE(LN) } { produces code for READ(LN) and WRITE(LN) }
procedure loadstream; procedure loadstream;
@ -1396,8 +1396,9 @@ implementation
var var
node,hp : ptree; node,hp : ptree;
typedtyp,pararesult : pdef; typedtyp,
doflush,has_length : boolean; pararesult : pdef;
has_length : boolean;
dummycoll : tdefcoll; dummycoll : tdefcoll;
iolabel : plabel; iolabel : plabel;
npara : longint; npara : longint;
@ -1411,8 +1412,6 @@ implementation
end end
else else
iolabel:=nil; iolabel:=nil;
{ no automatic call from flush }
doflush:=false;
{ for write of real with the length specified } { for write of real with the length specified }
has_length:=false; has_length:=false;
hp:=nil; hp:=nil;
@ -1424,11 +1423,9 @@ implementation
{ and state a parameter ? } { and state a parameter ? }
if p^.left=nil then if p^.left=nil then
begin begin
{ state screen address}
doflush:=true;
{ the following instructions are for "writeln;" } { the following instructions are for "writeln;" }
loadstream; loadstream;
{ save @Dateivarible in temporary variable } { save @aktfile in temporary variable }
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile)))); exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
end end
else else
@ -1449,7 +1446,7 @@ implementation
if codegenerror then if codegenerror then
exit; exit;
{ save reference in temporary variables } { reference in tempor„re Variable retten } { save reference in temporary variables }
if node^.left^.location.loc<>LOC_REFERENCE then if node^.left^.location.loc<>LOC_REFERENCE then
begin begin
Message(cg_e_illegal_expression); Message(cg_e_illegal_expression);
@ -1463,25 +1460,23 @@ implementation
end end
else else
begin begin
{ if we write to stdout/in then flush after the write(ln) } { load stdin/stdout stream }
doflush:=true;
loadstream; loadstream;
end; end;
{ save @Dateivarible in temporary variable } { save @aktfile in temporary variable }
exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile)))); exprasmlist^.concat(new(pai386,op_reg_ref(A_MOV,S_L,R_EDI,newreference(aktfile))));
if doread then if doread then
{ parameter by READ gives call by reference } { parameter by READ gives call by reference }
dummycoll.paratyp:=vs_var dummycoll.paratyp:=vs_var
{ an WRITE Call by "Const" } { an WRITE Call by "Const" }
else dummycoll.paratyp:=vs_const; else
dummycoll.paratyp:=vs_const;
{ because of secondcallparan, which otherwise attaches } { because of secondcallparan, which otherwise attaches }
if ft=ft_typed then if ft=ft_typed then
begin
{ this is to avoid copy of simple const parameters } { this is to avoid copy of simple const parameters }
dummycoll.data:=new(pformaldef,init); dummycoll.data:=new(pformaldef,init)
end
else else
{ I think, this isn't a good solution (FK) } { I think, this isn't a good solution (FK) }
dummycoll.data:=nil; dummycoll.data:=nil;
@ -1496,9 +1491,7 @@ implementation
Message(parser_e_illegal_colon_qualifier); Message(parser_e_illegal_colon_qualifier);
if ft=ft_typed then if ft=ft_typed then
never_copy_const_param:=true; never_copy_const_param:=true;
secondcallparan(hp,@dummycoll,false secondcallparan(hp,@dummycoll,false,false,0);
,false,0
);
if ft=ft_typed then if ft=ft_typed then
never_copy_const_param:=false; never_copy_const_param:=false;
hp^.right:=node; hp^.right:=node;
@ -1523,8 +1516,7 @@ implementation
if doread then if doread then
emitcall('TYPED_READ',true) emitcall('TYPED_READ',true)
else else
emitcall('TYPED_WRITE',true) emitcall('TYPED_WRITE',true);
{!!!!!!!}
end end
else else
begin begin
@ -1540,9 +1532,7 @@ implementation
hp:=node; hp:=node;
node:=node^.right; node:=node^.right;
hp^.right:=nil; hp^.right:=nil;
secondcallparan(hp,@dummycoll,false secondcallparan(hp,@dummycoll,false,false,0);
,false,0
);
hp^.right:=node; hp^.right:=node;
if codegenerror then if codegenerror then
exit; exit;
@ -1559,9 +1549,7 @@ implementation
hp:=node; hp:=node;
node:=node^.right; node:=node^.right;
hp^.right:=nil; hp^.right:=nil;
secondcallparan(hp,@dummycoll,false secondcallparan(hp,@dummycoll,false,false,0);
,false,0
);
hp^.right:=node; hp^.right:=node;
if pararesult^.deftype<>floatdef then if pararesult^.deftype<>floatdef then
Message(parser_e_illegal_colon_qualifier); Message(parser_e_illegal_colon_qualifier);
@ -1575,15 +1563,11 @@ implementation
end end
end; end;
case pararesult^.deftype of case pararesult^.deftype of
stringdef: stringdef : begin
begin
if doread then if doread then
emitcall('READ_TEXT_STRING',true) emitcall('READ_TEXT_STRING',true)
else else
begin
emitcall('WRITE_TEXT_STRING',true); emitcall('WRITE_TEXT_STRING',true);
{ungetiftemp(hp^.left^.location.reference);}
end;
end; end;
pointerdef : begin pointerdef : begin
if is_equal(ppointerdef(pararesult)^.definition,cchardef) then if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
@ -1597,8 +1581,8 @@ implementation
Message(parser_e_illegal_parameter_list); Message(parser_e_illegal_parameter_list);
end; end;
arraydef : begin arraydef : begin
if (parraydef(pararesult)^.lowrange=0) if (parraydef(pararesult)^.lowrange=0) and
and is_equal(parraydef(pararesult)^.definition,cchardef) then is_equal(parraydef(pararesult)^.definition,cchardef) then
begin begin
if doread then if doread then
emitcall('READ_TEXT_PCHAR_AS_ARRAY',true) emitcall('READ_TEXT_PCHAR_AS_ARRAY',true)
@ -1608,9 +1592,7 @@ implementation
else else
Message(parser_e_illegal_parameter_list); Message(parser_e_illegal_parameter_list);
end; end;
floatdef : begin
floatdef:
begin
if doread then if doread then
emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true) emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
else else
@ -1645,10 +1627,12 @@ implementation
Message(parser_e_illegal_parameter_list) Message(parser_e_illegal_parameter_list)
else else
emitcall('WRITE_TEXT_BOOLEAN',true); emitcall('WRITE_TEXT_BOOLEAN',true);
else Message(parser_e_illegal_parameter_list); else
Message(parser_e_illegal_parameter_list);
end; end;
end; end;
else Message(parser_e_illegal_parameter_list); else
Message(parser_e_illegal_parameter_list);
end; end;
end; end;
{ load ESI in methods again } { load ESI in methods again }
@ -1656,31 +1640,39 @@ implementation
maybe_loadesi; maybe_loadesi;
end; end;
end; end;
if callwriteln then { Insert end of writing for textfiles }
if ft=ft_text then
begin begin
pushusedregisters(pushed,$ff); pushusedregisters(pushed,$ff);
emit_push_mem(aktfile); emit_push_mem(aktfile);
{ pushexceptlabel; } if doread then
if ft<>ft_text then
Message(parser_e_illegal_parameter_list) ;
emitcall('WRITELN_TEXT',true);
popusedregisters(pushed);
maybe_loadesi;
end;
if doflush and not(doread) then
begin begin
pushusedregisters(pushed,$ff); if doln then
{ pushexceptlabel; } emitcall('READLN_END',true)
emitcall('FLUSH_STDOUT',true); else
emitcall('READ_END',true);
end
else
begin
if doln then
emitcall('WRITELN_END',true)
else
emitcall('WRITE_END',true);
end;
popusedregisters(pushed); popusedregisters(pushed);
maybe_loadesi; maybe_loadesi;
end; end;
if iolabel<>nil then { Insert IOCheck if set }
if assigned(iolabel) then
begin begin
{ registers are saved in the procedure } { registers are saved in the procedure }
exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0)))); exprasmlist^.concat(new(pai386,op_csymbol(A_PUSH,S_L,newcsymbol(lab2str(iolabel),0))));
emitcall('IOCHECK',true); emitcall('IOCHECK',true);
end; end;
{ Freeup all used temps }
ungetiftemp(aktfile); ungetiftemp(aktfile);
if assigned(p^.left) then if assigned(p^.left) then
begin begin
@ -1691,8 +1683,7 @@ implementation
while assigned(hp) do while assigned(hp) do
begin begin
if assigned(hp^.left) then if assigned(hp^.left) then
if (hp^.left^.location.loc=LOC_REFERENCE) or if (hp^.left^.location.loc in [LOC_MEM,LOC_REFERENCE]) then
(hp^.left^.location.loc=LOC_MEM) then
ungetiftemp(hp^.left^.location.reference); ungetiftemp(hp^.left^.location.reference);
hp:=hp^.right; hp:=hp^.right;
end; end;
@ -2090,17 +2081,7 @@ implementation
in_read_x : in_read_x :
handlereadwrite(true,false); handlereadwrite(true,false);
in_readln_x : in_readln_x :
begin handlereadwrite(true,true);
handlereadwrite(true,false);
pushusedregisters(pushed,$ff);
emit_push_mem(aktfile);
{ pushexceptlabel; }
if ft<>ft_text then
Message(parser_e_illegal_parameter_list);
emitcall('READLN_TEXT',true);
popusedregisters(pushed);
maybe_loadesi;
end;
in_str_x_string : in_str_x_string :
begin begin
handle_str; handle_str;
@ -2273,7 +2254,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.5 1998-06-25 14:04:17 peter Revision 1.6 1998-07-01 15:28:48 peter
+ better writeln/readln handling, now 100% like tp7
Revision 1.5 1998/06/25 14:04:17 peter
+ internal inc/dec + internal inc/dec
Revision 1.4 1998/06/25 08:48:06 florian Revision 1.4 1998/06/25 08:48:06 florian