+ the new files for the scanner

compiler/scandir.inc

@@ -0,0 +1,803 @@
+{
+    $Id$
+    Copyright (c) 1998 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=16;
+type
+   directivestr=string[directivelen];
+   tdirectivetoken=(
+     _DIR_NONE,
+     _DIR_D,_DIR_DEFINE,
+     _DIR_ELSE,_DIR_ENDIF,_DIR_ERROR,
+     _DIR_FATAL,
+     _DIR_I,_DIR_I386_ATT,_DIR_I386_DIRECT,_DIR_I386_INTEL,_DIR_IF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,
+     _DIR_INFO,
+     _DIR_L,_DIR_LINKLIB,
+     _DIR_MESSAGE,_DIR_MMX,
+     _DIR_NOTE,
+     _DIR_OUTPUT_FORMAT,
+     _DIR_PACKRECORDS,
+     _DIR_SATURATION,_DIR_STOP,
+     _DIR_UNDEF,
+     _DIR_WAIT,_DIR_WARNING
+     );
+const
+   firstdirective=_DIR_NONE;
+   lastdirective=_DIR_WARNING;
+   directive:array[tdirectivetoken] of directivestr=(
+     '',
+     'D','DEFINE',
+     'ELSE','ENDIF','ERROR',
+     'FATAL',
+     'I','I386_ATT','I386_DIRECT','I386_INTEL','IF','IFDEF','IFNDEF','IFOPT','INFO',
+     'L','LINKLIB',
+     'MESSAGE','MMX',
+     'NOTE',
+     'OUTPUT_FORMAT',
+     'PACKRECORDS',
+     'SATURATION','STOP',
+     'UNDEF',
+     'WAIT','WARNING'
+     );
+
+
+
+    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;
+
+    function read_preproc : ttoken;
+      begin
+         skipspace;
+         case c of
+        'A'..'Z',
+        'a'..'z',
+    '_','0'..'9' : begin
+                     preprocpat:=readid;
+                     read_preproc:=ID;
+                   end;
+             '(' : begin
+                     readchar;
+                     read_preproc:=LKLAMMER;
+                   end;
+             ')' : begin
+                     readchar;
+                     read_preproc:=RKLAMMER;
+                   end;
+             '+' : begin
+                     readchar;
+                     read_preproc:=PLUS;
+                   end;
+             '-' : begin
+                     readchar;
+                     read_preproc:=MINUS;
+                   end;
+             '*' : begin
+                     readchar;
+                     read_preproc:=STAR;
+                   end;
+             '/' : begin
+                     readchar;
+                     read_preproc:=SLASH;
+                   end;
+             '=' : begin
+                     readchar;
+                     read_preproc:=EQUAL;
+                   end;
+             '>' : begin
+                     readchar;
+                     if c='=' then
+                      begin
+                        readchar;
+                        read_preproc:=GTE;
+                      end
+                     else
+                      read_preproc:=GT;
+                   end;
+             '<' : begin
+                     readchar;
+                     case c of
+                      '>' : begin
+                              readchar;
+                              read_preproc:=UNEQUAL;
+                            end;
+                      '=' : begin
+                              readchar;
+                              read_preproc:=LTE;
+                            end;
+                     else   read_preproc:=LT;
+                     end;
+                   end;
+             #26 : Message(scan_f_end_of_file);
+         else
+          begin
+            read_preproc:=_EOF;
+          end;
+         end;
+      end;
+
+
+    procedure preproc_consume(t : ttoken);
+      begin
+         if t<>preproc_token then
+          Message(scan_e_preproc_syntax_error);
+         preproc_token:=read_preproc;
+      end;
+
+    function read_expr : string;forward;
+
+    function read_factor : string;
+      var
+         hs : string;
+         mac : pmacrosym;
+         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:=pmacrosym(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_marco_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 : word;
+         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);
+
+       procedure newpreproc(isifdef,a:boolean;const s:string;w:tmsgconst);
+       begin
+         preprocstack:=new(ppreprocstack,init(isifdef,
+           ((preprocstack=nil) or preprocstack^.accept) and a,preprocstack));
+         preprocstack^.name:=s;
+         preprocstack^.line_nb:=current_module^.current_inputfile^.line_no;
+         if preprocstack^.accept then
+          Message2(w,preprocstack^.name,'accepted')
+         else
+          Message2(w,preprocstack^.name,'rejected');
+       end;
+
+      var
+        hs    : string;
+        mac   : pmacrosym;
+        found : boolean;
+      begin
+        while true do
+         begin
+           case t of
+   _DIR_ENDIF : begin
+                { we can always accept an ELSE }
+                  if assigned(preprocstack) then
+                   begin
+                     Message1(scan_c_endif_found,preprocstack^.name);
+                     if not preprocstack^.isifdef then
+                      popstack;
+                   end
+                  else
+                   Message(scan_e_endif_without_if);
+                { now pop the condition }
+                  if assigned(preprocstack) then
+                   begin
+                   { we only use $ifdef in the stack }
+                     if preprocstack^.isifdef then
+                      popstack
+                     else
+                      Message(scan_e_too_much_endifs);
+                   end
+                  else
+                   Message(scan_e_endif_without_if);
+                end;
+    _DIR_ELSE : begin
+                  if assigned(preprocstack) then
+                   begin
+                     preprocstack:=new(ppreprocstack,init(false,
+                       not(preprocstack^.accept) and
+                       ((preprocstack^.next=nil) or (preprocstack^.next^.accept)),preprocstack));
+                     preprocstack^.line_nb:=current_module^.current_inputfile^.line_no;
+                     preprocstack^.name:=preprocstack^.next^.name;
+                     if preprocstack^.accept then
+                      Message2(scan_c_else_found,preprocstack^.name,'accepted')
+                     else
+                      Message2(scan_c_else_found,preprocstack^.name,'rejected');
+                   end
+                  else
+                   Message(scan_e_endif_without_if);
+                end;
+   _DIR_IFDEF : begin
+                  skipspace;
+                  hs:=readid;
+                  mac:=pmacrosym(macros^.search(hs));
+                  newpreproc(true,assigned(mac) and mac^.defined,hs,scan_c_ifdef_found);
+                end;
+   _DIR_IFOPT : begin
+                  skipspace;
+                  hs:=readid;
+                  if (length(hs)=1) and (c in ['-','+']) then
+                   begin
+                     found:=CheckSwitch(hs[1],c);
+                     readchar; {read + or -}
+                   end
+                  else
+                   Message(scan_w_illegal_switch);
+                  newpreproc(true,found,hs,scan_c_ifopt_found);
+                end;
+      _DIR_IF : begin
+                  skipspace;
+                  { start preproc expression scanner }
+                  preproc_token:=read_preproc;
+                  hs:=read_expr;
+                  newpreproc(true,hs<>'0',hs,scan_c_if_found);
+                end;
+  _DIR_IFNDEF : begin
+                  skipspace;
+                  hs:=readid;
+                  mac:=pmacrosym(macros^.search(hs));
+                  newpreproc(true,not(assigned(mac) and mac^.defined),hs,scan_c_ifndef_found);
+                end;
+           end;
+         { accept the text ? }
+           if (preprocstack=nil) or preprocstack^.accept then
+            break
+           else
+            begin
+              Message(scan_c_skipping_until);
+              repeat
+                skipuntildirective;
+                t:=Get_Directive(readid);
+              until is_conditional(t);
+            end;
+         end;
+      end;
+
+
+    procedure dir_define(t:tdirectivetoken);
+      var
+        ht  : ttoken;
+        hs2,
+        hs  : string;
+        mac : pmacrosym;
+      begin
+        skipspace;
+        hs:=readid;
+        mac:=pmacrosym(macros^.search(hs));
+        if not assigned(mac) then
+          begin
+            mac:=new(pmacrosym,init(hs));
+            mac^.defined:=true;
+            Message1(parser_m_macro_defined,mac^.name);
+            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;
+        if support_macros then
+          begin
+          { key words are never substituted }
+             hs2:=pattern;
+             pattern:=hs;
+             if is_keyword(ht) then
+              Message(scan_e_keyword_cant_be_a_macro);
+             pattern:=hs2;
+           { !!!!!! handle macro params, need we this? }
+             skipspace;
+           { may be a macro? }
+             if c=':' then
+               begin
+                  readchar;
+                  if c='=' then
+                    begin
+                       { first char }
+                       readchar;
+                       macropos:=0;
+                       while (c<>'}') do
+                         begin
+                            macrobuffer^[macropos]:=c;
+                            readchar;
+                            if c=#26 then Message(scan_f_end_of_file);
+                            inc(macropos);
+                            if macropos>maxmacrolen then
+                             Message(scan_f_macro_buffer_overflow);
+                         end;
+                       { 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);
+                    end;
+               end;
+          end;
+      end;
+
+
+    procedure dir_undef(t:tdirectivetoken);
+      var
+        hs  : string;
+        mac : pmacrosym;
+      begin
+        skipspace;
+        hs:=readid;
+        mac:=pmacrosym(macros^.search(hs));
+        if not assigned(mac) then
+          begin
+             mac:=new(pmacrosym,init(hs));
+             Message1(parser_m_macro_undefined,mac^.name);
+             mac^.defined:=false;
+             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;
+      end;
+
+
+    procedure dir_message(t:tdirectivetoken);
+      var
+        w   : tmsgconst;
+      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_NOTE : w:=scan_n_user_defined;
+    _DIR_MESSAGE,
+       _DIR_INFO : w:=scan_i_user_defined;
+        end;
+        skipspace;
+        Message1(w,readcomment);
+      end;
+
+
+    procedure dir_switch(t:tdirectivetoken);
+{$ifdef SUPPORT_MMX}
+      var
+        sw : tcswitch;
+{$endif}
+      begin
+{$ifdef SUPPORT_MMX}
+        case t of
+          _DIR_MMX : sw:=cs_mmx;
+   _DIR_SATURATION : sw:=cs_mmx_saturation;
+        end;
+{$endif}
+      end;
+
+
+    procedure dir_include(t:tdirectivetoken);
+      var
+        hs    : string;
+        path  : dirstr;
+        name  : namestr;
+        ext   : extstr;
+        hp    : pinputfile;
+        found : boolean;
+      begin
+        skipspace;
+        hs:=readcomment;
+	while (hs<>'') and (hs[length(hs)]=' ') do
+	 dec(byte(hs[0]));
+	hs:=FixFileName(hs);
+        fsplit(hs,path,name,ext);
+      { first look in the path of _d then currentmodule }
+        path:=search(hs,path+';'+current_module^.current_inputfile^.path^+';'+includesearchpath,found);
+        hp:=new(pinputfile,init(path,name,ext));
+        hp^.reset;
+        if ioresult=0 then
+         begin
+           current_module^.current_inputfile^.bufpos:=longint(inputpointer)-longint(inputbuffer);
+           hp^.next:=current_module^.current_inputfile;
+           current_module^.current_inputfile:=hp;
+           current_module^.sourcefiles.register_file(hp);
+           inputbuffer:=current_module^.current_inputfile^.buf;
+           Message1(scan_u_start_include_file,current_module^.current_inputfile^.name^);
+           reload;
+         end
+        else
+         Message1(scan_f_cannot_open_includefile,hs);
+      end;
+
+
+    procedure dir_description(t:tdirectivetoken);
+      begin
+      end;
+
+
+    procedure dir_linkobject(t:tdirectivetoken);
+      var
+        path,hs : string;
+        found   : boolean;
+      begin
+        skipspace;
+        hs:=FixFileName(readstring);
+        if (not path_absolute(hs)) and (not assigned(current_module^.current_inputfile^.path)) then
+         path:=search(hs,current_module^.current_inputfile^.path^+';'+objectsearchpath,found);
+        Linker.AddObjectFile(path+hs);
+        current_module^.linkofiles.insert(hs);
+      end;
+
+
+    procedure dir_linklib(t:tdirectivetoken);
+      var
+        hs : string;
+      begin
+        skipspace;
+        hs:=FixFileName(readstring);
+        Linker.AddLibraryFile(hs);
+        current_module^.linklibfiles.insert(hs);
+      end;
+
+
+    procedure dir_outputformat(t:tdirectivetoken);
+      var
+        hs : string;
+      begin
+        if not current_module^.in_main then
+         Message(scan_w_switch_is_global)
+        else
+          begin
+            skipspace;
+            hs:=readid;
+{$ifdef i386}
+            if hs='NASM' then
+              current_module^.output_format:=of_nasm
+            else
+             if hs='MASM' then
+              current_module^.output_format:=of_masm
+            else
+             if hs='O' then
+              current_module^.output_format:=of_o
+            else
+             if hs='OBJ' then
+              current_module^.output_format:=of_obj
+            else
+{$endif}
+              Message(scan_w_illegal_switch);
+          end;
+      { for use in globals }
+        output_format:=current_module^.output_format;
+      end;
+
+    procedure dir_packrecords(t:tdirectivetoken);
+      var
+        hs : string;
+      begin
+        skipspace;
+        if upcase(c)='N' then
+         begin
+           hs:=readid;
+           if hs='NORMAL' then
+            aktpackrecords:=2
+           else
+            Message(scan_w_only_pack_records);
+         end
+        else
+         begin
+           case readval of
+            1 : aktpackrecords:=1;
+            2 : aktpackrecords:=2;
+            4 : aktpackrecords:=4;
+           else
+            Message(scan_w_only_pack_records);
+           end;
+         end;
+      end;
+
+    procedure dir_wait(t:tdirectivetoken);
+      begin
+        Message(scan_i_press_enter);
+        readln;
+      end;
+
+    procedure dir_asmmode(t:tdirectivetoken);
+      begin
+{$ifdef i386}
+        case t of
+       _DIR_I386_ATT : aktasmmode:=I386_ATT;
+    _DIR_I386_DIRECT : aktasmmode:=I386_INTEL;
+     _DIR_I386_INTEL : aktasmmode:=I386_DIRECT;
+        end;
+{$endif}
+      end;
+
+
+      type
+        tdirectiveproc=procedure(t:tdirectivetoken);
+      const
+        directiveproc:array[tdirectivetoken] of tdirectiveproc=(
+         {_DIR_NONE} nil,
+         {_DIR_D} dir_description,
+         {_DIR_DEFINE} dir_define,
+         {_DIR_ELSE} dir_conditional,
+         {_DIR_ENDIF} dir_conditional,
+         {_DIR_ERROR} dir_message,
+         {_DIR_FATAL} dir_message,
+         {_DIR_I} dir_include,
+         {_DIR_I386_ATT} dir_asmmode,
+         {_DIR_I386_DIRECT} dir_asmmode,
+         {_DIR_I386_INTEL} dir_asmmode,
+         {_DIR_IF} dir_conditional,
+         {_DIR_IFDEF} dir_conditional,
+         {_DIR_IFNDEF} dir_conditional,
+         {_DIR_IFOPT} dir_conditional,
+         {_DIR_INFO} dir_message,
+         {_DIR_L} dir_linkobject,
+         {_DIR_LINKLIB} dir_linklib,
+         {_DIR_MESSAGE} dir_message,
+         {_DIR_MMX} dir_switch,
+         {_DIR_NOTE} dir_message,
+         {_DIR_OUTPUT_FORMAT} dir_outputformat,
+         {_DIR_PACKRECORDS} dir_packrecords,
+         {_DIR_SATURATION} dir_switch,
+         {_DIR_STOP} dir_message,
+         {_DIR_UNDEF} dir_undef,
+         {_DIR_WAIT} dir_wait,
+         {_DIR_WARNING} dir_message
+         );
+
+  {-------------------------------------------
+            Main switches handling
+  -------------------------------------------}
+
+    procedure handledirectives;
+      var
+        t     : tdirectivetoken;
+        p     : tdirectiveproc;
+        hs    : string;
+      begin
+         readchar; {Remove the $}
+         hs:=readid;
+         Message1(scan_d_handling_switch,'$'+hs);
+         if hs='' then
+          Message1(scan_w_illegal_switch,'$'+hs);
+      { Check for compiler switches }
+         while (length(hs)=1) and (c in ['-','+']) do
+          begin
+            HandleSwitch(hs[1],c);
+            readchar; {Remove + or -}
+            if c=',' then
+             begin
+               readchar;   {Remove , }
+               hs:=readid; {Check for multiple switches on one line}
+               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 assigned(p) then
+                p(t);
+             end
+            else
+             Message1(scan_w_illegal_directive,'$'+hs);
+          { conditionals already read the comment }
+            if (comment_level>0) then
+             readcomment;
+          end;
+      end;
+
+{
+  $Log$
+  Revision 1.1  1998-04-27 23:13:53  peter
+    + the new files for the scanner
+
+}

compiler/switches.pas

@@ -0,0 +1,164 @@
+{
+    $Id$
+    Copyright (c) 1998 by Peter Vreman
+
+    This unit implements the parsing of the switches like $I-
+
+    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 switches;
+interface
+
+procedure HandleSwitch(switch,state:char);
+function CheckSwitch(switch,state:char):boolean;
+
+
+implementation
+uses globals,verbose,files,systems;
+
+{****************************************************************************
+                       Special functions for some switches
+****************************************************************************}
+
+{$ifndef FPC}
+  {$F+}
+{$endif}
+
+procedure sw_stackcheck;
+begin
+  if target_info.target=target_Linux then
+   Message(scan_n_stack_check_global_under_linux);
+end;
+
+{$ifndef FPC}
+  {$F-}
+{$endif}
+
+{****************************************************************************
+                          Main Switches Parsing
+****************************************************************************}
+
+type
+  TSwitchType=(local,unitglobal,programglobal,illegal,unsupported);
+  SwitchRec=record
+    typesw : TSwitchType;
+    setsw  : tcswitch;
+    proc   : procedure;
+  end;
+const
+  SwitchTable:array['A'..'Z'] of SwitchRec=(
+   {A} (typesw:unsupported; setsw:cs_none; proc:nil),
+   {B} (typesw:unsupported; setsw:cs_none; proc:nil),
+   {C} (typesw:illegal; setsw:cs_none; proc:nil),
+   {D} (typesw:unitglobal; setsw:cs_debuginfo; proc:nil),
+   {E} (typesw:programglobal; setsw:cs_fp_emulation; proc:nil),
+   {F} (typesw:unsupported; setsw:cs_none; proc:nil),
+   {G} (typesw:unsupported; setsw:cs_none; proc:nil),
+   {H} (typesw:illegal; setsw:cs_none; proc:nil),
+   {I} (typesw:local; setsw:cs_iocheck; proc:nil),
+   {J} (typesw:illegal; setsw:cs_none; proc:nil),
+   {K} (typesw:unsupported; setsw:cs_none; proc:nil),
+   {L} (typesw:unsupported; setsw:cs_none; proc:nil),
+   {M} (typesw:illegal; setsw:cs_none; proc:nil),
+   {N} (typesw:unsupported; setsw:cs_none; proc:nil),
+   {O} (typesw:unsupported; setsw:cs_none; proc:nil),
+   {P} (typesw:unsupported; setsw:cs_none; proc:nil),
+   {Q} (typesw:local; setsw:cs_check_overflow; proc:nil),
+   {R} (typesw:local; setsw:cs_rangechecking; proc:nil),
+   {S} (typesw:local; setsw:cs_check_stack; proc:nil),
+   {T} (typesw:local; setsw:cs_typed_addresses; proc:nil),
+   {U} (typesw:illegal; setsw:cs_none; proc:nil),
+   {V} (typesw:local; setsw:cs_strict_var_strings; proc:nil),
+   {W} (typesw:unsupported; setsw:cs_none; proc:nil),
+   {X} (typesw:unitglobal; setsw:cs_extsyntax; proc:nil),
+   {Y} (typesw:unsupported; setsw:cs_none; proc:nil),
+   {Z} (typesw:illegal; setsw:cs_none; proc:nil)
+    );
+
+procedure HandleSwitch(switch,state:char);
+begin
+  switch:=upcase(switch);
+{ Is the Switch in the letters ? }
+  if not ((switch in ['A'..'Z']) and (state in ['-','+'])) then
+   begin
+     Message(scan_w_illegal_switch);
+     exit;
+   end;
+{ Handle the switch }
+  with SwitchTable[switch] do
+   begin
+     case typesw of
+       illegal : Message1(scan_w_illegal_switch,'$'+switch);
+   unsupported : Message1(scan_w_unsupported_switch,'$'+switch);
+    unitglobal,
+ programglobal,
+         local : begin
+                   if (typesw=local) or
+                      ((typesw=unitglobal) and current_module^.in_main) or
+                      ((typesw=programglobal) and current_module^.in_main and (current_module=main_module)) then
+                    begin
+                      if state='+' then
+                       aktswitches:=aktswitches+[setsw]
+                      else
+                       aktswitches:=aktswitches-[setsw];
+                    end
+                   else
+                    Message(scan_w_switch_is_global);
+                   if assigned(proc) then
+                    begin
+                    {$ifdef FPC}
+                      proc();
+                    {$else}
+                      proc;
+                    {$endif}
+                    end;
+                 end;
+      end;
+   end;
+end;
+
+
+function CheckSwitch(switch,state:char):boolean;
+var
+  found : boolean;
+begin
+  switch:=upcase(switch);
+{ Is the Switch in the letters ? }
+  if not ((switch in ['A'..'Z']) and (state in ['-','+'])) then
+   begin
+     Message(scan_w_illegal_switch);
+     CheckSwitch:=false;
+     exit;
+   end;
+{ Check the switch }
+  with SwitchTable[switch] do
+   begin
+     found:=(setsw in aktswitches);
+     if state='-' then
+      found:=not found;
+     CheckSwitch:=found;
+   end;
+end;
+
+
+end.
+{
+  $Log$
+  Revision 1.1  1998-04-27 23:13:53  peter
+    + the new files for the scanner
+
+}