* easier registration of directives

compiler/scandir.inc

@@ -1,1462 +0,0 @@
-{
-    $Id$
-    Copyright (c) 1998-2000 by Peter Vreman
-
-    This unit implements directive parsing for the scanner
-
-    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.
-
- ****************************************************************************
-}
-const
-   directivelen=15;
-type
-   directivestr=string[directivelen];
-   tdirectivetoken=(
-     _DIR_NONE,
-     _DIR_ALIGN,_DIR_APPTYPE,_DIR_ASMMODE,_DIR_ASSERTIONS,
-     _DIR_BOOLEVAL,
-     _DIR_D,_DIR_DEBUGINFO,_DIR_DEFINE,_DIR_DESCRIPTION,
-     _DIR_ELSE,_DIR_ENDIF,_DIR_ERROR,_DIR_EXTENDEDSYNTAX,
-     _DIR_FATAL,
-     _DIR_GOTO,
-     _DIR_HINT,_DIR_HINTS,
-     _DIR_I,_DIR_I386_ATT,_DIR_I386_DIRECT,_DIR_I386_INTEL,_DIR_IOCHECKS,
-       _DIR_IF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_INCLUDE,_DIR_INCLUDEPATH,
-       _DIR_INFO,_DIR_INLINE,
-       _DIR_INTERFACES,
-     _DIR_L,_DIR_LIBRARYPATH,_DIR_LINK,_DIR_LINKLIB,_DIR_LOCALSYMBOLS,
-       _DIR_LONGSTRINGS,
-     _DIR_M,_DIR_MACRO,_DIR_MAXFPUREGISTERS,_DIR_MEMORY,_DIR_MESSAGE,_DIR_MINENUMSIZE,_DIR_MMX,_DIR_MODE,
-     _DIR_NOTE,_DIR_NOTES,
-     _DIR_OBJECTPATH,_DIR_OPENSTRINGS,_DIR_OUTPUT_FORMAT,_DIR_OVERFLOWCHECKS,
-     _DIR_PACKENUM,_DIR_PACKRECORDS,
-     {$IFDEF Testvarsets}
-      _DIR_PACKSET,
-     {$ENDIF}
-     _DIR_R,_DIR_RANGECHECKS,_DIR_REFERENCEINFO,
-     _DIR_SATURATION,_DIR_SMARTLINK,_DIR_STACKFRAMES,_DIR_STATIC,_DIR_STOP,
-     _DIR_TYPEDADDRESS,_DIR_TYPEINFO,
-     _DIR_UNDEF,_DIR_UNITPATH,
-     _DIR_VARSTRINGCHECKS,_DIR_VERSION,
-     _DIR_WAIT,_DIR_WARNING,_DIR_WARNINGS,
-     _DIR_Z1,_DIR_Z2,_DIR_Z4
-     );
-const
-   firstdirective=_DIR_NONE;
-   lastdirective=_DIR_Z4;
-   directive:array[tdirectivetoken] of directivestr=(
-     {12345678901234567890 (To determine longest string.)}
-     '',
-     'ALIGN',
-     'APPTYPE',
-     'ASMMODE',
-     'ASSERTIONS',
-     'BOOLEVAL',
-     'D',
-     'DEBUGINFO',
-     'DEFINE',
-     'DESCRIPTION',
-     'ELSE',
-     'ENDIF',
-     'ERROR',
-     'EXTENDEDSYNTAX',
-     'FATAL',
-     'GOTO',
-     'HINT',
-     'HINTS',
-     'I',
-     {12345678901234567890 (To determine longest string.)}
-     'I386_ATT',
-     'I386_DIRECT',
-     'I386_INTEL',
-     'IOCHECKS',
-     'IF',
-     'IFDEF',
-     'IFNDEF',
-     'IFOPT',
-     'INCLUDE',
-     'INCLUDEPATH',
-     'INFO',
-     'INLINE',
-     'INTERFACES',
-     'L',
-     'LIBRARYPATH',
-     'LINK',
-     'LINKLIB',
-     'LOCALSYMBOLS',
-     'LONGSTRINGS',
-     'M',
-     {12345678901234567890 (To determine longest string.)}
-     'MACRO',
-     'MAXFPUREGISTERS',
-     'MEMORY',
-     'MESSAGE',
-     'MINENUMSIZE',
-     'MMX',
-     'MODE',
-     'NOTE',
-     'NOTES',
-     'OBJECTPATH',
-     'OPENSTRINGS',
-     'OUTPUT_FORMAT',
-     'OVERFLOWCHECKS',
-     'PACKENUM',
-     'PACKRECORDS',
-     {$IFDEF testvarsets}
-     'PACKSET',
-     {$ENDIF}
-     'R',
-     'RANGECHECKS',
-     'REFERENCEINFO',
-     'SATURATION',
-     'SMARTLINK',
-     {12345678901234567890 (To determine longest string.)}
-     'STACKFRAMES',
-     'STATIC',
-     'STOP',
-     'TYPEDADDRESS',
-     'TYPEINFO',
-     'UNDEF',
-     'UNITPATH',
-     'VARSTRINGCHECKS',
-     'VERSION',
-     'WAIT',
-     'WARNING',
-     'WARNINGS',
-     'Z1',
-     'Z2',
-     'Z4'
-     );
-
-
-
-    function Get_Directive(const hs:string):tdirectivetoken;
-      var
-        i : tdirectivetoken;
-      begin
-        for i:=firstdirective to lastdirective do
-         if directive[i]=hs then
-          begin
-            Get_Directive:=i;
-            exit;
-          end;
-        Get_Directive:=_DIR_NONE;
-     end;
-
-
-  {-------------------------------------------
-           IF Conditional Handling
-  -------------------------------------------}
-
-    var
-      preprocpat    : string;
-      preproc_token : ttoken;
-
-    procedure preproc_consume(t : ttoken);
-      begin
-        if t<>preproc_token then
-         Message(scan_e_preproc_syntax_error);
-        preproc_token:=current_scanner^.readpreproc;
-      end;
-
-    function read_expr : string;forward;
-
-    function read_factor : string;
-      var
-         hs : string;
-         mac : tmacro;
-         len : byte;
-      begin
-         if preproc_token=_ID then
-           begin
-              if preprocpat='NOT' then
-                begin
-                   preproc_consume(_ID);
-                   hs:=read_expr;
-                   if hs='0' then
-                     read_factor:='1'
-                   else
-                     read_factor:='0';
-                end
-              else
-                begin
-                   mac:=tmacro(current_scanner^.macros.search(hs));
-                   hs:=preprocpat;
-                   preproc_consume(_ID);
-                   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
-                        else
-                          read_factor:='';
-                     end
-                   else
-                     read_factor:=hs;
-                end
-           end
-         else if 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;
-      begin
-         hs1:=read_factor;
-         while true do
-           begin
-              if (preproc_token=_ID) then
-                begin
-                   if preprocpat='AND' then
-                     begin
-                        preproc_consume(_ID);
-                        hs2:=read_factor;
-                        if (hs1<>'0') and (hs2<>'0') then
-                          hs1:='1';
-                     end
-                   else
-                     break;
-                end
-              else
-                break;
-           end;
-         read_term:=hs1;
-      end;
-
-
-    function read_simple_expr : string;
-      var
-         hs1,hs2 : string;
-      begin
-         hs1:=read_term;
-         while true do
-           begin
-              if (preproc_token=_ID) then
-                begin
-                   if preprocpat='OR' then
-                     begin
-                        preproc_consume(_ID);
-                        hs2:=read_term;
-                        if (hs1<>'0') or (hs2<>'0') then
-                          hs1:='1';
-                     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:=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:=l1<l2;
-                    _GT : b:=l1>l2;
-                   _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:=hs1<hs2;
-                    _GT : b:=hs1>hs2;
-                   _GTE : b:=hs1>=hs2;
-                   _LTE : b:=hs1<=hs2;
-              end;
-           end;
-         if b then
-           read_expr:='1'
-         else
-           read_expr:='0';
-     end;
-
-  {-------------------------------------------
-                Directives
-  -------------------------------------------}
-
-    function is_conditional(t:tdirectivetoken):boolean;
-      begin
-        is_conditional:=(t in [_DIR_ENDIF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_IF,_DIR_ELSE]);
-      end;
-
-
-    procedure dir_conditional(t:tdirectivetoken);
-      var
-        hs    : string;
-        mac   : tmacro;
-        found : boolean;
-        state : char;
-        oldaktfilepos : tfileposinfo;
-      begin
-        oldaktfilepos:=aktfilepos;
-        while true do
-         begin
-           current_scanner^.gettokenpos;
-           case t of
-   _DIR_ENDIF : begin
-                  current_scanner^.poppreprocstack;
-                end;
-    _DIR_ELSE : begin
-                  current_scanner^.elsepreprocstack;
-                end;
-   _DIR_IFDEF : begin
-                  current_scanner^.skipspace;
-                  hs:=current_scanner^.readid;
-                  mac:=tmacro(current_scanner^.macros.search(hs));
-                  if assigned(mac) then
-                    mac.is_used:=true;
-                  current_scanner^.addpreprocstack(pp_ifdef,assigned(mac) and mac.defined,hs,scan_c_ifdef_found);
-                end;
-   _DIR_IFOPT : begin
-                  current_scanner^.skipspace;
-                  hs:=current_scanner^.readid;
-                  if (length(hs)>1) 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;
-      _DIR_IF : begin
-                  current_scanner^.skipspace;
-                  { start preproc expression scanner }
-                  preproc_token:=current_scanner^.readpreproc;
-                  hs:=read_expr;
-                  current_scanner^.addpreprocstack(pp_if,hs<>'0',hs,scan_c_if_found);
-                end;
-  _DIR_IFNDEF : begin
-                  current_scanner^.skipspace;
-                  hs:=current_scanner^.readid;
-                  mac:=tmacro(current_scanner^.macros.search(hs));
-                  if assigned(mac) then
-                    mac.is_used:=true;
-                  current_scanner^.addpreprocstack(pp_ifndef,not(assigned(mac) and mac.defined),hs,scan_c_ifndef_found);
-                end;
-           end;
-         { 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;
-                t:=Get_Directive(current_scanner^.readid);
-              until is_conditional(t);
-              current_scanner^.gettokenpos;
-              Message1(scan_d_handling_switch,'$'+directive[t]);
-            end;
-         end;
-        aktfilepos:=oldaktfilepos;
-      end;
-
-
-    procedure dir_define(t:tdirectivetoken);
-      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_m_macro_defined,mac.name);
-            current_scanner^.macros.insert(mac);
-          end
-        else
-          begin
-            Message1(parser_m_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);
-                           #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_undef(t:tdirectivetoken);
-      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_m_macro_undefined,mac.name);
-             mac.defined:=false;
-             current_scanner^.macros.insert(mac);
-          end
-        else
-          begin
-             Message1(parser_m_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_message(t:tdirectivetoken);
-      var
-        w   : longint;
-      begin
-        case t of
-       _DIR_STOP,
-      _DIR_FATAL : w:=scan_f_user_defined;
-      _DIR_ERROR : w:=scan_e_user_defined;
-    _DIR_WARNING : w:=scan_w_user_defined;
-       _DIR_HINT : w:=scan_h_user_defined;
-       _DIR_NOTE : w:=scan_n_user_defined;
-    _DIR_MESSAGE,
-       _DIR_INFO : w:=scan_i_user_defined;
-        end;
-        current_scanner^.skipspace;
-        Message1(w,current_scanner^.readcomment);
-      end;
-
-
-    procedure dir_moduleswitch(t:tdirectivetoken);
-      var
-        sw : tmoduleswitch;
-        state : char;
-      begin
-        sw:=cs_modulenone;
-        case t of
-          _DIR_GOTO      : sw:=cs_support_goto;
-          _DIR_MACRO     : sw:=cs_support_macro;
-          _DIR_INLINE    : sw:=cs_support_inline;
-          _DIR_SMARTLINK : sw:=cs_create_smart;
-          _DIR_STATIC    : sw:=cs_static_keyword;
-        end;
-        state:=current_scanner^.readstate;
-        if (sw<>cs_modulenone) and (state in ['-','+']) then
-         begin
-           if state='-' then
-            aktmoduleswitches:=aktmoduleswitches-[sw]
-           else
-            aktmoduleswitches:=aktmoduleswitches+[sw];
-         end;
-      end;
-
-    procedure dir_interfacesswitch(t:tdirectivetoken);
-      var
-        hs : string;
-      begin
-        {corba/com/default}
-        current_scanner^.skipspace;
-        hs:=current_scanner^.readid;
-        if (hs='CORBA') then
-          aktinterfacetype:=it_interfacecorba
-        else if (hs='COM') then
-          aktinterfacetype:=it_interfacecom
-        else if (hs='DEFAULT') then
-          aktinterfacetype:=initinterfacetype
-        else
-          Message(scan_e_invalid_interface_type);
-      end;
-
-    procedure dir_localswitch(t:tdirectivetoken);
-      var
-        sw : tlocalswitch;
-        state : char;
-      begin
-        sw:=cs_localnone;
-{$ifdef SUPPORT_MMX}
-        case t of
-          _DIR_MMX : sw:=cs_mmx;
-          _DIR_SATURATION : sw:=cs_mmx_saturation;
-        end;
-{$endif}
-        state:=current_scanner^.readstate;
-        if (sw<>cs_localnone) and (state in ['-','+']) then
-         begin
-           if not localswitcheschanged then
-             nextaktlocalswitches:=aktlocalswitches;
-           if state='-' then
-            nextaktlocalswitches:=nextaktlocalswitches-[sw]
-           else
-            nextaktlocalswitches:=nextaktlocalswitches+[sw];
-           localswitcheschanged:=true;
-         end;
-      end;
-
-
-    procedure dir_include(t:tdirectivetoken);
-      var
-        foundfile,
-        hs    : string;
-        path  : dirstr;
-        name  : namestr;
-        ext   : extstr;
-        hp    : tinputfile;
-        i     : longint;
-        found : boolean;
-      begin
-        current_scanner^.skipspace;
-        hs:=current_scanner^.readcomment;
-        i:=length(hs);
-        while (i>0) and (hs[i]=' ') do
-         dec(i);
-        Delete(hs,i+1,length(hs)-i);
-        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
-             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));
-         end
-        else
-         begin
-           hs:=FixFileName(hs);
-           fsplit(hs,path,name,ext);
-         { look for the include file
-            1. specified path,path of current inputfile,current dir
-            2. local includepath
-            3. global includepath }
-           found:=false;
-           foundfile:='';
-           if path<>'' then
-             path:=path+';';
-           found:=FindFile(name+ext,path+current_scanner^.inputfile.path^+';.'+DirSep,foundfile);
-           if (not found) then
-            found:=current_module.localincludesearchpath.FindFile(name+ext,foundfile);
-           if (not found) then
-            found:=includesearchpath.FindFile(name+ext,foundfile);
-         { save old postion and decrease linebreak }
-           if c=newline then
-            dec(current_scanner^.line_no);
-           dec(longint(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 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;
-         { process first read char }
-           case c of
-            #26 : current_scanner^.reload;
-            #10,
-            #13 : current_scanner^.linebreak;
-           end;
-         end;
-      end;
-
-
-    procedure dir_description(t:tdirectivetoken);
-      begin
-        if not (target_info.target in [target_i386_os2,target_i386_win32,target_i386_netware]) then
-          Message(scan_w_decription_not_support);
-        { change description global var in all cases }
-        { it not used but in win32, os2 and netware }
-        current_scanner^.skipspace;
-        description:=current_scanner^.readcomment;
-      end;
-
-
-    procedure dir_version(t:tdirectivetoken);
-      var
-        major, minor, revision : longint;
-        error : integer;
-      begin
-        if not (target_info.target in [target_i386_os2,target_i386_win32,target_i386_netware]) then  // AD
-          begin
-            Message(scan_n_version_not_support);
-            exit;
-          end;
-        if (compile_level<>1) then
-          Message(scan_n_only_exe_version)
-        else
-          begin
-            { change description global var in all cases }
-            { it not used but in win32, os2 and netware }
-            current_scanner^.skipspace;
-            { we should only accept Major.Minor format for win32 and os2 }
-            current_scanner^.readnumber;
-            major:=0;
-            minor:=0;
-            revision:=0;
-            valint(pattern,major,error);
-            if error<>0 then
-              begin
-                Message1(scan_w_wrong_version_ignored,pattern);
-                exit;
-              end;
-            if c='.' then
-              begin
-                current_scanner^.readchar;
-                current_scanner^.readnumber;
-                valint(pattern,minor,error);
-                if error<>0 then
-                  begin
-                    Message1(scan_w_wrong_version_ignored,tostr(major)+'.'+pattern);
-                    exit;
-                  end;
-                if (c='.') and
-                   (target_info.target = target_i386_netware) then  // AD
-                  begin
-                     current_scanner^.readchar;
-                     current_scanner^.readnumber;
-                     valint(pattern,revision,error);
-                     if error<>0 then
-                       begin
-                          Message1(scan_w_wrong_version_ignored,tostr(revision)+'.'+pattern);
-                          exit;
-                       end;
-                     dllmajor:=major;
-                     dllminor:=minor;
-                     dllrevision:=revision;
-                     dllversion:=tostr(major)+','+tostr(minor)+','+tostr(revision);
-                  end
-                else
-                  begin
-                     dllmajor:=major;
-                     dllminor:=minor;
-                     dllversion:=tostr(major)+'.'+tostr(minor);
-                  end;
-              end
-            else
-              dllversion:=tostr(major);
-          end;
-      end;
-
-
-    procedure dir_linkobject(t:tdirectivetoken);
-      var
-        s : string;
-      begin
-        current_scanner^.skipspace;
-        s:=AddExtension(FixFileName(current_scanner^.readcomment),target_info.objext);
-        current_module.linkotherofiles.add(s,link_allways);
-      end;
-
-
-    procedure dir_resource(t:tdirectivetoken);
-      var
-        s : string;
-      begin
-        current_scanner^.skipspace;
-        s:=current_scanner^.readcomment;
-        { replace * with current module name.
-          This should always be defined. }
-        if s[1]='*' then
-          if Assigned(Current_Module) then
-            begin
-            delete(S,1,1);
-            insert(lower(current_module.modulename^),S,1);
-            end;
-        s:=AddExtension(FixFileName(s),target_info.resext);
-        if target_info.res<>res_none then
-          if (target_info.res = res_i386_emx) and
-                                 not (Current_module.ResourceFiles.Empty) then
-            Message(scan_w_only_one_resourcefile_supported)
-          else
-            current_module.resourcefiles.insert(FixFileName(s))
-        else
-          Message(scan_e_resourcefiles_not_supported);
-      end;
-
-
-    procedure dir_linklib(t:tdirectivetoken);
-      type
-        tLinkMode=(lm_shared,lm_static);
-      var
-        s : string;
-        quote : char;
-        libname,
-        linkmodestr : string;
-        p : longint;
-        linkMode : tLinkMode;
-      begin
-        current_scanner^.skipspace;
-        s:=current_scanner^.readcomment;
-        p:=pos(',',s);
-        if p=0 then
-         begin
-           libname:=TrimSpace(s);
-           linkmodeStr:='';
-         end
-        else
-         begin
-           libname:=TrimSpace(copy(s,1,p-1));
-           linkmodeStr:=Upper(TrimSpace(copy(s,p+1,255)));
-         end;
-        if (libname='') or (libname='''''') or (libname='""') then
-         exit;
-        { get linkmode, default is shared linking }
-        if linkModeStr='STATIC' then
-         linkmode:=lm_static
-        else if (LinkModeStr='SHARED') or (LinkModeStr='') then
-         linkmode:=lm_shared
-        else
-         begin
-           Comment(V_Error,'Wrong link mode specified: "'+Linkmodestr+'"');
-           exit;
-         end;
-        { create library name }
-        if libname[1] in ['''','"'] then
-         begin
-           quote:=libname[1];
-           Delete(libname,1,1);
-           p:=pos(quote,libname);
-           if p>0 then
-            Delete(libname,p,1);
-         end;
-        { add to the list of libraries to link }
-        if linkMode=lm_static then
-         current_module.linkOtherStaticLibs.add(FixFileName(libname),link_allways)
-        else
-         current_module.linkOtherSharedLibs.add(FixFileName(libname),link_allways);
-      end;
-
-
-    procedure dir_outputformat(t:tdirectivetoken);
-      begin
-        if not current_module.in_global then
-         Message(scan_w_switch_is_global)
-        else
-          begin
-            current_scanner^.skipspace;
-            if set_string_asm(current_scanner^.readid) then
-             aktoutputformat:=target_asm.id
-            else
-             Message1(scan_w_illegal_switch,pattern);
-          end;
-      end;
-
-
-    procedure dir_unitpath(t:tdirectivetoken);
-      begin
-        if not current_module.in_global then
-         Message(scan_w_switch_is_global)
-        else
-          begin
-            current_scanner^.skipspace;
-            current_module.localunitsearchpath.AddPath(current_scanner^.readcomment,false);
-          end;
-      end;
-
-
-    procedure dir_includepath(t:tdirectivetoken);
-      begin
-        if not current_module.in_global then
-         Message(scan_w_switch_is_global)
-        else
-          begin
-            current_scanner^.skipspace;
-            current_module.localincludesearchpath.AddPath(current_scanner^.readcomment,false);
-          end;
-      end;
-
-
-    procedure dir_librarypath(t:tdirectivetoken);
-      begin
-        if not current_module.in_global then
-         Message(scan_w_switch_is_global)
-        else
-          begin
-            current_scanner^.skipspace;
-            current_module.locallibrarysearchpath.AddPath(current_scanner^.readcomment,false);
-          end;
-      end;
-
-
-    procedure dir_objectpath(t:tdirectivetoken);
-      begin
-        if not current_module.in_global then
-         Message(scan_w_switch_is_global)
-        else
-          begin
-            current_scanner^.skipspace;
-            current_module.localobjectsearchpath.AddPath(current_scanner^.readcomment,false);
-          end;
-      end;
-
-
-    procedure dir_mode(t:tdirectivetoken);
-      begin
-        if not current_module.in_global then
-         Message(scan_w_switch_is_global)
-        else
-          begin
-            current_scanner^.skipspace;
-            current_scanner^.readstring;
-            if not SetCompileMode(pattern,false) then
-             Message1(scan_w_illegal_switch,pattern);
-          end;
-
-      end;
-
-
-    procedure dir_packrecords(t:tdirectivetoken);
-      var
-        hs : string;
-      begin
-        current_scanner^.skipspace;
-        if not(c in ['0'..'9']) then
-         begin
-           hs:=current_scanner^.readid;
-           if (hs='C') then
-            aktpackrecords:=packrecord_C
-           else
-            if (hs='NORMAL') or (hs='DEFAULT') then
-             aktpackrecords:=packrecord_2
-           else
-            Message(scan_w_only_pack_records);
-         end
-        else
-         begin
-           case current_scanner^.readval of
-             1 : aktpackrecords:=packrecord_1;
-             2 : aktpackrecords:=packrecord_2;
-             4 : aktpackrecords:=packrecord_4;
-             8 : aktpackrecords:=packrecord_8;
-            16 : aktpackrecords:=packrecord_16;
-            32 : aktpackrecords:=packrecord_32;
-           else
-            Message(scan_w_only_pack_records);
-           end;
-         end;
-      end;
-
-    procedure dir_maxfpuregisters(t:tdirectivetoken);
-
-      var
-         l : longint;
-         hs : string;
-
-      begin
-         current_scanner^.skipspace;
-         if not(c in ['0'..'9']) then
-           begin
-              hs:=current_scanner^.readid;
-              if (hs='NORMAL') or (hs='DEFAULT') then
-                aktmaxfpuregisters:=-1
-              else
-                Message(scan_e_invalid_maxfpureg_value);
-           end
-         else
-           begin
-              l:=current_scanner^.readval;
-              case l of
-                 0..8:
-                   aktmaxfpuregisters:=l;
-                 else
-                   Message(scan_e_invalid_maxfpureg_value);
-              end;
-           end;
-      end;
-
-
-    procedure dir_packenum(t:tdirectivetoken);
-      var
-        hs : string;
-      begin
-        if t in [_DIR_Z1,_DIR_Z2,_DIR_Z4] then
-         begin
-           aktpackenum:=ord(pattern[2])-ord('0');
-           exit;
-         end;
-        current_scanner^.skipspace;
-        if not(c in ['0'..'9']) then
-         begin
-           hs:=current_scanner^.readid;
-           if (hs='NORMAL') or (hs='DEFAULT') then
-            aktpackenum:=4
-           else
-            Message(scan_w_only_pack_enum);
-         end
-        else
-         begin
-           case current_scanner^.readval of
-            1 : aktpackenum:=1;
-            2 : aktpackenum:=2;
-            4 : aktpackenum:=4;
-           else
-            Message(scan_w_only_pack_enum);
-           end;
-         end;
-      end;
-
-{$ifdef testvarsets}
-    procedure dir_setalloc(t:tdirectivetoken);
-      var
-        hs : string;
-      begin
-        current_scanner^.skipspace;
-        if not(c in ['1','2','4']) then
-         begin
-           hs:=current_scanner^.readid;
-           if (hs='FIXED') or ((hs='DEFAULT') OR (hs='NORMAL')) then
-           aktsetalloc:=0               {Fixed mode, sets are 4 or 32 bytes}
-          else
-           Message(scan_w_only_packset);
-          end
-        else
-         begin
-           case current_scanner^.readval of
-            1 : aktpackenum:=1;
-            2 : aktpackenum:=2;
-            4 : aktpackenum:=4;
-           else
-            Message(scan_w_only_packset);
-           end;
-         end;
-      end;
-{$ENDIF}
-    procedure dir_apptype(t:tdirectivetoken);
-
-      var
-         hs : string;
-
-      begin
-        if (target_info.target<>target_i386_win32)
-                                 and (target_info.target<>target_i386_os2) then
-          Message(scan_w_app_type_not_support);
-        if not current_module.in_global then
-          Message(scan_w_switch_is_global)
-        else
-          begin
-             current_scanner^.skipspace;
-             hs:=current_scanner^.readid;
-             if hs='GUI' then
-               apptype:=app_gui
-             else if hs='CONSOLE' then
-               apptype:=app_cui
-             else if (hs='FS') and (target_info.target=target_i386_os2) then
-               apptype:=app_fs
-             else
-               Message1(scan_w_unsupported_app_type,hs);
-          end;
-      end;
-
-    procedure dir_wait(t:tdirectivetoken);
-      var had_info : boolean;
-      begin
-        had_info:=(status.verbosity and V_Info)<>0;
-        { this message should allways appear !! }
-        status.verbosity:=status.verbosity or V_Info;
-        Message(scan_i_press_enter);
-        readln;
-        If not(had_info) then
-          status.verbosity:=status.verbosity and (not V_Info);
-      end;
-
-
-    procedure dir_asmmode(t:tdirectivetoken);
-      var
-        s : string;
-      begin
-        current_scanner^.skipspace;
-        s:=current_scanner^.readid;
-        If Inside_asm_statement then
-          Message1(scan_w_no_asm_reader_switch_inside_asm,s);
-        if s='DEFAULT' then
-         aktasmmode:=initasmmode
-        else
-         if not set_string_asmmode(s,aktasmmode) then
-          Message1(scan_w_unsupported_asmmode_specifier,s);
-      end;
-
-
-    procedure dir_oldasmmode(t:tdirectivetoken);
-      begin
-        If Inside_asm_statement then
-          Message1(scan_w_no_asm_reader_switch_inside_asm,directive[t]);
-{$ifdef i386}
-        case t of
-         _DIR_I386_ATT    : aktasmmode:=asmmode_i386_att;
-         _DIR_I386_DIRECT : aktasmmode:=asmmode_i386_direct;
-         _DIR_I386_INTEL  : aktasmmode:=asmmode_i386_intel;
-        end;
-{$endif i386}
-      end;
-
-
-    procedure dir_delphiswitch(t:tdirectivetoken);
-      var
-        sw,state : char;
-      begin
-        case t of
-           _DIR_ALIGN : sw:='A';
-      _DIR_ASSERTIONS : sw:='C';
-        _DIR_BOOLEVAL : sw:='B';
-       _DIR_DEBUGINFO : sw:='D';
-        _DIR_IOCHECKS : sw:='I';
-    _DIR_LOCALSYMBOLS : sw:='L';
-     _DIR_LONGSTRINGS : sw:='H';
-     _DIR_OPENSTRINGS : sw:='P';
-  _DIR_OVERFLOWCHECKS : sw:='Q';
-     _DIR_RANGECHECKS : sw:='R';
-   _DIR_REFERENCEINFO : sw:='Y';
-     _DIR_STACKFRAMES : sw:='W';
-    _DIR_TYPEDADDRESS : sw:='T';
-        _DIR_TYPEINFO : sw:='M';
- _DIR_VARSTRINGCHECKS : sw:='V';
-        else
-         exit;
-        end;
-      { c contains the next char, a + or - would be fine }
-        state:=current_scanner^.readstate;
-        if state in ['-','+'] then
-          HandleSwitch(sw,state);
-      end;
-
-
-    procedure dir_memory(t:tdirectivetoken);
-      var
-        l : longint;
-      begin
-        current_scanner^.skipspace;
-        l:=current_scanner^.readval;
-        if l>1024 then
-         stacksize:=l;
-        current_scanner^.skipspace;
-        if c=',' then
-         begin
-           current_scanner^.readchar;
-           current_scanner^.skipspace;
-           l:=current_scanner^.readval;
-           if l>1024 then
-            heapsize:=l;
-         end;
-        if c=',' then
-         begin
-           current_scanner^.readchar;
-           current_scanner^.skipspace;
-           l:=current_scanner^.readval;
-           { Ignore this value, because the limit is set by the OS
-             info and shouldn't be changed by the user (PFV) }
-         end;
-      end;
-
-
-    procedure dir_setverbose(t:tdirectivetoken);
-      var
-        flag,
-        state : char;
-      begin
-        case t of
-         _DIR_HINTS : flag:='H';
-      _DIR_WARNINGS : flag:='W';
-         _DIR_NOTES : flag:='N';
-        else
-         exit;
-        end;
-      { support ON/OFF }
-        state:=current_scanner^.ReadState;
-        SetVerbosity(flag+state);
-      end;
-
-
-      type
-        tdirectiveproc=procedure(t:tdirectivetoken);
-      const
-        directiveproc:array[tdirectivetoken] of tdirectiveproc=(
-         {_DIR_NONE} nil,
-         {_DIR_ALIGN} dir_delphiswitch,
-         {_DIR_APPTYPE} dir_apptype,
-         {_DIR_ASMMODE} dir_asmmode,
-         {_DIR_ASSERTION} dir_delphiswitch,
-         {_DIR_BOOLEVAL} dir_delphiswitch,
-         {_DIR_D} dir_description,
-         {_DIR_DEBUGINFO} dir_delphiswitch,
-         {_DIR_DEFINE} dir_define,
-         {_DIR_DESCRIPTION} dir_description,
-         {_DIR_ELSE} dir_conditional,
-         {_DIR_ENDIF} dir_conditional,
-         {_DIR_ERROR} dir_message,
-         {_DIR_EXTENDEDSYNTAX} dir_delphiswitch,
-         {_DIR_FATAL} dir_message,
-         {_DIR_GOTO} dir_moduleswitch,
-         {_DIR_HINT} dir_message,
-         {_DIR_HINTS} dir_setverbose,
-         {_DIR_I} dir_include,
-         {_DIR_I386_ATT} dir_oldasmmode,
-         {_DIR_I386_DIRECT} dir_oldasmmode,
-         {_DIR_I386_INTEL} dir_oldasmmode,
-         {_DIR_IOCHECKS} dir_delphiswitch,
-         {_DIR_IF} dir_conditional,
-         {_DIR_IFDEF} dir_conditional,
-         {_DIR_IFNDEF} dir_conditional,
-         {_DIR_IFOPT} dir_conditional,
-         {_DIR_INCLUDE} dir_include,
-         {_DIR_INCLUDEPATH} dir_includepath,
-         {_DIR_INFO} dir_message,
-         {_DIR_INLINE} dir_moduleswitch,
-         {_DIR_INTERFACES} dir_interfacesswitch,
-         {_DIR_L} dir_linkobject,
-         {_DIR_LIBRARYPATH} dir_librarypath,
-         {_DIR_LINK} dir_linkobject,
-         {_DIR_LINKLIB} dir_linklib,
-         {_DIR_LOCALSYMBOLS} dir_delphiswitch,
-         {_DIR_LONGSTRINGS} dir_delphiswitch,
-         {_DIR_M} dir_memory,
-         {_DIR_MACRO} dir_moduleswitch,
-         {_DIR_MAXFPUREGISTERS} dir_maxfpuregisters,
-         {_DIR_MEMORY} dir_memory,
-         {_DIR_MESSAGE} dir_message,
-         {_DIR_MINENUMSIZE} dir_packenum,
-         {_DIR_MMX} dir_localswitch,
-         {_DIR_MODE} dir_mode,
-         {_DIR_NOTE} dir_message,
-         {_DIR_NOTES} dir_setverbose,
-         {_DIR_OBJECTPATH} dir_objectpath,
-         {_DIR_OPENSTRINGS} dir_delphiswitch,
-         {_DIR_OUTPUT_FORMAT} dir_outputformat,
-         {_DIR_OVERFLOWCHECKS} dir_delphiswitch,
-         {_DIR_PACKENUM} dir_packenum,
-         {_DIR_PACKRECORDS} dir_packrecords,
-         {$IFDEF TestVarsets}
-         {_DIR_PACKSET} dir_packset,
-         {$ENDIF}
-         {_DIR_R} dir_resource,
-         {_DIR_RANGECHECKS} dir_delphiswitch,
-         {_DIR_REFERENCEINFO} dir_delphiswitch,
-         {_DIR_SATURATION} dir_localswitch,
-         {_DIR_SMARTLINK} dir_moduleswitch,
-         {_DIR_STACKFRAMES} dir_delphiswitch,
-         {_DIR_STATIC} dir_moduleswitch,
-         {_DIR_STOP} dir_message,
-         {_DIR_TYPEDADDRESS} dir_delphiswitch,
-         {_DIR_TYPEINFO} dir_delphiswitch,
-         {_DIR_UNDEF} dir_undef,
-         {_DIR_UNITPATH} dir_unitpath,
-         {_DIR_VARSTRINGCHECKS} dir_delphiswitch,
-         {_DIR_VERSION} dir_version,
-         {_DIR_WAIT} dir_wait,
-         {_DIR_WARNING} dir_message,
-         {_DIR_WARNINGS} dir_setverbose,
-         {_DIR_Z1} dir_packenum,
-         {_DIR_Z2} dir_packenum,
-         {_DIR_Z4} dir_packenum
-         );
-
-  {-------------------------------------------
-            Main switches handling
-  -------------------------------------------}
-
-    procedure handledirectives;
-      var
-        t  : tdirectivetoken;
-        p  : tdirectiveproc;
-        hs : string;
-      begin
-         current_scanner^.gettokenpos;
-         current_scanner^.readchar; {Remove the $}
-         hs:=current_scanner^.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 (current_scanner^.ignoredirectives.find(hs)<>nil) then
-          begin
-            if (current_scanner^.comment_level>0) then
-             current_scanner^.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
-            t:=Get_Directive(hs);
-            if t<>_DIR_NONE then
-             begin
-               p:=directiveproc[t];
-               if {$ifndef FPCPROCVAR}@{$endif}p<>nil then
-                p(t);
-             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;
-
-{
-  $Log$
-  Revision 1.20  2001-04-13 01:22:13  peter
-    * symtable change to classes
-    * range check generation and errors fixed, make cycle DEBUG=1 works
-    * memory leaks fixed
-
-  Revision 1.19  2001/03/13 18:45:07  peter
-    * fixed some memory leaks
-
-  Revision 1.18  2001/02/20 21:41:18  peter
-    * new fixfilename, findfile for unix. Look first for lowercase, then
-      NormalCase and last for UPPERCASE names.
-
-  Revision 1.17  2001/01/20 18:32:52  hajny
-    + APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2
-
-  Revision 1.16  2001/01/13 00:09:21  peter
-    * made Pavel O. happy ;)
-
-  Revision 1.15  2000/12/25 00:07:28  peter
-    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
-      tlinkedlist objects)
-
-  Revision 1.14  2000/12/24 12:24:38  peter
-    * moved preprocessfile into a conditional
-
-  Revision 1.13  2000/12/12 19:48:52  peter
-    * fixed lost char after $I directive (merged)
-
-  Revision 1.12  2000/11/12 22:17:47  peter
-    * some realname updates for messages
-
-  Revision 1.11  2000/11/04 14:25:21  florian
-    + merged Attila's changes for interfaces, not tested yet
-
-  Revision 1.10  2000/10/31 22:02:51  peter
-    * symtable splitted, no real code changes
-
-  Revision 1.9  2000/09/26 10:50:41  jonas
-    * initmodeswitches is changed is you change the compiler mode from the
-      command line (the -S<x> switches didn't work anymore for changing the
-      compiler mode) (merged from fixes branch)
-
-  Revision 1.8  2000/09/24 21:33:47  peter
-    * message updates merges
-
-  Revision 1.7  2000/09/24 15:06:27  peter
-    * use defines.inc
-
-  Revision 1.6  2000/09/11 17:00:23  florian
-    + first implementation of Netware Module support, thanks to
-      Armin Diehl ([email protected]) for providing the patches
-
-  Revision 1.5  2000/09/10 21:18:15  peter
-    * macro warning (merged)
-
-  Revision 1.4  2000/08/12 15:30:44  peter
-    * IDE patch for stream reading (merged)
-
-  Revision 1.3  2000/08/08 19:28:57  peter
-    * memdebug/memory patches (merged)
-    * only once illegal directive (merged)
-
-  Revision 1.2  2000/07/13 11:32:49  michael
-  + removed logs
-
-}

compiler/scandir.pas

@@ -0,0 +1,879 @@
+{
+    $Id$
+    Copyright (c) 1998-2000 by Peter Vreman
+
+    This unit implements directive parsing for the scanner
+
+    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 scandir;
+
+{$i defines.inc}
+
+interface
+
+
+    procedure InitScannerDirectives;
+
+implementation
+
+    uses
+      dos,
+      cutils,
+      version,globtype,globals,systems,
+      verbose,comphook,
+      scanner,switches,
+      finput,fmodule;
+
+
+{*****************************************************************************
+                                    Helpers
+*****************************************************************************}
+
+    procedure do_delphiswitch(sw:char);
+      var
+        state : char;
+      begin
+      { c contains the next char, a + or - would be fine }
+        state:=current_scanner.readstate;
+        if state in ['-','+'] then
+          HandleSwitch(sw,state);
+      end;
+
+
+    procedure do_setverbose(flag:char);
+      var
+        state : char;
+      begin
+      { support ON/OFF }
+        state:=current_scanner.ReadState;
+        SetVerbosity(flag+state);
+      end;
+
+
+    procedure do_moduleswitch(sw:tmoduleswitch);
+      var
+        state : char;
+      begin
+        state:=current_scanner.readstate;
+        if (sw<>cs_modulenone) and (state in ['-','+']) then
+         begin
+           if state='-' then
+            exclude(aktmoduleswitches,sw)
+           else
+            include(aktmoduleswitches,sw);
+         end;
+      end;
+
+
+    procedure do_localswitch(sw:tlocalswitch);
+      var
+        state : char;
+      begin
+        state:=current_scanner.readstate;
+        if (sw<>cs_localnone) and (state in ['-','+']) then
+         begin
+           if not localswitcheschanged then
+             nextaktlocalswitches:=aktlocalswitches;
+           if state='-' then
+            nextaktlocalswitches:=nextaktlocalswitches-[sw]
+           else
+            nextaktlocalswitches:=nextaktlocalswitches+[sw];
+           localswitcheschanged:=true;
+         end;
+      end;
+
+
+    procedure do_message(w:integer);
+      begin
+        current_scanner.skipspace;
+        Message1(w,current_scanner.readcomment);
+      end;
+
+{*****************************************************************************
+                              Directive Callbacks
+*****************************************************************************}
+
+    procedure dir_align;
+      begin
+        do_delphiswitch('A');
+      end;
+
+    procedure dir_asmmode;
+      var
+        s : string;
+      begin
+        current_scanner.skipspace;
+        s:=current_scanner.readid;
+        If Inside_asm_statement then
+          Message1(scan_w_no_asm_reader_switch_inside_asm,s);
+        if s='DEFAULT' then
+         aktasmmode:=initasmmode
+        else
+         if not set_string_asmmode(s,aktasmmode) then
+          Message1(scan_w_unsupported_asmmode_specifier,s);
+      end;
+
+    procedure dir_apptype;
+      var
+         hs : string;
+      begin
+        if (target_info.target<>target_i386_win32)
+                                 and (target_info.target<>target_i386_os2) then
+          Message(scan_w_app_type_not_support);
+        if not current_module.in_global then
+          Message(scan_w_switch_is_global)
+        else
+          begin
+             current_scanner.skipspace;
+             hs:=current_scanner.readid;
+             if hs='GUI' then
+               apptype:=app_gui
+             else if hs='CONSOLE' then
+               apptype:=app_cui
+             else if (hs='FS') and (target_info.target=target_i386_os2) then
+               apptype:=app_fs
+             else
+               Message1(scan_w_unsupported_app_type,hs);
+          end;
+      end;
+
+    procedure dir_assertions;
+      begin
+        do_delphiswitch('C');
+      end;
+
+    procedure dir_booleval;
+      begin
+        do_delphiswitch('B');
+      end;
+
+    procedure dir_debuginfo;
+      begin
+        do_delphiswitch('D');
+      end;
+
+    procedure dir_description;
+      begin
+        if not (target_info.target in [target_i386_os2,target_i386_win32,target_i386_netware]) then
+          Message(scan_w_decription_not_support);
+        { change description global var in all cases }
+        { it not used but in win32, os2 and netware }
+        current_scanner.skipspace;
+        description:=current_scanner.readcomment;
+      end;
+
+    procedure dir_error;
+      begin
+        do_message(scan_e_user_defined);
+      end;
+
+    procedure dir_extendedsyntax;
+      begin
+        do_delphiswitch('X');
+      end;
+
+    procedure dir_fatal;
+      begin
+        do_message(scan_f_user_defined);
+      end;
+
+    procedure dir_goto;
+      begin
+        do_moduleswitch(cs_support_goto);
+      end;
+
+    procedure dir_hint;
+      begin
+        do_message(scan_h_user_defined);
+      end;
+
+    procedure dir_hints;
+      begin
+        do_setverbose('H');
+      end;
+
+    procedure dir_includepath;
+      begin
+        if not current_module.in_global then
+         Message(scan_w_switch_is_global)
+        else
+          begin
+            current_scanner.skipspace;
+            current_module.localincludesearchpath.AddPath(current_scanner.readcomment,false);
+          end;
+      end;
+
+    procedure dir_info;
+      begin
+        do_message(scan_i_user_defined);
+      end;
+
+    procedure dir_inline;
+      begin
+        do_moduleswitch(cs_support_inline);
+      end;
+
+    procedure dir_interfaces;
+      var
+        hs : string;
+      begin
+        {corba/com/default}
+        current_scanner.skipspace;
+        hs:=current_scanner.readid;
+        if (hs='CORBA') then
+          aktinterfacetype:=it_interfacecorba
+        else if (hs='COM') then
+          aktinterfacetype:=it_interfacecom
+        else if (hs='DEFAULT') then
+          aktinterfacetype:=initinterfacetype
+        else
+          Message(scan_e_invalid_interface_type);
+      end;
+
+    procedure dir_iochecks;
+      begin
+        do_delphiswitch('I');
+      end;
+
+    procedure dir_librarypath;
+      begin
+        if not current_module.in_global then
+         Message(scan_w_switch_is_global)
+        else
+          begin
+            current_scanner.skipspace;
+            current_module.locallibrarysearchpath.AddPath(current_scanner.readcomment,false);
+          end;
+      end;
+
+    procedure dir_link;
+      var
+        s : string;
+      begin
+        current_scanner.skipspace;
+        s:=AddExtension(FixFileName(current_scanner.readcomment),target_info.objext);
+        current_module.linkotherofiles.add(s,link_allways);
+      end;
+
+    procedure dir_linklib;
+      type
+        tLinkMode=(lm_shared,lm_static);
+      var
+        s : string;
+        quote : char;
+        libname,
+        linkmodestr : string;
+        p : longint;
+        linkMode : tLinkMode;
+      begin
+        current_scanner.skipspace;
+        s:=current_scanner.readcomment;
+        p:=pos(',',s);
+        if p=0 then
+         begin
+           libname:=TrimSpace(s);
+           linkmodeStr:='';
+         end
+        else
+         begin
+           libname:=TrimSpace(copy(s,1,p-1));
+           linkmodeStr:=Upper(TrimSpace(copy(s,p+1,255)));
+         end;
+        if (libname='') or (libname='''''') or (libname='""') then
+         exit;
+        { get linkmode, default is shared linking }
+        if linkModeStr='STATIC' then
+         linkmode:=lm_static
+        else if (LinkModeStr='SHARED') or (LinkModeStr='') then
+         linkmode:=lm_shared
+        else
+         begin
+           Comment(V_Error,'Wrong link mode specified: "'+Linkmodestr+'"');
+           exit;
+         end;
+        { create library name }
+        if libname[1] in ['''','"'] then
+         begin
+           quote:=libname[1];
+           Delete(libname,1,1);
+           p:=pos(quote,libname);
+           if p>0 then
+            Delete(libname,p,1);
+         end;
+        { add to the list of libraries to link }
+        if linkMode=lm_static then
+         current_module.linkOtherStaticLibs.add(FixFileName(libname),link_allways)
+        else
+         current_module.linkOtherSharedLibs.add(FixFileName(libname),link_allways);
+      end;
+
+    procedure dir_localsymbols;
+      begin
+        do_delphiswitch('L');
+      end;
+
+    procedure dir_longstrings;
+      begin
+        do_delphiswitch('H');
+      end;
+
+    procedure dir_macro;
+      begin
+        do_moduleswitch(cs_support_macro);
+      end;
+
+    procedure dir_maxfpuregisters;
+      var
+         l  : integer;
+         hs : string;
+      begin
+         current_scanner.skipspace;
+         if not(c in ['0'..'9']) then
+           begin
+              hs:=current_scanner.readid;
+              if (hs='NORMAL') or (hs='DEFAULT') then
+                aktmaxfpuregisters:=-1
+              else
+                Message(scan_e_invalid_maxfpureg_value);
+           end
+         else
+           begin
+              l:=current_scanner.readval;
+              case l of
+                 0..8:
+                   aktmaxfpuregisters:=l;
+                 else
+                   Message(scan_e_invalid_maxfpureg_value);
+              end;
+           end;
+      end;
+
+    procedure dir_memory;
+      var
+        l : longint;
+      begin
+        current_scanner.skipspace;
+        l:=current_scanner.readval;
+        if l>1024 then
+         stacksize:=l;
+        current_scanner.skipspace;
+        if c=',' then
+         begin
+           current_scanner.readchar;
+           current_scanner.skipspace;
+           l:=current_scanner.readval;
+           if l>1024 then
+            heapsize:=l;
+         end;
+        if c=',' then
+         begin
+           current_scanner.readchar;
+           current_scanner.skipspace;
+           l:=current_scanner.readval;
+           { Ignore this value, because the limit is set by the OS
+             info and shouldn't be changed by the user (PFV) }
+         end;
+      end;
+
+    procedure dir_message;
+      begin
+        do_message(scan_i_user_defined);
+      end;
+
+    procedure dir_mode;
+      begin
+        if not current_module.in_global then
+         Message(scan_w_switch_is_global)
+        else
+          begin
+            current_scanner.skipspace;
+            current_scanner.readstring;
+            if not SetCompileMode(pattern,false) then
+             Message1(scan_w_illegal_switch,pattern);
+          end;
+      end;
+
+    procedure dir_mmx;
+      begin
+        do_localswitch(cs_mmx);
+      end;
+
+    procedure dir_note;
+      begin
+        do_message(scan_n_user_defined);
+      end;
+
+    procedure dir_notes;
+      begin
+        do_setverbose('N');
+      end;
+
+    procedure dir_objectpath;
+      begin
+        if not current_module.in_global then
+         Message(scan_w_switch_is_global)
+        else
+          begin
+            current_scanner.skipspace;
+            current_module.localobjectsearchpath.AddPath(current_scanner.readcomment,false);
+          end;
+      end;
+
+    procedure dir_openstrings;
+      begin
+        do_delphiswitch('P');
+      end;
+
+    procedure dir_output_format;
+      begin
+        if not current_module.in_global then
+         Message(scan_w_switch_is_global)
+        else
+          begin
+            current_scanner.skipspace;
+            if set_string_asm(current_scanner.readid) then
+             aktoutputformat:=target_asm.id
+            else
+             Message1(scan_w_illegal_switch,pattern);
+          end;
+      end;
+
+    procedure dir_overflowchecks;
+      begin
+        do_delphiswitch('Q');
+      end;
+
+    procedure dir_packenum;
+      var
+        hs : string;
+      begin
+        current_scanner.skipspace;
+        if not(c in ['0'..'9']) then
+         begin
+           hs:=current_scanner.readid;
+           if (hs='NORMAL') or (hs='DEFAULT') then
+            aktpackenum:=4
+           else
+            Message(scan_w_only_pack_enum);
+         end
+        else
+         begin
+           case current_scanner.readval of
+            1 : aktpackenum:=1;
+            2 : aktpackenum:=2;
+            4 : aktpackenum:=4;
+           else
+            Message(scan_w_only_pack_enum);
+           end;
+         end;
+      end;
+
+    procedure dir_packrecords;
+      var
+        hs : string;
+      begin
+        current_scanner.skipspace;
+        if not(c in ['0'..'9']) then
+         begin
+           hs:=current_scanner.readid;
+           if (hs='C') then
+            aktpackrecords:=packrecord_C
+           else
+            if (hs='NORMAL') or (hs='DEFAULT') then
+             aktpackrecords:=packrecord_2
+           else
+            Message(scan_w_only_pack_records);
+         end
+        else
+         begin
+           case current_scanner.readval of
+             1 : aktpackrecords:=packrecord_1;
+             2 : aktpackrecords:=packrecord_2;
+             4 : aktpackrecords:=packrecord_4;
+             8 : aktpackrecords:=packrecord_8;
+            16 : aktpackrecords:=packrecord_16;
+            32 : aktpackrecords:=packrecord_32;
+           else
+            Message(scan_w_only_pack_records);
+           end;
+         end;
+      end;
+
+{$ifdef testvarsets}
+    procedure dir_packset;
+      var
+        hs : string;
+      begin
+        current_scanner.skipspace;
+        if not(c in ['1','2','4']) then
+         begin
+           hs:=current_scanner.readid;
+           if (hs='FIXED') or ((hs='DEFAULT') OR (hs='NORMAL')) then
+            aktsetalloc:=0               {Fixed mode, sets are 4 or 32 bytes}
+           else
+            Message(scan_w_only_packset);
+         end
+        else
+         begin
+           case current_scanner.readval of
+            1 : aktsetalloc:=1;
+            2 : aktsetalloc:=2;
+            4 : aktsetalloc:=4;
+           else
+            Message(scan_w_only_packset);
+           end;
+         end;
+      end;
+{$ENDIF}
+
+    procedure dir_rangechecks;
+      begin
+        do_delphiswitch('R');
+      end;
+
+    procedure dir_referenceinfo;
+      begin
+        do_delphiswitch('Y');
+      end;
+
+    procedure dir_resource;
+      var
+        s : string;
+      begin
+        current_scanner.skipspace;
+        s:=current_scanner.readcomment;
+        { replace * with current module name.
+          This should always be defined. }
+        if s[1]='*' then
+          if Assigned(Current_Module) then
+            begin
+            delete(S,1,1);
+            insert(lower(current_module.modulename^),S,1);
+            end;
+        s:=AddExtension(FixFileName(s),target_info.resext);
+        if target_info.res<>res_none then
+          if (target_info.res = res_i386_emx) and
+                                 not (Current_module.ResourceFiles.Empty) then
+            Message(scan_w_only_one_resourcefile_supported)
+          else
+            current_module.resourcefiles.insert(FixFileName(s))
+        else
+          Message(scan_e_resourcefiles_not_supported);
+      end;
+
+    procedure dir_saturation;
+      begin
+        do_localswitch(cs_mmx_saturation);
+      end;
+
+    procedure dir_smartlink;
+      begin
+        do_moduleswitch(cs_create_smart);
+      end;
+
+    procedure dir_stackframes;
+      begin
+        do_delphiswitch('W');
+      end;
+
+    procedure dir_static;
+      begin
+        do_moduleswitch(cs_static_keyword);
+      end;
+
+    procedure dir_stop;
+      begin
+        do_message(scan_f_user_defined);
+      end;
+
+    procedure dir_typedaddress;
+      begin
+        do_delphiswitch('T');
+      end;
+
+    procedure dir_typeinfo;
+      begin
+        do_delphiswitch('M');
+      end;
+
+    procedure dir_unitpath;
+      begin
+        if not current_module.in_global then
+         Message(scan_w_switch_is_global)
+        else
+          begin
+            current_scanner.skipspace;
+            current_module.localunitsearchpath.AddPath(current_scanner.readcomment,false);
+          end;
+      end;
+
+    procedure dir_varstringchecks;
+      begin
+        do_delphiswitch('V');
+      end;
+
+    procedure dir_version;
+      var
+        major, minor, revision : longint;
+        error : integer;
+      begin
+        if not (target_info.target in [target_i386_os2,target_i386_win32,target_i386_netware]) then  // AD
+          begin
+            Message(scan_n_version_not_support);
+            exit;
+          end;
+        if (compile_level<>1) then
+          Message(scan_n_only_exe_version)
+        else
+          begin
+            { change description global var in all cases }
+            { it not used but in win32, os2 and netware }
+            current_scanner.skipspace;
+            { we should only accept Major.Minor format for win32 and os2 }
+            current_scanner.readnumber;
+            major:=0;
+            minor:=0;
+            revision:=0;
+            valint(pattern,major,error);
+            if error<>0 then
+              begin
+                Message1(scan_w_wrong_version_ignored,pattern);
+                exit;
+              end;
+            if c='.' then
+              begin
+                current_scanner.readchar;
+                current_scanner.readnumber;
+                valint(pattern,minor,error);
+                if error<>0 then
+                  begin
+                    Message1(scan_w_wrong_version_ignored,tostr(major)+'.'+pattern);
+                    exit;
+                  end;
+                if (c='.') and
+                   (target_info.target = target_i386_netware) then  // AD
+                  begin
+                     current_scanner.readchar;
+                     current_scanner.readnumber;
+                     valint(pattern,revision,error);
+                     if error<>0 then
+                       begin
+                          Message1(scan_w_wrong_version_ignored,tostr(revision)+'.'+pattern);
+                          exit;
+                       end;
+                     dllmajor:=major;
+                     dllminor:=minor;
+                     dllrevision:=revision;
+                     dllversion:=tostr(major)+','+tostr(minor)+','+tostr(revision);
+                  end
+                else
+                  begin
+                     dllmajor:=major;
+                     dllminor:=minor;
+                     dllversion:=tostr(major)+'.'+tostr(minor);
+                  end;
+              end
+            else
+              dllversion:=tostr(major);
+          end;
+      end;
+
+    procedure dir_wait;
+      var
+        had_info : boolean;
+      begin
+        had_info:=(status.verbosity and V_Info)<>0;
+        { this message should allways appear !! }
+        status.verbosity:=status.verbosity or V_Info;
+        Message(scan_i_press_enter);
+        readln;
+        If not(had_info) then
+          status.verbosity:=status.verbosity and (not V_Info);
+      end;
+
+    procedure dir_warning;
+      begin
+        do_message(scan_w_user_defined);
+      end;
+
+    procedure dir_warnings;
+      begin
+        do_setverbose('W');
+      end;
+
+    procedure dir_z1;
+      begin
+        aktpackenum:=1;
+      end;
+
+    procedure dir_z2;
+      begin
+        aktpackenum:=2;
+      end;
+
+    procedure dir_z4;
+      begin
+        aktpackenum:=4;
+      end;
+
+
+{****************************************************************************
+                         Initialize Directives
+****************************************************************************}
+
+    procedure InitScannerDirectives;
+      begin
+        AddDirective('ALIGN',{$ifdef FPCPROCVAR}@{$endif}dir_align);
+        AddDirective('APPTYPE',{$ifdef FPCPROCVAR}@{$endif}dir_apptype);
+        AddDirective('ASMMODE',{$ifdef FPCPROCVAR}@{$endif}dir_asmmode);
+        AddDirective('ASSERTIONS',{$ifdef FPCPROCVAR}@{$endif}dir_assertions);
+        AddDirective('BOOLEVAL',{$ifdef FPCPROCVAR}@{$endif}dir_booleval);
+        AddDirective('D',{$ifdef FPCPROCVAR}@{$endif}dir_description);
+        AddDirective('DEBUGINFO',{$ifdef FPCPROCVAR}@{$endif}dir_debuginfo);
+        AddDirective('DESCRIPTION',{$ifdef FPCPROCVAR}@{$endif}dir_description);
+        AddDirective('ERROR',{$ifdef FPCPROCVAR}@{$endif}dir_error);
+        AddDirective('EXTENDEDSYNTAX',{$ifdef FPCPROCVAR}@{$endif}dir_extendedsyntax);
+        AddDirective('FATAL',{$ifdef FPCPROCVAR}@{$endif}dir_fatal);
+        AddDirective('GOTO',{$ifdef FPCPROCVAR}@{$endif}dir_goto);
+        AddDirective('HINT',{$ifdef FPCPROCVAR}@{$endif}dir_hint);
+        AddDirective('HINTS',{$ifdef FPCPROCVAR}@{$endif}dir_hints);
+        AddDirective('IOCHECKS',{$ifdef FPCPROCVAR}@{$endif}dir_iochecks);
+        AddDirective('INCLUDEPATH',{$ifdef FPCPROCVAR}@{$endif}dir_includepath);
+        AddDirective('INFO',{$ifdef FPCPROCVAR}@{$endif}dir_info);
+        AddDirective('INLINE',{$ifdef FPCPROCVAR}@{$endif}dir_inline);
+        AddDirective('INTERFACES',{$ifdef FPCPROCVAR}@{$endif}dir_interfaces);
+        AddDirective('L',{$ifdef FPCPROCVAR}@{$endif}dir_link);
+        AddDirective('LIBRARYPATH',{$ifdef FPCPROCVAR}@{$endif}dir_librarypath);
+        AddDirective('LINK',{$ifdef FPCPROCVAR}@{$endif}dir_link);
+        AddDirective('LINKLIB',{$ifdef FPCPROCVAR}@{$endif}dir_linklib);
+        AddDirective('LOCALSYMBOLS',{$ifdef FPCPROCVAR}@{$endif}dir_localsymbols);
+        AddDirective('LONGSTRINGS',{$ifdef FPCPROCVAR}@{$endif}dir_longstrings);
+        AddDirective('M',{$ifdef FPCPROCVAR}@{$endif}dir_memory);
+        AddDirective('MACRO',{$ifdef FPCPROCVAR}@{$endif}dir_macro);
+        AddDirective('MAXFPUREGISTERS',{$ifdef FPCPROCVAR}@{$endif}dir_maxfpuregisters);
+        AddDirective('MEMORY',{$ifdef FPCPROCVAR}@{$endif}dir_memory);
+        AddDirective('MESSAGE',{$ifdef FPCPROCVAR}@{$endif}dir_message);
+        AddDirective('MINENUMSIZE',{$ifdef FPCPROCVAR}@{$endif}dir_packenum);
+        AddDirective('MMX',{$ifdef FPCPROCVAR}@{$endif}dir_mmx);
+        AddDirective('MODE',{$ifdef FPCPROCVAR}@{$endif}dir_mode);
+        AddDirective('NOTE',{$ifdef FPCPROCVAR}@{$endif}dir_note);
+        AddDirective('NOTES',{$ifdef FPCPROCVAR}@{$endif}dir_notes);
+        AddDirective('OBJECTPATH',{$ifdef FPCPROCVAR}@{$endif}dir_objectpath);
+        AddDirective('OPENSTRINGS',{$ifdef FPCPROCVAR}@{$endif}dir_openstrings);
+        AddDirective('OUTPUT_FORMAT',{$ifdef FPCPROCVAR}@{$endif}dir_output_format);
+        AddDirective('OVERFLOWCHECKS',{$ifdef FPCPROCVAR}@{$endif}dir_overflowchecks);
+        AddDirective('PACKENUM',{$ifdef FPCPROCVAR}@{$endif}dir_packenum);
+        AddDirective('PACKRECORDS',{$ifdef FPCPROCVAR}@{$endif}dir_packrecords);
+{$IFDEF TestVarsets}
+        AddDirective('PACKSET',{$ifdef FPCPROCVAR}@{$endif}dir_packset);
+{$ENDIF}
+        AddDirective('R',{$ifdef FPCPROCVAR}@{$endif}dir_resource);
+        AddDirective('RANGECHECKS',{$ifdef FPCPROCVAR}@{$endif}dir_rangechecks);
+        AddDirective('REFERENCEINFO',{$ifdef FPCPROCVAR}@{$endif}dir_referenceinfo);
+        AddDirective('SATURATION',{$ifdef FPCPROCVAR}@{$endif}dir_saturation);
+        AddDirective('SMARTLINK',{$ifdef FPCPROCVAR}@{$endif}dir_smartlink);
+        AddDirective('STACKFRAMES',{$ifdef FPCPROCVAR}@{$endif}dir_stackframes);
+        AddDirective('STATIC',{$ifdef FPCPROCVAR}@{$endif}dir_static);
+        AddDirective('STOP',{$ifdef FPCPROCVAR}@{$endif}dir_stop);
+        AddDirective('TYPEDADDRESS',{$ifdef FPCPROCVAR}@{$endif}dir_typedaddress);
+        AddDirective('TYPEINFO',{$ifdef FPCPROCVAR}@{$endif}dir_typeinfo);
+        AddDirective('UNITPATH',{$ifdef FPCPROCVAR}@{$endif}dir_unitpath);
+        AddDirective('VARSTRINGCHECKS',{$ifdef FPCPROCVAR}@{$endif}dir_varstringchecks);
+        AddDirective('VERSION',{$ifdef FPCPROCVAR}@{$endif}dir_version);
+        AddDirective('WAIT',{$ifdef FPCPROCVAR}@{$endif}dir_wait);
+        AddDirective('WARNING',{$ifdef FPCPROCVAR}@{$endif}dir_warning);
+        AddDirective('WARNINGS',{$ifdef FPCPROCVAR}@{$endif}dir_warnings);
+        AddDirective('Z1',{$ifdef FPCPROCVAR}@{$endif}dir_z1);
+        AddDirective('Z2',{$ifdef FPCPROCVAR}@{$endif}dir_z2);
+        AddDirective('Z4',{$ifdef FPCPROCVAR}@{$endif}dir_z4);
+      end;
+
+
+
+end.
+{
+  $Log$
+  Revision 1.1  2001-04-13 18:00:36  peter
+    * easier registration of directives
+
+  Revision 1.20  2001/04/13 01:22:13  peter
+    * symtable change to classes
+    * range check generation and errors fixed, make cycle DEBUG=1 works
+    * memory leaks fixed
+
+  Revision 1.19  2001/03/13 18:45:07  peter
+    * fixed some memory leaks
+
+  Revision 1.18  2001/02/20 21:41:18  peter
+    * new fixfilename, findfile for unix. Look first for lowercase, then
+      NormalCase and last for UPPERCASE names.
+
+  Revision 1.17  2001/01/20 18:32:52  hajny
+    + APPTYPE support under OS/2, app_fs, GetEnvPChar for OS/2
+
+  Revision 1.16  2001/01/13 00:09:21  peter
+    * made Pavel O. happy ;)
+
+  Revision 1.15  2000/12/25 00:07:28  peter
+    + new tlinkedlist class (merge of old tstringqueue,tcontainer and
+      tlinkedlist objects)
+
+  Revision 1.14  2000/12/24 12:24:38  peter
+    * moved preprocessfile into a conditional
+
+  Revision 1.13  2000/12/12 19:48:52  peter
+    * fixed lost char after $I directive (merged)
+
+  Revision 1.12  2000/11/12 22:17:47  peter
+    * some realname updates for messages
+
+  Revision 1.11  2000/11/04 14:25:21  florian
+    + merged Attila's changes for interfaces, not tested yet
+
+  Revision 1.10  2000/10/31 22:02:51  peter
+    * symtable splitted, no real code changes
+
+  Revision 1.9  2000/09/26 10:50:41  jonas
+    * initmodeswitches is changed is you change the compiler mode from the
+      command line (the -S<x> switches didn't work anymore for changing the
+      compiler mode) (merged from fixes branch)
+
+  Revision 1.8  2000/09/24 21:33:47  peter
+    * message updates merges
+
+  Revision 1.7  2000/09/24 15:06:27  peter
+    * use defines.inc
+
+  Revision 1.6  2000/09/11 17:00:23  florian
+    + first implementation of Netware Module support, thanks to
+      Armin Diehl ([email protected]) for providing the patches
+
+  Revision 1.5  2000/09/10 21:18:15  peter
+    * macro warning (merged)
+
+  Revision 1.4  2000/08/12 15:30:44  peter
+    * IDE patch for stream reading (merged)
+
+  Revision 1.3  2000/08/08 19:28:57  peter
+    * memdebug/memory patches (merged)
+    * only once illegal directive (merged)
+
+  Revision 1.2  2000/07/13 11:32:49  michael
+  + removed logs
+
+}

compiler/scanner.pas

@@ -66,8 +66,17 @@ interface
           constructor Create(atyp:preproctyp;a:boolean;n:tpreprocstack);
        end;
 
-       pscannerfile = ^tscannerfile;
-       tscannerfile = object
+       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
           inputfile    : tinputfile;  { current inputfile list }
 
           inputbuffer,                { input buffer }
@@ -90,8 +99,11 @@ interface
           macros         : Tdictionary;
           in_asm_string  : boolean;
 
-          constructor init(const fn:string);
-          destructor done;
+          preproc_pattern : string;
+          preproc_token   : ttoken;
+
+          constructor Create(const fn:string);
+          destructor Destroy;override;
         { File buffer things }
           function  openinputfile:boolean;
           procedure closeinputfile;
@@ -115,6 +127,8 @@ interface
           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;
@@ -134,14 +148,13 @@ interface
        end;
 
 {$ifdef PREPROCWRITE}
-       tpreprocfile=^tpreprocfile;
-       tpreprocfile=object
+       tpreprocfile=class
          f   : text;
          buf : pointer;
          spacefound,
          eolfound : boolean;
-         constructor init(const fn:string);
-         destructor  done;
+         constructor create(const fn:string);
+         destructor  destroy;
          procedure Add(const s:string);
          procedure AddSpace;
        end;
@@ -152,18 +165,27 @@ interface
         c              : char;
         orgpattern,
         pattern        : string;
-        patternw : tcompilerwidestring;
+        patternw       : tcompilerwidestring;
 
         { token }
         token,                        { current token being parsed }
         idtoken    : ttoken;          { holds the token if the pattern is a known word }
 
-        current_scanner : pscannerfile;
+        current_scanner : tscannerfile;  { current scanner in use }
+
+        scannerdirectives : tdictionary; { dictionary with the supported directives }
+
         aktcommentstyle : tcommentstyle; { needed to use read_comment from directives }
 {$ifdef PREPROCWRITE}
-        preprocfile     : tpreprocfile; { used with only preprocessing }
+        preprocfile     : tpreprocfile;  { used with only preprocessing }
 {$endif PREPROCWRITE}
 
+    procedure adddirective(const s:string;p:tdirectiveproc);
+    procedure addconditional(const s:string;p:tdirectiveproc);
+
+    procedure InitScanner;
+    procedure DoneScanner;
+
 
 implementation
 
@@ -212,6 +234,462 @@ implementation
       end;
 
 
+{*****************************************************************************
+                           Conditional Directives
+*****************************************************************************}
+
+    procedure dir_else;
+      begin
+        current_scanner.elsepreprocstack;
+      end;
+
+
+    procedure dir_endif;
+      begin
+        current_scanner.poppreprocstack;
+      end;
+
+
+    procedure dir_ifdef;
+      var
+        hs    : string;
+        mac   : tmacro;
+      begin
+        current_scanner.skipspace;
+        hs:=current_scanner.readid;
+        mac:=tmacro(current_scanner.macros.search(hs));
+        if assigned(mac) then
+          mac.is_used:=true;
+        current_scanner.addpreprocstack(pp_ifdef,assigned(mac) and mac.defined,hs,scan_c_ifdef_found);
+      end;
+
+
+    procedure dir_ifndef;
+      var
+        hs    : string;
+        mac   : tmacro;
+      begin
+        current_scanner.skipspace;
+        hs:=current_scanner.readid;
+        mac:=tmacro(current_scanner.macros.search(hs));
+        if assigned(mac) then
+          mac.is_used:=true;
+        current_scanner.addpreprocstack(pp_ifndef,not(assigned(mac) and mac.defined),hs,scan_c_ifndef_found);
+      end;
+
+
+    procedure dir_ifopt;
+      var
+        hs    : string;
+        found : boolean;
+        state : char;
+      begin
+        current_scanner.skipspace;
+        hs:=current_scanner.readid;
+        if (length(hs)>1) 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;
+
+
+    procedure dir_if;
+
+        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 read_factor : string;
+        var
+           hs : string;
+           mac : tmacro;
+           len : byte;
+        begin
+           if current_scanner.preproc_token=_ID then
+             begin
+                if current_scanner.preproc_pattern='NOT' then
+                  begin
+                     preproc_consume(_ID);
+                     hs:=read_expr;
+                     if hs='0' then
+                       read_factor:='1'
+                     else
+                       read_factor:='0';
+                  end
+                else
+                  begin
+                     mac:=tmacro(current_scanner.macros.search(hs));
+                     hs:=current_scanner.preproc_pattern;
+                     preproc_consume(_ID);
+                     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
+                          else
+                            read_factor:='';
+                       end
+                     else
+                       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;
+        begin
+           hs1:=read_factor;
+           while true do
+             begin
+                if (current_scanner.preproc_token=_ID) then
+                  begin
+                     if current_scanner.preproc_pattern='AND' then
+                       begin
+                          preproc_consume(_ID);
+                          hs2:=read_factor;
+                          if (hs1<>'0') and (hs2<>'0') then
+                            hs1:='1';
+                       end
+                     else
+                       break;
+                  end
+                else
+                  break;
+             end;
+           read_term:=hs1;
+        end;
+
+
+        function read_simple_expr : string;
+        var
+           hs1,hs2 : string;
+        begin
+           hs1:=read_term;
+           while true do
+             begin
+                if (current_scanner.preproc_token=_ID) then
+                  begin
+                     if current_scanner.preproc_pattern='OR' then
+                       begin
+                          preproc_consume(_ID);
+                          hs2:=read_term;
+                          if (hs1<>'0') or (hs2<>'0') then
+                            hs1:='1';
+                       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:=l1<l2;
+                      _GT : b:=l1>l2;
+                     _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:=hs1<hs2;
+                      _GT : b:=hs1>hs2;
+                     _GTE : b:=hs1>=hs2;
+                     _LTE : b:=hs1<=hs2;
+                end;
+             end;
+           if b then
+             read_expr:='1'
+           else
+             read_expr:='0';
+        end;
+
+      var
+        hs : string;
+      begin
+        current_scanner.skipspace;
+        { start preproc expression scanner }
+        current_scanner.preproc_token:=current_scanner.readpreproc;
+        hs:=read_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_m_macro_defined,mac.name);
+            current_scanner.macros.insert(mac);
+          end
+        else
+          begin
+            Message1(parser_m_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);
+                           #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_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_m_macro_undefined,mac.name);
+             mac.defined:=false;
+             current_scanner.macros.insert(mac);
+          end
+        else
+          begin
+             Message1(parser_m_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;
+      var
+        foundfile,
+        hs    : string;
+        path  : dirstr;
+        name  : namestr;
+        ext   : extstr;
+        hp    : tinputfile;
+        i     : longint;
+        found : boolean;
+      begin
+        current_scanner.skipspace;
+        hs:=current_scanner.readcomment;
+        i:=length(hs);
+        while (i>0) and (hs[i]=' ') do
+         dec(i);
+        Delete(hs,i+1,length(hs)-i);
+        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
+             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));
+         end
+        else
+         begin
+           hs:=FixFileName(hs);
+           fsplit(hs,path,name,ext);
+         { look for the include file
+            1. specified path,path of current inputfile,current dir
+            2. local includepath
+            3. global includepath }
+           found:=false;
+           foundfile:='';
+           if path<>'' then
+             path:=path+';';
+           found:=FindFile(name+ext,path+current_scanner.inputfile.path^+';.'+DirSep,foundfile);
+           if (not found) then
+            found:=current_module.localincludesearchpath.FindFile(name+ext,foundfile);
+           if (not found) then
+            found:=includesearchpath.FindFile(name+ext,foundfile);
+         { save old postion and decrease linebreak }
+           if c=newline then
+            dec(current_scanner.line_no);
+           dec(longint(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 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;
+         { process first read char }
+           case c of
+            #26 : current_scanner.reload;
+            #10,
+            #13 : current_scanner.linebreak;
+           end;
+         end;
+      end;
+
+
+
 {*****************************************************************************
                                  TMacro
 *****************************************************************************}
@@ -240,7 +718,7 @@ implementation
 *****************************************************************************}
 
 {$ifdef PREPROCWRITE}
-    constructor tpreprocfile.init(const fn:string);
+    constructor tpreprocfile.create(const fn:string);
       begin
       { open outputfile }
         assign(f,fn);
@@ -257,7 +735,7 @@ implementation
       end;
 
 
-    destructor tpreprocfile.done;
+    destructor tpreprocfile.destroy;
       begin
         close(f);
         freemem(buf,preprocbufsize);
@@ -299,11 +777,30 @@ implementation
       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.init(const fn:string);
+    constructor tscannerfile.create(const fn:string);
       begin
         inputfile:=do_openinputfile(fn);
         if assigned(current_module) then
@@ -340,7 +837,7 @@ implementation
       end;
 
 
-    destructor tscannerfile.done;
+    destructor tscannerfile.destroy;
       begin
         if not invalid then
           begin
@@ -692,6 +1189,9 @@ implementation
         Message(scan_f_end_of_file);
       end;
 
+  {-------------------------------------------
+           IF Conditional Handling
+  -------------------------------------------}
 
     procedure tscannerfile.checkpreprocstack;
       begin
@@ -750,6 +1250,117 @@ implementation
       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;
+               p:=tdirectiveitem(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
+            t:=tdirectiveitem(scannerdirectives.search(hs));
+            if assigned(t) then
+             begin
+               if t.is_conditional then
+                handleconditional(t)
+               else
+                t.proc{$ifdef FPCPROCVAR}(){$endif};
+             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^;
@@ -963,8 +1574,8 @@ implementation
         state:=' ';
         if c=' ' then
          begin
-           current_scanner^.skipspace;
-           current_scanner^.readid;
+           current_scanner.skipspace;
+           current_scanner.readid;
            if pattern='ON' then
             state:='+'
            else
@@ -1101,13 +1712,6 @@ implementation
       end;
 
 
-{****************************************************************************
-                      Include directive scanning/parsing
-****************************************************************************}
-
-{$i scandir.inc}
-
-
 {****************************************************************************
                              Comment Handling
 ****************************************************************************}
@@ -1817,7 +2421,7 @@ exit_label:
         'A'..'Z',
         'a'..'z',
     '_','0'..'9' : begin
-                     preprocpat:=readid;
+                     current_scanner.preproc_pattern:=readid;
                      readpreproc:=_ID;
                    end;
              '}' : begin
@@ -1941,10 +2545,58 @@ exit_label:
          end;
       end;
 
+
+{*****************************************************************************
+                                   Helpers
+*****************************************************************************}
+
+    procedure adddirective(const s:string;p:tdirectiveproc);
+      begin
+        scannerdirectives.insert(tdirectiveitem.create(s,p));
+      end;
+
+
+    procedure addconditional(const s:string;p:tdirectiveproc);
+      begin
+        scannerdirectives.insert(tdirectiveitem.createcond(s,p));
+      end;
+
+
+{*****************************************************************************
+                                Initialization
+*****************************************************************************}
+
+    procedure InitScanner;
+      begin
+        scannerdirectives:=TDictionary.Create;
+        { Default directives }
+        AddDirective('DEFINE',{$ifdef FPCPROCVAR}@{$endif}dir_define);
+        AddDirective('UNDEF',{$ifdef FPCPROCVAR}@{$endif}dir_undef);
+        AddDirective('I',{$ifdef FPCPROCVAR}@{$endif}dir_include);
+        AddDirective('INCLUDE',{$ifdef FPCPROCVAR}@{$endif}dir_include);
+        { Default conditionals }
+        AddConditional('ELSE',{$ifdef FPCPROCVAR}@{$endif}dir_else);
+        AddConditional('ENDIF',{$ifdef FPCPROCVAR}@{$endif}dir_endif);
+        AddConditional('IF',{$ifdef FPCPROCVAR}@{$endif}dir_if);
+        AddConditional('IFDEF',{$ifdef FPCPROCVAR}@{$endif}dir_ifdef);
+        AddConditional('IFNDEF',{$ifdef FPCPROCVAR}@{$endif}dir_ifndef);
+        AddConditional('IFOPT',{$ifdef FPCPROCVAR}@{$endif}dir_ifopt);
+      end;
+
+
+    procedure DoneScanner;
+      begin
+        scannerdirectives.Free;
+      end;
+
+
 end.
 {
   $Log$
-  Revision 1.14  2001-04-13 01:22:13  peter
+  Revision 1.15  2001-04-13 18:00:36  peter
+    * easier registration of directives
+
+  Revision 1.14  2001/04/13 01:22:13  peter
     * symtable change to classes
     * range check generation and errors fixed, make cycle DEBUG=1 works
     * memory leaks fixed