mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-30 07:40:27 +02:00
* basic parsing for bodies of C programs
git-svn-id: trunk@948 -
This commit is contained in:
florian
parent
a02c5b9f45
commit
d94fa751e0
@ -2,71 +2,77 @@ unit converu;
|
||||
|
||||
interface
|
||||
|
||||
const TYPEDEF = 257;
|
||||
const DEFINE = 258;
|
||||
const COLON = 259;
|
||||
const SEMICOLON = 260;
|
||||
const COMMA = 261;
|
||||
const LKLAMMER = 262;
|
||||
const RKLAMMER = 263;
|
||||
const LECKKLAMMER = 264;
|
||||
const RECKKLAMMER = 265;
|
||||
const LGKLAMMER = 266;
|
||||
const RGKLAMMER = 267;
|
||||
const STRUCT = 268;
|
||||
const UNION = 269;
|
||||
const ENUM = 270;
|
||||
const ID = 271;
|
||||
const NUMBER = 272;
|
||||
const CSTRING = 273;
|
||||
const SHORT = 274;
|
||||
const UNSIGNED = 275;
|
||||
const LONG = 276;
|
||||
const INT = 277;
|
||||
const REAL = 278;
|
||||
const _CHAR = 279;
|
||||
const VOID = 280;
|
||||
const _CONST = 281;
|
||||
const _FAR = 282;
|
||||
const _HUGE = 283;
|
||||
const _NEAR = 284;
|
||||
const _ASSIGN = 285;
|
||||
const NEW_LINE = 286;
|
||||
const SPACE_DEFINE = 287;
|
||||
const EXTERN = 288;
|
||||
const STDCALL = 289;
|
||||
const CDECL = 290;
|
||||
const CALLBACK = 291;
|
||||
const PASCAL = 292;
|
||||
const WINAPI = 293;
|
||||
const APIENTRY = 294;
|
||||
const WINGDIAPI = 295;
|
||||
const SYS_TRAP = 296;
|
||||
const _PACKED = 297;
|
||||
const ELLIPSIS = 298;
|
||||
const R_AND = 299;
|
||||
const EQUAL = 300;
|
||||
const UNEQUAL = 301;
|
||||
const GT = 302;
|
||||
const LT = 303;
|
||||
const GTE = 304;
|
||||
const LTE = 305;
|
||||
const QUESTIONMARK = 306;
|
||||
const _OR = 307;
|
||||
const _AND = 308;
|
||||
const _PLUS = 309;
|
||||
const MINUS = 310;
|
||||
const _SHR = 311;
|
||||
const _SHL = 312;
|
||||
const STAR = 313;
|
||||
const _SLASH = 314;
|
||||
const _NOT = 315;
|
||||
const PSTAR = 316;
|
||||
const P_AND = 317;
|
||||
const POINT = 318;
|
||||
const DEREF = 319;
|
||||
const STICK = 320;
|
||||
const SIGNED = 321;
|
||||
const _WHILE = 257;
|
||||
const _FOR = 258;
|
||||
const _DO = 259;
|
||||
const _GOTO = 260;
|
||||
const _CONTINUE = 261;
|
||||
const _BREAK = 262;
|
||||
const TYPEDEF = 263;
|
||||
const DEFINE = 264;
|
||||
const COLON = 265;
|
||||
const SEMICOLON = 266;
|
||||
const COMMA = 267;
|
||||
const LKLAMMER = 268;
|
||||
const RKLAMMER = 269;
|
||||
const LECKKLAMMER = 270;
|
||||
const RECKKLAMMER = 271;
|
||||
const LGKLAMMER = 272;
|
||||
const RGKLAMMER = 273;
|
||||
const STRUCT = 274;
|
||||
const UNION = 275;
|
||||
const ENUM = 276;
|
||||
const ID = 277;
|
||||
const NUMBER = 278;
|
||||
const CSTRING = 279;
|
||||
const SHORT = 280;
|
||||
const UNSIGNED = 281;
|
||||
const LONG = 282;
|
||||
const INT = 283;
|
||||
const REAL = 284;
|
||||
const _CHAR = 285;
|
||||
const VOID = 286;
|
||||
const _CONST = 287;
|
||||
const _FAR = 288;
|
||||
const _HUGE = 289;
|
||||
const _NEAR = 290;
|
||||
const NEW_LINE = 291;
|
||||
const SPACE_DEFINE = 292;
|
||||
const EXTERN = 293;
|
||||
const STDCALL = 294;
|
||||
const CDECL = 295;
|
||||
const CALLBACK = 296;
|
||||
const PASCAL = 297;
|
||||
const WINAPI = 298;
|
||||
const APIENTRY = 299;
|
||||
const WINGDIAPI = 300;
|
||||
const SYS_TRAP = 301;
|
||||
const _PACKED = 302;
|
||||
const ELLIPSIS = 303;
|
||||
const _ASSIGN = 304;
|
||||
const R_AND = 305;
|
||||
const EQUAL = 306;
|
||||
const UNEQUAL = 307;
|
||||
const GT = 308;
|
||||
const LT = 309;
|
||||
const GTE = 310;
|
||||
const LTE = 311;
|
||||
const QUESTIONMARK = 312;
|
||||
const _OR = 313;
|
||||
const _AND = 314;
|
||||
const _PLUS = 315;
|
||||
const MINUS = 316;
|
||||
const _SHR = 317;
|
||||
const _SHL = 318;
|
||||
const STAR = 319;
|
||||
const _SLASH = 320;
|
||||
const _NOT = 321;
|
||||
const PSTAR = 322;
|
||||
const P_AND = 323;
|
||||
const POINT = 324;
|
||||
const DEREF = 325;
|
||||
const STICK = 326;
|
||||
const SIGNED = 327;
|
||||
|
||||
|
||||
implementation
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
@ -387,10 +387,15 @@ program h2pas;
|
||||
write(outfile,')');
|
||||
flush(outfile);
|
||||
end;
|
||||
else internalerror(2);
|
||||
else
|
||||
begin
|
||||
writeln(ord(p^.typ));
|
||||
internalerror(2);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure write_ifexpr(var outfile:text; p : presobject);
|
||||
begin
|
||||
@ -1144,8 +1149,42 @@ program h2pas;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
procedure write_statement_block(var outfile:text; p : presobject);
|
||||
begin
|
||||
writeln(outfile,aktspace,'begin');
|
||||
while assigned(p) do
|
||||
begin
|
||||
shift(2);
|
||||
if assigned(p^.p1) then
|
||||
begin
|
||||
case p^.p1^.typ of
|
||||
t_whilenode:
|
||||
begin
|
||||
write(outfile,aktspace,'while ');
|
||||
write_expr(outfile,p^.p1^.p1);
|
||||
writeln(outfile,' do');
|
||||
shift(2);
|
||||
write_statement_block(outfile,p^.p1^.p2);
|
||||
popshift;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
write(outfile,aktspace);
|
||||
write_expr(outfile,p^.p1);
|
||||
writeln(outfile,';');
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
p:=p^.next;
|
||||
popshift;
|
||||
end;
|
||||
writeln(outfile,aktspace,'end;');
|
||||
end;
|
||||
|
||||
%}
|
||||
|
||||
%token _WHILE _FOR _DO _GOTO _CONTINUE _BREAK
|
||||
%token TYPEDEF DEFINE
|
||||
%token COLON SEMICOLON COMMA
|
||||
%token LKLAMMER RKLAMMER LECKKLAMMER RECKKLAMMER
|
||||
@ -1155,10 +1194,11 @@ program h2pas;
|
||||
%token SHORT UNSIGNED LONG INT REAL _CHAR
|
||||
%token VOID _CONST
|
||||
%token _FAR _HUGE _NEAR
|
||||
%token _ASSIGN NEW_LINE SPACE_DEFINE
|
||||
%token NEW_LINE SPACE_DEFINE
|
||||
%token EXTERN STDCALL CDECL CALLBACK PASCAL WINAPI APIENTRY WINGDIAPI SYS_TRAP
|
||||
%token _PACKED
|
||||
%token ELLIPSIS
|
||||
%right _ASSIGN
|
||||
%right R_AND
|
||||
%left EQUAL UNEQUAL GT LT GTE LTE
|
||||
%left QUESTIONMARK COLON
|
||||
@ -1233,8 +1273,211 @@ systrap_specifier:
|
||||
| { $$:=nil; }
|
||||
;
|
||||
|
||||
statement :
|
||||
expr SEMICOLON { $$:=$1; } |
|
||||
_WHILE LKLAMMER expr RKLAMMER statement_list { $$:=new(presobject,init_two(t_whilenode,$3,$5)); }
|
||||
;
|
||||
|
||||
|
||||
statement_list : statement statement_list
|
||||
{
|
||||
$$:=new(presobject,init_one(t_statement_list,$1));
|
||||
$$^.next:=$2;
|
||||
} |
|
||||
statement
|
||||
{
|
||||
$$:=new(presobject,init_one(t_statement_list,$1));
|
||||
} |
|
||||
SEMICOLON
|
||||
{
|
||||
$$:=new(presobject,init_one(t_statement_list,nil));
|
||||
} |
|
||||
{
|
||||
$$:=new(presobject,init_one(t_statement_list,nil));
|
||||
}
|
||||
;
|
||||
|
||||
statement_block :
|
||||
LGKLAMMER statement_list RGKLAMMER { $$:=$2; }
|
||||
;
|
||||
|
||||
declaration :
|
||||
dec_specifier type_specifier dec_modifier declarator_list systrap_specifier SEMICOLON
|
||||
dec_specifier type_specifier dec_modifier declarator_list statement_block
|
||||
{
|
||||
IsExtern:=false;
|
||||
(* by default we must pop the args pushed on stack *)
|
||||
no_pop:=false;
|
||||
if (assigned($4)and assigned($4^.p1)and assigned($4^.p1^.p1))
|
||||
and ($4^.p1^.p1^.typ=t_procdef) then
|
||||
begin
|
||||
repeat
|
||||
If UseLib then
|
||||
IsExtern:=true
|
||||
else
|
||||
IsExtern:=assigned($1)and($1^.str='extern');
|
||||
no_pop:=assigned($3) and ($3^.str='no_pop');
|
||||
|
||||
if (block_type<>bt_func) and not(createdynlib) then
|
||||
begin
|
||||
writeln(outfile);
|
||||
block_type:=bt_func;
|
||||
end;
|
||||
|
||||
(* dyn. procedures must be put into a var block *)
|
||||
if createdynlib then
|
||||
begin
|
||||
if (block_type<>bt_var) then
|
||||
begin
|
||||
if not(compactmode) then
|
||||
writeln(outfile);
|
||||
writeln(outfile,aktspace,'var');
|
||||
block_type:=bt_var;
|
||||
end;
|
||||
shift(2);
|
||||
end;
|
||||
if not CompactMode then
|
||||
begin
|
||||
write(outfile,aktspace);
|
||||
if not IsExtern then
|
||||
write(implemfile,aktspace);
|
||||
end;
|
||||
(* distinguish between procedure and function *)
|
||||
if assigned($2) then
|
||||
if ($2^.typ=t_void) and ($4^.p1^.p1^.p1=nil) then
|
||||
begin
|
||||
if createdynlib then
|
||||
begin
|
||||
write(outfile,$4^.p1^.p2^.p,' : procedure');
|
||||
end
|
||||
else
|
||||
begin
|
||||
shift(10);
|
||||
write(outfile,'procedure ',$4^.p1^.p2^.p);
|
||||
end;
|
||||
if assigned($4^.p1^.p1^.p2) then
|
||||
write_args(outfile,$4^.p1^.p1^.p2);
|
||||
if createdynlib then
|
||||
begin
|
||||
loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
|
||||
freedynlibproc.add($4^.p1^.p2^.p+':=nil;');
|
||||
end
|
||||
else if not IsExtern then
|
||||
begin
|
||||
write(implemfile,'procedure ',$4^.p1^.p2^.p);
|
||||
if assigned($4^.p1^.p1^.p2) then
|
||||
write_args(implemfile,$4^.p1^.p1^.p2);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
if createdynlib then
|
||||
begin
|
||||
write(outfile,$4^.p1^.p2^.p,' : function');
|
||||
end
|
||||
else
|
||||
begin
|
||||
shift(9);
|
||||
write(outfile,'function ',$4^.p1^.p2^.p);
|
||||
end;
|
||||
|
||||
if assigned($4^.p1^.p1^.p2) then
|
||||
write_args(outfile,$4^.p1^.p1^.p2);
|
||||
write(outfile,':');
|
||||
write_p_a_def(outfile,$4^.p1^.p1^.p1,$2);
|
||||
if createdynlib then
|
||||
begin
|
||||
loaddynlibproc.add('pointer('+$4^.p1^.p2^.p+'):=GetProcAddress(hlib,'''+$4^.p1^.p2^.p+''');');
|
||||
freedynlibproc.add($4^.p1^.p2^.p+':=nil;');
|
||||
end
|
||||
else if not IsExtern then
|
||||
begin
|
||||
write(implemfile,'function ',$4^.p1^.p2^.p);
|
||||
if assigned($4^.p1^.p1^.p2) then
|
||||
write_args(implemfile,$4^.p1^.p1^.p2);
|
||||
write(implemfile,':');
|
||||
write_p_a_def(implemfile,$4^.p1^.p1^.p1,$2);
|
||||
end;
|
||||
end;
|
||||
(* No CDECL in interface for Uselib *)
|
||||
if IsExtern and (not no_pop) then
|
||||
write(outfile,';cdecl');
|
||||
popshift;
|
||||
if createdynlib then
|
||||
begin
|
||||
writeln(outfile,';');
|
||||
end
|
||||
else if UseLib then
|
||||
begin
|
||||
if IsExtern then
|
||||
begin
|
||||
write (outfile,';external');
|
||||
If UseName then
|
||||
Write(outfile,' External_library name ''',$4^.p1^.p2^.p,'''');
|
||||
end;
|
||||
writeln(outfile,';');
|
||||
end
|
||||
else
|
||||
begin
|
||||
writeln(outfile,';');
|
||||
if not IsExtern then
|
||||
begin
|
||||
writeln(implemfile,';');
|
||||
shift(2);
|
||||
if $5^.typ=t_statement_list then
|
||||
write_statement_block(implemfile,$5);
|
||||
popshift;
|
||||
end;
|
||||
end;
|
||||
IsExtern:=false;
|
||||
if not(compactmode) and not(createdynlib) then
|
||||
writeln(outfile);
|
||||
until not NeedEllipsisOverload;
|
||||
end
|
||||
else (* $4^.p1^.p1^.typ=t_procdef *)
|
||||
if assigned($4)and assigned($4^.p1) then
|
||||
begin
|
||||
shift(2);
|
||||
if block_type<>bt_var then
|
||||
begin
|
||||
if not(compactmode) then
|
||||
writeln(outfile);
|
||||
writeln(outfile,aktspace,'var');
|
||||
end;
|
||||
block_type:=bt_var;
|
||||
|
||||
shift(3);
|
||||
|
||||
IsExtern:=assigned($1)and($1^.str='extern');
|
||||
(* walk through all declarations *)
|
||||
hp:=$4;
|
||||
while assigned(hp) and assigned(hp^.p1) do
|
||||
begin
|
||||
(* write new var name *)
|
||||
if assigned(hp^.p1^.p2) and assigned(hp^.p1^.p2^.p) then
|
||||
write(outfile,aktspace,hp^.p1^.p2^.p);
|
||||
write(outfile,' : ');
|
||||
shift(2);
|
||||
(* write its type *)
|
||||
write_p_a_def(outfile,hp^.p1^.p1,$2);
|
||||
if assigned(hp^.p1^.p2)and assigned(hp^.p1^.p2^.p)then
|
||||
begin
|
||||
if isExtern then
|
||||
write(outfile,';cvar;external')
|
||||
else
|
||||
write(outfile,';cvar;public');
|
||||
end;
|
||||
writeln(outfile,';');
|
||||
popshift;
|
||||
hp:=hp^.p2;
|
||||
end;
|
||||
popshift;
|
||||
popshift;
|
||||
end;
|
||||
if assigned($1)then dispose($1,done);
|
||||
if assigned($2)then dispose($2,done);
|
||||
if assigned($4)then dispose($4,done);
|
||||
}
|
||||
| dec_specifier type_specifier dec_modifier declarator_list systrap_specifier SEMICOLON
|
||||
{
|
||||
IsExtern:=false;
|
||||
(* by default we must pop the args pushed on stack *)
|
||||
@ -2251,32 +2494,33 @@ abstract_declarator :
|
||||
}
|
||||
;
|
||||
|
||||
expr :
|
||||
shift_expr
|
||||
{$$:=$1;}
|
||||
expr : shift_expr
|
||||
{ $$:=$1; }
|
||||
;
|
||||
|
||||
shift_expr :
|
||||
expr EQUAL expr
|
||||
{ $$:=new(presobject,init_bop(' = ',$1,$3));}
|
||||
expr _ASSIGN expr
|
||||
{ $$:=new(presobject,init_bop(':=',$1,$3)); }
|
||||
| expr EQUAL expr
|
||||
{ $$:=new(presobject,init_bop('=',$1,$3));}
|
||||
| expr UNEQUAL expr
|
||||
{ $$:=new(presobject,init_bop(' <> ',$1,$3));}
|
||||
{ $$:=new(presobject,init_bop('<>',$1,$3));}
|
||||
| expr GT expr
|
||||
{ $$:=new(presobject,init_bop(' > ',$1,$3));}
|
||||
{ $$:=new(presobject,init_bop('>',$1,$3));}
|
||||
| expr GTE expr
|
||||
{ $$:=new(presobject,init_bop(' >= ',$1,$3));}
|
||||
{ $$:=new(presobject,init_bop('>=',$1,$3));}
|
||||
| expr LT expr
|
||||
{ $$:=new(presobject,init_bop(' < ',$1,$3));}
|
||||
{ $$:=new(presobject,init_bop('<',$1,$3));}
|
||||
| expr LTE expr
|
||||
{ $$:=new(presobject,init_bop(' <= ',$1,$3));}
|
||||
{ $$:=new(presobject,init_bop('<=',$1,$3));}
|
||||
| expr _PLUS expr
|
||||
{ $$:=new(presobject,init_bop(' + ',$1,$3));}
|
||||
{ $$:=new(presobject,init_bop('+',$1,$3));}
|
||||
| expr MINUS expr
|
||||
{ $$:=new(presobject,init_bop(' - ',$1,$3));}
|
||||
{ $$:=new(presobject,init_bop('-',$1,$3));}
|
||||
| expr STAR expr
|
||||
{ $$:=new(presobject,init_bop(' * ',$1,$3));}
|
||||
{ $$:=new(presobject,init_bop('*',$1,$3));}
|
||||
| expr _SLASH expr
|
||||
{ $$:=new(presobject,init_bop(' / ',$1,$3));}
|
||||
{ $$:=new(presobject,init_bop('/',$1,$3));}
|
||||
| expr _OR expr
|
||||
{ $$:=new(presobject,init_bop(' or ',$1,$3));}
|
||||
| expr _AND expr
|
||||
@ -2288,7 +2532,8 @@ shift_expr :
|
||||
| expr _SHR expr
|
||||
{ $$:=new(presobject,init_bop(' shr ',$1,$3));}
|
||||
| expr QUESTIONMARK colon_expr
|
||||
{ $3^.p1:=$1;
|
||||
{
|
||||
$3^.p1:=$1;
|
||||
$$:=$3;
|
||||
inc(if_nb);
|
||||
$$^.p:=strpnew('if_local'+str(if_nb));
|
||||
|
||||
@ -29,7 +29,7 @@ unit scan;
|
||||
lexlib,yacclib;
|
||||
|
||||
const
|
||||
version = '0.99.16';
|
||||
version = '1.0.0';
|
||||
|
||||
type
|
||||
Char=system.char;
|
||||
@ -108,8 +108,18 @@ unit scan;
|
||||
p2 the typecast expr }
|
||||
t_size_specifier,
|
||||
{ p1 expr for size }
|
||||
t_default_value
|
||||
t_default_value,
|
||||
{ p1 expr for value }
|
||||
t_statement_list,
|
||||
{ p1 is the statement
|
||||
next is next if it exist }
|
||||
t_whilenode,
|
||||
t_fornode,
|
||||
t_dowhilenode,
|
||||
t_switchnode,
|
||||
t_gotonode,
|
||||
t_continuenode,
|
||||
t_breaknode
|
||||
);
|
||||
|
||||
const
|
||||
@ -141,7 +151,15 @@ const
|
||||
't_funcname',
|
||||
't_typespec',
|
||||
't_size_specifier',
|
||||
't_default_value'
|
||||
't_default_value',
|
||||
't_statement_list',
|
||||
't_whilenode',
|
||||
't_fornode',
|
||||
't_dowhilenode',
|
||||
't_switchnode',
|
||||
't_gotonode',
|
||||
't_continuenode',
|
||||
't_breaknode'
|
||||
);
|
||||
|
||||
type
|
||||
@ -782,6 +800,7 @@ D [0-9]
|
||||
"near" return(_NEAR);
|
||||
"HUGE" return(_HUGE);
|
||||
"huge" return(_HUGE);
|
||||
"while" return(_WHILE);
|
||||
[A-Za-z_][A-Za-z0-9_]* begin
|
||||
if in_space_define=1 then
|
||||
in_space_define:=2;
|
||||
|
||||
5492
utils/h2pas/scan.pas
5492
utils/h2pas/scan.pas
File diff suppressed because it is too large
Load Diff
Loading…
Reference in New Issue
Block a user