{ $Id$ 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,cpuinfo; const max_include_nesting=32; max_macro_nesting=16; maxmacrolen=16*1024; preprocbufsize=32*1024; type tcommentstyle = (comment_none,comment_tp,comment_oldtp,comment_delphi,comment_c); pmacrobuffer = ^tmacrobuffer; tmacrobuffer = array[0..maxmacrolen-1] of char; tscannerfile = class; tmacro = class(TNamedIndexItem) defined, defined_at_startup, is_used : boolean; buftext : pchar; buflen : longint; fileinfo : tfileposinfo; constructor Create(const n : string); destructor destroy;override; end; preproctyp = (pp_ifdef,pp_ifndef,pp_if,pp_ifopt,pp_else); 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; 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; comment_level, yylexcount : longint; lastasmgetchar : char; ignoredirectives : tstringlist; { ignore directives, used to give warnings only once } preprocstack : tpreprocstack; macros : Tdictionary; 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 def_macro(const s : string); procedure set_macro(const s : string;value : string); procedure gettokenpos; procedure inc_comment_level; procedure dec_comment_level; procedure illegal_char(c:char); procedure end_of_file; procedure checkpreprocstack; procedure poppreprocstack; procedure addpreprocstack(atyp : preproctyp;a:boolean;const s:string;w:longint); procedure elsepreprocstack; procedure handleconditional(p:tdirectiveitem); procedure handledirectives; procedure linebreak; procedure readchar; procedure readstring; procedure readnumber; function readid:string; function readval:longint; function readcomment:string; function readstate:char; procedure skipspace; procedure skipuntildirective; procedure skipcomment; procedure skipdelphicomment; procedure skipoldtpcomment; procedure readtoken; 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; implementation uses {$ifdef delphi} dmisc, {$else} dos, {$endif delphi} cutils, systems, switches, symbase,symtable,symtype, 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'); function is_keyword(const s:string):boolean; var low,high,mid : longint; begin if not (length(s) in [tokenlenmin..tokenlenmax]) then begin is_keyword:=false; exit; end; low:=ord(tokenidx^[length(s),s[1]].first); high:=ord(tokenidx^[length(s),s[1]].last); while low1) then Message1(scan_w_illegal_switch,hs) else begin state:=current_scanner.ReadState; if state in ['-','+'] then found:=CheckSwitch(hs[1],state); end; current_scanner.addpreprocstack(pp_ifopt,found,hs,scan_c_ifopt_found); end; function parse_compiler_expr:string; function read_expr : 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 readpreproc: string; var hs: string; mac : tmacro; len : integer; begin hs := current_scanner.preproc_pattern; mac:=tmacro(current_scanner.macros.search(hs)); if assigned(mac) then begin if mac.defined and 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); end; end; readpreproc := hs; end; function read_factor : string; var hs : string; mac: tmacro; srsym : tsym; srsymtable : tsymtable; begin if current_scanner.preproc_token=_ID then begin if readpreproc='DEFINED' then begin 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 := current_scanner.preproc_pattern; mac := tmacro(current_scanner.macros.search(hs)); if assigned(mac) 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 readpreproc='DECLARED' then begin 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 readpreproc='NOT' then begin preproc_consume(_ID); hs:=read_expr; if hs='0' then read_factor:='1' else read_factor:='0'; end else begin hs:=readpreproc; preproc_consume(_ID); read_factor:=hs; end end else if current_scanner.preproc_token =_LKLAMMER then begin preproc_consume(_LKLAMMER); read_factor:=read_expr; preproc_consume(_RKLAMMER); end else Message(scan_e_error_in_preproc_expr); end; function read_term : string; var hs1,hs2 : string; l1,l2 : longint; w : integer; begin hs1:=read_factor; while true do begin if (current_scanner.preproc_token=_ID) then begin if readpreproc='AND' then begin preproc_consume(_ID); hs2:=read_expr; valint(hs1,l1,w); valint(hs2,l2,w); if (l1>0) and (l2>0) then hs1:='1' else hs1:='0'; read_term := hs1; exit; end else break; end else break; end; read_term:=hs1; end; function read_simple_expr : string; var hs1,hs2 : string; l1,l2 : longint; w : integer; begin hs1:=read_term; while true do begin if (current_scanner.preproc_token=_ID) then begin if readpreproc='OR' then begin preproc_consume(_ID); hs2:=read_expr; valint(hs1,l1,w); valint(hs2,l2,w); if (l1>0) or (l2>0) then hs1:='1' else hs1:='0'; read_simple_expr := hs1; exit; end else break; end else break; end; read_simple_expr:=hs1; end; function read_expr : string; var hs1,hs2 : string; b : boolean; t : ttoken; w : integer; l1,l2 : longint; begin hs1:=read_simple_expr; t:=current_scanner.preproc_token; if not(t in [_EQUAL,_UNEQUAL,_LT,_GT,_LTE,_GTE]) then begin read_expr:=hs1; exit; end; preproc_consume(t); hs2:=read_simple_expr; if is_number(hs1) and is_number(hs2) then begin valint(hs1,l1,w); valint(hs2,l2,w); case t of _EQUAL : b:=l1=l2; _UNEQUAL : b:=l1<>l2; _LT : b:=l1l2; _GTE : b:=l1>=l2; _LTE : b:=l1<=l2; end; end else begin case t of _EQUAL : b:=hs1=hs2; _UNEQUAL : b:=hs1<>hs2; _LT : b:=hs1hs2; _GTE : b:=hs1>=hs2; _LTE : b:=hs1<=hs2; end; end; if b then read_expr:='1' else read_expr:='0'; end; begin current_scanner.skipspace; { start preproc expression scanner } current_scanner.preproc_token:=current_scanner.readpreproc; parse_compiler_expr:=read_expr; end; procedure dir_if; var hs : string; begin hs:=parse_compiler_expr; current_scanner.addpreprocstack(pp_if,hs<>'0',hs,scan_c_if_found); end; procedure dir_define; var hs : string; bracketcount : longint; mac : tmacro; macropos : longint; macrobuffer : pmacrobuffer; begin current_scanner.skipspace; hs:=current_scanner.readid; mac:=tmacro(current_scanner.macros.search(hs)); if not assigned(mac) then begin mac:=tmacro.create(hs); mac.defined:=true; Message1(parser_c_macro_defined,mac.name); current_scanner.macros.insert(mac); end else begin Message1(parser_c_macro_defined,mac.name); mac.defined:=true; { 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 { key words are never substituted } if is_keyword(hs) then Message(scan_e_keyword_cant_be_a_macro); { !!!!!! handle macro params, need we this? } current_scanner.skipspace; { may be a macro? } if c=':' then begin current_scanner.readchar; if c='=' then begin new(macrobuffer); macropos:=0; { parse macro, brackets are counted so it's possible to have a $ifdef etc. in the macro } bracketcount:=0; repeat current_scanner.readchar; 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); 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; end; 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_setc; var hs : string; mac : tmacro; begin current_scanner.skipspace; hs:=current_scanner.readid; mac:=tmacro(current_scanner.macros.search(hs)); if not assigned(mac) then begin mac:=tmacro.create(hs); mac.defined:=true; Message1(parser_c_macro_defined,mac.name); current_scanner.macros.insert(mac); end else begin Message1(parser_c_macro_defined,mac.name); mac.defined:=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); { !!!!!! handle macro params, need we this? } current_scanner.skipspace; { may be a macro? } //both versions with := and = are allowed if c=':' then current_scanner.readchar; if c='=' then begin current_scanner.readchar; hs:= parse_compiler_expr; if length(hs) <> 0 then begin { 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(current_scanner.macros.search(hs)); if not assigned(mac) then begin mac:=tmacro.create(hs); Message1(parser_c_macro_undefined,mac.name); mac.defined:=false; current_scanner.macros.insert(mac); end else begin Message1(parser_c_macro_undefined,mac.name); mac.defined:=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 1. specified path,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+';'+current_scanner.inputfile.path^; end else hpath:=current_scanner.inputfile.path^; found:=FindFile(name+ext,hpath+';.'+source_info.DirSep,foundfile); if (not found) then found:=current_module.localincludesearchpath.FindFile(name+ext,foundfile); if (not found) then found:=includesearchpath.FindFile(name+ext,foundfile); 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='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,target_info.sourceext,foundfile); if (not found) then found:=findincludefile(path,name,target_info.pasext,foundfile); end; if current_scanner.inputfilecount0 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:={$ifndef FPCPROCVAR}@{$endif}p; end; constructor TDirectiveItem.CreateCond(const n:string;p:tdirectiveproc); begin inherited CreateName(n); is_conditional:=true; proc:={$ifndef FPCPROCVAR}@{$endif}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; macros:=tdictionary.create; 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; macros.free; end; procedure tscannerfile.def_macro(const s : string); var mac : tmacro; begin mac:=tmacro(macros.search(s)); if mac=nil then begin mac:=tmacro.create(s); Message1(parser_c_macro_defined,mac.name); macros.insert(mac); end; mac.defined:=true; mac.defined_at_startup:=true; end; procedure tscannerfile.set_macro(const s : string;value : string); var mac : tmacro; begin mac:=tmacro(macros.search(s)); if mac=nil then begin mac:=tmacro.create(s); macros.insert(mac); end else begin if assigned(mac.buftext) then freemem(mac.buftext,mac.buflen); end; Message2(parser_c_macro_set_to,mac.name,value); mac.buflen:=length(value); getmem(mac.buftext,mac.buflen); move(value[1],mac.buftext^,mac.buflen); mac.defined:=true; mac.defined_at_startup:=true; 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.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#26) and (not endoffile) then begin readbuf; inputpointer:=buf; inputbuffer:=buf; inputstart:=bufstart; { first line? } if line_no=0 then begin 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.addpreprocstack(atyp : preproctyp;a:boolean;const s:string;w:longint); begin preprocstack:=tpreprocstack.create(atyp,((preprocstack=nil) or preprocstack.accept) and a,preprocstack); preprocstack.name:=s; preprocstack.line_nb:=line_no; preprocstack.owner:=self; if preprocstack.accept then Message2(w,preprocstack.name,'accepted') else Message2(w,preprocstack.name,'rejected'); end; procedure tscannerfile.elsepreprocstack; begin if assigned(preprocstack) then begin preprocstack.typ:=pp_else; preprocstack.line_nb:=line_no; if not(assigned(preprocstack.next)) or (preprocstack.next.accept) then preprocstack.accept:=not preprocstack.accept; 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{$ifdef FPCPROCVAR}(){$endif}; { 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{$ifdef FPCPROCVAR}(){$endif}; 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; begin 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; 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; 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; valint(pattern,l,w); readval:=l; 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.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; 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 incomment : boolean; found : longint; next_char_loaded : boolean; oldcommentstyle : tcommentstyle; begin found:=0; next_char_loaded:=false; incomment:=true; oldcommentstyle:=aktcommentstyle; 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 not(m_nested_comment in aktmodeswitches) or (comment_level=0) then begin found:=1; aktcommentstyle:=comment_tp; end; inc_comment_level; incomment:=true; end; '*' : begin if incomment then begin readchar; if c=')' then begin dec_comment_level; found:=0; incomment:=false; end else next_char_loaded:=true; end else found := 0; end; '}' : begin dec_comment_level; found:=0; incomment:=false; end; '$' : begin if found=1 then found:=2; end; '''' : if not incomment 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 not incomment then begin readchar; if c='*' then begin readchar; if c='$' then begin found:=2; inc_comment_level; aktcommentstyle:=comment_oldtp; end else begin skipoldtpcomment; aktcommentstyle:=oldcommentstyle; end; end; next_char_loaded:=true; end else found:=0; end; '/' : begin if not incomment then begin readchar; if c='/' then begin skipdelphicomment; aktcommentstyle:=oldcommentstyle; end; 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_e_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; var code : integer; len, low,high,mid : longint; m : longint; mac : tmacro; asciinr : string[6]; msgwritten, iswidestring : boolean; label exit_label; begin if localswitcheschanged then begin aktlocalswitches:=nextaktlocalswitches; localswitcheschanged:=false; 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 low0) 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; 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; 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; 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; goto exit_label; end; '<' : begin readchar; 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; 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', '_','0'..'9' : begin current_scanner.preproc_pattern:=readid; readpreproc:=_ID; end; '}' : begin readpreproc:=_END; end; '(' : begin readchar; readpreproc:=_LKLAMMER; end; ')' : begin readchar; readpreproc:=_RKLAMMER; 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 : end_of_file; else begin readpreproc:=_EOF; checkpreprocstack; end; 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; { Default Turbo directives and conditionals } AddDirective('DEFINE',directive_turbo, {$ifdef FPCPROCVAR}@{$endif}dir_define); AddDirective('UNDEF',directive_turbo, {$ifdef FPCPROCVAR}@{$endif}dir_undef); AddDirective('I',directive_turbo, {$ifdef FPCPROCVAR}@{$endif}dir_include); AddDirective('INCLUDE',directive_turbo, {$ifdef FPCPROCVAR}@{$endif}dir_include); AddConditional('ELSE',directive_turbo, {$ifdef FPCPROCVAR}@{$endif}dir_else); AddConditional('ENDIF',directive_turbo, {$ifdef FPCPROCVAR}@{$endif}dir_endif); AddConditional('IFEND',directive_turbo, {$ifdef FPCPROCVAR}@{$endif}dir_endif); AddConditional('IF',directive_turbo, {$ifdef FPCPROCVAR}@{$endif}dir_if); AddConditional('IFDEF',directive_turbo, {$ifdef FPCPROCVAR}@{$endif}dir_ifdef); AddConditional('IFNDEF',directive_turbo, {$ifdef FPCPROCVAR}@{$endif}dir_ifndef); AddConditional('IFOPT',directive_turbo, {$ifdef FPCPROCVAR}@{$endif}dir_ifopt); { Default Mac directives and conditionals: } AddDirective('SETC',directive_mac, {$ifdef FPCPROCVAR}@{$endif}dir_setc); AddConditional('IFC',directive_mac, {$ifdef FPCPROCVAR}@{$endif}dir_if); AddConditional('ELSEC',directive_mac, {$ifdef FPCPROCVAR}@{$endif}dir_else); AddConditional('ENDC',directive_mac, {$ifdef FPCPROCVAR}@{$endif}dir_endif); end; procedure DoneScanner; begin turbo_scannerdirectives.Free; mac_scannerdirectives.Free; DoneWideString(patternw); end; end. { $Log$ Revision 1.66 2003-11-12 16:57:59 peter * do nothing for macro's in tempcloseinput,tempopeninput Revision 1.65 2003/11/10 19:08:59 peter + $IF DECLARED() added Revision 1.64 2003/11/10 19:08:32 peter * line numbering is now only done when #10, #10#13 is really parsed instead of when it is the next character Revision 1.63 2003/10/29 21:02:51 peter * set ms_compiled after the program/unit is parsed * check for ms_compiled before checking preproc matches Revision 1.62 2003/09/17 22:30:19 olle + support for a different set of compiler directives under $MODE MAC + added mac directives $SETC $IFC $ELSEC $ENDC Revision 1.61 2003/09/03 11:18:37 florian * fixed arm concatcopy + arm support in the common compiler sources added * moved some generic cg code around + tfputype added * ... Revision 1.60 2003/08/10 17:25:23 peter * fixed some reported bugs Revision 1.59 2003/05/25 10:26:43 peter * recursive include depth check Revision 1.58 2003/04/26 00:30:27 peter * don't close inputfile when still closed Revision 1.57 2003/01/09 21:52:37 peter * merged some verbosity options. * V_LineInfo is a verbosity flag to include line info Revision 1.56 2002/12/29 14:57:50 peter * unit loading changed to first register units and load them afterwards. This is needed to support uses xxx in yyy correctly * unit dependency check fixed Revision 1.55 2002/12/27 18:05:58 peter * use gettoken to get filename for include Revision 1.54 2002/12/27 16:45:50 peter * fix delphi comment parsing when skipping preproc directive Revision 1.53 2002/12/27 15:26:43 peter * give an error when no symbol is specified after $if(n)def Revision 1.52 2002/12/24 23:32:02 peter * support quotes around include filenames Revision 1.51 2002/12/05 19:27:00 carl * remove a stupid thing that i commited Revision 1.50 2002/11/29 22:31:19 carl + unimplemented hint directive added * hint directive parsing implemented * warning on these directives Revision 1.49 2002/11/26 22:56:40 peter * fix macro nesting check Revision 1.48 2002/09/16 19:05:48 peter * parse ^ after nil as caret Revision 1.47 2002/09/06 14:58:42 carl * bugfix of bug report 2072 (merged) Revision 1.46 2002/09/05 19:27:05 peter * fixed crash when current_module becomes nil Revision 1.45 2002/09/05 14:17:27 pierre * fix for bug 2004 merged Revision 1.44 2002/08/12 16:46:04 peter * tscannerfile is now destroyed in tmodule.reset and current_scanner is updated accordingly. This removes all the loading and saving of the old scanner and the invalid flag marking Revision 1.43 2002/08/11 14:28:19 peter * TScannerFile.SetInvalid added that will also reset inputfile Revision 1.42 2002/08/10 14:46:31 carl + moved target_cpu_string to cpuinfo * renamed asmmode enum. * assembler reader has now less ifdef's * move from nppcmem.pas -> ncgmem.pas vec. node. Revision 1.41 2002/08/06 21:12:16 florian + support for octal constants, they are specified by a leading & Revision 1.40 2002/07/20 17:35:52 florian + char constants specified with #.. with more than 3 digits are handled as widechar Revision 1.39 2002/05/18 13:34:17 peter * readded missing revisions Revision 1.38 2002/05/16 19:46:44 carl + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand + try to fix temp allocation (still in ifdef) + generic constructor calls + start of tassembler / tmodulebase class cleanup Revision 1.36 2002/04/21 18:57:23 peter * fixed memleaks when file can't be opened Revision 1.35 2002/04/21 15:22:26 carl * first check .inc file extension Revision 1.34 2002/04/21 07:24:09 carl - remove my fixes until Peter agrees on the fix (sorry Peter) Revision 1.32 2002/04/19 15:42:11 peter * default extension checking for include files Revision 1.31 2002/03/01 14:39:44 peter * fixed // and (* parsing to not be done when already parsing a tp comment in skipuntildirective Revision 1.30 2002/03/01 12:39:26 peter * support // parsing in skipuntildirective Revision 1.29 2002/01/27 21:44:26 peter * FPCTARGETOS/FPCTARGETCPU added as internal environment variable Revision 1.28 2002/01/24 18:25:50 peter * implicit result variable generation for assembler routines * removed m_tp modeswitch, use m_tp7 or not(m_fpc) instead }