mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 04:59:29 +01:00 
			
		
		
		
	activated by defining 'newst', but doesn't compile yet. Changes in type checking and oop are completed. What is left is to write a new symtablestack and adapt the parser to use it.
		
			
				
	
	
		
			1382 lines
		
	
	
		
			41 KiB
		
	
	
	
		
			PHP
		
	
	
	
	
	
			
		
		
	
	
			1382 lines
		
	
	
		
			41 KiB
		
	
	
	
		
			PHP
		
	
	
	
	
	
{
 | 
						|
    $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_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',
 | 
						|
     '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 : 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;
 | 
						|
                             {$ifndef TP}
 | 
						|
                               {$ifopt H+}
 | 
						|
                                 setlength(hs,len);
 | 
						|
                               {$else}
 | 
						|
                                 hs[0]:=char(len);
 | 
						|
                               {$endif}
 | 
						|
                             {$else}
 | 
						|
                               hs[0]:=char(len);
 | 
						|
                             {$endif}
 | 
						|
                             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   : pmacrosym;
 | 
						|
        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:=pmacrosym(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
 | 
						|
                   Message(scan_w_illegal_switch)
 | 
						|
                  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:=pmacrosym(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 : pmacrosym;
 | 
						|
        macropos : longint;
 | 
						|
        macrobuffer : pmacrobuffer;
 | 
						|
      begin
 | 
						|
        current_scanner^.skipspace;
 | 
						|
        hs:=current_scanner^.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;
 | 
						|
        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;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    procedure dir_undef(t:tdirectivetoken);
 | 
						|
      var
 | 
						|
        hs  : string;
 | 
						|
        mac : pmacrosym;
 | 
						|
      begin
 | 
						|
        current_scanner^.skipspace;
 | 
						|
        hs:=current_scanner^.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;
 | 
						|
        mac^.is_used:=true;
 | 
						|
      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_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_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 state='-' then
 | 
						|
            aktlocalswitches:=aktlocalswitches-[sw]
 | 
						|
           else
 | 
						|
            aktlocalswitches:=aktlocalswitches+[sw];
 | 
						|
         end;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    procedure dir_include(t:tdirectivetoken);
 | 
						|
      var
 | 
						|
        hs    : string;
 | 
						|
        path  : dirstr;
 | 
						|
        name  : namestr;
 | 
						|
        ext   : extstr;
 | 
						|
        hp    : pinputfile;
 | 
						|
        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;
 | 
						|
           if path<>'' then
 | 
						|
             path:=path+';';
 | 
						|
           path:=FindFile(name+ext,path+current_scanner^.inputfile^.path^+';.'+DirSep,found);
 | 
						|
           if (not found) then
 | 
						|
            path:=current_module^.localincludesearchpath.FindFile(name+ext,found);
 | 
						|
           if (not found) then
 | 
						|
            path:=includesearchpath.FindFile(name+ext,found);
 | 
						|
         { shutdown current file }
 | 
						|
           current_scanner^.tempcloseinputfile;
 | 
						|
         { load new file }
 | 
						|
           hp:=new(pinputfile,init(path+name+ext));
 | 
						|
           current_scanner^.addfile(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;
 | 
						|
         { register for refs }
 | 
						|
           current_module^.sourcefiles^.register_file(hp);
 | 
						|
         end;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    procedure dir_description(t:tdirectivetoken);
 | 
						|
      begin
 | 
						|
        if not (target_info.target in [target_i386_os2,target_i386_win32]) then
 | 
						|
          Message(scan_w_decription_not_support);
 | 
						|
        { change description global var in all cases }
 | 
						|
        { it not used but in win32 and os2 }
 | 
						|
        current_scanner^.skipspace;
 | 
						|
        description:=current_scanner^.readcomment;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    procedure dir_version(t:tdirectivetoken);
 | 
						|
      var
 | 
						|
        major, minor : longint;
 | 
						|
        error : integer;
 | 
						|
      begin
 | 
						|
        if not (target_info.target in [target_i386_os2,target_i386_win32]) then
 | 
						|
          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 and os2 }
 | 
						|
            current_scanner^.skipspace;
 | 
						|
            { we should only accept Major.Minor format }
 | 
						|
            current_scanner^.readnumber;
 | 
						|
            major:=0;
 | 
						|
            minor:=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
 | 
						|
                    Message(scan_w_wrong_version_ignored);
 | 
						|
                    exit;
 | 
						|
                  end;
 | 
						|
                dllmajor:=major;
 | 
						|
                dllminor:=minor;
 | 
						|
                dllversion:=tostr(major)+'.'+tostr(minor);
 | 
						|
              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);
 | 
						|
      {$IFDEF NEWST}
 | 
						|
        current_module^.linkotherofiles.
 | 
						|
         insert(new(Plinkitem,init(s,link_allways)));
 | 
						|
      {$ELSE}
 | 
						|
        current_module^.linkotherofiles.
 | 
						|
         insert(s,link_allways);
 | 
						|
      {$ENDIF NEWST}
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    procedure dir_resource(t:tdirectivetoken);
 | 
						|
      var
 | 
						|
        s : string;
 | 
						|
      begin
 | 
						|
        current_scanner^.skipspace;
 | 
						|
        s:=AddExtension(FixFileName(current_scanner^.readcomment),target_info.resext);
 | 
						|
        if target_info.res<>res_none then
 | 
						|
          current_module^.resourcefiles.insert(FixFileName(s))
 | 
						|
        else
 | 
						|
          Message(scan_e_resourcefiles_not_supported);
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    procedure dir_linklib(t:tdirectivetoken);
 | 
						|
      begin
 | 
						|
        current_scanner^.skipspace;
 | 
						|
        current_scanner^.readstring;
 | 
						|
      {$IFDEF NEWST}
 | 
						|
        current_module^.linkOtherSharedLibs.
 | 
						|
         insert(new(Plinkitem,init(orgpattern,link_allways)));
 | 
						|
      {$ELSE}
 | 
						|
        current_module^.linkOtherSharedLibs.
 | 
						|
         insert(orgpattern,link_allways);
 | 
						|
      {$ENDIF}
 | 
						|
      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
 | 
						|
             Message(scan_w_illegal_switch);
 | 
						|
          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 pattern='DEFAULT' then
 | 
						|
             aktmodeswitches:=initmodeswitches
 | 
						|
            else
 | 
						|
             if pattern='DELPHI' then
 | 
						|
              aktmodeswitches:=delphimodeswitches
 | 
						|
            else
 | 
						|
             if pattern='TP' then
 | 
						|
              aktmodeswitches:=tpmodeswitches
 | 
						|
            else
 | 
						|
             if pattern='FPC' then
 | 
						|
              aktmodeswitches:=fpcmodeswitches
 | 
						|
            else
 | 
						|
             if pattern='OBJFPC' then
 | 
						|
              aktmodeswitches:=objfpcmodeswitches
 | 
						|
            else
 | 
						|
             if pattern='GPC' then
 | 
						|
              aktmodeswitches:=gpcmodeswitches
 | 
						|
            else
 | 
						|
             Message(scan_w_illegal_switch);
 | 
						|
          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 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:=at_gui
 | 
						|
             else if hs='CONSOLE' then
 | 
						|
               apptype:=at_cui
 | 
						|
             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_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;
 | 
						|
         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;
 | 
						|
         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);
 | 
						|
            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];
 | 
						|
             {$ifndef TP}
 | 
						|
               if assigned(p) then
 | 
						|
             {$else}
 | 
						|
               if @p<>nil then
 | 
						|
             {$endif}
 | 
						|
                p(t);
 | 
						|
             end
 | 
						|
            else
 | 
						|
             Message1(scan_w_illegal_directive,'$'+hs);
 | 
						|
          { 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.76  2000-02-28 17:23:57  daniel
 | 
						|
  * Current work of symtable integration committed. The symtable can be
 | 
						|
    activated by defining 'newst', but doesn't compile yet. Changes in type
 | 
						|
    checking and oop are completed. What is left is to write a new
 | 
						|
    symtablestack and adapt the parser to use it.
 | 
						|
 | 
						|
  Revision 1.75  2000/02/14 20:58:43  marco
 | 
						|
   * Basic structures for new sethandling implemented.
 | 
						|
 | 
						|
  Revision 1.74  2000/02/09 13:23:03  peter
 | 
						|
    * log truncated
 | 
						|
 | 
						|
  Revision 1.73  2000/01/14 14:28:40  pierre
 | 
						|
   * avoid searching of include file in start dir first
 | 
						|
 | 
						|
  Revision 1.72  2000/01/07 01:14:37  peter
 | 
						|
    * updated copyright to 2000
 | 
						|
 | 
						|
  Revision 1.71  2000/01/04 15:15:53  florian
 | 
						|
    + added compiler switch $maxfpuregisters
 | 
						|
    + fixed a small problem in secondvecn
 | 
						|
 | 
						|
  Revision 1.70  1999/12/20 23:23:30  pierre
 | 
						|
   + $description $version
 | 
						|
 | 
						|
  Revision 1.69  1999/12/02 17:34:34  peter
 | 
						|
    * preprocessor support. But it fails on the caret in type blocks
 | 
						|
 | 
						|
  Revision 1.68  1999/11/24 11:39:53  pierre
 | 
						|
   * asmmode message was placed too early
 | 
						|
 | 
						|
  Revision 1.67  1999/11/12 11:03:50  peter
 | 
						|
    * searchpaths changed to stringqueue object
 | 
						|
 | 
						|
  Revision 1.66  1999/11/06 14:34:26  peter
 | 
						|
    * truncated log to 20 revs
 | 
						|
 | 
						|
  Revision 1.65  1999/10/30 12:32:30  peter
 | 
						|
    * fixed line counter when the first line had #10 only. This was buggy
 | 
						|
      for both the main file as for include files
 | 
						|
 | 
						|
  Revision 1.64  1999/09/27 23:38:17  peter
 | 
						|
    * bracket support for macro define
 | 
						|
 | 
						|
  Revision 1.63  1999/09/20 16:39:02  peter
 | 
						|
    * cs_create_smart instead of cs_smartlink
 | 
						|
    * -CX is create smartlink
 | 
						|
    * -CD is create dynamic, but does nothing atm.
 | 
						|
 | 
						|
  Revision 1.62  1999/09/03 10:00:49  peter
 | 
						|
    * included the 1.60 version of Pierre which was lost !
 | 
						|
 | 
						|
  Revision 1.61  1999/09/02 18:47:46  daniel
 | 
						|
    * Could not compile with TP, some arrays moved to heap
 | 
						|
    * NOAG386BIN default for TP
 | 
						|
    * AG386* files were not compatible with TP, fixed.
 | 
						|
 | 
						|
  Revision 1.60  1999/08/31 15:55:45  pierre
 | 
						|
    + tmacrosym.is_used set
 | 
						|
 | 
						|
  Revision 1.59  1999/08/05 16:53:10  peter
 | 
						|
    * V_Fatal=1, all other V_ are also increased
 | 
						|
    * Check for local procedure when assigning procvar
 | 
						|
    * fixed comment parsing because directives
 | 
						|
    * oldtp mode directives better supported
 | 
						|
    * added some messages to errore.msg
 | 
						|
 | 
						|
  Revision 1.58  1999/08/04 13:03:03  jonas
 | 
						|
    * all tokens now start with an underscore
 | 
						|
    * PowerPC compiles!!
 | 
						|
 | 
						|
  Revision 1.57  1999/07/26 14:55:36  florian
 | 
						|
    * $mode gives now a warning if an unknown mode keyword follows
 | 
						|
 | 
						|
  Revision 1.56  1999/07/23 16:05:27  peter
 | 
						|
    * alignment is now saved in the symtable
 | 
						|
    * C alignment added for records
 | 
						|
    * PPU version increased to solve .12 <-> .13 probs
 | 
						|
 | 
						|
}
 |