mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-31 08:11:29 +01:00
eccbc78e04
+ use {$bitpacking on/+} to change the meaning of "packed"
into "bitpacked" for arrays. This is the default for MacPas.
You can also define individual arrays as "bitpacked", but
this is not encouraged since this keyword is not known by
other compilers and therefore makes your code unportable.
+ pack(unpackedarray,index,packedarray) to pack
length(packedarray) elements starting at
unpackedarray[index] into packedarray.
+ unpack(packedarray,unpackedarray,index) to unpack
packedarray into unpackedarray, with the first
element being stored at unpackedarray[index]
* todo:
* "open packed arrays" and rtti for packed arrays are not
yet supported
* gdb does not properly support bitpacked arrays
git-svn-id: trunk@4449 -
3957 lines
124 KiB
ObjectPascal
3957 lines
124 KiB
ObjectPascal
{
|
|
Copyright (c) 1998-2002 by Florian Klaempfl
|
|
|
|
This unit implements the scanner part and handling of the switches
|
|
|
|
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 scanner;
|
|
|
|
{$i fpcdefs.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
cclasses,
|
|
globtype,globals,version,tokens,
|
|
verbose,comphook,
|
|
finput,
|
|
widestr;
|
|
|
|
const
|
|
max_include_nesting=32;
|
|
max_macro_nesting=16;
|
|
preprocbufsize=32*1024;
|
|
|
|
|
|
type
|
|
tcommentstyle = (comment_none,comment_tp,comment_oldtp,comment_delphi,comment_c);
|
|
|
|
tscannerfile = class;
|
|
|
|
preproctyp = (pp_ifdef,pp_ifndef,pp_if,pp_ifopt,pp_else,pp_elseif);
|
|
|
|
tpreprocstack = class
|
|
typ : preproctyp;
|
|
accept : boolean;
|
|
next : tpreprocstack;
|
|
name : stringid;
|
|
line_nb : longint;
|
|
owner : tscannerfile;
|
|
constructor Create(atyp:preproctyp;a:boolean;n:tpreprocstack);
|
|
end;
|
|
|
|
tdirectiveproc=procedure;
|
|
|
|
tdirectiveitem = class(TNamedIndexItem)
|
|
public
|
|
is_conditional : boolean;
|
|
proc : tdirectiveproc;
|
|
constructor Create(const n:string;p:tdirectiveproc);
|
|
constructor CreateCond(const n:string;p:tdirectiveproc);
|
|
end;
|
|
|
|
tcompile_time_predicate = function(var valuedescr: String) : Boolean;
|
|
|
|
tscannerfile = class
|
|
public
|
|
inputfile : tinputfile; { current inputfile list }
|
|
inputfilecount : longint;
|
|
|
|
inputbuffer, { input buffer }
|
|
inputpointer : pchar;
|
|
inputstart : longint;
|
|
|
|
line_no, { line }
|
|
lastlinepos : longint;
|
|
|
|
lasttokenpos : longint; { token }
|
|
lasttoken,
|
|
nexttoken : ttoken;
|
|
|
|
replaysavetoken : ttoken;
|
|
replaytokenbuf,
|
|
recordtokenbuf : tdynamicarray;
|
|
|
|
comment_level,
|
|
yylexcount : longint;
|
|
lastasmgetchar : char;
|
|
ignoredirectives : tstringlist; { ignore directives, used to give warnings only once }
|
|
preprocstack : tpreprocstack;
|
|
in_asm_string : boolean;
|
|
|
|
preproc_pattern : string;
|
|
preproc_token : ttoken;
|
|
|
|
constructor Create(const fn:string);
|
|
destructor Destroy;override;
|
|
{ File buffer things }
|
|
function openinputfile:boolean;
|
|
procedure closeinputfile;
|
|
function tempopeninputfile:boolean;
|
|
procedure tempcloseinputfile;
|
|
procedure saveinputfile;
|
|
procedure restoreinputfile;
|
|
procedure firstfile;
|
|
procedure nextfile;
|
|
procedure addfile(hp:tinputfile);
|
|
procedure reload;
|
|
procedure insertmacro(const macname:string;p:pchar;len,line,fileindex:longint);
|
|
{ Scanner things }
|
|
procedure gettokenpos;
|
|
procedure inc_comment_level;
|
|
procedure dec_comment_level;
|
|
procedure illegal_char(c:char);
|
|
procedure end_of_file;
|
|
procedure checkpreprocstack;
|
|
procedure poppreprocstack;
|
|
procedure ifpreprocstack(atyp : preproctyp;compile_time_predicate:tcompile_time_predicate;messid:longint);
|
|
procedure elseifpreprocstack(compile_time_predicate:tcompile_time_predicate);
|
|
procedure elsepreprocstack;
|
|
procedure handleconditional(p:tdirectiveitem);
|
|
procedure handledirectives;
|
|
procedure linebreak;
|
|
procedure recordtoken;
|
|
procedure startrecordtokens(buf:tdynamicarray);
|
|
procedure stoprecordtokens;
|
|
procedure replaytoken;
|
|
procedure startreplaytokens(buf:tdynamicarray);
|
|
procedure readchar;
|
|
procedure readstring;
|
|
procedure readnumber;
|
|
function readid:string;
|
|
function readval:longint;
|
|
function readval_asstring:string;
|
|
function readcomment:string;
|
|
function readquotedstring:string;
|
|
function readstate:char;
|
|
function readstatedefault:char;
|
|
procedure skipspace;
|
|
procedure skipuntildirective;
|
|
procedure skipcomment;
|
|
procedure skipdelphicomment;
|
|
procedure skipoldtpcomment;
|
|
procedure readtoken(allowrecordtoken:boolean);
|
|
function readpreproc:ttoken;
|
|
function asmgetcharstart : char;
|
|
function asmgetchar:char;
|
|
end;
|
|
|
|
{$ifdef PREPROCWRITE}
|
|
tpreprocfile=class
|
|
f : text;
|
|
buf : pointer;
|
|
spacefound,
|
|
eolfound : boolean;
|
|
constructor create(const fn:string);
|
|
destructor destroy;
|
|
procedure Add(const s:string);
|
|
procedure AddSpace;
|
|
end;
|
|
{$endif PREPROCWRITE}
|
|
|
|
var
|
|
{ read strings }
|
|
c : char;
|
|
orgpattern,
|
|
pattern : string;
|
|
patternw : pcompilerwidestring;
|
|
|
|
{ token }
|
|
token, { current token being parsed }
|
|
idtoken : ttoken; { holds the token if the pattern is a known word }
|
|
|
|
current_scanner : tscannerfile; { current scanner in use }
|
|
|
|
aktcommentstyle : tcommentstyle; { needed to use read_comment from directives }
|
|
{$ifdef PREPROCWRITE}
|
|
preprocfile : tpreprocfile; { used with only preprocessing }
|
|
{$endif PREPROCWRITE}
|
|
|
|
type
|
|
tdirectivemode = (directive_all, directive_turbo, directive_mac);
|
|
|
|
procedure AddDirective(const s:string; dm: tdirectivemode; p:tdirectiveproc);
|
|
procedure AddConditional(const s:string; dm: tdirectivemode; p:tdirectiveproc);
|
|
|
|
procedure InitScanner;
|
|
procedure DoneScanner;
|
|
|
|
{To be called when the language mode is finally determined}
|
|
Function SetCompileMode(const s:string; changeInit: boolean):boolean;
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
dos,
|
|
cutils,
|
|
systems,
|
|
switches,
|
|
symbase,symtable,symtype,symsym,symconst,symdef,defutil,
|
|
fmodule;
|
|
|
|
var
|
|
{ dictionaries with the supported directives }
|
|
turbo_scannerdirectives : tdictionary; { for other modes }
|
|
mac_scannerdirectives : tdictionary; { for mode mac }
|
|
|
|
|
|
{*****************************************************************************
|
|
Helper routines
|
|
*****************************************************************************}
|
|
|
|
const
|
|
{ use any special name that is an invalid file name to avoid problems }
|
|
preprocstring : array [preproctyp] of string[7]
|
|
= ('$IFDEF','$IFNDEF','$IF','$IFOPT','$ELSE','$ELSEIF');
|
|
|
|
|
|
function is_keyword(const s:string):boolean;
|
|
var
|
|
low,high,mid : longint;
|
|
begin
|
|
if not (length(s) in [tokenlenmin..tokenlenmax]) or
|
|
not (s[1] in ['a'..'z','A'..'Z']) then
|
|
begin
|
|
is_keyword:=false;
|
|
exit;
|
|
end;
|
|
low:=ord(tokenidx^[length(s),s[1]].first);
|
|
high:=ord(tokenidx^[length(s),s[1]].last);
|
|
while low<high do
|
|
begin
|
|
mid:=(high+low+1) shr 1;
|
|
if pattern<tokeninfo^[ttoken(mid)].str then
|
|
high:=mid-1
|
|
else
|
|
low:=mid;
|
|
end;
|
|
is_keyword:=(pattern=tokeninfo^[ttoken(high)].str) and
|
|
(tokeninfo^[ttoken(high)].keyword in aktmodeswitches);
|
|
end;
|
|
|
|
|
|
Function SetCompileMode(const s:string; changeInit: boolean):boolean;
|
|
var
|
|
b : boolean;
|
|
oldaktmodeswitches : tmodeswitches;
|
|
begin
|
|
oldaktmodeswitches:=aktmodeswitches;
|
|
|
|
b:=true;
|
|
if s='DEFAULT' then
|
|
aktmodeswitches:=initmodeswitches
|
|
else
|
|
if s='DELPHI' then
|
|
aktmodeswitches:=delphimodeswitches
|
|
else
|
|
if s='TP' then
|
|
aktmodeswitches:=tpmodeswitches
|
|
else
|
|
if s='FPC' then
|
|
aktmodeswitches:=fpcmodeswitches
|
|
else
|
|
if s='OBJFPC' then
|
|
aktmodeswitches:=objfpcmodeswitches
|
|
else
|
|
if s='GPC' then
|
|
aktmodeswitches:=gpcmodeswitches
|
|
else
|
|
if s='MACPAS' then
|
|
aktmodeswitches:=macmodeswitches
|
|
else
|
|
b:=false;
|
|
|
|
if b and changeInit then
|
|
initmodeswitches := aktmodeswitches;
|
|
|
|
if b then
|
|
begin
|
|
{ resolve all postponed switch changes }
|
|
if localswitcheschanged then
|
|
begin
|
|
aktlocalswitches:=nextaktlocalswitches;
|
|
localswitcheschanged:=false;
|
|
end;
|
|
{ turn ansistrings on by default ? }
|
|
if (m_delphi in aktmodeswitches) then
|
|
begin
|
|
include(aktlocalswitches,cs_ansistrings);
|
|
if changeinit then
|
|
include(initlocalswitches,cs_ansistrings);
|
|
end
|
|
else
|
|
begin
|
|
exclude(aktlocalswitches,cs_ansistrings);
|
|
if changeinit then
|
|
exclude(initlocalswitches,cs_ansistrings);
|
|
end;
|
|
|
|
{ turn on bitpacking for mode macpas }
|
|
if (m_mac in aktmodeswitches) then
|
|
begin
|
|
include(aktlocalswitches,cs_bitpacking);
|
|
if changeinit then
|
|
include(initlocalswitches,cs_bitpacking);
|
|
end;
|
|
|
|
{ support goto/label by default in delphi/tp7/mac modes }
|
|
if ([m_delphi,m_tp7,m_mac] * aktmodeswitches <> []) then
|
|
begin
|
|
include(aktmoduleswitches,cs_support_goto);
|
|
if changeinit then
|
|
include(initmoduleswitches,cs_support_goto);
|
|
end;
|
|
|
|
{ Default enum packing for delphi/tp7 }
|
|
if (m_tp7 in aktmodeswitches) or
|
|
(m_delphi in aktmodeswitches) then
|
|
aktpackenum:=1
|
|
else if (m_mac in aktmodeswitches) then
|
|
{ compatible with Metrowerks Pascal }
|
|
aktpackenum:=2
|
|
else
|
|
aktpackenum:=4;
|
|
if changeinit then
|
|
initpackenum:=aktpackenum;
|
|
{$ifdef i386}
|
|
{ Default to intel assembler for delphi/tp7 on i386 }
|
|
if (m_delphi in aktmodeswitches) or
|
|
(m_tp7 in aktmodeswitches) then
|
|
aktasmmode:=asmmode_i386_intel;
|
|
if changeinit then
|
|
initasmmode:=aktasmmode;
|
|
{$endif i386}
|
|
|
|
{ Undefine old symbol }
|
|
if (m_delphi in oldaktmodeswitches) then
|
|
undef_system_macro('FPC_DELPHI')
|
|
else if (m_tp7 in oldaktmodeswitches) then
|
|
undef_system_macro('FPC_TP')
|
|
else if (m_objfpc in oldaktmodeswitches) then
|
|
undef_system_macro('FPC_OBJFPC')
|
|
else if (m_gpc in oldaktmodeswitches) then
|
|
undef_system_macro('FPC_GPC')
|
|
else if (m_mac in oldaktmodeswitches) then
|
|
undef_system_macro('FPC_MACPAS');
|
|
|
|
{ define new symbol in delphi,objfpc,tp,gpc,macpas mode }
|
|
if (m_delphi in aktmodeswitches) then
|
|
def_system_macro('FPC_DELPHI')
|
|
else if (m_tp7 in aktmodeswitches) then
|
|
def_system_macro('FPC_TP')
|
|
else if (m_objfpc in aktmodeswitches) then
|
|
def_system_macro('FPC_OBJFPC')
|
|
else if (m_gpc in aktmodeswitches) then
|
|
def_system_macro('FPC_GPC')
|
|
else if (m_mac in aktmodeswitches) then
|
|
def_system_macro('FPC_MACPAS');
|
|
end;
|
|
|
|
SetCompileMode:=b;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
Conditional Directives
|
|
*****************************************************************************}
|
|
|
|
procedure dir_else;
|
|
begin
|
|
current_scanner.elsepreprocstack;
|
|
end;
|
|
|
|
|
|
procedure dir_endif;
|
|
begin
|
|
current_scanner.poppreprocstack;
|
|
end;
|
|
|
|
function isdef(var valuedescr: String): Boolean;
|
|
var
|
|
hs : string;
|
|
mac : tmacro;
|
|
begin
|
|
current_scanner.skipspace;
|
|
hs:=current_scanner.readid;
|
|
valuedescr:= hs;
|
|
if hs='' then
|
|
Message(scan_e_error_in_preproc_expr);
|
|
mac:=tmacro(search_macro(hs));
|
|
if assigned(mac) then
|
|
mac.is_used:=true;
|
|
isdef:= assigned(mac) and mac.defined;
|
|
end;
|
|
|
|
procedure dir_ifdef;
|
|
begin
|
|
current_scanner.ifpreprocstack(pp_ifdef,@isdef,scan_c_ifdef_found);
|
|
end;
|
|
|
|
function isnotdef(var valuedescr: String): Boolean;
|
|
var
|
|
hs : string;
|
|
mac : tmacro;
|
|
begin
|
|
current_scanner.skipspace;
|
|
hs:=current_scanner.readid;
|
|
valuedescr:= hs;
|
|
if hs='' then
|
|
Message(scan_e_error_in_preproc_expr);
|
|
mac:=tmacro(search_macro(hs));
|
|
if assigned(mac) then
|
|
mac.is_used:=true;
|
|
isnotdef:= not (assigned(mac) and mac.defined);
|
|
end;
|
|
|
|
procedure dir_ifndef;
|
|
begin
|
|
current_scanner.ifpreprocstack(pp_ifndef,@isnotdef,scan_c_ifndef_found);
|
|
end;
|
|
|
|
function opt_check(var valuedescr: String): Boolean;
|
|
var
|
|
hs : string;
|
|
state : char;
|
|
begin
|
|
opt_check:= false;
|
|
current_scanner.skipspace;
|
|
hs:=current_scanner.readid;
|
|
valuedescr:= hs;
|
|
if (length(hs)>1) then
|
|
Message1(scan_w_illegal_switch,hs)
|
|
else
|
|
begin
|
|
state:=current_scanner.ReadState;
|
|
if state in ['-','+'] then
|
|
opt_check:=CheckSwitch(hs[1],state)
|
|
else
|
|
Message(scan_e_error_in_preproc_expr);
|
|
end;
|
|
end;
|
|
|
|
procedure dir_ifopt;
|
|
begin
|
|
current_scanner.ifpreprocstack(pp_ifopt,@opt_check,scan_c_ifopt_found);
|
|
end;
|
|
|
|
procedure dir_libprefix;
|
|
var
|
|
s : string;
|
|
begin
|
|
current_scanner.skipspace;
|
|
if c <> '''' then
|
|
Message2(scan_f_syn_expected, '''', c);
|
|
s := current_scanner.readquotedstring;
|
|
stringdispose(outputprefix);
|
|
outputprefix := stringdup(s);
|
|
with current_module do
|
|
setfilename(paramfn^, paramallowoutput);
|
|
end;
|
|
|
|
procedure dir_libsuffix;
|
|
var
|
|
s : string;
|
|
begin
|
|
current_scanner.skipspace;
|
|
if c <> '''' then
|
|
Message2(scan_f_syn_expected, '''', c);
|
|
s := current_scanner.readquotedstring;
|
|
stringdispose(outputsuffix);
|
|
outputsuffix := stringdup(s);
|
|
with current_module do
|
|
setfilename(paramfn^, paramallowoutput);
|
|
end;
|
|
|
|
procedure dir_extension;
|
|
var
|
|
s : string;
|
|
begin
|
|
current_scanner.skipspace;
|
|
if c <> '''' then
|
|
Message2(scan_f_syn_expected, '''', c);
|
|
s := current_scanner.readquotedstring;
|
|
outputextension := '.'+s;
|
|
with current_module do
|
|
setfilename(paramfn^, paramallowoutput);
|
|
end;
|
|
|
|
{
|
|
Compile time expression type check
|
|
----------------------------------
|
|
Each subexpression returns its type to the caller, which then can
|
|
do type check. Since data types of compile time expressions is
|
|
not well defined, the type system does a best effort. The drawback is
|
|
that some errors might not be detected.
|
|
|
|
Instead of returning a particular data type, a set of possible data types
|
|
are returned. This way ambigouos types can be handled. For instance a
|
|
value of 1 can be both a boolean and and integer.
|
|
|
|
Booleans
|
|
--------
|
|
|
|
The following forms of boolean values are supported:
|
|
* C coded, that is 0 is false, non-zero is true.
|
|
* TRUE/FALSE for mac style compile time variables
|
|
|
|
Thus boolean mac compile time variables are always stored as TRUE/FALSE.
|
|
When a compile time expression is evaluated, they are then translated
|
|
to C coded booleans (0/1), to simplify for the expression evaluator.
|
|
|
|
Note that this scheme then also of support mac compile time variables which
|
|
are 0/1 but with a boolean meaning.
|
|
|
|
The TRUE/FALSE format is new from 22 august 2005, but the above scheme
|
|
means that units which is not recompiled, and thus stores
|
|
compile time variables as the old format (0/1), continue to work.
|
|
|
|
Short circuit evaluation
|
|
------------------------
|
|
For this to work, the part of a compile time expression which is short
|
|
circuited, should not be evaluated, while it still should be parsed.
|
|
Therefor there is a parameter eval, telling whether evaluation is needed.
|
|
In case not, the value returned can be arbitrary.
|
|
}
|
|
|
|
type
|
|
{Compile time expression types}
|
|
TCTEType = (ctetBoolean, ctetInteger, ctetString, ctetSet);
|
|
TCTETypeSet = set of TCTEType;
|
|
|
|
const
|
|
cteTypeNames : array[TCTEType] of string[10] = (
|
|
'BOOLEAN','INTEGER','STRING','SET');
|
|
|
|
{Subset of types which can be elements in sets.}
|
|
setElementTypes = [ctetBoolean, ctetInteger, ctetString];
|
|
|
|
|
|
function GetCTETypeName(t: TCTETypeSet): String;
|
|
var
|
|
i: TCTEType;
|
|
begin
|
|
result:= '';
|
|
for i:= Low(TCTEType) to High(TCTEType) do
|
|
if i in t then
|
|
if result = '' then
|
|
result:= cteTypeNames[i]
|
|
else
|
|
result:= result + ' or ' + cteTypeNames[i];
|
|
end;
|
|
|
|
procedure CTEError(actType, desiredExprType: TCTETypeSet; place: String);
|
|
|
|
begin
|
|
Message3(scan_e_compile_time_typeerror,
|
|
GetCTETypeName(desiredExprType),
|
|
GetCTETypeName(actType),
|
|
place
|
|
);
|
|
end;
|
|
|
|
function parse_compiler_expr(var compileExprType: TCTETypeSet):string;
|
|
|
|
function read_expr(var exprType: TCTETypeSet; eval : Boolean) : string; forward;
|
|
|
|
procedure preproc_consume(t : ttoken);
|
|
begin
|
|
if t<>current_scanner.preproc_token then
|
|
Message(scan_e_preproc_syntax_error);
|
|
current_scanner.preproc_token:=current_scanner.readpreproc;
|
|
end;
|
|
|
|
function preproc_substitutedtoken(var macroType: TCTETypeSet; eval : Boolean): string;
|
|
{ Currently this parses identifiers as well as numbers.
|
|
The result from this procedure can either be that the token
|
|
itself is a value, or that it is a compile time variable/macro,
|
|
which then is substituted for another value (for macros
|
|
recursivelly substituted).}
|
|
|
|
var
|
|
hs: string;
|
|
mac : tmacro;
|
|
macrocount,
|
|
len : integer;
|
|
numres : longint;
|
|
w: word;
|
|
begin
|
|
result := current_scanner.preproc_pattern;
|
|
if not eval then
|
|
exit;
|
|
|
|
mac:= nil;
|
|
{ Substitue macros and compiler variables with their content/value.
|
|
For real macros also do recursive substitution. }
|
|
macrocount:=0;
|
|
repeat
|
|
mac:=tmacro(search_macro(result));
|
|
|
|
inc(macrocount);
|
|
if macrocount>max_macro_nesting then
|
|
begin
|
|
Message(scan_w_macro_too_deep);
|
|
break;
|
|
end;
|
|
|
|
if assigned(mac) and mac.defined then
|
|
if assigned(mac.buftext) then
|
|
begin
|
|
if mac.buflen>255 then
|
|
begin
|
|
len:=255;
|
|
Message(scan_w_macro_cut_after_255_chars);
|
|
end
|
|
else
|
|
len:=mac.buflen;
|
|
hs[0]:=char(len);
|
|
move(mac.buftext^,hs[1],len);
|
|
result:=upcase(hs);
|
|
mac.is_used:=true;
|
|
end
|
|
else
|
|
begin
|
|
Message1(scan_e_error_macro_lacks_value, result);
|
|
break;
|
|
end
|
|
else
|
|
begin
|
|
break;
|
|
end;
|
|
|
|
if mac.is_compiler_var then
|
|
break;
|
|
until false;
|
|
|
|
{ At this point, result do contain the value. Do some decoding and
|
|
determine the type.}
|
|
val(result,numres,w);
|
|
if (w=0) then {It is an integer}
|
|
begin
|
|
if (numres = 0) or (numres = 1) then
|
|
macroType := [ctetInteger, ctetBoolean]
|
|
else
|
|
macroType := [ctetInteger];
|
|
end
|
|
else if assigned(mac) and (m_mac in aktmodeswitches) and (result='FALSE') then
|
|
begin
|
|
result:= '0';
|
|
macroType:= [ctetBoolean];
|
|
end
|
|
else if assigned(mac) and (m_mac in aktmodeswitches) and (result='TRUE') then
|
|
begin
|
|
result:= '1';
|
|
macroType:= [ctetBoolean];
|
|
end
|
|
else if (m_mac in aktmodeswitches) and
|
|
(not assigned(mac) or not mac.defined) and
|
|
(macrocount = 1) then
|
|
begin
|
|
{Errors in mode mac is issued here. For non macpas modes there is
|
|
more liberty, but the error will eventually be caught at a later stage.}
|
|
Message1(scan_e_error_macro_undefined, result);
|
|
macroType:= [ctetString]; {Just to have something}
|
|
end
|
|
else
|
|
macroType:= [ctetString];
|
|
end;
|
|
|
|
function read_factor(var factorType: TCTETypeSet; eval : Boolean) : string;
|
|
var
|
|
hs : string;
|
|
mac: tmacro;
|
|
srsym : tsym;
|
|
srsymtable : tsymtable;
|
|
l : longint;
|
|
w : integer;
|
|
hasKlammer: Boolean;
|
|
setElemType : TCTETypeSet;
|
|
|
|
begin
|
|
if current_scanner.preproc_token=_ID then
|
|
begin
|
|
if current_scanner.preproc_pattern='DEFINED' then
|
|
begin
|
|
factorType:= [ctetBoolean];
|
|
preproc_consume(_ID);
|
|
current_scanner.skipspace;
|
|
if current_scanner.preproc_token =_LKLAMMER then
|
|
begin
|
|
preproc_consume(_LKLAMMER);
|
|
current_scanner.skipspace;
|
|
hasKlammer:= true;
|
|
end
|
|
else if (m_mac in aktmodeswitches) then
|
|
hasKlammer:= false
|
|
else
|
|
Message(scan_e_error_in_preproc_expr);
|
|
|
|
if current_scanner.preproc_token =_ID then
|
|
begin
|
|
hs := current_scanner.preproc_pattern;
|
|
mac := tmacro(search_macro(hs));
|
|
if assigned(mac) and mac.defined then
|
|
begin
|
|
hs := '1';
|
|
mac.is_used:=true;
|
|
end
|
|
else
|
|
hs := '0';
|
|
read_factor := hs;
|
|
preproc_consume(_ID);
|
|
current_scanner.skipspace;
|
|
end
|
|
else
|
|
Message(scan_e_error_in_preproc_expr);
|
|
|
|
if hasKlammer then
|
|
if current_scanner.preproc_token =_RKLAMMER then
|
|
preproc_consume(_RKLAMMER)
|
|
else
|
|
Message(scan_e_error_in_preproc_expr);
|
|
end
|
|
else
|
|
if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='UNDEFINED') then
|
|
begin
|
|
factorType:= [ctetBoolean];
|
|
preproc_consume(_ID);
|
|
current_scanner.skipspace;
|
|
if current_scanner.preproc_token =_ID then
|
|
begin
|
|
hs := current_scanner.preproc_pattern;
|
|
mac := tmacro(search_macro(hs));
|
|
if assigned(mac) then
|
|
begin
|
|
hs := '0';
|
|
mac.is_used:=true;
|
|
end
|
|
else
|
|
hs := '1';
|
|
read_factor := hs;
|
|
preproc_consume(_ID);
|
|
current_scanner.skipspace;
|
|
end
|
|
else
|
|
Message(scan_e_error_in_preproc_expr);
|
|
end
|
|
else
|
|
if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='OPTION') then
|
|
begin
|
|
factorType:= [ctetBoolean];
|
|
preproc_consume(_ID);
|
|
current_scanner.skipspace;
|
|
if current_scanner.preproc_token =_LKLAMMER then
|
|
begin
|
|
preproc_consume(_LKLAMMER);
|
|
current_scanner.skipspace;
|
|
end
|
|
else
|
|
Message(scan_e_error_in_preproc_expr);
|
|
|
|
if not (current_scanner.preproc_token = _ID) then
|
|
Message(scan_e_error_in_preproc_expr);
|
|
|
|
hs:=current_scanner.preproc_pattern;
|
|
if (length(hs) > 1) then
|
|
{This is allowed in Metrowerks Pascal}
|
|
Message(scan_e_error_in_preproc_expr)
|
|
else
|
|
begin
|
|
if CheckSwitch(hs[1],'+') then
|
|
read_factor := '1'
|
|
else
|
|
read_factor := '0';
|
|
end;
|
|
|
|
preproc_consume(_ID);
|
|
current_scanner.skipspace;
|
|
if current_scanner.preproc_token =_RKLAMMER then
|
|
preproc_consume(_RKLAMMER)
|
|
else
|
|
Message(scan_e_error_in_preproc_expr);
|
|
end
|
|
else
|
|
if current_scanner.preproc_pattern='SIZEOF' then
|
|
begin
|
|
factorType:= [ctetInteger];
|
|
preproc_consume(_ID);
|
|
current_scanner.skipspace;
|
|
if current_scanner.preproc_token =_LKLAMMER then
|
|
begin
|
|
preproc_consume(_LKLAMMER);
|
|
current_scanner.skipspace;
|
|
end
|
|
else
|
|
Message(scan_e_preproc_syntax_error);
|
|
|
|
if eval then
|
|
if searchsym(current_scanner.preproc_pattern,srsym,srsymtable) then
|
|
begin
|
|
l:=0;
|
|
case srsym.typ of
|
|
globalvarsym,
|
|
localvarsym,
|
|
paravarsym :
|
|
l:=tabstractvarsym(srsym).getsize;
|
|
typedconstsym :
|
|
l:=ttypedconstsym(srsym).getsize;
|
|
typesym:
|
|
l:=ttypesym(srsym).restype.def.size;
|
|
else
|
|
Message(scan_e_error_in_preproc_expr);
|
|
end;
|
|
str(l,read_factor);
|
|
end
|
|
else
|
|
Message1(sym_e_id_not_found,current_scanner.preproc_pattern);
|
|
|
|
preproc_consume(_ID);
|
|
current_scanner.skipspace;
|
|
|
|
if current_scanner.preproc_token =_RKLAMMER then
|
|
preproc_consume(_RKLAMMER)
|
|
else
|
|
Message(scan_e_preproc_syntax_error);
|
|
end
|
|
else
|
|
if current_scanner.preproc_pattern='DECLARED' then
|
|
begin
|
|
factorType:= [ctetBoolean];
|
|
preproc_consume(_ID);
|
|
current_scanner.skipspace;
|
|
if current_scanner.preproc_token =_LKLAMMER then
|
|
begin
|
|
preproc_consume(_LKLAMMER);
|
|
current_scanner.skipspace;
|
|
end
|
|
else
|
|
Message(scan_e_error_in_preproc_expr);
|
|
if current_scanner.preproc_token =_ID then
|
|
begin
|
|
hs := upper(current_scanner.preproc_pattern);
|
|
if searchsym(hs,srsym,srsymtable) then
|
|
hs := '1'
|
|
else
|
|
hs := '0';
|
|
read_factor := hs;
|
|
preproc_consume(_ID);
|
|
current_scanner.skipspace;
|
|
end
|
|
else
|
|
Message(scan_e_error_in_preproc_expr);
|
|
if current_scanner.preproc_token =_RKLAMMER then
|
|
preproc_consume(_RKLAMMER)
|
|
else
|
|
Message(scan_e_error_in_preproc_expr);
|
|
end
|
|
else
|
|
if current_scanner.preproc_pattern='NOT' then
|
|
begin
|
|
factorType:= [ctetBoolean];
|
|
preproc_consume(_ID);
|
|
hs:=read_factor(factorType, eval);
|
|
if eval then
|
|
begin
|
|
if not (ctetBoolean in factorType) then
|
|
CTEError(factorType, [ctetBoolean], 'NOT');
|
|
val(hs,l,w);
|
|
if l<>0 then
|
|
read_factor:='0'
|
|
else
|
|
read_factor:='1';
|
|
end
|
|
else
|
|
read_factor:='0'; {Just to have something}
|
|
end
|
|
else
|
|
if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='TRUE') then
|
|
begin
|
|
factorType:= [ctetBoolean];
|
|
preproc_consume(_ID);
|
|
read_factor:='1';
|
|
end
|
|
else
|
|
if (m_mac in aktmodeswitches) and (current_scanner.preproc_pattern='FALSE') then
|
|
begin
|
|
factorType:= [ctetBoolean];
|
|
preproc_consume(_ID);
|
|
read_factor:='0';
|
|
end
|
|
else
|
|
begin
|
|
hs:=preproc_substitutedtoken(factorType, eval);
|
|
|
|
{ Default is to return the original symbol }
|
|
read_factor:=hs;
|
|
if eval and (m_delphi in aktmodeswitches) and (ctetString in factorType) then
|
|
if searchsym(current_scanner.preproc_pattern,srsym,srsymtable) then
|
|
begin
|
|
case srsym.typ of
|
|
constsym :
|
|
begin
|
|
with tconstsym(srsym) do
|
|
begin
|
|
case consttyp of
|
|
constord :
|
|
begin
|
|
case consttype.def.deftype of
|
|
orddef:
|
|
begin
|
|
if is_integer(consttype.def) then
|
|
begin
|
|
read_factor:=tostr(value.valueord);
|
|
factorType:= [ctetInteger];
|
|
end
|
|
else if is_boolean(consttype.def) then
|
|
begin
|
|
read_factor:=tostr(value.valueord);
|
|
factorType:= [ctetBoolean];
|
|
end
|
|
else if is_char(consttype.def) then
|
|
begin
|
|
read_factor:=chr(value.valueord);
|
|
factorType:= [ctetString];
|
|
end
|
|
end;
|
|
enumdef:
|
|
begin
|
|
read_factor:=tostr(value.valueord);
|
|
factorType:= [ctetInteger];
|
|
end;
|
|
end;
|
|
end;
|
|
conststring :
|
|
begin
|
|
read_factor := upper(pchar(value.valueptr));
|
|
factorType:= [ctetString];
|
|
end;
|
|
constset :
|
|
begin
|
|
hs:=',';
|
|
for l:=0 to 255 do
|
|
if l in pconstset(tconstsym(srsym).value.valueptr)^ then
|
|
hs:=hs+tostr(l)+',';
|
|
read_factor := hs;
|
|
factorType:= [ctetSet];
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
enumsym :
|
|
begin
|
|
read_factor:=tostr(tenumsym(srsym).value);
|
|
factorType:= [ctetInteger];
|
|
end;
|
|
end;
|
|
end;
|
|
preproc_consume(_ID);
|
|
current_scanner.skipspace;
|
|
end
|
|
end
|
|
else if current_scanner.preproc_token =_LKLAMMER then
|
|
begin
|
|
preproc_consume(_LKLAMMER);
|
|
read_factor:=read_expr(factorType, eval);
|
|
preproc_consume(_RKLAMMER);
|
|
end
|
|
else if current_scanner.preproc_token = _LECKKLAMMER then
|
|
begin
|
|
preproc_consume(_LECKKLAMMER);
|
|
read_factor := ',';
|
|
while current_scanner.preproc_token = _ID do
|
|
begin
|
|
read_factor := read_factor+read_factor(setElemType, eval)+',';
|
|
if current_scanner.preproc_token = _COMMA then
|
|
preproc_consume(_COMMA);
|
|
end;
|
|
// TODO Add check of setElemType
|
|
preproc_consume(_RECKKLAMMER);
|
|
factorType:= [ctetSet];
|
|
end
|
|
else
|
|
Message(scan_e_error_in_preproc_expr);
|
|
end;
|
|
|
|
function read_term(var termType: TCTETypeSet; eval : Boolean) : string;
|
|
var
|
|
hs1,hs2 : string;
|
|
l1,l2 : longint;
|
|
w : integer;
|
|
termType2: TCTETypeSet;
|
|
begin
|
|
hs1:=read_factor(termType, eval);
|
|
repeat
|
|
if (current_scanner.preproc_token<>_ID) then
|
|
break;
|
|
if current_scanner.preproc_pattern<>'AND' then
|
|
break;
|
|
|
|
val(hs1,l1,w);
|
|
if l1=0 then
|
|
eval:= false; {Short circuit evaluation of OR}
|
|
|
|
if eval then
|
|
begin
|
|
{Check if first expr is boolean. Must be done here, after we know
|
|
it is an AND expression.}
|
|
if not (ctetBoolean in termType) then
|
|
CTEError(termType, [ctetBoolean], 'AND');
|
|
termType:= [ctetBoolean];
|
|
end;
|
|
|
|
preproc_consume(_ID);
|
|
hs2:=read_factor(termType2, eval);
|
|
|
|
if eval then
|
|
begin
|
|
if not (ctetBoolean in termType2) then
|
|
CTEError(termType2, [ctetBoolean], 'AND');
|
|
|
|
val(hs2,l2,w);
|
|
if (l1<>0) and (l2<>0) then
|
|
hs1:='1'
|
|
else
|
|
hs1:='0';
|
|
end;
|
|
until false;
|
|
read_term:=hs1;
|
|
end;
|
|
|
|
|
|
function read_simple_expr(var simpleExprType: TCTETypeSet; eval : Boolean) : string;
|
|
var
|
|
hs1,hs2 : string;
|
|
l1,l2 : longint;
|
|
w : integer;
|
|
simpleExprType2: TCTETypeSet;
|
|
begin
|
|
hs1:=read_term(simpleExprType, eval);
|
|
repeat
|
|
if (current_scanner.preproc_token<>_ID) then
|
|
break;
|
|
if current_scanner.preproc_pattern<>'OR' then
|
|
break;
|
|
|
|
val(hs1,l1,w);
|
|
if l1<>0 then
|
|
eval:= false; {Short circuit evaluation of OR}
|
|
|
|
if eval then
|
|
begin
|
|
{Check if first expr is boolean. Must be done here, after we know
|
|
it is an OR expression.}
|
|
if not (ctetBoolean in simpleExprType) then
|
|
CTEError(simpleExprType, [ctetBoolean], 'OR');
|
|
simpleExprType:= [ctetBoolean];
|
|
end;
|
|
|
|
preproc_consume(_ID);
|
|
hs2:=read_term(simpleExprType2, eval);
|
|
|
|
if eval then
|
|
begin
|
|
if not (ctetBoolean in simpleExprType2) then
|
|
CTEError(simpleExprType2, [ctetBoolean], 'OR');
|
|
|
|
val(hs2,l2,w);
|
|
if (l1<>0) or (l2<>0) then
|
|
hs1:='1'
|
|
else
|
|
hs1:='0';
|
|
end;
|
|
until false;
|
|
read_simple_expr:=hs1;
|
|
end;
|
|
|
|
function read_expr(var exprType: TCTETypeSet; eval : Boolean) : string;
|
|
var
|
|
hs1,hs2 : string;
|
|
b : boolean;
|
|
op : ttoken;
|
|
w : integer;
|
|
l1,l2 : longint;
|
|
exprType2: TCTETypeSet;
|
|
begin
|
|
hs1:=read_simple_expr(exprType, eval);
|
|
op:=current_scanner.preproc_token;
|
|
if (op = _ID) and (current_scanner.preproc_pattern = 'IN') then
|
|
op := _IN;
|
|
if not (op in [_IN,_EQUAL,_UNEQUAL,_LT,_GT,_LTE,_GTE]) then
|
|
begin
|
|
read_expr:=hs1;
|
|
exit;
|
|
end;
|
|
|
|
if (op = _IN) then
|
|
preproc_consume(_ID)
|
|
else
|
|
preproc_consume(op);
|
|
hs2:=read_simple_expr(exprType2, eval);
|
|
|
|
if eval then
|
|
begin
|
|
if op = _IN then
|
|
begin
|
|
if exprType2 <> [ctetSet] then
|
|
CTEError(exprType2, [ctetSet], 'IN');
|
|
if exprType = [ctetSet] then
|
|
CTEError(exprType, setElementTypes, 'IN');
|
|
|
|
if is_number(hs1) and is_number(hs2) then
|
|
Message(scan_e_preproc_syntax_error)
|
|
else if hs2[1] = ',' then
|
|
b:=pos(','+hs1+',', hs2) > 0 { TODO For integer sets, perhaps check for numeric equivalence so that 0 = 00 }
|
|
else
|
|
Message(scan_e_preproc_syntax_error);
|
|
end
|
|
else
|
|
begin
|
|
if (exprType * exprType2) = [] then
|
|
CTEError(exprType2, exprType, tokeninfo^[op].str);
|
|
|
|
if is_number(hs1) and is_number(hs2) then
|
|
begin
|
|
val(hs1,l1,w);
|
|
val(hs2,l2,w);
|
|
case op of
|
|
_EQUAL :
|
|
b:=l1=l2;
|
|
_UNEQUAL :
|
|
b:=l1<>l2;
|
|
_LT :
|
|
b:=l1<l2;
|
|
_GT :
|
|
b:=l1>l2;
|
|
_GTE :
|
|
b:=l1>=l2;
|
|
_LTE :
|
|
b:=l1<=l2;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
case op of
|
|
_EQUAL :
|
|
b:=hs1=hs2;
|
|
_UNEQUAL :
|
|
b:=hs1<>hs2;
|
|
_LT :
|
|
b:=hs1<hs2;
|
|
_GT :
|
|
b:=hs1>hs2;
|
|
_GTE :
|
|
b:=hs1>=hs2;
|
|
_LTE :
|
|
b:=hs1<=hs2;
|
|
end;
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
b:= false; {Just to have something}
|
|
|
|
if b then
|
|
read_expr:='1'
|
|
else
|
|
read_expr:='0';
|
|
exprType:= [ctetBoolean];
|
|
end;
|
|
|
|
begin
|
|
current_scanner.skipspace;
|
|
{ start preproc expression scanner }
|
|
current_scanner.preproc_token:=current_scanner.readpreproc;
|
|
parse_compiler_expr:=read_expr(compileExprType, true);
|
|
end;
|
|
|
|
function boolean_compile_time_expr(var valuedescr: String): Boolean;
|
|
var
|
|
hs : string;
|
|
exprType: TCTETypeSet;
|
|
begin
|
|
hs:=parse_compiler_expr(exprType);
|
|
if (exprType * [ctetBoolean]) = [] then
|
|
CTEError(exprType, [ctetBoolean], 'IF or ELSEIF');
|
|
boolean_compile_time_expr:= hs <> '0';
|
|
valuedescr:= hs;
|
|
end;
|
|
|
|
procedure dir_if;
|
|
begin
|
|
current_scanner.ifpreprocstack(pp_if,@boolean_compile_time_expr, scan_c_if_found);
|
|
end;
|
|
|
|
procedure dir_elseif;
|
|
begin
|
|
current_scanner.elseifpreprocstack(@boolean_compile_time_expr);
|
|
end;
|
|
|
|
procedure dir_define_impl(macstyle: boolean);
|
|
var
|
|
hs : string;
|
|
bracketcount : longint;
|
|
mac : tmacro;
|
|
macropos : longint;
|
|
macrobuffer : pmacrobuffer;
|
|
begin
|
|
current_scanner.skipspace;
|
|
hs:=current_scanner.readid;
|
|
mac:=tmacro(search_macro(hs));
|
|
if not assigned(mac) or (mac.owner <> current_module.localmacrosymtable) then
|
|
begin
|
|
mac:=tmacro.create(hs);
|
|
mac.defined:=true;
|
|
Message1(parser_c_macro_defined,mac.name);
|
|
current_module.localmacrosymtable.insert(mac);
|
|
end
|
|
else
|
|
begin
|
|
Message1(parser_c_macro_defined,mac.name);
|
|
mac.defined:=true;
|
|
mac.is_compiler_var:=false;
|
|
{ delete old definition }
|
|
if assigned(mac.buftext) then
|
|
begin
|
|
freemem(mac.buftext,mac.buflen);
|
|
mac.buftext:=nil;
|
|
end;
|
|
end;
|
|
mac.is_used:=true;
|
|
if (cs_support_macro in aktmoduleswitches) then
|
|
begin
|
|
current_scanner.skipspace;
|
|
|
|
if not macstyle then
|
|
begin
|
|
{ may be a macro? }
|
|
if c <> ':' then
|
|
exit;
|
|
current_scanner.readchar;
|
|
if c <> '=' then
|
|
exit;
|
|
current_scanner.readchar;
|
|
current_scanner.skipspace;
|
|
end;
|
|
|
|
{ key words are never substituted }
|
|
if is_keyword(hs) then
|
|
Message(scan_e_keyword_cant_be_a_macro);
|
|
|
|
new(macrobuffer);
|
|
macropos:=0;
|
|
{ parse macro, brackets are counted so it's possible
|
|
to have a $ifdef etc. in the macro }
|
|
bracketcount:=0;
|
|
repeat
|
|
case c of
|
|
'}' :
|
|
if (bracketcount=0) then
|
|
break
|
|
else
|
|
dec(bracketcount);
|
|
'{' :
|
|
inc(bracketcount);
|
|
#10,#13 :
|
|
current_scanner.linebreak;
|
|
#26 :
|
|
current_scanner.end_of_file;
|
|
end;
|
|
macrobuffer^[macropos]:=c;
|
|
inc(macropos);
|
|
if macropos>=maxmacrolen then
|
|
Message(scan_f_macro_buffer_overflow);
|
|
current_scanner.readchar;
|
|
until false;
|
|
|
|
{ free buffer of macro ?}
|
|
if assigned(mac.buftext) then
|
|
freemem(mac.buftext,mac.buflen);
|
|
{ get new mem }
|
|
getmem(mac.buftext,macropos);
|
|
mac.buflen:=macropos;
|
|
{ copy the text }
|
|
move(macrobuffer^,mac.buftext^,macropos);
|
|
dispose(macrobuffer);
|
|
end
|
|
else
|
|
begin
|
|
{ check if there is an assignment, then we need to give a
|
|
warning }
|
|
current_scanner.skipspace;
|
|
if c=':' then
|
|
begin
|
|
current_scanner.readchar;
|
|
if c='=' then
|
|
Message(scan_w_macro_support_turned_off);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure dir_define;
|
|
begin
|
|
dir_define_impl(false);
|
|
end;
|
|
|
|
procedure dir_definec;
|
|
begin
|
|
dir_define_impl(true);
|
|
end;
|
|
|
|
procedure dir_setc;
|
|
var
|
|
hs : string;
|
|
mac : tmacro;
|
|
exprType: TCTETypeSet;
|
|
l : longint;
|
|
w : integer;
|
|
begin
|
|
current_scanner.skipspace;
|
|
hs:=current_scanner.readid;
|
|
mac:=tmacro(search_macro(hs));
|
|
if not assigned(mac) or
|
|
(mac.owner <> current_module.localmacrosymtable) then
|
|
begin
|
|
mac:=tmacro.create(hs);
|
|
mac.defined:=true;
|
|
mac.is_compiler_var:=true;
|
|
Message1(parser_c_macro_defined,mac.name);
|
|
current_module.localmacrosymtable.insert(mac);
|
|
end
|
|
else
|
|
begin
|
|
mac.defined:=true;
|
|
mac.is_compiler_var:=true;
|
|
{ delete old definition }
|
|
if assigned(mac.buftext) then
|
|
begin
|
|
freemem(mac.buftext,mac.buflen);
|
|
mac.buftext:=nil;
|
|
end;
|
|
end;
|
|
mac.is_used:=true;
|
|
|
|
{ key words are never substituted }
|
|
if is_keyword(hs) then
|
|
Message(scan_e_keyword_cant_be_a_macro);
|
|
|
|
{ macro assignment can be both := and = }
|
|
current_scanner.skipspace;
|
|
if c=':' then
|
|
current_scanner.readchar;
|
|
if c='=' then
|
|
begin
|
|
current_scanner.readchar;
|
|
hs:= parse_compiler_expr(exprType);
|
|
if (exprType * [ctetBoolean, ctetInteger]) = [] then
|
|
CTEError(exprType, [ctetBoolean, ctetInteger], 'SETC');
|
|
|
|
if length(hs) <> 0 then
|
|
begin
|
|
{If we are absolutely shure it is boolean, translate
|
|
to TRUE/FALSE to increase possibility to do future type check}
|
|
if exprType = [ctetBoolean] then
|
|
begin
|
|
val(hs,l,w);
|
|
if l<>0 then
|
|
hs:='TRUE'
|
|
else
|
|
hs:='FALSE';
|
|
end;
|
|
Message2(parser_c_macro_set_to,mac.name,hs);
|
|
{ free buffer of macro ?}
|
|
if assigned(mac.buftext) then
|
|
freemem(mac.buftext,mac.buflen);
|
|
{ get new mem }
|
|
getmem(mac.buftext,length(hs));
|
|
mac.buflen:=length(hs);
|
|
{ copy the text }
|
|
move(hs[1],mac.buftext^,mac.buflen);
|
|
end
|
|
else
|
|
Message(scan_e_preproc_syntax_error);
|
|
end
|
|
else
|
|
Message(scan_e_preproc_syntax_error);
|
|
end;
|
|
|
|
|
|
procedure dir_undef;
|
|
var
|
|
hs : string;
|
|
mac : tmacro;
|
|
begin
|
|
current_scanner.skipspace;
|
|
hs:=current_scanner.readid;
|
|
mac:=tmacro(search_macro(hs));
|
|
if not assigned(mac) or
|
|
(mac.owner <> current_module.localmacrosymtable) then
|
|
begin
|
|
mac:=tmacro.create(hs);
|
|
Message1(parser_c_macro_undefined,mac.name);
|
|
mac.defined:=false;
|
|
current_module.localmacrosymtable.insert(mac);
|
|
end
|
|
else
|
|
begin
|
|
Message1(parser_c_macro_undefined,mac.name);
|
|
mac.defined:=false;
|
|
mac.is_compiler_var:=false;
|
|
{ delete old definition }
|
|
if assigned(mac.buftext) then
|
|
begin
|
|
freemem(mac.buftext,mac.buflen);
|
|
mac.buftext:=nil;
|
|
end;
|
|
end;
|
|
mac.is_used:=true;
|
|
end;
|
|
|
|
procedure dir_include;
|
|
|
|
function findincludefile(const path,name,ext:string;var foundfile:string):boolean;
|
|
var
|
|
found : boolean;
|
|
hpath : string;
|
|
|
|
begin
|
|
(* look for the include file
|
|
If path was specified as part of {$I } then
|
|
1. specified path (expanded with path of inputfile if relative)
|
|
else
|
|
1. path of current inputfile,current dir
|
|
2. local includepath
|
|
3. global includepath *)
|
|
found:=false;
|
|
foundfile:='';
|
|
hpath:='';
|
|
if path<>'' then
|
|
begin
|
|
if not path_absolute(path) then
|
|
hpath:=current_scanner.inputfile.path^+path
|
|
else
|
|
hpath:=path;
|
|
found:=FindFile(name+ext, hpath,foundfile);
|
|
end
|
|
else
|
|
begin
|
|
hpath:=current_scanner.inputfile.path^+';'+CurDirRelPath(source_info);
|
|
found:=FindFile(name+ext, hpath,foundfile);
|
|
if not found then
|
|
found:=current_module.localincludesearchpath.FindFile(name+ext,foundfile);
|
|
if not found then
|
|
found:=includesearchpath.FindFile(name+ext,foundfile);
|
|
end;
|
|
findincludefile:=found;
|
|
end;
|
|
|
|
|
|
var
|
|
args,
|
|
foundfile,
|
|
hs : string;
|
|
path : dirstr;
|
|
name : namestr;
|
|
ext : extstr;
|
|
hp : tinputfile;
|
|
found : boolean;
|
|
begin
|
|
current_scanner.skipspace;
|
|
args:=current_scanner.readcomment;
|
|
hs:=GetToken(args,' ');
|
|
if hs='' then
|
|
exit;
|
|
if (hs[1]='%') then
|
|
begin
|
|
{ case insensitive }
|
|
hs:=upper(hs);
|
|
{ remove %'s }
|
|
Delete(hs,1,1);
|
|
if hs[length(hs)]='%' then
|
|
Delete(hs,length(hs),1);
|
|
{ save old }
|
|
path:=hs;
|
|
{ first check for internal macros }
|
|
if hs='TIME' then
|
|
hs:=gettimestr
|
|
else
|
|
if hs='DATE' then
|
|
hs:=getdatestr
|
|
else
|
|
if hs='FILE' then
|
|
hs:=current_module.sourcefiles.get_file_name(aktfilepos.fileindex)
|
|
else
|
|
if hs='LINE' then
|
|
hs:=tostr(aktfilepos.line)
|
|
else
|
|
if hs='FPCVERSION' then
|
|
hs:=version_string
|
|
else
|
|
if hs='FPCDATE' then
|
|
hs:=date_string
|
|
else
|
|
if hs='FPCTARGET' then
|
|
hs:=target_cpu_string
|
|
else
|
|
if hs='FPCTARGETCPU' then
|
|
hs:=target_cpu_string
|
|
else
|
|
if hs='FPCTARGETOS' then
|
|
hs:=target_info.shortname
|
|
else
|
|
hs:=getenv(hs);
|
|
if hs='' then
|
|
Message1(scan_w_include_env_not_found,path);
|
|
{ make it a stringconst }
|
|
hs:=''''+hs+'''';
|
|
current_scanner.insertmacro(path,@hs[1],length(hs),
|
|
current_scanner.line_no,current_scanner.inputfile.ref_index);
|
|
end
|
|
else
|
|
begin
|
|
hs:=FixFileName(hs);
|
|
fsplit(hs,path,name,ext);
|
|
{ try to find the file }
|
|
found:=findincludefile(path,name,ext,foundfile);
|
|
if (ext='') then
|
|
begin
|
|
{ try default extensions .inc , .pp and .pas }
|
|
if (not found) then
|
|
found:=findincludefile(path,name,'.inc',foundfile);
|
|
if (not found) then
|
|
found:=findincludefile(path,name,sourceext,foundfile);
|
|
if (not found) then
|
|
found:=findincludefile(path,name,pasext,foundfile);
|
|
end;
|
|
if current_scanner.inputfilecount<max_include_nesting then
|
|
begin
|
|
inc(current_scanner.inputfilecount);
|
|
{ we need to reread the current char }
|
|
dec(current_scanner.inputpointer);
|
|
{ shutdown current file }
|
|
current_scanner.tempcloseinputfile;
|
|
{ load new file }
|
|
hp:=do_openinputfile(foundfile);
|
|
current_scanner.addfile(hp);
|
|
current_module.sourcefiles.register_file(hp);
|
|
if (not found) then
|
|
Message1(scan_f_cannot_open_includefile,hs);
|
|
if (not current_scanner.openinputfile) then
|
|
Message1(scan_f_cannot_open_includefile,hs);
|
|
Message1(scan_t_start_include_file,current_scanner.inputfile.path^+current_scanner.inputfile.name^);
|
|
current_scanner.reload;
|
|
end
|
|
else
|
|
Message(scan_f_include_deep_ten);
|
|
end;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
Preprocessor writting
|
|
*****************************************************************************}
|
|
|
|
{$ifdef PREPROCWRITE}
|
|
constructor tpreprocfile.create(const fn:string);
|
|
begin
|
|
{ open outputfile }
|
|
assign(f,fn);
|
|
{$I-}
|
|
rewrite(f);
|
|
{$I+}
|
|
if ioresult<>0 then
|
|
Comment(V_Fatal,'can''t create file '+fn);
|
|
getmem(buf,preprocbufsize);
|
|
settextbuf(f,buf^,preprocbufsize);
|
|
{ reset }
|
|
eolfound:=false;
|
|
spacefound:=false;
|
|
end;
|
|
|
|
|
|
destructor tpreprocfile.destroy;
|
|
begin
|
|
close(f);
|
|
freemem(buf,preprocbufsize);
|
|
end;
|
|
|
|
|
|
procedure tpreprocfile.add(const s:string);
|
|
begin
|
|
write(f,s);
|
|
end;
|
|
|
|
procedure tpreprocfile.addspace;
|
|
begin
|
|
if eolfound then
|
|
begin
|
|
writeln(f,'');
|
|
eolfound:=false;
|
|
spacefound:=false;
|
|
end
|
|
else
|
|
if spacefound then
|
|
begin
|
|
write(f,' ');
|
|
spacefound:=false;
|
|
end;
|
|
end;
|
|
{$endif PREPROCWRITE}
|
|
|
|
|
|
{*****************************************************************************
|
|
TPreProcStack
|
|
*****************************************************************************}
|
|
|
|
constructor tpreprocstack.create(atyp : preproctyp;a:boolean;n:tpreprocstack);
|
|
begin
|
|
accept:=a;
|
|
typ:=atyp;
|
|
next:=n;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
TDirectiveItem
|
|
*****************************************************************************}
|
|
|
|
constructor TDirectiveItem.Create(const n:string;p:tdirectiveproc);
|
|
begin
|
|
inherited CreateName(n);
|
|
is_conditional:=false;
|
|
proc:=p;
|
|
end;
|
|
|
|
|
|
constructor TDirectiveItem.CreateCond(const n:string;p:tdirectiveproc);
|
|
begin
|
|
inherited CreateName(n);
|
|
is_conditional:=true;
|
|
proc:=p;
|
|
end;
|
|
|
|
{****************************************************************************
|
|
TSCANNERFILE
|
|
****************************************************************************}
|
|
|
|
constructor tscannerfile.create(const fn:string);
|
|
begin
|
|
inputfile:=do_openinputfile(fn);
|
|
if assigned(current_module) then
|
|
current_module.sourcefiles.register_file(inputfile);
|
|
{ reset localinput }
|
|
inputbuffer:=nil;
|
|
inputpointer:=nil;
|
|
inputstart:=0;
|
|
{ reset scanner }
|
|
preprocstack:=nil;
|
|
comment_level:=0;
|
|
yylexcount:=0;
|
|
block_type:=bt_general;
|
|
line_no:=0;
|
|
lastlinepos:=0;
|
|
lasttokenpos:=0;
|
|
lasttoken:=NOTOKEN;
|
|
nexttoken:=NOTOKEN;
|
|
lastasmgetchar:=#0;
|
|
ignoredirectives:=TStringList.Create;
|
|
in_asm_string:=false;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.firstfile;
|
|
begin
|
|
{ load block }
|
|
if not openinputfile then
|
|
Message1(scan_f_cannot_open_input,inputfile.name^);
|
|
reload;
|
|
end;
|
|
|
|
|
|
destructor tscannerfile.destroy;
|
|
begin
|
|
if assigned(current_module) and
|
|
(current_module.state=ms_compiled) and
|
|
(status.errorcount=0) then
|
|
checkpreprocstack
|
|
else
|
|
begin
|
|
while assigned(preprocstack) do
|
|
poppreprocstack;
|
|
end;
|
|
if not inputfile.closed then
|
|
closeinputfile;
|
|
ignoredirectives.free;
|
|
end;
|
|
|
|
|
|
function tscannerfile.openinputfile:boolean;
|
|
begin
|
|
openinputfile:=inputfile.open;
|
|
{ load buffer }
|
|
inputbuffer:=inputfile.buf;
|
|
inputpointer:=inputfile.buf;
|
|
inputstart:=inputfile.bufstart;
|
|
{ line }
|
|
line_no:=0;
|
|
lastlinepos:=0;
|
|
lasttokenpos:=0;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.closeinputfile;
|
|
begin
|
|
inputfile.close;
|
|
{ reset buffer }
|
|
inputbuffer:=nil;
|
|
inputpointer:=nil;
|
|
inputstart:=0;
|
|
{ reset line }
|
|
line_no:=0;
|
|
lastlinepos:=0;
|
|
lasttokenpos:=0;
|
|
end;
|
|
|
|
|
|
function tscannerfile.tempopeninputfile:boolean;
|
|
begin
|
|
if inputfile.is_macro then
|
|
exit;
|
|
tempopeninputfile:=inputfile.tempopen;
|
|
{ reload buffer }
|
|
inputbuffer:=inputfile.buf;
|
|
inputpointer:=inputfile.buf;
|
|
inputstart:=inputfile.bufstart;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.tempcloseinputfile;
|
|
begin
|
|
if inputfile.closed or inputfile.is_macro then
|
|
exit;
|
|
inputfile.setpos(inputstart+(inputpointer-inputbuffer));
|
|
inputfile.tempclose;
|
|
{ reset buffer }
|
|
inputbuffer:=nil;
|
|
inputpointer:=nil;
|
|
inputstart:=0;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.saveinputfile;
|
|
begin
|
|
inputfile.saveinputpointer:=inputpointer;
|
|
inputfile.savelastlinepos:=lastlinepos;
|
|
inputfile.saveline_no:=line_no;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.restoreinputfile;
|
|
begin
|
|
inputpointer:=inputfile.saveinputpointer;
|
|
lastlinepos:=inputfile.savelastlinepos;
|
|
line_no:=inputfile.saveline_no;
|
|
if not inputfile.is_macro then
|
|
parser_current_file:=inputfile.name^;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.nextfile;
|
|
var
|
|
to_dispose : tinputfile;
|
|
begin
|
|
if assigned(inputfile.next) then
|
|
begin
|
|
if inputfile.is_macro then
|
|
to_dispose:=inputfile
|
|
else
|
|
begin
|
|
to_dispose:=nil;
|
|
dec(inputfilecount);
|
|
end;
|
|
{ we can allways close the file, no ? }
|
|
inputfile.close;
|
|
inputfile:=inputfile.next;
|
|
if assigned(to_dispose) then
|
|
to_dispose.free;
|
|
restoreinputfile;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.startrecordtokens(buf:tdynamicarray);
|
|
begin
|
|
if not assigned(buf) then
|
|
internalerror(200511172);
|
|
if assigned(recordtokenbuf) then
|
|
internalerror(200511173);
|
|
recordtokenbuf:=buf;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.stoprecordtokens;
|
|
begin
|
|
if not assigned(recordtokenbuf) then
|
|
internalerror(200511174);
|
|
recordtokenbuf:=nil;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.recordtoken;
|
|
begin
|
|
if not assigned(recordtokenbuf) then
|
|
internalerror(200511176);
|
|
recordtokenbuf.write(token,1);
|
|
if token=_ID then
|
|
recordtokenbuf.write(idtoken,1);
|
|
case token of
|
|
_CWCHAR,
|
|
_CWSTRING :
|
|
begin
|
|
recordtokenbuf.write(patternw^.len,sizeof(sizeint));
|
|
recordtokenbuf.write(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
|
|
end;
|
|
_CCHAR,
|
|
_CSTRING,
|
|
_INTCONST,
|
|
_REALNUMBER :
|
|
begin
|
|
recordtokenbuf.write(pattern[0],1);
|
|
recordtokenbuf.write(pattern[1],length(pattern));
|
|
end;
|
|
_ID :
|
|
begin
|
|
recordtokenbuf.write(orgpattern[0],1);
|
|
recordtokenbuf.write(orgpattern[1],length(orgpattern));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.startreplaytokens(buf:tdynamicarray);
|
|
begin
|
|
if not assigned(buf) then
|
|
internalerror(200511175);
|
|
{ save current token }
|
|
if token in [_CWCHAR,_CWSTRING,_CCHAR,_CSTRING,_INTCONST,_REALNUMBER,_ID] then
|
|
internalerror(200511178);
|
|
replaysavetoken:=token;
|
|
dec(inputpointer);
|
|
{ install buffer }
|
|
replaytokenbuf:=buf;
|
|
{ reload next token }
|
|
replaytokenbuf.seek(0);
|
|
replaytoken;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.replaytoken;
|
|
var
|
|
wlen : sizeint;
|
|
begin
|
|
if not assigned(replaytokenbuf) then
|
|
internalerror(200511177);
|
|
{ End of replay buffer? Then load the next char from the file again }
|
|
if replaytokenbuf.pos>=replaytokenbuf.size then
|
|
begin
|
|
replaytokenbuf:=nil;
|
|
c:=inputpointer^;
|
|
inc(inputpointer);
|
|
token:=replaysavetoken;
|
|
exit;
|
|
end;
|
|
{ load token from the buffer }
|
|
replaytokenbuf.read(token,1);
|
|
if token=_ID then
|
|
replaytokenbuf.read(idtoken,1);
|
|
case token of
|
|
_CWCHAR,
|
|
_CWSTRING :
|
|
begin
|
|
replaytokenbuf.read(wlen,sizeof(SizeInt));
|
|
setlengthwidestring(patternw,wlen);
|
|
replaytokenbuf.read(patternw^.data^,patternw^.len*sizeof(tcompilerwidechar));
|
|
pattern:='';
|
|
end;
|
|
_CCHAR,
|
|
_CSTRING,
|
|
_INTCONST,
|
|
_REALNUMBER :
|
|
begin
|
|
replaytokenbuf.read(pattern[0],1);
|
|
replaytokenbuf.read(pattern[1],length(pattern));
|
|
orgpattern:='';
|
|
end;
|
|
_ID :
|
|
begin
|
|
replaytokenbuf.read(orgpattern[0],1);
|
|
replaytokenbuf.read(orgpattern[1],length(orgpattern));
|
|
pattern:=upper(orgpattern);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.addfile(hp:tinputfile);
|
|
begin
|
|
saveinputfile;
|
|
{ add to list }
|
|
hp.next:=inputfile;
|
|
inputfile:=hp;
|
|
{ load new inputfile }
|
|
restoreinputfile;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.reload;
|
|
begin
|
|
with inputfile do
|
|
begin
|
|
{ when nothing more to read then leave immediatly, so we
|
|
don't change the aktfilepos and leave it point to the last
|
|
char }
|
|
if (c=#26) and (not assigned(next)) then
|
|
exit;
|
|
repeat
|
|
{ still more to read?, then change the #0 to a space so its seen
|
|
as a seperator, this can't be used for macro's which can change
|
|
the place of the #0 in the buffer with tempopen }
|
|
if (c=#0) and (bufsize>0) and
|
|
not(inputfile.is_macro) and
|
|
(inputpointer-inputbuffer<bufsize) then
|
|
begin
|
|
c:=' ';
|
|
inc(inputpointer);
|
|
exit;
|
|
end;
|
|
{ can we read more from this file ? }
|
|
if (c<>#26) and (not endoffile) then
|
|
begin
|
|
readbuf;
|
|
inputpointer:=buf;
|
|
inputbuffer:=buf;
|
|
inputstart:=bufstart;
|
|
{ first line? }
|
|
if line_no=0 then
|
|
begin
|
|
c:=inputpointer^;
|
|
{ eat utf-8 signature? }
|
|
if (ord(inputpointer^)=$ef) and
|
|
(ord((inputpointer+1)^)=$bb) and
|
|
(ord((inputpointer+2)^)=$bf) then
|
|
begin
|
|
inc(inputpointer,3);
|
|
message(scan_c_switching_to_utf8);
|
|
aktsourcecodepage:='utf8';
|
|
end;
|
|
|
|
line_no:=1;
|
|
if cs_asm_source in aktglobalswitches then
|
|
inputfile.setline(line_no,bufstart);
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
{ load eof position in tokenpos/aktfilepos }
|
|
gettokenpos;
|
|
{ close file }
|
|
closeinputfile;
|
|
{ no next module, than EOF }
|
|
if not assigned(inputfile.next) then
|
|
begin
|
|
c:=#26;
|
|
exit;
|
|
end;
|
|
{ load next file and reopen it }
|
|
nextfile;
|
|
tempopeninputfile;
|
|
{ status }
|
|
Message1(scan_t_back_in,inputfile.name^);
|
|
end;
|
|
{ load next char }
|
|
c:=inputpointer^;
|
|
inc(inputpointer);
|
|
until c<>#0; { if also end, then reload again }
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.insertmacro(const macname:string;p:pchar;len,line,fileindex:longint);
|
|
var
|
|
hp : tinputfile;
|
|
begin
|
|
{ save old postion }
|
|
dec(inputpointer);
|
|
tempcloseinputfile;
|
|
{ create macro 'file' }
|
|
{ use special name to dispose after !! }
|
|
hp:=do_openinputfile('_Macro_.'+macname);
|
|
addfile(hp);
|
|
with inputfile do
|
|
begin
|
|
setmacro(p,len);
|
|
{ local buffer }
|
|
inputbuffer:=buf;
|
|
inputpointer:=buf;
|
|
inputstart:=bufstart;
|
|
ref_index:=fileindex;
|
|
end;
|
|
{ reset line }
|
|
line_no:=line;
|
|
lastlinepos:=0;
|
|
lasttokenpos:=0;
|
|
{ load new c }
|
|
c:=inputpointer^;
|
|
inc(inputpointer);
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.gettokenpos;
|
|
{ load the values of tokenpos and lasttokenpos }
|
|
begin
|
|
lasttokenpos:=inputstart+(inputpointer-inputbuffer);
|
|
akttokenpos.line:=line_no;
|
|
akttokenpos.column:=lasttokenpos-lastlinepos;
|
|
akttokenpos.fileindex:=inputfile.ref_index;
|
|
aktfilepos:=akttokenpos;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.inc_comment_level;
|
|
var
|
|
oldaktfilepos : tfileposinfo;
|
|
begin
|
|
if (m_nested_comment in aktmodeswitches) then
|
|
inc(comment_level)
|
|
else
|
|
comment_level:=1;
|
|
if (comment_level>1) then
|
|
begin
|
|
oldaktfilepos:=aktfilepos;
|
|
gettokenpos; { update for warning }
|
|
Message1(scan_w_comment_level,tostr(comment_level));
|
|
aktfilepos:=oldaktfilepos;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.dec_comment_level;
|
|
begin
|
|
if (m_nested_comment in aktmodeswitches) then
|
|
dec(comment_level)
|
|
else
|
|
comment_level:=0;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.linebreak;
|
|
var
|
|
cur : char;
|
|
oldtokenpos,
|
|
oldaktfilepos : tfileposinfo;
|
|
begin
|
|
with inputfile do
|
|
begin
|
|
if (byte(inputpointer^)=0) and not(endoffile) then
|
|
begin
|
|
cur:=c;
|
|
reload;
|
|
if byte(cur)+byte(c)<>23 then
|
|
dec(inputpointer);
|
|
end
|
|
else
|
|
begin
|
|
{ Support all combination of #10 and #13 as line break }
|
|
if (byte(inputpointer^)+byte(c)=23) then
|
|
inc(inputpointer);
|
|
end;
|
|
{ Always return #10 as line break }
|
|
c:=#10;
|
|
{ increase line counters }
|
|
lastlinepos:=bufstart+(inputpointer-inputbuffer);
|
|
inc(line_no);
|
|
{ update linebuffer }
|
|
if cs_asm_source in aktglobalswitches then
|
|
inputfile.setline(line_no,lastlinepos);
|
|
{ update for status and call the show status routine,
|
|
but don't touch aktfilepos ! }
|
|
oldaktfilepos:=aktfilepos;
|
|
oldtokenpos:=akttokenpos;
|
|
gettokenpos; { update for v_status }
|
|
inc(status.compiledlines);
|
|
ShowStatus;
|
|
aktfilepos:=oldaktfilepos;
|
|
akttokenpos:=oldtokenpos;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.illegal_char(c:char);
|
|
var
|
|
s : string;
|
|
begin
|
|
if c in [#32..#255] then
|
|
s:=''''+c+''''
|
|
else
|
|
s:='#'+tostr(ord(c));
|
|
Message2(scan_f_illegal_char,s,'$'+hexstr(ord(c),2));
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.end_of_file;
|
|
begin
|
|
checkpreprocstack;
|
|
Message(scan_f_end_of_file);
|
|
end;
|
|
|
|
{-------------------------------------------
|
|
IF Conditional Handling
|
|
-------------------------------------------}
|
|
|
|
procedure tscannerfile.checkpreprocstack;
|
|
begin
|
|
{ check for missing ifdefs }
|
|
while assigned(preprocstack) do
|
|
begin
|
|
Message4(scan_e_endif_expected,preprocstring[preprocstack.typ],preprocstack.name,
|
|
preprocstack.owner.inputfile.name^,tostr(preprocstack.line_nb));
|
|
poppreprocstack;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.poppreprocstack;
|
|
var
|
|
hp : tpreprocstack;
|
|
begin
|
|
if assigned(preprocstack) then
|
|
begin
|
|
Message1(scan_c_endif_found,preprocstack.name);
|
|
hp:=preprocstack.next;
|
|
preprocstack.free;
|
|
preprocstack:=hp;
|
|
end
|
|
else
|
|
Message(scan_e_endif_without_if);
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.ifpreprocstack(atyp : preproctyp;compile_time_predicate:tcompile_time_predicate;messid:longint);
|
|
var
|
|
condition: Boolean;
|
|
valuedescr: String;
|
|
begin
|
|
if (preprocstack=nil) or preprocstack.accept then
|
|
condition:= compile_time_predicate(valuedescr)
|
|
else
|
|
begin
|
|
condition:= false;
|
|
valuedescr:= '';
|
|
end;
|
|
preprocstack:=tpreprocstack.create(atyp, condition, preprocstack);
|
|
preprocstack.name:=valuedescr;
|
|
preprocstack.line_nb:=line_no;
|
|
preprocstack.owner:=self;
|
|
if preprocstack.accept then
|
|
Message2(messid,preprocstack.name,'accepted')
|
|
else
|
|
Message2(messid,preprocstack.name,'rejected');
|
|
end;
|
|
|
|
procedure tscannerfile.elsepreprocstack;
|
|
begin
|
|
if assigned(preprocstack) and
|
|
(preprocstack.typ<>pp_else) then
|
|
begin
|
|
if (preprocstack.typ=pp_elseif) then
|
|
preprocstack.accept:=false
|
|
else
|
|
if (not(assigned(preprocstack.next)) or (preprocstack.next.accept)) then
|
|
preprocstack.accept:=not preprocstack.accept;
|
|
preprocstack.typ:=pp_else;
|
|
preprocstack.line_nb:=line_no;
|
|
if preprocstack.accept then
|
|
Message2(scan_c_else_found,preprocstack.name,'accepted')
|
|
else
|
|
Message2(scan_c_else_found,preprocstack.name,'rejected');
|
|
end
|
|
else
|
|
Message(scan_e_endif_without_if);
|
|
end;
|
|
|
|
procedure tscannerfile.elseifpreprocstack(compile_time_predicate:tcompile_time_predicate);
|
|
var
|
|
valuedescr: String;
|
|
begin
|
|
if assigned(preprocstack) and
|
|
(preprocstack.typ in [pp_if,pp_elseif]) then
|
|
begin
|
|
{ when the branch is accepted we use pp_elseif so we know that
|
|
all the next branches need to be rejected. when this branch is still
|
|
not accepted then leave it at pp_if }
|
|
if (preprocstack.typ=pp_elseif) then
|
|
preprocstack.accept:=false
|
|
else if (preprocstack.typ=pp_if) and preprocstack.accept then
|
|
begin
|
|
preprocstack.accept:=false;
|
|
preprocstack.typ:=pp_elseif;
|
|
end
|
|
else if (not(assigned(preprocstack.next)) or (preprocstack.next.accept))
|
|
and compile_time_predicate(valuedescr) then
|
|
begin
|
|
preprocstack.name:=valuedescr;
|
|
preprocstack.accept:=true;
|
|
preprocstack.typ:=pp_elseif;
|
|
end;
|
|
|
|
preprocstack.line_nb:=line_no;
|
|
if preprocstack.accept then
|
|
Message2(scan_c_else_found,preprocstack.name,'accepted')
|
|
else
|
|
Message2(scan_c_else_found,preprocstack.name,'rejected');
|
|
end
|
|
else
|
|
Message(scan_e_endif_without_if);
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.handleconditional(p:tdirectiveitem);
|
|
var
|
|
oldaktfilepos : tfileposinfo;
|
|
begin
|
|
oldaktfilepos:=aktfilepos;
|
|
repeat
|
|
current_scanner.gettokenpos;
|
|
p.proc();
|
|
{ accept the text ? }
|
|
if (current_scanner.preprocstack=nil) or current_scanner.preprocstack.accept then
|
|
break
|
|
else
|
|
begin
|
|
current_scanner.gettokenpos;
|
|
Message(scan_c_skipping_until);
|
|
repeat
|
|
current_scanner.skipuntildirective;
|
|
if not (m_mac in aktmodeswitches) then
|
|
p:=tdirectiveitem(turbo_scannerdirectives.search(current_scanner.readid))
|
|
else
|
|
p:=tdirectiveitem(mac_scannerdirectives.search(current_scanner.readid));
|
|
until assigned(p) and (p.is_conditional);
|
|
current_scanner.gettokenpos;
|
|
Message1(scan_d_handling_switch,'$'+p.name);
|
|
end;
|
|
until false;
|
|
aktfilepos:=oldaktfilepos;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.handledirectives;
|
|
var
|
|
t : tdirectiveitem;
|
|
hs : string;
|
|
begin
|
|
gettokenpos;
|
|
readchar; {Remove the $}
|
|
hs:=readid;
|
|
{$ifdef PREPROCWRITE}
|
|
if parapreprocess then
|
|
begin
|
|
t:=Get_Directive(hs);
|
|
if not(is_conditional(t) or (t=_DIR_DEFINE) or (t=_DIR_UNDEF)) then
|
|
begin
|
|
preprocfile^.AddSpace;
|
|
preprocfile^.Add('{$'+hs+current_scanner.readcomment+'}');
|
|
exit;
|
|
end;
|
|
end;
|
|
{$endif PREPROCWRITE}
|
|
{ skip this directive? }
|
|
if (ignoredirectives.find(hs)<>nil) then
|
|
begin
|
|
if (comment_level>0) then
|
|
readcomment;
|
|
{ we've read the whole comment }
|
|
aktcommentstyle:=comment_none;
|
|
exit;
|
|
end;
|
|
if hs='' then
|
|
begin
|
|
Message1(scan_w_illegal_switch,'$'+hs);
|
|
end;
|
|
{ Check for compiler switches }
|
|
while (length(hs)=1) and (c in ['-','+']) do
|
|
begin
|
|
HandleSwitch(hs[1],c);
|
|
current_scanner.readchar; {Remove + or -}
|
|
if c=',' then
|
|
begin
|
|
current_scanner.readchar; {Remove , }
|
|
{ read next switch, support $v+,$+}
|
|
hs:=current_scanner.readid;
|
|
if (hs='') then
|
|
begin
|
|
if (c='$') and (m_fpc in aktmodeswitches) then
|
|
begin
|
|
current_scanner.readchar; { skip $ }
|
|
hs:=current_scanner.readid;
|
|
end;
|
|
if (hs='') then
|
|
Message1(scan_w_illegal_directive,'$'+c);
|
|
end
|
|
else
|
|
Message1(scan_d_handling_switch,'$'+hs);
|
|
end
|
|
else
|
|
hs:='';
|
|
end;
|
|
{ directives may follow switches after a , }
|
|
if hs<>'' then
|
|
begin
|
|
if not (m_mac in aktmodeswitches) then
|
|
t:=tdirectiveitem(turbo_scannerdirectives.search(hs))
|
|
else
|
|
t:=tdirectiveitem(mac_scannerdirectives.search(hs));
|
|
|
|
if assigned(t) then
|
|
begin
|
|
if t.is_conditional then
|
|
handleconditional(t)
|
|
else
|
|
begin
|
|
Message1(scan_d_handling_switch,'$'+hs);
|
|
t.proc();
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
current_scanner.ignoredirectives.insert(hs);
|
|
Message1(scan_w_illegal_directive,'$'+hs);
|
|
end;
|
|
{ conditionals already read the comment }
|
|
if (current_scanner.comment_level>0) then
|
|
current_scanner.readcomment;
|
|
{ we've read the whole comment }
|
|
aktcommentstyle:=comment_none;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.readchar;
|
|
begin
|
|
c:=inputpointer^;
|
|
if c=#0 then
|
|
reload
|
|
else
|
|
inc(inputpointer);
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.readstring;
|
|
var
|
|
i : longint;
|
|
err : boolean;
|
|
begin
|
|
err:=false;
|
|
i:=0;
|
|
repeat
|
|
case c of
|
|
'_',
|
|
'0'..'9',
|
|
'A'..'Z' :
|
|
begin
|
|
if i<255 then
|
|
begin
|
|
inc(i);
|
|
orgpattern[i]:=c;
|
|
pattern[i]:=c;
|
|
end
|
|
else
|
|
begin
|
|
if not err then
|
|
begin
|
|
Message(scan_e_string_exceeds_255_chars);
|
|
err:=true;
|
|
end;
|
|
end;
|
|
c:=inputpointer^;
|
|
inc(inputpointer);
|
|
end;
|
|
'a'..'z' :
|
|
begin
|
|
if i<255 then
|
|
begin
|
|
inc(i);
|
|
orgpattern[i]:=c;
|
|
pattern[i]:=chr(ord(c)-32)
|
|
end
|
|
else
|
|
begin
|
|
if not err then
|
|
begin
|
|
Message(scan_e_string_exceeds_255_chars);
|
|
err:=true;
|
|
end;
|
|
end;
|
|
c:=inputpointer^;
|
|
inc(inputpointer);
|
|
end;
|
|
#0 :
|
|
reload;
|
|
else
|
|
break;
|
|
end;
|
|
until false;
|
|
orgpattern[0]:=chr(i);
|
|
pattern[0]:=chr(i);
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.readnumber;
|
|
var
|
|
base,
|
|
i : longint;
|
|
begin
|
|
case c of
|
|
'%' :
|
|
begin
|
|
readchar;
|
|
base:=2;
|
|
pattern[1]:='%';
|
|
i:=1;
|
|
end;
|
|
'&' :
|
|
begin
|
|
readchar;
|
|
base:=8;
|
|
pattern[1]:='&';
|
|
i:=1;
|
|
end;
|
|
'$' :
|
|
begin
|
|
readchar;
|
|
base:=16;
|
|
pattern[1]:='$';
|
|
i:=1;
|
|
end;
|
|
else
|
|
begin
|
|
base:=10;
|
|
i:=0;
|
|
end;
|
|
end;
|
|
while ((base>=10) and (c in ['0'..'9'])) or
|
|
((base=16) and (c in ['A'..'F','a'..'f'])) or
|
|
((base=8) and (c in ['0'..'7'])) or
|
|
((base=2) and (c in ['0'..'1'])) do
|
|
begin
|
|
if i<255 then
|
|
begin
|
|
inc(i);
|
|
pattern[i]:=c;
|
|
end;
|
|
readchar;
|
|
end;
|
|
pattern[0]:=chr(i);
|
|
end;
|
|
|
|
|
|
function tscannerfile.readid:string;
|
|
begin
|
|
readstring;
|
|
readid:=pattern;
|
|
end;
|
|
|
|
|
|
function tscannerfile.readval:longint;
|
|
var
|
|
l : longint;
|
|
w : integer;
|
|
begin
|
|
readnumber;
|
|
val(pattern,l,w);
|
|
readval:=l;
|
|
end;
|
|
|
|
|
|
function tscannerfile.readval_asstring:string;
|
|
begin
|
|
readnumber;
|
|
readval_asstring:=pattern;
|
|
end;
|
|
|
|
|
|
function tscannerfile.readcomment:string;
|
|
var
|
|
i : longint;
|
|
begin
|
|
i:=0;
|
|
repeat
|
|
case c of
|
|
'{' :
|
|
begin
|
|
if aktcommentstyle=comment_tp then
|
|
inc_comment_level;
|
|
end;
|
|
'}' :
|
|
begin
|
|
if aktcommentstyle=comment_tp then
|
|
begin
|
|
readchar;
|
|
dec_comment_level;
|
|
if comment_level=0 then
|
|
break
|
|
else
|
|
continue;
|
|
end;
|
|
end;
|
|
'*' :
|
|
begin
|
|
if aktcommentstyle=comment_oldtp then
|
|
begin
|
|
readchar;
|
|
if c=')' then
|
|
begin
|
|
readchar;
|
|
dec_comment_level;
|
|
break;
|
|
end
|
|
else
|
|
{ Add both characters !!}
|
|
if (i<255) then
|
|
begin
|
|
inc(i);
|
|
readcomment[i]:='*';
|
|
if (i<255) then
|
|
begin
|
|
inc(i);
|
|
readcomment[i]:='*';
|
|
end;
|
|
end;
|
|
end
|
|
else
|
|
{ Not old TP comment, so add...}
|
|
begin
|
|
if (i<255) then
|
|
begin
|
|
inc(i);
|
|
readcomment[i]:='*';
|
|
end;
|
|
end;
|
|
end;
|
|
#10,#13 :
|
|
linebreak;
|
|
#26 :
|
|
end_of_file;
|
|
else
|
|
begin
|
|
if (i<255) then
|
|
begin
|
|
inc(i);
|
|
readcomment[i]:=c;
|
|
end;
|
|
end;
|
|
end;
|
|
readchar;
|
|
until false;
|
|
readcomment[0]:=chr(i);
|
|
end;
|
|
|
|
|
|
function tscannerfile.readquotedstring:string;
|
|
var
|
|
i : longint;
|
|
msgwritten : boolean;
|
|
begin
|
|
i:=0;
|
|
msgwritten:=false;
|
|
if (c='''') then
|
|
begin
|
|
repeat
|
|
readchar;
|
|
case c of
|
|
#26 :
|
|
end_of_file;
|
|
#10,#13 :
|
|
Message(scan_f_string_exceeds_line);
|
|
'''' :
|
|
begin
|
|
readchar;
|
|
if c<>'''' then
|
|
break;
|
|
end;
|
|
end;
|
|
if i<255 then
|
|
begin
|
|
inc(i);
|
|
result[i]:=c;
|
|
end
|
|
else
|
|
begin
|
|
if not msgwritten then
|
|
begin
|
|
Message(scan_e_string_exceeds_255_chars);
|
|
msgwritten:=true;
|
|
end;
|
|
end;
|
|
until false;
|
|
end;
|
|
result[0]:=chr(i);
|
|
end;
|
|
|
|
|
|
function tscannerfile.readstate:char;
|
|
var
|
|
state : char;
|
|
begin
|
|
state:=' ';
|
|
if c=' ' then
|
|
begin
|
|
current_scanner.skipspace;
|
|
current_scanner.readid;
|
|
if pattern='ON' then
|
|
state:='+'
|
|
else
|
|
if pattern='OFF' then
|
|
state:='-';
|
|
end
|
|
else
|
|
state:=c;
|
|
if not (state in ['+','-']) then
|
|
Message(scan_e_wrong_switch_toggle);
|
|
readstate:=state;
|
|
end;
|
|
|
|
|
|
function tscannerfile.readstatedefault:char;
|
|
var
|
|
state : char;
|
|
begin
|
|
state:=' ';
|
|
if c=' ' then
|
|
begin
|
|
current_scanner.skipspace;
|
|
current_scanner.readid;
|
|
if pattern='ON' then
|
|
state:='+'
|
|
else
|
|
if pattern='OFF' then
|
|
state:='-'
|
|
else
|
|
if pattern='DEFAULT' then
|
|
state:='*';
|
|
end
|
|
else
|
|
state:=c;
|
|
if not (state in ['+','-','*']) then
|
|
Message(scan_e_wrong_switch_toggle_default);
|
|
readstatedefault:=state;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.skipspace;
|
|
begin
|
|
repeat
|
|
case c of
|
|
#26 :
|
|
begin
|
|
reload;
|
|
if (c=#26) and not assigned(inputfile.next) then
|
|
break;
|
|
continue;
|
|
end;
|
|
#10,
|
|
#13 :
|
|
linebreak;
|
|
#9,#11,#12,' ' :
|
|
;
|
|
else
|
|
break;
|
|
end;
|
|
readchar;
|
|
until false;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.skipuntildirective;
|
|
var
|
|
found : longint;
|
|
next_char_loaded : boolean;
|
|
begin
|
|
found:=0;
|
|
next_char_loaded:=false;
|
|
repeat
|
|
case c of
|
|
#10,
|
|
#13 :
|
|
linebreak;
|
|
#26 :
|
|
begin
|
|
reload;
|
|
if (c=#26) and not assigned(inputfile.next) then
|
|
end_of_file;
|
|
continue;
|
|
end;
|
|
'{' :
|
|
begin
|
|
if (aktcommentstyle in [comment_tp,comment_none]) then
|
|
begin
|
|
aktcommentstyle:=comment_tp;
|
|
if (comment_level=0) then
|
|
found:=1;
|
|
inc_comment_level;
|
|
end;
|
|
end;
|
|
'*' :
|
|
begin
|
|
if (aktcommentstyle=comment_oldtp) then
|
|
begin
|
|
readchar;
|
|
if c=')' then
|
|
begin
|
|
dec_comment_level;
|
|
found:=0;
|
|
aktcommentstyle:=comment_none;
|
|
end
|
|
else
|
|
next_char_loaded:=true;
|
|
end
|
|
else
|
|
found := 0;
|
|
end;
|
|
'}' :
|
|
begin
|
|
if (aktcommentstyle=comment_tp) then
|
|
begin
|
|
dec_comment_level;
|
|
if (comment_level=0) then
|
|
aktcommentstyle:=comment_none;
|
|
found:=0;
|
|
end;
|
|
end;
|
|
'$' :
|
|
begin
|
|
if found=1 then
|
|
found:=2;
|
|
end;
|
|
'''' :
|
|
if (aktcommentstyle=comment_none) then
|
|
begin
|
|
repeat
|
|
readchar;
|
|
case c of
|
|
#26 :
|
|
end_of_file;
|
|
#10,#13 :
|
|
break;
|
|
'''' :
|
|
begin
|
|
readchar;
|
|
if c<>'''' then
|
|
begin
|
|
next_char_loaded:=true;
|
|
break;
|
|
end;
|
|
end;
|
|
end;
|
|
until false;
|
|
end;
|
|
'(' :
|
|
begin
|
|
if (aktcommentstyle=comment_none) then
|
|
begin
|
|
readchar;
|
|
if c='*' then
|
|
begin
|
|
readchar;
|
|
if c='$' then
|
|
begin
|
|
found:=2;
|
|
inc_comment_level;
|
|
aktcommentstyle:=comment_oldtp;
|
|
end
|
|
else
|
|
begin
|
|
skipoldtpcomment;
|
|
next_char_loaded:=true;
|
|
end;
|
|
end
|
|
else
|
|
next_char_loaded:=true;
|
|
end
|
|
else
|
|
found:=0;
|
|
end;
|
|
'/' :
|
|
begin
|
|
if (aktcommentstyle=comment_none) then
|
|
begin
|
|
readchar;
|
|
if c='/' then
|
|
skipdelphicomment;
|
|
next_char_loaded:=true;
|
|
end
|
|
else
|
|
found:=0;
|
|
end;
|
|
else
|
|
found:=0;
|
|
end;
|
|
if next_char_loaded then
|
|
next_char_loaded:=false
|
|
else
|
|
readchar;
|
|
until (found=2);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
Comment Handling
|
|
****************************************************************************}
|
|
|
|
procedure tscannerfile.skipcomment;
|
|
begin
|
|
aktcommentstyle:=comment_tp;
|
|
readchar;
|
|
inc_comment_level;
|
|
{ handle compiler switches }
|
|
if (c='$') then
|
|
handledirectives;
|
|
{ handle_switches can dec comment_level, }
|
|
while (comment_level>0) do
|
|
begin
|
|
case c of
|
|
'{' :
|
|
inc_comment_level;
|
|
'}' :
|
|
dec_comment_level;
|
|
#10,#13 :
|
|
linebreak;
|
|
#26 :
|
|
begin
|
|
reload;
|
|
if (c=#26) and not assigned(inputfile.next) then
|
|
end_of_file;
|
|
continue;
|
|
end;
|
|
end;
|
|
readchar;
|
|
end;
|
|
aktcommentstyle:=comment_none;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.skipdelphicomment;
|
|
begin
|
|
aktcommentstyle:=comment_delphi;
|
|
inc_comment_level;
|
|
readchar;
|
|
{ this is not supported }
|
|
if c='$' then
|
|
Message(scan_w_wrong_styled_switch);
|
|
{ skip comment }
|
|
while not (c in [#10,#13,#26]) do
|
|
readchar;
|
|
dec_comment_level;
|
|
aktcommentstyle:=comment_none;
|
|
end;
|
|
|
|
|
|
procedure tscannerfile.skipoldtpcomment;
|
|
var
|
|
found : longint;
|
|
begin
|
|
aktcommentstyle:=comment_oldtp;
|
|
inc_comment_level;
|
|
{ only load a char if last already processed,
|
|
was cause of bug1634 PM }
|
|
if c=#0 then
|
|
readchar;
|
|
{ this is now supported }
|
|
if (c='$') then
|
|
handledirectives;
|
|
{ skip comment }
|
|
while (comment_level>0) do
|
|
begin
|
|
found:=0;
|
|
repeat
|
|
case c of
|
|
#26 :
|
|
begin
|
|
reload;
|
|
if (c=#26) and not assigned(inputfile.next) then
|
|
end_of_file;
|
|
continue;
|
|
end;
|
|
#10,#13 :
|
|
linebreak;
|
|
'*' :
|
|
begin
|
|
if found=3 then
|
|
found:=4
|
|
else
|
|
found:=1;
|
|
end;
|
|
')' :
|
|
begin
|
|
if found in [1,4] then
|
|
begin
|
|
dec_comment_level;
|
|
if comment_level=0 then
|
|
found:=2
|
|
else
|
|
found:=0;
|
|
end;
|
|
end;
|
|
'(' :
|
|
begin
|
|
if found=4 then
|
|
inc_comment_level;
|
|
found:=3;
|
|
end;
|
|
else
|
|
begin
|
|
if found=4 then
|
|
inc_comment_level;
|
|
found:=0;
|
|
end;
|
|
end;
|
|
readchar;
|
|
until (found=2);
|
|
end;
|
|
aktcommentstyle:=comment_none;
|
|
end;
|
|
|
|
|
|
|
|
{****************************************************************************
|
|
Token Scanner
|
|
****************************************************************************}
|
|
|
|
procedure tscannerfile.readtoken(allowrecordtoken:boolean);
|
|
var
|
|
code : integer;
|
|
len,
|
|
low,high,mid : longint;
|
|
w : word;
|
|
m : longint;
|
|
mac : tmacro;
|
|
asciinr : string[6];
|
|
msgwritten,
|
|
iswidestring : boolean;
|
|
label
|
|
exit_label;
|
|
begin
|
|
if localswitcheschanged then
|
|
begin
|
|
aktlocalswitches:=nextaktlocalswitches;
|
|
localswitcheschanged:=false;
|
|
end;
|
|
|
|
{ record tokens? }
|
|
if allowrecordtoken and
|
|
assigned(recordtokenbuf) then
|
|
recordtoken;
|
|
|
|
{ replay tokens? }
|
|
if assigned(replaytokenbuf) then
|
|
begin
|
|
replaytoken;
|
|
goto exit_label;
|
|
end;
|
|
|
|
{ was there already a token read, then return that token }
|
|
if nexttoken<>NOTOKEN then
|
|
begin
|
|
token:=nexttoken;
|
|
nexttoken:=NOTOKEN;
|
|
goto exit_label;
|
|
end;
|
|
|
|
{ Skip all spaces and comments }
|
|
repeat
|
|
case c of
|
|
'{' :
|
|
skipcomment;
|
|
#26 :
|
|
begin
|
|
reload;
|
|
if (c=#26) and not assigned(inputfile.next) then
|
|
break;
|
|
end;
|
|
' ',#9..#13 :
|
|
begin
|
|
{$ifdef PREPROCWRITE}
|
|
if parapreprocess then
|
|
begin
|
|
if c=#10 then
|
|
preprocfile.eolfound:=true
|
|
else
|
|
preprocfile.spacefound:=true;
|
|
end;
|
|
{$endif PREPROCWRITE}
|
|
skipspace;
|
|
end
|
|
else
|
|
break;
|
|
end;
|
|
until false;
|
|
|
|
{ Save current token position, for EOF its already loaded }
|
|
if c<>#26 then
|
|
gettokenpos;
|
|
|
|
{ Check first for a identifier/keyword, this is 20+% faster (PFV) }
|
|
if c in ['A'..'Z','a'..'z','_'] then
|
|
begin
|
|
readstring;
|
|
token:=_ID;
|
|
idtoken:=_ID;
|
|
{ keyword or any other known token,
|
|
pattern is always uppercased }
|
|
if (pattern[1]<>'_') and (length(pattern) in [tokenlenmin..tokenlenmax]) then
|
|
begin
|
|
low:=ord(tokenidx^[length(pattern),pattern[1]].first);
|
|
high:=ord(tokenidx^[length(pattern),pattern[1]].last);
|
|
while low<high do
|
|
begin
|
|
mid:=(high+low+1) shr 1;
|
|
if pattern<tokeninfo^[ttoken(mid)].str then
|
|
high:=mid-1
|
|
else
|
|
low:=mid;
|
|
end;
|
|
with tokeninfo^[ttoken(high)] do
|
|
if pattern=str then
|
|
begin
|
|
if keyword in aktmodeswitches then
|
|
if op=NOTOKEN then
|
|
token:=ttoken(high)
|
|
else
|
|
token:=op;
|
|
idtoken:=ttoken(high);
|
|
end;
|
|
end;
|
|
{ Only process identifiers and not keywords }
|
|
if token=_ID then
|
|
begin
|
|
{ this takes some time ... }
|
|
if (cs_support_macro in aktmoduleswitches) then
|
|
begin
|
|
mac:=tmacro(search_macro(pattern));
|
|
if assigned(mac) and (not mac.is_compiler_var) and (assigned(mac.buftext)) then
|
|
begin
|
|
if yylexcount<max_macro_nesting then
|
|
begin
|
|
mac.is_used:=true;
|
|
inc(yylexcount);
|
|
insertmacro(pattern,mac.buftext,mac.buflen,
|
|
mac.fileinfo.line,mac.fileinfo.fileindex);
|
|
{ handle empty macros }
|
|
if c=#0 then
|
|
reload;
|
|
readtoken(false);
|
|
{ that's all folks }
|
|
dec(yylexcount);
|
|
exit;
|
|
end
|
|
else
|
|
Message(scan_w_macro_too_deep);
|
|
end;
|
|
end;
|
|
end;
|
|
{ return token }
|
|
goto exit_label;
|
|
end
|
|
else
|
|
begin
|
|
idtoken:=_NOID;
|
|
case c of
|
|
|
|
'$' :
|
|
begin
|
|
readnumber;
|
|
token:=_INTCONST;
|
|
goto exit_label;
|
|
end;
|
|
|
|
'%' :
|
|
begin
|
|
if not(m_fpc in aktmodeswitches) then
|
|
Illegal_Char(c)
|
|
else
|
|
begin
|
|
readnumber;
|
|
token:=_INTCONST;
|
|
goto exit_label;
|
|
end;
|
|
end;
|
|
|
|
'&' :
|
|
begin
|
|
if m_fpc in aktmodeswitches then
|
|
begin
|
|
readnumber;
|
|
token:=_INTCONST;
|
|
goto exit_label;
|
|
end
|
|
else if m_mac in aktmodeswitches then
|
|
begin
|
|
readchar;
|
|
token:=_AMPERSAND;
|
|
goto exit_label;
|
|
end
|
|
else
|
|
Illegal_Char(c);
|
|
end;
|
|
|
|
'0'..'9' :
|
|
begin
|
|
readnumber;
|
|
if (c in ['.','e','E']) then
|
|
begin
|
|
{ first check for a . }
|
|
if c='.' then
|
|
begin
|
|
readchar;
|
|
{ is it a .. from a range? }
|
|
case c of
|
|
'.' :
|
|
begin
|
|
readchar;
|
|
token:=_INTCONST;
|
|
nexttoken:=_POINTPOINT;
|
|
goto exit_label;
|
|
end;
|
|
')' :
|
|
begin
|
|
readchar;
|
|
token:=_INTCONST;
|
|
nexttoken:=_RECKKLAMMER;
|
|
goto exit_label;
|
|
end;
|
|
end;
|
|
{ insert the number after the . }
|
|
pattern:=pattern+'.';
|
|
while c in ['0'..'9'] do
|
|
begin
|
|
pattern:=pattern+c;
|
|
readchar;
|
|
end;
|
|
end;
|
|
{ E can also follow after a point is scanned }
|
|
if c in ['e','E'] then
|
|
begin
|
|
pattern:=pattern+'E';
|
|
readchar;
|
|
if c in ['-','+'] then
|
|
begin
|
|
pattern:=pattern+c;
|
|
readchar;
|
|
end;
|
|
if not(c in ['0'..'9']) then
|
|
Illegal_Char(c);
|
|
while c in ['0'..'9'] do
|
|
begin
|
|
pattern:=pattern+c;
|
|
readchar;
|
|
end;
|
|
end;
|
|
token:=_REALNUMBER;
|
|
goto exit_label;
|
|
end;
|
|
token:=_INTCONST;
|
|
goto exit_label;
|
|
end;
|
|
|
|
';' :
|
|
begin
|
|
readchar;
|
|
token:=_SEMICOLON;
|
|
goto exit_label;
|
|
end;
|
|
|
|
'[' :
|
|
begin
|
|
readchar;
|
|
token:=_LECKKLAMMER;
|
|
goto exit_label;
|
|
end;
|
|
|
|
']' :
|
|
begin
|
|
readchar;
|
|
token:=_RECKKLAMMER;
|
|
goto exit_label;
|
|
end;
|
|
|
|
'(' :
|
|
begin
|
|
readchar;
|
|
case c of
|
|
'*' :
|
|
begin
|
|
c:=#0;{Signal skipoldtpcomment to reload a char }
|
|
skipoldtpcomment;
|
|
readtoken(false);
|
|
exit;
|
|
end;
|
|
'.' :
|
|
begin
|
|
readchar;
|
|
token:=_LECKKLAMMER;
|
|
goto exit_label;
|
|
end;
|
|
end;
|
|
token:=_LKLAMMER;
|
|
goto exit_label;
|
|
end;
|
|
|
|
')' :
|
|
begin
|
|
readchar;
|
|
token:=_RKLAMMER;
|
|
goto exit_label;
|
|
end;
|
|
|
|
'+' :
|
|
begin
|
|
readchar;
|
|
if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
|
|
begin
|
|
readchar;
|
|
token:=_PLUSASN;
|
|
goto exit_label;
|
|
end;
|
|
token:=_PLUS;
|
|
goto exit_label;
|
|
end;
|
|
|
|
'-' :
|
|
begin
|
|
readchar;
|
|
if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
|
|
begin
|
|
readchar;
|
|
token:=_MINUSASN;
|
|
goto exit_label;
|
|
end;
|
|
token:=_MINUS;
|
|
goto exit_label;
|
|
end;
|
|
|
|
':' :
|
|
begin
|
|
readchar;
|
|
if c='=' then
|
|
begin
|
|
readchar;
|
|
token:=_ASSIGNMENT;
|
|
goto exit_label;
|
|
end;
|
|
token:=_COLON;
|
|
goto exit_label;
|
|
end;
|
|
|
|
'*' :
|
|
begin
|
|
readchar;
|
|
if (c='=') and (cs_support_c_operators in aktmoduleswitches) then
|
|
begin
|
|
readchar;
|
|
token:=_STARASN;
|
|
end
|
|
else
|
|
if c='*' then
|
|
begin
|
|
readchar;
|
|
token:=_STARSTAR;
|
|
end
|
|
else
|
|
token:=_STAR;
|
|
goto exit_label;
|
|
end;
|
|
|
|
'/' :
|
|
begin
|
|
readchar;
|
|
case c of
|
|
'=' :
|
|
begin
|
|
if (cs_support_c_operators in aktmoduleswitches) then
|
|
begin
|
|
readchar;
|
|
token:=_SLASHASN;
|
|
goto exit_label;
|
|
end;
|
|
end;
|
|
'/' :
|
|
begin
|
|
skipdelphicomment;
|
|
readtoken(false);
|
|
exit;
|
|
end;
|
|
end;
|
|
token:=_SLASH;
|
|
goto exit_label;
|
|
end;
|
|
|
|
'|' :
|
|
if m_mac in aktmodeswitches then
|
|
begin
|
|
readchar;
|
|
token:=_PIPE;
|
|
goto exit_label;
|
|
end
|
|
else
|
|
Illegal_Char(c);
|
|
|
|
'=' :
|
|
begin
|
|
readchar;
|
|
token:=_EQUAL;
|
|
goto exit_label;
|
|
end;
|
|
|
|
'.' :
|
|
begin
|
|
readchar;
|
|
case c of
|
|
'.' :
|
|
begin
|
|
readchar;
|
|
case c of
|
|
'.' :
|
|
begin
|
|
readchar;
|
|
token:=_POINTPOINTPOINT;
|
|
goto exit_label;
|
|
end;
|
|
else
|
|
begin
|
|
token:=_POINTPOINT;
|
|
goto exit_label;
|
|
end;
|
|
end;
|
|
end;
|
|
')' :
|
|
begin
|
|
readchar;
|
|
token:=_RECKKLAMMER;
|
|
goto exit_label;
|
|
end;
|
|
end;
|
|
token:=_POINT;
|
|
goto exit_label;
|
|
end;
|
|
|
|
'@' :
|
|
begin
|
|
readchar;
|
|
token:=_KLAMMERAFFE;
|
|
goto exit_label;
|
|
end;
|
|
|
|
',' :
|
|
begin
|
|
readchar;
|
|
token:=_COMMA;
|
|
goto exit_label;
|
|
end;
|
|
|
|
'''','#','^' :
|
|
begin
|
|
len:=0;
|
|
msgwritten:=false;
|
|
pattern:='';
|
|
iswidestring:=false;
|
|
if c='^' then
|
|
begin
|
|
readchar;
|
|
c:=upcase(c);
|
|
if (block_type in [bt_type,bt_specialize]) or
|
|
(lasttoken=_ID) or (lasttoken=_NIL) or
|
|
(lasttoken=_RKLAMMER) or (lasttoken=_RECKKLAMMER) or (lasttoken=_CARET) then
|
|
begin
|
|
token:=_CARET;
|
|
goto exit_label;
|
|
end
|
|
else
|
|
begin
|
|
inc(len);
|
|
if c<#64 then
|
|
pattern[len]:=chr(ord(c)+64)
|
|
else
|
|
pattern[len]:=chr(ord(c)-64);
|
|
readchar;
|
|
end;
|
|
end;
|
|
repeat
|
|
case c of
|
|
'#' :
|
|
begin
|
|
readchar; { read # }
|
|
if c='$' then
|
|
begin
|
|
readchar; { read leading $ }
|
|
asciinr:='$';
|
|
while (upcase(c) in ['A'..'F','0'..'9']) and (length(asciinr)<6) do
|
|
begin
|
|
asciinr:=asciinr+c;
|
|
readchar;
|
|
end;
|
|
end
|
|
else
|
|
begin
|
|
asciinr:='';
|
|
while (c in ['0'..'9']) and (length(asciinr)<6) do
|
|
begin
|
|
asciinr:=asciinr+c;
|
|
readchar;
|
|
end;
|
|
end;
|
|
val(asciinr,m,code);
|
|
if (asciinr='') or (code<>0) then
|
|
Message(scan_e_illegal_char_const)
|
|
else if (m<0) or (m>255) or (length(asciinr)>3) then
|
|
begin
|
|
if (m>=0) and (m<=65535) then
|
|
begin
|
|
if not iswidestring then
|
|
begin
|
|
ascii2unicode(@pattern[1],len,patternw);
|
|
iswidestring:=true;
|
|
len:=0;
|
|
end;
|
|
concatwidestringchar(patternw,tcompilerwidechar(m));
|
|
end
|
|
else
|
|
Message(scan_e_illegal_char_const)
|
|
end
|
|
else if iswidestring then
|
|
concatwidestringchar(patternw,asciichar2unicode(char(m)))
|
|
else
|
|
begin
|
|
if len<255 then
|
|
begin
|
|
inc(len);
|
|
pattern[len]:=chr(m);
|
|
end
|
|
else
|
|
begin
|
|
if not msgwritten then
|
|
begin
|
|
Message(scan_e_string_exceeds_255_chars);
|
|
msgwritten:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
'''' :
|
|
begin
|
|
repeat
|
|
readchar;
|
|
case c of
|
|
#26 :
|
|
end_of_file;
|
|
#10,#13 :
|
|
Message(scan_f_string_exceeds_line);
|
|
'''' :
|
|
begin
|
|
readchar;
|
|
if c<>'''' then
|
|
break;
|
|
end;
|
|
end;
|
|
{ interpret as utf-8 string? }
|
|
if (ord(c)>=$80) and (aktsourcecodepage='utf8') then
|
|
begin
|
|
{ convert existing string to an utf-8 string }
|
|
if not iswidestring then
|
|
begin
|
|
ascii2unicode(@pattern[1],len,patternw);
|
|
iswidestring:=true;
|
|
len:=0;
|
|
end;
|
|
{ four or more chars aren't handled }
|
|
if (ord(c) and $f0)=$f0 then
|
|
message(scan_e_utf8_bigger_than_65535)
|
|
{ three chars }
|
|
else if (ord(c) and $e0)=$e0 then
|
|
begin
|
|
w:=ord(c) and $f;
|
|
readchar;
|
|
if (ord(c) and $c0)<>$80 then
|
|
message(scan_e_utf8_malformed);
|
|
w:=(w shl 6) or (ord(c) and $3f);
|
|
readchar;
|
|
if (ord(c) and $c0)<>$80 then
|
|
message(scan_e_utf8_malformed);
|
|
w:=(w shl 6) or (ord(c) and $3f);
|
|
concatwidestringchar(patternw,w);
|
|
end
|
|
{ two chars }
|
|
else if (ord(c) and $c0)<>0 then
|
|
begin
|
|
w:=ord(c) and $1f;
|
|
readchar;
|
|
if (ord(c) and $c0)<>$80 then
|
|
message(scan_e_utf8_malformed);
|
|
w:=(w shl 6) or (ord(c) and $3f);
|
|
concatwidestringchar(patternw,w);
|
|
end
|
|
{ illegal }
|
|
else if (ord(c) and $80)<>0 then
|
|
message(scan_e_utf8_malformed)
|
|
else
|
|
concatwidestringchar(patternw,tcompilerwidechar(c))
|
|
end
|
|
else if iswidestring then
|
|
begin
|
|
if aktsourcecodepage='utf8' then
|
|
concatwidestringchar(patternw,ord(c))
|
|
else
|
|
concatwidestringchar(patternw,asciichar2unicode(c))
|
|
end
|
|
else
|
|
begin
|
|
if len<255 then
|
|
begin
|
|
inc(len);
|
|
pattern[len]:=c;
|
|
end
|
|
else
|
|
begin
|
|
if not msgwritten then
|
|
begin
|
|
Message(scan_e_string_exceeds_255_chars);
|
|
msgwritten:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
until false;
|
|
end;
|
|
'^' :
|
|
begin
|
|
readchar;
|
|
c:=upcase(c);
|
|
if c<#64 then
|
|
c:=chr(ord(c)+64)
|
|
else
|
|
c:=chr(ord(c)-64);
|
|
|
|
if iswidestring then
|
|
concatwidestringchar(patternw,asciichar2unicode(c))
|
|
else
|
|
begin
|
|
if len<255 then
|
|
begin
|
|
inc(len);
|
|
pattern[len]:=c;
|
|
end
|
|
else
|
|
begin
|
|
if not msgwritten then
|
|
begin
|
|
Message(scan_e_string_exceeds_255_chars);
|
|
msgwritten:=true;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
readchar;
|
|
end;
|
|
else
|
|
break;
|
|
end;
|
|
until false;
|
|
{ strings with length 1 become const chars }
|
|
if iswidestring then
|
|
begin
|
|
if patternw^.len=1 then
|
|
token:=_CWCHAR
|
|
else
|
|
token:=_CWSTRING;
|
|
end
|
|
else
|
|
begin
|
|
pattern[0]:=chr(len);
|
|
if len=1 then
|
|
token:=_CCHAR
|
|
else
|
|
token:=_CSTRING;
|
|
end;
|
|
goto exit_label;
|
|
end;
|
|
|
|
'>' :
|
|
begin
|
|
readchar;
|
|
if (block_type in [bt_type,bt_specialize]) then
|
|
token:=_RSHARPBRACKET
|
|
else
|
|
begin
|
|
case c of
|
|
'=' :
|
|
begin
|
|
readchar;
|
|
token:=_GTE;
|
|
goto exit_label;
|
|
end;
|
|
'>' :
|
|
begin
|
|
readchar;
|
|
token:=_OP_SHR;
|
|
goto exit_label;
|
|
end;
|
|
'<' :
|
|
begin { >< is for a symetric diff for sets }
|
|
readchar;
|
|
token:=_SYMDIF;
|
|
goto exit_label;
|
|
end;
|
|
end;
|
|
token:=_GT;
|
|
end;
|
|
goto exit_label;
|
|
end;
|
|
|
|
'<' :
|
|
begin
|
|
readchar;
|
|
if (block_type in [bt_type,bt_specialize]) then
|
|
token:=_LSHARPBRACKET
|
|
else
|
|
begin
|
|
case c of
|
|
'>' :
|
|
begin
|
|
readchar;
|
|
token:=_UNEQUAL;
|
|
goto exit_label;
|
|
end;
|
|
'=' :
|
|
begin
|
|
readchar;
|
|
token:=_LTE;
|
|
goto exit_label;
|
|
end;
|
|
'<' :
|
|
begin
|
|
readchar;
|
|
token:=_OP_SHL;
|
|
goto exit_label;
|
|
end;
|
|
end;
|
|
token:=_LT;
|
|
end;
|
|
goto exit_label;
|
|
end;
|
|
|
|
#26 :
|
|
begin
|
|
token:=_EOF;
|
|
checkpreprocstack;
|
|
goto exit_label;
|
|
end;
|
|
else
|
|
Illegal_Char(c);
|
|
end;
|
|
end;
|
|
exit_label:
|
|
lasttoken:=token;
|
|
end;
|
|
|
|
|
|
function tscannerfile.readpreproc:ttoken;
|
|
begin
|
|
skipspace;
|
|
case c of
|
|
'_',
|
|
'A'..'Z',
|
|
'a'..'z' :
|
|
begin
|
|
current_scanner.preproc_pattern:=readid;
|
|
readpreproc:=_ID;
|
|
end;
|
|
'0'..'9' :
|
|
begin
|
|
current_scanner.preproc_pattern:=readval_asstring;
|
|
{ realnumber? }
|
|
if c='.' then
|
|
begin
|
|
readchar;
|
|
while c in ['0'..'9'] do
|
|
begin
|
|
current_scanner.preproc_pattern:=current_scanner.preproc_pattern+c;
|
|
readchar;
|
|
end;
|
|
end;
|
|
readpreproc:=_ID;
|
|
end;
|
|
'$','%','&' :
|
|
begin
|
|
current_scanner.preproc_pattern:=readval_asstring;
|
|
readpreproc:=_ID;
|
|
end;
|
|
',' :
|
|
begin
|
|
readchar;
|
|
readpreproc:=_COMMA;
|
|
end;
|
|
'}' :
|
|
begin
|
|
readpreproc:=_END;
|
|
end;
|
|
'(' :
|
|
begin
|
|
readchar;
|
|
readpreproc:=_LKLAMMER;
|
|
end;
|
|
')' :
|
|
begin
|
|
readchar;
|
|
readpreproc:=_RKLAMMER;
|
|
end;
|
|
'[' :
|
|
begin
|
|
readchar;
|
|
readpreproc:=_LECKKLAMMER;
|
|
end;
|
|
']' :
|
|
begin
|
|
readchar;
|
|
readpreproc:=_RECKKLAMMER;
|
|
end;
|
|
'+' :
|
|
begin
|
|
readchar;
|
|
readpreproc:=_PLUS;
|
|
end;
|
|
'-' :
|
|
begin
|
|
readchar;
|
|
readpreproc:=_MINUS;
|
|
end;
|
|
'*' :
|
|
begin
|
|
readchar;
|
|
readpreproc:=_STAR;
|
|
end;
|
|
'/' :
|
|
begin
|
|
readchar;
|
|
readpreproc:=_SLASH;
|
|
end;
|
|
'=' :
|
|
begin
|
|
readchar;
|
|
readpreproc:=_EQUAL;
|
|
end;
|
|
'>' :
|
|
begin
|
|
readchar;
|
|
if c='=' then
|
|
begin
|
|
readchar;
|
|
readpreproc:=_GTE;
|
|
end
|
|
else
|
|
readpreproc:=_GT;
|
|
end;
|
|
'<' :
|
|
begin
|
|
readchar;
|
|
case c of
|
|
'>' :
|
|
begin
|
|
readchar;
|
|
readpreproc:=_UNEQUAL;
|
|
end;
|
|
'=' :
|
|
begin
|
|
readchar;
|
|
readpreproc:=_LTE;
|
|
end;
|
|
else
|
|
readpreproc:=_LT;
|
|
end;
|
|
end;
|
|
#26 :
|
|
begin
|
|
readpreproc:=_EOF;
|
|
checkpreprocstack;
|
|
end;
|
|
else
|
|
Illegal_Char(c);
|
|
end;
|
|
end;
|
|
|
|
|
|
function tscannerfile.asmgetcharstart : char;
|
|
begin
|
|
{ return first the character already
|
|
available in c }
|
|
lastasmgetchar:=c;
|
|
result:=asmgetchar;
|
|
end;
|
|
|
|
|
|
function tscannerfile.asmgetchar : char;
|
|
begin
|
|
if lastasmgetchar<>#0 then
|
|
begin
|
|
c:=lastasmgetchar;
|
|
lastasmgetchar:=#0;
|
|
end
|
|
else
|
|
readchar;
|
|
if in_asm_string then
|
|
begin
|
|
asmgetchar:=c;
|
|
exit;
|
|
end;
|
|
repeat
|
|
case c of
|
|
{$ifndef arm}
|
|
// the { ... } is used in ARM assembler to define register sets, so we can't used
|
|
// it as comment, either (* ... *), /* ... */ or // ... should be used instead
|
|
'{' :
|
|
skipcomment;
|
|
{$endif arm}
|
|
#10,#13 :
|
|
begin
|
|
linebreak;
|
|
asmgetchar:=c;
|
|
exit;
|
|
end;
|
|
#26 :
|
|
begin
|
|
reload;
|
|
if (c=#26) and not assigned(inputfile.next) then
|
|
end_of_file;
|
|
continue;
|
|
end;
|
|
'/' :
|
|
begin
|
|
readchar;
|
|
if c='/' then
|
|
skipdelphicomment
|
|
else
|
|
begin
|
|
asmgetchar:='/';
|
|
lastasmgetchar:=c;
|
|
exit;
|
|
end;
|
|
end;
|
|
'(' :
|
|
begin
|
|
readchar;
|
|
if c='*' then
|
|
begin
|
|
c:=#0;{Signal skipoldtpcomment to reload a char }
|
|
skipoldtpcomment;
|
|
end
|
|
else
|
|
begin
|
|
asmgetchar:='(';
|
|
lastasmgetchar:=c;
|
|
exit;
|
|
end;
|
|
end;
|
|
else
|
|
begin
|
|
asmgetchar:=c;
|
|
exit;
|
|
end;
|
|
end;
|
|
until false;
|
|
end;
|
|
|
|
|
|
{*****************************************************************************
|
|
Helpers
|
|
*****************************************************************************}
|
|
|
|
procedure AddDirective(const s:string; dm: tdirectivemode; p:tdirectiveproc);
|
|
begin
|
|
if dm in [directive_all, directive_turbo] then
|
|
turbo_scannerdirectives.insert(tdirectiveitem.create(s,p));
|
|
if dm in [directive_all, directive_mac] then
|
|
mac_scannerdirectives.insert(tdirectiveitem.create(s,p));
|
|
end;
|
|
|
|
procedure AddConditional(const s:string; dm: tdirectivemode; p:tdirectiveproc);
|
|
begin
|
|
if dm in [directive_all, directive_turbo] then
|
|
turbo_scannerdirectives.insert(tdirectiveitem.createcond(s,p));
|
|
if dm in [directive_all, directive_mac] then
|
|
mac_scannerdirectives.insert(tdirectiveitem.createcond(s,p));
|
|
end;
|
|
|
|
{*****************************************************************************
|
|
Initialization
|
|
*****************************************************************************}
|
|
|
|
procedure InitScanner;
|
|
begin
|
|
InitWideString(patternw);
|
|
turbo_scannerdirectives:=TDictionary.Create;
|
|
mac_scannerdirectives:=TDictionary.Create;
|
|
|
|
{ Common directives and conditionals }
|
|
AddDirective('I',directive_all, @dir_include);
|
|
AddDirective('DEFINE',directive_all, @dir_define);
|
|
AddDirective('UNDEF',directive_all, @dir_undef);
|
|
|
|
AddConditional('IF',directive_all, @dir_if);
|
|
AddConditional('IFDEF',directive_all, @dir_ifdef);
|
|
AddConditional('IFNDEF',directive_all, @dir_ifndef);
|
|
AddConditional('ELSE',directive_all, @dir_else);
|
|
AddConditional('ELSEIF',directive_all, @dir_elseif);
|
|
AddConditional('ENDIF',directive_all, @dir_endif);
|
|
|
|
{ Directives and conditionals for all modes except mode macpas}
|
|
AddDirective('INCLUDE',directive_turbo, @dir_include);
|
|
AddDirective('LIBPREFIX',directive_turbo, @dir_libprefix);
|
|
AddDirective('LIBSUFFIX',directive_turbo, @dir_libsuffix);
|
|
AddDirective('EXTENSION',directive_turbo, @dir_extension);
|
|
|
|
AddConditional('IFEND',directive_turbo, @dir_endif);
|
|
AddConditional('IFOPT',directive_turbo, @dir_ifopt);
|
|
|
|
{ Directives and conditionals for mode macpas: }
|
|
AddDirective('SETC',directive_mac, @dir_setc);
|
|
AddDirective('DEFINEC',directive_mac, @dir_definec);
|
|
AddDirective('UNDEFC',directive_mac, @dir_undef);
|
|
|
|
AddConditional('IFC',directive_mac, @dir_if);
|
|
AddConditional('ELSEC',directive_mac, @dir_else);
|
|
AddConditional('ELIFC',directive_mac, @dir_elseif);
|
|
AddConditional('ENDC',directive_mac, @dir_endif);
|
|
end;
|
|
|
|
|
|
procedure DoneScanner;
|
|
begin
|
|
turbo_scannerdirectives.Free;
|
|
mac_scannerdirectives.Free;
|
|
DoneWideString(patternw);
|
|
end;
|
|
|
|
|
|
end.
|