paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-07-25 05:46:35 +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

356
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;
@ -1395,12 +1395,13 @@ implementation
end; end;
var var
node,hp : ptree; node,hp : ptree;
typedtyp,pararesult : pdef; typedtyp,
doflush,has_length : boolean; pararesult : pdef;
dummycoll : tdefcoll; has_length : boolean;
iolabel : plabel; dummycoll : tdefcoll;
npara : longint; iolabel : plabel;
npara : longint;
begin begin
{ I/O check } { I/O check }
@ -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,13 +1491,11 @@ 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;
if codegenerror then if codegenerror then
exit; exit;
emit_push_mem(aktfile); emit_push_mem(aktfile);
@ -1510,21 +1503,20 @@ implementation
begin begin
{ OK let's try this } { OK let's try this }
{ first we must only allow the right type } { first we must only allow the right type }
{ we have to call blockread or blockwrite } { we have to call blockread or blockwrite }
{ but the real problem is that } { but the real problem is that }
{ reset and rewrite should have set } { reset and rewrite should have set }
{ the type size } { the type size }
{ as recordsize for that file !!!! } { as recordsize for that file !!!! }
{ how can we make that } { how can we make that }
{ I think that is only possible by adding } { I think that is only possible by adding }
{ reset and rewrite to the inline list a call } { reset and rewrite to the inline list a call }
{ allways read only one record by element } { allways read only one record by element }
push_int(typedtyp^.size); push_int(typedtyp^.size);
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
@ -1533,170 +1525,169 @@ implementation
{ handle possible field width } { handle possible field width }
{ of course only for write(ln) } { of course only for write(ln) }
if not doread then if not doread then
begin begin
{ handle total width parameter } { handle total width parameter }
if assigned(node) and node^.is_colon_para then
begin
hp:=node;
node:=node^.right;
hp^.right:=nil;
secondcallparan(hp,@dummycoll,false
,false,0
);
hp^.right:=node;
if codegenerror then
exit;
has_length:=true;
end
else
if pararesult^.deftype<>floatdef then
push_int(0)
else
push_int(-32767);
{ a second colon para for a float ? }
if assigned(node) and node^.is_colon_para then if assigned(node) and node^.is_colon_para then
begin begin
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;
); if codegenerror then
hp^.right:=node; exit;
if pararesult^.deftype<>floatdef then has_length:=true;
Message(parser_e_illegal_colon_qualifier); end
if codegenerror then else
exit; if pararesult^.deftype<>floatdef then
push_int(0)
else
push_int(-32767);
{ a second colon para for a float ? }
if assigned(node) and node^.is_colon_para then
begin
hp:=node;
node:=node^.right;
hp^.right:=nil;
secondcallparan(hp,@dummycoll,false,false,0);
hp^.right:=node;
if pararesult^.deftype<>floatdef then
Message(parser_e_illegal_colon_qualifier);
if codegenerror then
exit;
end end
else else
begin begin
if pararesult^.deftype=floatdef then if pararesult^.deftype=floatdef then
push_int(-1); push_int(-1);
end end
end;
case pararesult^.deftype of
stringdef:
begin
if doread then
emitcall('READ_TEXT_STRING',true)
else
begin
emitcall('WRITE_TEXT_STRING',true);
{ungetiftemp(hp^.left^.location.reference);}
end;
end;
pointerdef : begin
if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
begin
if doread then
emitcall('READ_TEXT_PCHAR_AS_POINTER',true)
else
emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true);
end
else
Message(parser_e_illegal_parameter_list);
end;
arraydef : begin
if (parraydef(pararesult)^.lowrange=0)
and is_equal(parraydef(pararesult)^.definition,cchardef) then
begin
if doread then
emitcall('READ_TEXT_PCHAR_AS_ARRAY',true)
else
emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true);
end
else
Message(parser_e_illegal_parameter_list);
end;
floatdef:
begin
if doread then
emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
else
emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
end;
orddef : begin
case porddef(pararesult)^.typ of
u8bit : if doread then
emitcall('READ_TEXT_BYTE',true);
s8bit : if doread then
emitcall('READ_TEXT_SHORTINT',true);
u16bit : if doread then
emitcall('READ_TEXT_WORD',true);
s16bit : if doread then
emitcall('READ_TEXT_INTEGER',true);
s32bit : if doread then
emitcall('READ_TEXT_LONGINT',true)
else
emitcall('WRITE_TEXT_LONGINT',true);
u32bit : if doread then
emitcall('READ_TEXT_CARDINAL',true)
else
emitcall('WRITE_TEXT_CARDINAL',true);
uchar : if doread then
emitcall('READ_TEXT_CHAR',true)
else
emitcall('WRITE_TEXT_CHAR',true);
bool8bit,
bool16bit,
bool32bit : if doread then
{ emitcall('READ_TEXT_BOOLEAN',true) }
Message(parser_e_illegal_parameter_list)
else
emitcall('WRITE_TEXT_BOOLEAN',true);
else Message(parser_e_illegal_parameter_list);
end;
end;
else Message(parser_e_illegal_parameter_list);
end;
end; end;
{ load ESI in methods again } case pararesult^.deftype of
popusedregisters(pushed); stringdef : begin
maybe_loadesi; if doread then
emitcall('READ_TEXT_STRING',true)
else
emitcall('WRITE_TEXT_STRING',true);
end;
pointerdef : begin
if is_equal(ppointerdef(pararesult)^.definition,cchardef) then
begin
if doread then
emitcall('READ_TEXT_PCHAR_AS_POINTER',true)
else
emitcall('WRITE_TEXT_PCHAR_AS_POINTER',true);
end
else
Message(parser_e_illegal_parameter_list);
end;
arraydef : begin
if (parraydef(pararesult)^.lowrange=0) and
is_equal(parraydef(pararesult)^.definition,cchardef) then
begin
if doread then
emitcall('READ_TEXT_PCHAR_AS_ARRAY',true)
else
emitcall('WRITE_TEXT_PCHAR_AS_ARRAY',true);
end
else
Message(parser_e_illegal_parameter_list);
end;
floatdef : begin
if doread then
emitcall('READ_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true)
else
emitcall('WRITE_TEXT_'+float_name[pfloatdef(pararesult)^.typ],true);
end;
orddef : begin
case porddef(pararesult)^.typ of
u8bit : if doread then
emitcall('READ_TEXT_BYTE',true);
s8bit : if doread then
emitcall('READ_TEXT_SHORTINT',true);
u16bit : if doread then
emitcall('READ_TEXT_WORD',true);
s16bit : if doread then
emitcall('READ_TEXT_INTEGER',true);
s32bit : if doread then
emitcall('READ_TEXT_LONGINT',true)
else
emitcall('WRITE_TEXT_LONGINT',true);
u32bit : if doread then
emitcall('READ_TEXT_CARDINAL',true)
else
emitcall('WRITE_TEXT_CARDINAL',true);
uchar : if doread then
emitcall('READ_TEXT_CHAR',true)
else
emitcall('WRITE_TEXT_CHAR',true);
bool8bit,
bool16bit,
bool32bit : if doread then
{ emitcall('READ_TEXT_BOOLEAN',true) }
Message(parser_e_illegal_parameter_list)
else
emitcall('WRITE_TEXT_BOOLEAN',true);
else
Message(parser_e_illegal_parameter_list);
end;
end;
else
Message(parser_e_illegal_parameter_list);
end;
end;
{ load ESI in methods again }
popusedregisters(pushed);
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 begin
Message(parser_e_illegal_parameter_list) ; if doln then
emitcall('WRITELN_TEXT',true); emitcall('READLN_END',true)
popusedregisters(pushed); else
maybe_loadesi;
emitcall('READ_END',true);
end
else
begin
if doln then
emitcall('WRITELN_END',true)
else
emitcall('WRITE_END',true);
end;
popusedregisters(pushed);
maybe_loadesi;
end; end;
if doflush and not(doread) then { Insert IOCheck if set }
begin if assigned(iolabel) then
pushusedregisters(pushed,$ff);
{ pushexceptlabel; }
emitcall('FLUSH_STDOUT',true);
popusedregisters(pushed);
maybe_loadesi;
end;
if iolabel<>nil 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
p^.left:=reversparameter(p^.left); p^.left:=reversparameter(p^.left);
if npara<>nb_para then if npara<>nb_para then
Message(cg_f_internal_error_in_secondinline); Message(cg_f_internal_error_in_secondinline);
hp:=p^.left; hp:=p^.left;
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;
end; end;
end; end;
procedure handle_str; procedure handle_str;
@ -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