paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-12-06 12:29:11 +01:00
Code Issues Packages Projects Releases Wiki Activity

* fixed very oldish case indention style

Browse Source 
git-svn-id: trunk@15643 -
This commit is contained in:
florian 2010-07-26 20:13:53 +00:00
parent 0e074dc9f5
commit b4764ca98a
2 changed files with 206 additions and 202 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

204
utils/h2pas/h2pas.pas
View File

@ -764,109 +764,111 @@ program h2pas;
exit; exit;
end; end;
case p^.typ of case p^.typ of
t_pointerdef : begin t_pointerdef :
(* procedure variable ? *) begin
if assigned(p^.p1) and (p^.p1^.typ=t_procdef) then (* procedure variable ? *)
begin if assigned(p^.p1) and (p^.p1^.typ=t_procdef) then
is_procvar:=true; begin
(* distinguish between procedure and function *) is_procvar:=true;
if (simple_type^.typ=t_void) and (p^.p1^.p1=nil) then (* distinguish between procedure and function *)
begin if (simple_type^.typ=t_void) and (p^.p1^.p1=nil) then
write(outfile,'procedure '); begin
write(outfile,'procedure ');
shift(10); shift(10);
(* write arguments *) (* write arguments *)
if assigned(p^.p1^.p2) then if assigned(p^.p1^.p2) then
write_args(outfile,p^.p1^.p2); write_args(outfile,p^.p1^.p2);
flush(outfile); flush(outfile);
popshift; popshift;
end end
else else
begin begin
write(outfile,'function '); write(outfile,'function ');
shift(9); shift(9);
(* write arguments *) (* write arguments *)
if assigned(p^.p1^.p2) then if assigned(p^.p1^.p2) then
write_args(outfile,p^.p1^.p2); write_args(outfile,p^.p1^.p2);
write(outfile,':'); write(outfile,':');
flush(outfile); flush(outfile);
write_p_a_def(outfile,p^.p1^.p1,simple_type); write_p_a_def(outfile,p^.p1^.p1,simple_type);
popshift; popshift;
end end
end end
else else
begin begin
(* generate "pointer" ? *) (* generate "pointer" ? *)
if (simple_type^.typ=t_void) and (p^.p1=nil) then if (simple_type^.typ=t_void) and (p^.p1=nil) then
begin begin
write(outfile,'pointer'); write(outfile,'pointer');
flush(outfile); flush(outfile);
end end
else else
begin begin
pointerwritten:=false; pointerwritten:=false;
if (p^.p1=nil) and UsePPointers then if (p^.p1=nil) and UsePPointers then
begin begin
if (simple_type^.typ=t_id) then if (simple_type^.typ=t_id) then
begin begin
write(outfile,PointerName(simple_type^.p)); write(outfile,PointerName(simple_type^.p));
pointerwritten:=true; pointerwritten:=true;
end end
{ structure } { structure }
else if (simple_type^.typ in [t_uniondef,t_structdef]) and else if (simple_type^.typ in [t_uniondef,t_structdef]) and
(simple_type^.p1=nil) and (simple_type^.p2^.typ=t_id) then (simple_type^.p1=nil) and (simple_type^.p2^.typ=t_id) then
begin begin
write(outfile,PointerName(simple_type^.p2^.p)); write(outfile,PointerName(simple_type^.p2^.p));
pointerwritten:=true; pointerwritten:=true;
end; end;
end;
if not pointerwritten then
begin
if in_args then
begin
write(outfile,'P');
pointerprefix:=true;
end
else
write(outfile,'^');
write_p_a_def(outfile,p^.p1,simple_type);
pointerprefix:=false;
end;
end;
end;
end;
t_arraydef : begin
constant:=false;
if assigned(p^.p2) then
begin
if p^.p2^.typ=t_id then
begin
val(p^.p2^.str,i,error);
if error=0 then
begin
dec(i);
constant:=true;
end;
end;
if not constant then
begin
write(outfile,'array[0..(');
write_expr(outfile,p^.p2);
write(outfile,')-1] of ');
end
else
begin
write(outfile,'array[0..',i,'] of ');
end;
end
else
begin
(* open array *)
write(outfile,'array of ');
end;
flush(outfile);
write_p_a_def(outfile,p^.p1,simple_type);
end; end;
if not pointerwritten then
begin
if in_args then
begin
write(outfile,'P');
pointerprefix:=true;
end
else
write(outfile,'^');
write_p_a_def(outfile,p^.p1,simple_type);
pointerprefix:=false;
end;
end;
end;
end;
t_arraydef :
begin
constant:=false;
if assigned(p^.p2) then
begin
if p^.p2^.typ=t_id then
begin
val(p^.p2^.str,i,error);
if error=0 then
begin
dec(i);
constant:=true;
end;
end;
if not constant then
begin
write(outfile,'array[0..(');
write_expr(outfile,p^.p2);
write(outfile,')-1] of ');
end
else
begin
write(outfile,'array[0..',i,'] of ');
end;
end
else
begin
(* open array *)
write(outfile,'array of ');
end;
flush(outfile);
write_p_a_def(outfile,p^.p1,simple_type);
end;
else internalerror(1); else internalerror(1);
end; end;
end; end;

204
utils/h2pas/h2pas.y
View File

@ -760,109 +760,111 @@ program h2pas;
exit; exit;
end; end;
case p^.typ of case p^.typ of
t_pointerdef : begin t_pointerdef :
(* procedure variable ? *) begin
if assigned(p^.p1) and (p^.p1^.typ=t_procdef) then (* procedure variable ? *)
begin if assigned(p^.p1) and (p^.p1^.typ=t_procdef) then
is_procvar:=true; begin
(* distinguish between procedure and function *) is_procvar:=true;
if (simple_type^.typ=t_void) and (p^.p1^.p1=nil) then (* distinguish between procedure and function *)
begin if (simple_type^.typ=t_void) and (p^.p1^.p1=nil) then
write(outfile,'procedure '); begin
write(outfile,'procedure ');
shift(10); shift(10);
(* write arguments *) (* write arguments *)
if assigned(p^.p1^.p2) then if assigned(p^.p1^.p2) then
write_args(outfile,p^.p1^.p2); write_args(outfile,p^.p1^.p2);
flush(outfile); flush(outfile);
popshift; popshift;
end end
else else
begin begin
write(outfile,'function '); write(outfile,'function ');
shift(9); shift(9);
(* write arguments *) (* write arguments *)
if assigned(p^.p1^.p2) then if assigned(p^.p1^.p2) then
write_args(outfile,p^.p1^.p2); write_args(outfile,p^.p1^.p2);
write(outfile,':'); write(outfile,':');
flush(outfile); flush(outfile);
write_p_a_def(outfile,p^.p1^.p1,simple_type); write_p_a_def(outfile,p^.p1^.p1,simple_type);
popshift; popshift;
end end
end end
else else
begin begin
(* generate "pointer" ? *) (* generate "pointer" ? *)
if (simple_type^.typ=t_void) and (p^.p1=nil) then if (simple_type^.typ=t_void) and (p^.p1=nil) then
begin begin
write(outfile,'pointer'); write(outfile,'pointer');
flush(outfile); flush(outfile);
end end
else else
begin begin
pointerwritten:=false; pointerwritten:=false;
if (p^.p1=nil) and UsePPointers then if (p^.p1=nil) and UsePPointers then
begin begin
if (simple_type^.typ=t_id) then if (simple_type^.typ=t_id) then
begin begin
write(outfile,PointerName(simple_type^.p)); write(outfile,PointerName(simple_type^.p));
pointerwritten:=true; pointerwritten:=true;
end end
{ structure } { structure }
else if (simple_type^.typ in [t_uniondef,t_structdef]) and else if (simple_type^.typ in [t_uniondef,t_structdef]) and
(simple_type^.p1=nil) and (simple_type^.p2^.typ=t_id) then (simple_type^.p1=nil) and (simple_type^.p2^.typ=t_id) then
begin begin
write(outfile,PointerName(simple_type^.p2^.p)); write(outfile,PointerName(simple_type^.p2^.p));
pointerwritten:=true; pointerwritten:=true;
end; end;
end;
if not pointerwritten then
begin
if in_args then
begin
write(outfile,'P');
pointerprefix:=true;
end
else
write(outfile,'^');
write_p_a_def(outfile,p^.p1,simple_type);
pointerprefix:=false;
end;
end;
end;
end;
t_arraydef : begin
constant:=false;
if assigned(p^.p2) then
begin
if p^.p2^.typ=t_id then
begin
val(p^.p2^.str,i,error);
if error=0 then
begin
dec(i);
constant:=true;
end;
end;
if not constant then
begin
write(outfile,'array[0..(');
write_expr(outfile,p^.p2);
write(outfile,')-1] of ');
end
else
begin
write(outfile,'array[0..',i,'] of ');
end;
end
else
begin
(* open array *)
write(outfile,'array of ');
end;
flush(outfile);
write_p_a_def(outfile,p^.p1,simple_type);
end; end;
if not pointerwritten then
begin
if in_args then
begin
write(outfile,'P');
pointerprefix:=true;
end
else
write(outfile,'^');
write_p_a_def(outfile,p^.p1,simple_type);
pointerprefix:=false;
end;
end;
end;
end;
t_arraydef :
begin
constant:=false;
if assigned(p^.p2) then
begin
if p^.p2^.typ=t_id then
begin
val(p^.p2^.str,i,error);
if error=0 then
begin
dec(i);
constant:=true;
end;
end;
if not constant then
begin
write(outfile,'array[0..(');
write_expr(outfile,p^.p2);
write(outfile,')-1] of ');
end
else
begin
write(outfile,'array[0..',i,'] of ');
end;
end
else
begin
(* open array *)
write(outfile,'array of ');
end;
flush(outfile);
write_p_a_def(outfile,p^.p1,simple_type);
end;
else internalerror(1); else internalerror(1);
end; end;
end; end;