mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-06 22:48:07 +02:00
1088 lines
38 KiB
Plaintext
1088 lines
38 KiB
Plaintext
%{
|
|
{
|
|
Copyright (c) 1998-2000 by Florian Klaempfl
|
|
|
|
This program is free software; you can redistribute it and/or modify
|
|
it under the terms of the GNU General Public License as published by
|
|
the Free Software Foundation; either version 2 of the License, or
|
|
(at your option) any later version.
|
|
|
|
This program is distributed in the hope that it will be useful,
|
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
GNU General Public License for more details.
|
|
|
|
You should have received a copy of the GNU General Public License
|
|
along with this program; if not, write to the Free Software
|
|
Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
|
****************************************************************************}
|
|
|
|
|
|
unit scan;
|
|
{$H+}
|
|
{$GOTO ON}
|
|
|
|
interface
|
|
|
|
uses
|
|
strings,
|
|
h2plexlib,h2pyacclib;
|
|
|
|
const
|
|
version = '1.0.0';
|
|
|
|
type
|
|
Char=system.char;
|
|
ttyp = (
|
|
t_id,
|
|
{ p contains the string }
|
|
t_arraydef,
|
|
{ }
|
|
t_pointerdef,
|
|
{ p1 contains the definition
|
|
if in type overrider
|
|
or nothing for args
|
|
}
|
|
t_addrdef,
|
|
|
|
t_void,
|
|
{ no field }
|
|
t_dec,
|
|
{ }
|
|
t_declist,
|
|
{ p1 is t_dec
|
|
next if exists }
|
|
t_memberdec,
|
|
{ p1 is type specifier
|
|
p2 is declarator_list }
|
|
t_structdef,
|
|
{ }
|
|
t_memberdeclist,
|
|
{ p1 is memberdec
|
|
next is next if it exist }
|
|
t_procdef,
|
|
{ }
|
|
t_uniondef,
|
|
{ }
|
|
t_enumdef,
|
|
{ }
|
|
t_enumlist,
|
|
{ }
|
|
t_preop,
|
|
{ p contains the operator string
|
|
p1 contains the right expr }
|
|
t_bop,
|
|
{ p contains the operator string
|
|
p1 contains the left expr
|
|
p2 contains the right expr }
|
|
t_arrayop,
|
|
{
|
|
p1 contains the array expr
|
|
p2 contains the index expressions }
|
|
t_callop,
|
|
{
|
|
p1 contains the proc expr
|
|
p2 contains the index expressions }
|
|
t_arg,
|
|
{
|
|
p1 contain the typedef
|
|
p2 the declarator (t_dec)
|
|
}
|
|
t_arglist,
|
|
{ }
|
|
t_funexprlist,
|
|
{ }
|
|
t_exprlist,
|
|
{ p1 contains the expr
|
|
next contains the next if it exists }
|
|
t_ifexpr,
|
|
{ p1 contains the condition expr
|
|
p2 contains the if branch
|
|
p3 contains the else branch }
|
|
t_funcname,
|
|
{ p1 contains the function dname
|
|
p2 contains the funexprlist
|
|
p3 possibly contains the return type }
|
|
t_typespec,
|
|
{ p1 is the type itself
|
|
p2 the typecast expr }
|
|
t_size_specifier,
|
|
{ p1 expr for size }
|
|
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
|
|
ttypstr: array[ttyp] of string =
|
|
(
|
|
't_id',
|
|
't_arraydef',
|
|
't_pointerdef',
|
|
't_addrdef',
|
|
't_void',
|
|
't_dec',
|
|
't_declist',
|
|
't_memberdec',
|
|
't_structdef',
|
|
't_memberdeclist',
|
|
't_procdef',
|
|
't_uniondef',
|
|
't_enumdef',
|
|
't_enumlist',
|
|
't_preop',
|
|
't_bop',
|
|
't_arrayop',
|
|
't_callop',
|
|
't_arg',
|
|
't_arglist',
|
|
't_funexprlist',
|
|
't_exprlist',
|
|
't_ifexpr',
|
|
't_funcname',
|
|
't_typespec',
|
|
't_size_specifier',
|
|
't_default_value',
|
|
't_statement_list',
|
|
't_whilenode',
|
|
't_fornode',
|
|
't_dowhilenode',
|
|
't_switchnode',
|
|
't_gotonode',
|
|
't_continuenode',
|
|
't_breaknode'
|
|
);
|
|
|
|
type
|
|
|
|
presobject = ^tresobject;
|
|
tresobject = object
|
|
typ : ttyp;
|
|
p : pchar;
|
|
next : presobject;
|
|
p1,p2,p3 : presobject;
|
|
{ name of int/real, then no T prefix is required }
|
|
intname : boolean;
|
|
constructor init_no(t : ttyp);
|
|
constructor init_one(t : ttyp;_p1 : presobject);
|
|
constructor init_two(t : ttyp;_p1,_p2 : presobject);
|
|
constructor init_three(t : ttyp;_p1,_p2,_p3 : presobject);
|
|
constructor init_id(const s : string);
|
|
constructor init_intid(const s : string);
|
|
constructor init_bop(const s : string;_p1,_p2 : presobject);
|
|
constructor init_preop(const s : string;_p1 : presobject);
|
|
procedure setstr(const s:string);
|
|
function str : string;
|
|
function strlength : byte;
|
|
function get_copy : presobject;
|
|
{ can this ve considered as a constant ? }
|
|
function is_const : boolean;
|
|
destructor done;
|
|
end;
|
|
|
|
tblocktype = (bt_type,bt_const,bt_var,bt_func,bt_no);
|
|
|
|
|
|
var
|
|
infile : string;
|
|
c : char;
|
|
aktspace : string;
|
|
block_type : tblocktype;
|
|
commentstr: string;
|
|
|
|
const
|
|
in_define : boolean = false;
|
|
{ True if define spans to the next line }
|
|
cont_line : boolean = false;
|
|
{ 1 after define; 2 after the ID to print the first separating space }
|
|
in_space_define : byte = 0;
|
|
arglevel : longint = 0;
|
|
|
|
{> 1 = ifdef level in a ifdef C++ block
|
|
1 = first level in an ifdef block
|
|
0 = not in an ifdef block
|
|
-1 = in else part of ifdef block, process like we weren't in the block
|
|
but skip the incoming end.
|
|
> -1 = ifdef sublevel in an else block.
|
|
}
|
|
cplusblocklevel : LongInt = 0;
|
|
|
|
|
|
function yylex : integer;
|
|
function act_token : string;
|
|
procedure internalerror(i : integer);
|
|
|
|
function strpnew(const s : string) : pchar;
|
|
|
|
procedure writetree(p: presobject);
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
h2poptions, h2pconst, scanbase;
|
|
|
|
const
|
|
newline = #10;
|
|
|
|
|
|
procedure writeentry(p: presobject; var currentlevel: integer);
|
|
begin
|
|
if assigned(p^.p1) then
|
|
begin
|
|
WriteLn(' Entry p1[',ttypstr[p^.p1^.typ],']',p^.p1^.str);
|
|
end;
|
|
if assigned(p^.p2) then
|
|
begin
|
|
WriteLn(' Entry p2[',ttypstr[p^.p2^.typ],']',p^.p2^.str);
|
|
end;
|
|
if assigned(p^.p3) then
|
|
begin
|
|
WriteLn(' Entry p3[',ttypstr[p^.p3^.typ],']',p^.p3^.str);
|
|
end;
|
|
end;
|
|
|
|
procedure writetree(p: presobject);
|
|
var
|
|
localp: presobject;
|
|
localp1: presobject;
|
|
currentlevel : integer;
|
|
begin
|
|
localp:=p;
|
|
currentlevel:=0;
|
|
while assigned(localp) do
|
|
begin
|
|
WriteLn('Entry[',ttypstr[localp^.typ],']',localp^.str);
|
|
case localp^.typ of
|
|
{ Some arguments sharing the same type }
|
|
t_arglist:
|
|
begin
|
|
localp1:=localp;
|
|
while assigned(localp1) do
|
|
begin
|
|
writeentry(localp1,currentlevel);
|
|
localp1:=localp1^.p1;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
localp:=localp^.next;
|
|
end;
|
|
end;
|
|
|
|
|
|
|
|
procedure internalerror(i : integer);
|
|
begin
|
|
writeln('Internal error ',i,' in line ',yylineno);
|
|
halt(1);
|
|
end;
|
|
|
|
|
|
procedure commenteof;
|
|
begin
|
|
writeln('unexpected EOF inside comment at line ',yylineno);
|
|
end;
|
|
|
|
|
|
procedure copy_until_eol;
|
|
begin
|
|
c:=get_char;
|
|
while c<>newline do
|
|
begin
|
|
write(outfile,c);
|
|
c:=get_char;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure skip_until_eol;
|
|
begin
|
|
c:=get_char;
|
|
while c<>newline do
|
|
c:=get_char;
|
|
end;
|
|
|
|
|
|
function strpnew(const s : string) : pchar;
|
|
var
|
|
p : pchar;
|
|
begin
|
|
getmem(p,length(s)+1);
|
|
strpcopy(p,s);
|
|
strpnew:=p;
|
|
end;
|
|
|
|
function NotInCPlusBlock : Boolean; inline;
|
|
begin
|
|
NotInCPlusBlock := cplusblocklevel < 1;
|
|
end;
|
|
|
|
constructor tresobject.init_preop(const s : string;_p1 : presobject);
|
|
begin
|
|
typ:=t_preop;
|
|
p:=strpnew(s);
|
|
p1:=_p1;
|
|
p2:=nil;
|
|
p3:=nil;
|
|
next:=nil;
|
|
intname:=false;
|
|
end;
|
|
|
|
constructor tresobject.init_bop(const s : string;_p1,_p2 : presobject);
|
|
begin
|
|
typ:=t_bop;
|
|
p:=strpnew(s);
|
|
p1:=_p1;
|
|
p2:=_p2;
|
|
p3:=nil;
|
|
next:=nil;
|
|
intname:=false;
|
|
end;
|
|
|
|
constructor tresobject.init_id(const s : string);
|
|
begin
|
|
typ:=t_id;
|
|
p:=strpnew(s);
|
|
p1:=nil;
|
|
p2:=nil;
|
|
p3:=nil;
|
|
next:=nil;
|
|
intname:=false;
|
|
end;
|
|
|
|
constructor tresobject.init_intid(const s : string);
|
|
begin
|
|
typ:=t_id;
|
|
p:=strpnew(s);
|
|
p1:=nil;
|
|
p2:=nil;
|
|
p3:=nil;
|
|
next:=nil;
|
|
intname:=true;
|
|
end;
|
|
|
|
constructor tresobject.init_two(t : ttyp;_p1,_p2 : presobject);
|
|
begin
|
|
typ:=t;
|
|
p1:=_p1;
|
|
p2:=_p2;
|
|
p3:=nil;
|
|
p:=nil;
|
|
next:=nil;
|
|
intname:=false;
|
|
end;
|
|
|
|
constructor tresobject.init_three(t : ttyp;_p1,_p2,_p3 : presobject);
|
|
begin
|
|
typ:=t;
|
|
p1:=_p1;
|
|
p2:=_p2;
|
|
p3:=_p3;
|
|
p:=nil;
|
|
next:=nil;
|
|
intname:=false;
|
|
end;
|
|
|
|
constructor tresobject.init_one(t : ttyp;_p1 : presobject);
|
|
begin
|
|
typ:=t;
|
|
p1:=_p1;
|
|
p2:=nil;
|
|
p3:=nil;
|
|
next:=nil;
|
|
p:=nil;
|
|
intname:=false;
|
|
end;
|
|
|
|
constructor tresobject.init_no(t : ttyp);
|
|
begin
|
|
typ:=t;
|
|
p:=nil;
|
|
p1:=nil;
|
|
p2:=nil;
|
|
p3:=nil;
|
|
next:=nil;
|
|
intname:=false;
|
|
end;
|
|
|
|
procedure tresobject.setstr(const s : string);
|
|
begin
|
|
if assigned(p) then
|
|
strdispose(p);
|
|
p:=strpnew(s);
|
|
end;
|
|
|
|
function tresobject.str : string;
|
|
begin
|
|
str:=strpas(p);
|
|
end;
|
|
|
|
function tresobject.strlength : byte;
|
|
begin
|
|
if assigned(p) then
|
|
strlength:=strlen(p)
|
|
else
|
|
strlength:=0;
|
|
end;
|
|
|
|
{ can this ve considered as a constant ? }
|
|
function tresobject.is_const : boolean;
|
|
begin
|
|
case typ of
|
|
t_id,t_void :
|
|
is_const:=true;
|
|
t_preop :
|
|
is_const:= ((str='-') or (str=' not ')) and p1^.is_const;
|
|
t_bop :
|
|
is_const:= p2^.is_const and p1^.is_const;
|
|
else
|
|
is_const:=false;
|
|
end;
|
|
end;
|
|
|
|
function tresobject.get_copy : presobject;
|
|
var
|
|
newres : presobject;
|
|
begin
|
|
newres:=new(presobject,init_no(typ));
|
|
newres^.intname:=intname;
|
|
if assigned(p) then
|
|
newres^.p:=strnew(p);
|
|
if assigned(p1) then
|
|
newres^.p1:=p1^.get_copy;
|
|
if assigned(p2) then
|
|
newres^.p2:=p2^.get_copy;
|
|
if assigned(p3) then
|
|
newres^.p3:=p3^.get_copy;
|
|
if assigned(next) then
|
|
newres^.next:=next^.get_copy;
|
|
get_copy:=newres;
|
|
end;
|
|
|
|
destructor tresobject.done;
|
|
begin
|
|
(* writeln('disposing ',byte(typ)); *)
|
|
if assigned(p)then strdispose(p);
|
|
if assigned(p1) then
|
|
dispose(p1,done);
|
|
if assigned(p2) then
|
|
dispose(p2,done);
|
|
if assigned(p3) then
|
|
dispose(p3,done);
|
|
if assigned(next) then
|
|
dispose(next,done);
|
|
end;
|
|
%}
|
|
|
|
D [0-9]
|
|
%%
|
|
|
|
"/*" if NotInCPlusBlock then
|
|
begin
|
|
if not stripcomment then
|
|
write(outfile,aktspace,'{');
|
|
repeat
|
|
c:=get_char;
|
|
case c of
|
|
'*' :
|
|
begin
|
|
c:=get_char;
|
|
if c='/' then
|
|
begin
|
|
if not stripcomment then
|
|
write(outfile,' }');
|
|
c:=get_char;
|
|
if c=newline then
|
|
writeln(outfile);
|
|
unget_char(c);
|
|
flush(outfile);
|
|
exit;
|
|
end
|
|
else
|
|
begin
|
|
if not stripcomment then
|
|
write(outfile,'*');
|
|
unget_char(c)
|
|
end;
|
|
end;
|
|
newline :
|
|
begin
|
|
if not stripcomment then
|
|
begin
|
|
writeln(outfile);
|
|
write(outfile,aktspace);
|
|
end;
|
|
end;
|
|
{ Don't write this thing out, to
|
|
avoid nested comments.
|
|
}
|
|
'{','}' :
|
|
begin
|
|
end;
|
|
#0 :
|
|
commenteof;
|
|
else
|
|
if not stripcomment then
|
|
write(outfile,c);
|
|
end;
|
|
until false;
|
|
flush(outfile);
|
|
end
|
|
else
|
|
skip_until_eol;
|
|
"//" if NotInCPlusBlock then
|
|
begin
|
|
commentstr:='';
|
|
if (in_define) and not (stripcomment) then
|
|
begin
|
|
commentstr:='{';
|
|
end
|
|
else
|
|
If not stripcomment then
|
|
write(outfile,aktspace,'{');
|
|
|
|
repeat
|
|
c:=get_char;
|
|
case c of
|
|
newline :
|
|
begin
|
|
unget_char(c);
|
|
if not stripcomment then
|
|
begin
|
|
if in_define then
|
|
begin
|
|
commentstr:=commentstr+' }';
|
|
end
|
|
else
|
|
begin
|
|
write(outfile,' }');
|
|
writeln(outfile);
|
|
end;
|
|
end;
|
|
flush(outfile);
|
|
exit;
|
|
end;
|
|
{ Don't write this comment out,
|
|
to avoid nested comment problems
|
|
}
|
|
'{','}' :
|
|
begin
|
|
end;
|
|
#0 :
|
|
commenteof;
|
|
else
|
|
if not stripcomment then
|
|
begin
|
|
if in_define then
|
|
begin
|
|
commentstr:=commentstr+c;
|
|
end
|
|
else
|
|
write(outfile,c);
|
|
end;
|
|
end;
|
|
until false;
|
|
flush(outfile);
|
|
end
|
|
else
|
|
skip_until_eol;
|
|
\"[^\"]*\" if NotInCPlusBlock then return(CSTRING) else skip_until_eol;
|
|
\'[^\']*\' if NotInCPlusBlock then return(CSTRING) else skip_until_eol;
|
|
"L"\"[^\"]*\" if NotInCPlusBlock then
|
|
begin
|
|
if win32headers then
|
|
return(CSTRING)
|
|
else
|
|
return(256);
|
|
end
|
|
else skip_until_eol;
|
|
"L"\'[^\']*\' if NotInCPlusBlock then
|
|
begin
|
|
if win32headers then
|
|
return(CSTRING)
|
|
else
|
|
return(256);
|
|
end
|
|
else
|
|
skip_until_eol;
|
|
{D}+[Uu]?[Ll]?[Ll]? if NotInCPlusBlock then
|
|
begin
|
|
if yytext[1]='0' then
|
|
begin
|
|
delete(yytext,1,1);
|
|
yytext:='&'+yytext;
|
|
end;
|
|
while yytext[length(yytext)] in ['L','U','l','u'] do
|
|
Delete(yytext,length(yytext),1);
|
|
return(NUMBER);
|
|
end
|
|
else skip_until_eol;
|
|
"0x"[0-9A-Fa-f]*[Uu]?[Ll]?[Ll]?
|
|
if NotInCPlusBlock then
|
|
begin
|
|
(* handle pre- and postfixes *)
|
|
if copy(yytext,1,2)='0x' then
|
|
begin
|
|
delete(yytext,1,2);
|
|
yytext:='$'+yytext;
|
|
end;
|
|
while yytext[length(yytext)] in ['L','U','l','u'] do
|
|
Delete(yytext,length(yytext),1);
|
|
return(NUMBER);
|
|
end
|
|
else
|
|
skip_until_eol;
|
|
{D}+(\.{D}+)?([Ee][+-]?{D}+)?
|
|
if NotInCPlusBlock then
|
|
begin
|
|
return(NUMBER);
|
|
end
|
|
else
|
|
skip_until_eol;
|
|
"->" if NotInCPlusBlock then
|
|
begin
|
|
if in_define then
|
|
return(DEREF)
|
|
else
|
|
return(256);
|
|
end
|
|
else
|
|
skip_until_eol;
|
|
"-" if NotInCPlusBlock then return(MINUS) else skip_until_eol;
|
|
"==" if NotInCPlusBlock then return(EQUAL) else skip_until_eol;
|
|
"!=" if NotInCPlusBlock then return(UNEQUAL) else skip_until_eol;
|
|
">=" if NotInCPlusBlock then return(GTE) else skip_until_eol;
|
|
"<=" if NotInCPlusBlock then return(LTE) else skip_until_eol;
|
|
">>" if NotInCPlusBlock then return(_SHR) else skip_until_eol;
|
|
"##" if NotInCPlusBlock then return(STICK) else skip_until_eol;
|
|
"<<" if NotInCPlusBlock then return(_SHL) else skip_until_eol;
|
|
">" if NotInCPlusBlock then return(GT) else skip_until_eol;
|
|
"<" if NotInCPlusBlock then return(LT) else skip_until_eol;
|
|
"|" if NotInCPlusBlock then return(_OR) else skip_until_eol;
|
|
"&" if NotInCPlusBlock then return(_AND) else skip_until_eol;
|
|
"~" if NotInCPlusBlock then return(_NOT) else skip_until_eol; (* inverse, but handled as not operation *)
|
|
"!" if NotInCPlusBlock then return(_NOT) else skip_until_eol;
|
|
"/" if NotInCPlusBlock then return(_SLASH) else skip_until_eol;
|
|
"+" if NotInCPlusBlock then return(_PLUS) else skip_until_eol;
|
|
"?" if NotInCPlusBlock then return(QUESTIONMARK) else skip_until_eol;
|
|
":" if NotInCPlusBlock then return(COLON) else skip_until_eol;
|
|
"," if NotInCPlusBlock then return(COMMA) else skip_until_eol;
|
|
"[" if NotInCPlusBlock then return(LECKKLAMMER) else skip_until_eol;
|
|
"]" if NotInCPlusBlock then return(RECKKLAMMER) else skip_until_eol;
|
|
"(" if NotInCPlusBlock then
|
|
begin
|
|
inc(arglevel);
|
|
return(LKLAMMER);
|
|
end
|
|
else
|
|
skip_until_eol;
|
|
")" if NotInCPlusBlock then
|
|
begin
|
|
dec(arglevel);
|
|
return(RKLAMMER);
|
|
end
|
|
else
|
|
skip_until_eol;
|
|
"*" if NotInCPlusBlock then return(STAR) else skip_until_eol;
|
|
"..." if NotInCPlusBlock then return(ELLIPSIS) else skip_until_eol;
|
|
"." if NotInCPlusBlock then
|
|
if in_define then
|
|
return(POINT)
|
|
else
|
|
return(256);
|
|
"=" if NotInCPlusBlock then return(_ASSIGN) else skip_until_eol;
|
|
"extern" if NotInCPlusBlock then return(EXTERN) else skip_until_eol;
|
|
"STDCALL" if NotInCPlusBlock then
|
|
begin
|
|
if Win32headers then
|
|
return(STDCALL)
|
|
else
|
|
return(ID);
|
|
end
|
|
else
|
|
begin
|
|
skip_until_eol;
|
|
end;
|
|
"CDECL" if NotInCPlusBlock then
|
|
begin
|
|
if not Win32headers then
|
|
return(ID)
|
|
else
|
|
return(CDECL);
|
|
end
|
|
else
|
|
begin
|
|
skip_until_eol;
|
|
end;
|
|
"PASCAL" if NotInCPlusBlock then
|
|
begin
|
|
if not Win32headers then
|
|
return(ID)
|
|
else
|
|
return(PASCAL);
|
|
end
|
|
else
|
|
begin
|
|
skip_until_eol;
|
|
end;
|
|
"PACKED" if NotInCPlusBlock then
|
|
begin
|
|
if not Win32headers then
|
|
return(ID)
|
|
else
|
|
return(_PACKED);
|
|
end
|
|
else
|
|
begin
|
|
skip_until_eol;
|
|
end;
|
|
"WINAPI" if NotInCPlusBlock then
|
|
begin
|
|
if not Win32headers then
|
|
return(ID)
|
|
else
|
|
return(WINAPI);
|
|
end
|
|
else
|
|
begin
|
|
skip_until_eol;
|
|
end;
|
|
"SYS_TRAP" if NotInCPlusBlock then
|
|
begin
|
|
if not palmpilot then
|
|
return(ID)
|
|
else
|
|
return(SYS_TRAP);
|
|
end
|
|
else
|
|
begin
|
|
skip_until_eol;
|
|
end;
|
|
"WINGDIAPI" if NotInCPlusBlock then
|
|
begin
|
|
if not Win32headers then
|
|
return(ID)
|
|
else
|
|
return(WINGDIAPI);
|
|
end
|
|
else
|
|
begin
|
|
skip_until_eol;
|
|
end;
|
|
"CALLBACK" if NotInCPlusBlock then
|
|
begin
|
|
if not Win32headers then
|
|
return(ID)
|
|
else
|
|
return(CALLBACK);
|
|
end
|
|
else
|
|
begin
|
|
skip_until_eol;
|
|
end;
|
|
"EXPENTRY" if NotInCPlusBlock then
|
|
begin
|
|
if not Win32headers then
|
|
return(ID)
|
|
else
|
|
return(CALLBACK);
|
|
end
|
|
else
|
|
begin
|
|
skip_until_eol;
|
|
end;
|
|
"void" if NotInCPlusBlock then return(VOID) else skip_until_eol;
|
|
"VOID" if NotInCPlusBlock then return(VOID) else skip_until_eol;
|
|
"#ifdef"[ \t]*"__cplusplus"[ \t]*\n"extern \"C\" {"\n"#endif"
|
|
begin
|
|
if not stripinfo then
|
|
writeln(outfile,'{ C++ extern C conditionnal removed }');
|
|
end;
|
|
"#ifdef"[ \t]*"cplusplus"[ \t]*\n"extern \"C\" {"\n"#endif"
|
|
begin
|
|
if not stripinfo then
|
|
writeln(outfile,'{ C++ extern C conditionnal removed }');
|
|
end;
|
|
"#ifdef"[ \t]*"__cplusplus"[ \t]*\n"}"\n"#endif"
|
|
begin
|
|
if not stripinfo then
|
|
writeln(outfile,'{ C++ end of extern C conditionnal removed }');
|
|
end;
|
|
"#ifdef"[ \t]*"cplusplus"[ \t]*\n"}"\n"#endif"
|
|
begin
|
|
if not stripinfo then
|
|
writeln(outfile,'{ C++ end of extern C conditionnal removed }');
|
|
end;
|
|
"#ifdef"[ \t]*"cplusplus"[ \t]*
|
|
begin
|
|
Inc(cplusblocklevel);
|
|
end;
|
|
"#ifdef"[ \t]*"__cplusplus"[ \t]*
|
|
begin
|
|
Inc(cplusblocklevel);
|
|
end;
|
|
"#ifdef"[ \t]
|
|
begin
|
|
if cplusblocklevel > 0 then
|
|
Inc(cplusblocklevel)
|
|
else
|
|
begin
|
|
if cplusblocklevel < 0 then
|
|
Dec(cplusblocklevel);
|
|
write(outfile,'{$ifdef ');
|
|
copy_until_eol;
|
|
writeln(outfile,'}');
|
|
flush(outfile);
|
|
end;
|
|
end;
|
|
"#"[ \t]*"else" begin
|
|
if cplusblocklevel < -1 then
|
|
begin
|
|
writeln(outfile,'{$else}');
|
|
block_type:=bt_no;
|
|
flush(outfile);
|
|
end
|
|
else
|
|
case cplusblocklevel of
|
|
0 :
|
|
begin
|
|
writeln(outfile,'{$else}');
|
|
block_type:=bt_no;
|
|
flush(outfile);
|
|
end;
|
|
1 : cplusblocklevel := -1;
|
|
-1 : cplusblocklevel := 1;
|
|
end;
|
|
end;
|
|
"#"[ \t]*"endif" begin
|
|
if cplusblocklevel > 0 then
|
|
begin
|
|
Dec(cplusblocklevel);
|
|
end
|
|
else
|
|
begin
|
|
case cplusblocklevel of
|
|
0 : begin
|
|
writeln(outfile,'{$endif}');
|
|
block_type:=bt_no;
|
|
flush(outfile);
|
|
end;
|
|
-1 : begin
|
|
cplusblocklevel :=0;
|
|
end
|
|
else
|
|
inc(cplusblocklevel);
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
"#"[ \t]*"elif" begin
|
|
if cplusblocklevel < -1 then
|
|
begin
|
|
if not stripinfo then
|
|
write(outfile,'(*** was #elif ****)');
|
|
write(outfile,'{$else');
|
|
copy_until_eol;
|
|
writeln(outfile,'}');
|
|
block_type:=bt_no;
|
|
flush(outfile);
|
|
end
|
|
else
|
|
case cplusblocklevel of
|
|
0 :
|
|
begin
|
|
if not stripinfo then
|
|
write(outfile,'(*** was #elif ****)');
|
|
write(outfile,'{$else');
|
|
copy_until_eol;
|
|
writeln(outfile,'}');
|
|
block_type:=bt_no;
|
|
flush(outfile);
|
|
end;
|
|
1 : cplusblocklevel := -1;
|
|
-1 : cplusblocklevel := 1;
|
|
end;
|
|
end;
|
|
"#"[ \t]*"undef" begin
|
|
write(outfile,'{$undef');
|
|
copy_until_eol;
|
|
writeln(outfile,'}');
|
|
flush(outfile);
|
|
end;
|
|
"#"[ \t]*"error" begin
|
|
write(outfile,'{$error');
|
|
copy_until_eol;
|
|
writeln(outfile,'}');
|
|
flush(outfile);
|
|
end;
|
|
"#"[ \t]*"include" if NotInCPlusBlock then
|
|
begin
|
|
write(outfile,'{$include');
|
|
copy_until_eol;
|
|
writeln(outfile,'}');
|
|
flush(outfile);
|
|
block_type:=bt_no;
|
|
end
|
|
else
|
|
skip_until_eol;
|
|
"#"[ \t]*"if" begin
|
|
if cplusblocklevel > 0 then
|
|
Inc(cplusblocklevel)
|
|
else
|
|
begin
|
|
if cplusblocklevel < 0 then
|
|
Dec(cplusblocklevel);
|
|
write(outfile,'{$if');
|
|
copy_until_eol;
|
|
writeln(outfile,'}');
|
|
flush(outfile);
|
|
block_type:=bt_no;
|
|
end;
|
|
end;
|
|
"# "[0-9]+" " if NotInCPlusBlock then
|
|
(* preprocessor line info *)
|
|
repeat
|
|
c:=get_char;
|
|
case c of
|
|
newline :
|
|
begin
|
|
unget_char(c);
|
|
exit;
|
|
end;
|
|
#0 :
|
|
commenteof;
|
|
end;
|
|
until false
|
|
else
|
|
skip_until_eol;
|
|
"#"[ \t]*"pragma" begin
|
|
if not stripinfo then
|
|
begin
|
|
write(outfile,'(** unsupported pragma');
|
|
write(outfile,'#pragma');
|
|
copy_until_eol;
|
|
writeln(outfile,'*)');
|
|
flush(outfile);
|
|
end
|
|
else
|
|
skip_until_eol;
|
|
block_type:=bt_no;
|
|
end;
|
|
"#"[ \t]*"define" if NotInCPlusBlock then
|
|
begin
|
|
commentstr:='';
|
|
in_define:=true;
|
|
in_space_define:=1;
|
|
return(DEFINE);
|
|
end
|
|
else
|
|
skip_until_eol;
|
|
"char" if NotInCPlusBlock then return(_CHAR) else skip_until_eol;
|
|
"union" if NotInCPlusBlock then return(UNION) else skip_until_eol;
|
|
"enum" if NotInCPlusBlock then return(ENUM) else skip_until_eol;
|
|
"struct" if NotInCPlusBlock then return(STRUCT) else skip_until_eol;
|
|
"{" if NotInCPlusBlock then return(LGKLAMMER) else skip_until_eol;
|
|
"}" if NotInCPlusBlock then return(RGKLAMMER) else skip_until_eol;
|
|
"typedef" if NotInCPlusBlock then return(TYPEDEF) else skip_until_eol;
|
|
"int" if NotInCPlusBlock then return(INT) else skip_until_eol;
|
|
"short" if NotInCPlusBlock then return(SHORT) else skip_until_eol;
|
|
"long" if NotInCPlusBlock then return(LONG) else skip_until_eol;
|
|
"signed" if NotInCPlusBlock then return(SIGNED) else skip_until_eol;
|
|
"unsigned" if NotInCPlusBlock then return(UNSIGNED) else skip_until_eol;
|
|
"__int8" if NotInCPlusBlock then return(INT8) else skip_until_eol;
|
|
"__int16" if NotInCPlusBlock then return(INT16) else skip_until_eol;
|
|
"__int32" if NotInCPlusBlock then return(INT32) else skip_until_eol;
|
|
"__int64" if NotInCPlusBlock then return(INT64) else skip_until_eol;
|
|
"int8" if NotInCPlusBlock then return(INT8) else skip_until_eol;
|
|
"int16" if NotInCPlusBlock then return(INT16) else skip_until_eol;
|
|
"int32" if NotInCPlusBlock then return(INT32) else skip_until_eol;
|
|
"int64" if NotInCPlusBlock then return(INT64) else skip_until_eol;
|
|
"float" if NotInCPlusBlock then return(FLOAT) else skip_until_eol;
|
|
"const" if NotInCPlusBlock then return(_CONST) else skip_until_eol;
|
|
"CONST" if NotInCPlusBlock then return(_CONST) else skip_until_eol;
|
|
"FAR" if NotInCPlusBlock then return(_FAR) else skip_until_eol;
|
|
"far" if NotInCPlusBlock then return(_FAR) else skip_until_eol;
|
|
"NEAR" if NotInCPlusBlock then return(_NEAR) else skip_until_eol;
|
|
"near" if NotInCPlusBlock then return(_NEAR) else skip_until_eol;
|
|
"HUGE" if NotInCPlusBlock then return(_HUGE) else skip_until_eol;
|
|
"huge" if NotInCPlusBlock then return(_HUGE) else skip_until_eol;
|
|
"while" if NotInCPlusBlock then return(_WHILE) else skip_until_eol;
|
|
[A-Za-z_][A-Za-z0-9_]* if NotInCPlusBlock then
|
|
begin
|
|
if in_space_define=1 then
|
|
in_space_define:=2;
|
|
return(ID);
|
|
end
|
|
else
|
|
skip_until_eol;
|
|
";" if NotInCPlusBlock then return(SEMICOLON) else skip_until_eol;
|
|
[ \f\t] if NotInCPlusBlock then
|
|
begin
|
|
if (arglevel=0) and (in_space_define=2) then
|
|
begin
|
|
in_space_define:=0;
|
|
return(SPACE_DEFINE);
|
|
end;
|
|
end
|
|
else
|
|
skip_until_eol;
|
|
\n begin
|
|
if in_define then
|
|
begin
|
|
in_space_define:=0;
|
|
if cont_line then
|
|
begin
|
|
cont_line:=false;
|
|
end
|
|
else
|
|
begin
|
|
in_define:=false;
|
|
if NotInCPlusBlock then
|
|
return(NEW_LINE)
|
|
else
|
|
skip_until_eol
|
|
end;
|
|
end;
|
|
end;
|
|
\\$ begin
|
|
if in_define then
|
|
begin
|
|
cont_line:=true;
|
|
end
|
|
else
|
|
begin
|
|
writeln('Unexpected wrap of line ',yylineno);
|
|
writeln('"',yyline,'"');
|
|
return(256);
|
|
end;
|
|
end;
|
|
. begin
|
|
writeln('Illegal character in line ',yylineno);
|
|
writeln('"',yyline,'"');
|
|
return(256);
|
|
end;
|
|
%%
|
|
|
|
|
|
function act_token : string;
|
|
begin
|
|
act_token:=yytext;
|
|
end;
|
|
|
|
end.
|
|
|
|
|
|
|
|
|