mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-11-04 16:39:24 +01:00 
			
		
		
		
	
		
			
				
	
	
		
			1039 lines
		
	
	
		
			31 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
			
		
		
	
	
			1039 lines
		
	
	
		
			31 KiB
		
	
	
	
		
			ObjectPascal
		
	
	
	
	
	
{
 | 
						|
    $Id$
 | 
						|
    Copyright (c) 1998-2002 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 fpcdefs.inc}
 | 
						|
 | 
						|
interface
 | 
						|
 | 
						|
 | 
						|
    procedure InitScannerDirectives;
 | 
						|
 | 
						|
implementation
 | 
						|
 | 
						|
    uses
 | 
						|
      cutils,
 | 
						|
      globtype,globals,systems,widestr,
 | 
						|
      verbose,comphook,
 | 
						|
      scanner,switches,
 | 
						|
      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
 | 
						|
            exclude(nextaktlocalswitches,sw)
 | 
						|
           else
 | 
						|
            include(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;
 | 
						|
      var
 | 
						|
        hs : string;
 | 
						|
      begin
 | 
						|
        current_scanner.skipspace;
 | 
						|
        if not(c in ['0'..'9']) then
 | 
						|
         begin
 | 
						|
           { Support also the ON and OFF as switch }
 | 
						|
           hs:=current_scanner.readid;
 | 
						|
           if (hs='ON') then
 | 
						|
            aktalignment.recordalignmax:=4
 | 
						|
           else
 | 
						|
            if (hs='OFF') then
 | 
						|
             aktalignment.recordalignmax:=1
 | 
						|
           else
 | 
						|
            Message(scan_w_only_pack_records);
 | 
						|
         end
 | 
						|
        else
 | 
						|
         begin
 | 
						|
           case current_scanner.readval of
 | 
						|
             1 : aktalignment.recordalignmax:=1;
 | 
						|
             2 : aktalignment.recordalignmax:=2;
 | 
						|
             4 : aktalignment.recordalignmax:=4;
 | 
						|
             8 : aktalignment.recordalignmax:=8;
 | 
						|
            16 : aktalignment.recordalignmax:=16;
 | 
						|
            32 : aktalignment.recordalignmax:=32;
 | 
						|
           else
 | 
						|
            Message(scan_w_only_pack_records);
 | 
						|
           end;
 | 
						|
         end;
 | 
						|
      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_asmmode_by_string(s,aktasmmode) then
 | 
						|
          Message1(scan_w_unsupported_asmmode_specifier,s);
 | 
						|
      end;
 | 
						|
 | 
						|
{$ifdef m68k}
 | 
						|
    procedure dir_appid;
 | 
						|
      begin
 | 
						|
        if target_info.system<>system_m68k_palmos then
 | 
						|
          Message(scan_w_appid_not_support);
 | 
						|
        { change description global var in all cases }
 | 
						|
        { it not used but in win32 and os2 }
 | 
						|
        current_scanner.skipspace;
 | 
						|
        palmos_applicationid:=current_scanner.readcomment;
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure dir_appname;
 | 
						|
      begin
 | 
						|
        if target_info.system<>system_m68k_palmos then
 | 
						|
          Message(scan_w_appname_not_support);
 | 
						|
        { change description global var in all cases }
 | 
						|
        { it not used but in win32 and os2 }
 | 
						|
        current_scanner.skipspace;
 | 
						|
        palmos_applicationname:=current_scanner.readcomment;
 | 
						|
      end;
 | 
						|
{$endif m68k}
 | 
						|
 | 
						|
    procedure dir_apptype;
 | 
						|
      var
 | 
						|
         hs : string;
 | 
						|
      begin
 | 
						|
        if not (target_info.system in [system_i386_win32,system_i386_os2,
 | 
						|
                                       system_i386_emx]) 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.system in [system_i386_os2,
 | 
						|
                                                         system_i386_emx]) then
 | 
						|
               apptype:=app_fs
 | 
						|
             else
 | 
						|
               Message1(scan_w_unsupported_app_type,hs);
 | 
						|
          end;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    procedure dir_calling;
 | 
						|
      var
 | 
						|
         hs : string;
 | 
						|
      begin
 | 
						|
        current_scanner.skipspace;
 | 
						|
        hs:=current_scanner.readid;
 | 
						|
        if not SetAktProcCall(hs,false) then
 | 
						|
          Message1(parser_w_unknown_proc_directive_ignored,hs);
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
    procedure dir_objectchecks;
 | 
						|
      begin
 | 
						|
        do_localswitch(cs_check_object);
 | 
						|
      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.system in [system_i386_os2,system_i386_emx,
 | 
						|
                 system_i386_win32,system_i386_netware,system_i386_wdosx]) then
 | 
						|
          Message(scan_w_description_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_screenname; {ad}
 | 
						|
      begin
 | 
						|
        if target_info.system <> system_i386_netware then
 | 
						|
          {Message(scan_w_decription_not_support);}
 | 
						|
          comment (V_Warning,'Screenname only supported for target netware');
 | 
						|
        current_scanner.skipspace;
 | 
						|
        nwscreenname:=current_scanner.readcomment;
 | 
						|
      end;
 | 
						|
 | 
						|
      procedure dir_threadname; {ad}
 | 
						|
      begin
 | 
						|
        if target_info.system <> system_i386_netware then
 | 
						|
          {Message(scan_w_decription_not_support);}
 | 
						|
          comment (V_Warning,'Threadname only supported for target netware');
 | 
						|
        current_scanner.skipspace;
 | 
						|
        nwthreadname:=current_scanner.readcomment;
 | 
						|
      end;
 | 
						|
 | 
						|
      procedure dir_copyright; {ad}
 | 
						|
      begin
 | 
						|
        if target_info.system <> system_i386_netware then
 | 
						|
          {Message(scan_w_decription_not_support);}
 | 
						|
          comment (V_Warning,'Copyright only supported for target netware');
 | 
						|
        current_scanner.skipspace;
 | 
						|
        nwcopyright:=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_implicitexceptions;
 | 
						|
      begin
 | 
						|
        do_moduleswitch(cs_implicit_exceptions);
 | 
						|
      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_target_asm_by_string(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;
 | 
						|
           { C has the special recordalignmax of -1 }
 | 
						|
           if (hs='C') then
 | 
						|
            aktalignment.recordalignmax:=-1
 | 
						|
           else
 | 
						|
            if (hs='NORMAL') or (hs='DEFAULT') then
 | 
						|
             aktalignment.recordalignmax:=2
 | 
						|
           else
 | 
						|
            Message(scan_w_only_pack_records);
 | 
						|
         end
 | 
						|
        else
 | 
						|
         begin
 | 
						|
           case current_scanner.readval of
 | 
						|
             1 : aktalignment.recordalignmax:=1;
 | 
						|
             2 : aktalignment.recordalignmax:=2;
 | 
						|
             4 : aktalignment.recordalignmax:=4;
 | 
						|
             8 : aktalignment.recordalignmax:=8;
 | 
						|
            16 : aktalignment.recordalignmax:=16;
 | 
						|
            32 : aktalignment.recordalignmax:=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_profile;
 | 
						|
      var
 | 
						|
        mac : tmacro;
 | 
						|
      begin
 | 
						|
        do_moduleswitch(cs_profile);
 | 
						|
        { defined/undefine FPC_PROFILE }
 | 
						|
        mac:=tmacro(current_scanner.macros.search('FPC_PROFILE'));
 | 
						|
        if not assigned(mac) then
 | 
						|
         begin
 | 
						|
           mac:=tmacro.create('FPC_PROFILE');
 | 
						|
           current_scanner.macros.insert(mac);
 | 
						|
         end;
 | 
						|
        mac.defined:=(cs_profile in aktmoduleswitches);
 | 
						|
      end;
 | 
						|
 | 
						|
    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_emxbind) 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_threading;
 | 
						|
      var
 | 
						|
        mac : tmacro;
 | 
						|
      begin
 | 
						|
        do_moduleswitch(cs_threading);
 | 
						|
        { defined/undefine FPC_THREADING }
 | 
						|
        mac:=tmacro(current_scanner.macros.search('FPC_THREADING'));
 | 
						|
        if not assigned(mac) then
 | 
						|
         begin
 | 
						|
           mac:=tmacro.create('FPC_THREADING');
 | 
						|
           current_scanner.macros.insert(mac);
 | 
						|
         end;
 | 
						|
        mac.defined:=(cs_threading in aktmoduleswitches);
 | 
						|
      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
 | 
						|
          with current_scanner,current_module,localunitsearchpath do
 | 
						|
            begin
 | 
						|
              skipspace;
 | 
						|
              AddPath(path^,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.system in [system_i386_os2,system_i386_emx,
 | 
						|
                 system_i386_win32,system_i386_netware,system_i386_wdosx]) 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, 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) or (major > high(word)) or (major < 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) or (minor > high(word)) or (minor < 0) then
 | 
						|
                  begin
 | 
						|
                    Message1(scan_w_wrong_version_ignored,tostr(major)+'.'+pattern);
 | 
						|
                    exit;
 | 
						|
                  end;
 | 
						|
                if (c='.') and
 | 
						|
                   (target_info.system = system_i386_netware) then
 | 
						|
                  begin
 | 
						|
                     current_scanner.readchar;
 | 
						|
                     current_scanner.readnumber;
 | 
						|
                     valint(pattern,revision,error);
 | 
						|
                     if (error<>0) or (revision > high(word)) or (revision < 0) then
 | 
						|
                       begin
 | 
						|
                          Message1(scan_w_wrong_version_ignored,tostr(revision)+'.'+pattern);
 | 
						|
                          exit;
 | 
						|
                       end;
 | 
						|
                     dllmajor:=word(major);
 | 
						|
                     dllminor:=word(minor);
 | 
						|
                     dllrevision:=word(revision);
 | 
						|
                     dllversion:=tostr(major)+','+tostr(minor)+','+tostr(revision);
 | 
						|
                  end
 | 
						|
                else
 | 
						|
                  begin
 | 
						|
                     dllmajor:=word(major);
 | 
						|
                     dllminor:=word(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_writeableconst;
 | 
						|
      begin
 | 
						|
        do_delphiswitch('J');
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure dir_z1;
 | 
						|
      begin
 | 
						|
        aktpackenum:=1;
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure dir_z2;
 | 
						|
      begin
 | 
						|
        aktpackenum:=2;
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure dir_z4;
 | 
						|
      begin
 | 
						|
        aktpackenum:=4;
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure dir_externalsym;
 | 
						|
      begin
 | 
						|
      end;
 | 
						|
 | 
						|
    procedure dir_codepage;
 | 
						|
      var
 | 
						|
         s : string;
 | 
						|
      begin
 | 
						|
        if not current_module.in_global then
 | 
						|
          Message(scan_w_switch_is_global)
 | 
						|
        else
 | 
						|
          begin
 | 
						|
             current_scanner.skipspace;
 | 
						|
             s:=current_scanner.readcomment;
 | 
						|
             if not(cpavailable(s)) then
 | 
						|
               Message1(option_code_page_not_available,s)
 | 
						|
             else
 | 
						|
               aktsourcecodepage:=s;
 | 
						|
          end;
 | 
						|
      end;
 | 
						|
 | 
						|
 | 
						|
{****************************************************************************
 | 
						|
                         Initialize Directives
 | 
						|
****************************************************************************}
 | 
						|
 | 
						|
    procedure InitScannerDirectives;
 | 
						|
      begin
 | 
						|
        AddDirective('ALIGN',{$ifdef FPCPROCVAR}@{$endif}dir_align);
 | 
						|
{$ifdef m68k}
 | 
						|
        AddDirective('APPID',{$ifdef FPCPROCVAR}@{$endif}dir_appid);
 | 
						|
        AddDirective('APPNAME',{$ifdef FPCPROCVAR}@{$endif}dir_appname);
 | 
						|
{$endif m68k}
 | 
						|
        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('CALLING',{$ifdef FPCPROCVAR}@{$endif}dir_calling);
 | 
						|
        AddDirective('CODEPAGE',{$ifdef FPCPROCVAR}@{$endif}dir_codepage);
 | 
						|
        AddDirective('COPYRIGHT',{$ifdef FPCPROCVAR}@{$endif}dir_copyright);
 | 
						|
        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('EXTERNALSYM',{$ifdef FPCPROCVAR}@{$endif}dir_externalsym);
 | 
						|
        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('IMPLICITEXCEPTIONS',{$ifdef FPCPROCVAR}@{$endif}dir_implicitexceptions);
 | 
						|
        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('OBJECTCHECKS',{$ifdef FPCPROCVAR}@{$endif}dir_objectchecks);
 | 
						|
        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('PROFILE',{$ifdef FPCPROCVAR}@{$endif}dir_profile);
 | 
						|
        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('SCREENNAME',{$ifdef FPCPROCVAR}@{$endif}dir_screenname);
 | 
						|
        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('THREADING',{$ifdef FPCPROCVAR}@{$endif}dir_threading);
 | 
						|
        AddDirective('THREADNAME',{$ifdef FPCPROCVAR}@{$endif}dir_threadname);
 | 
						|
        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('WRITEABLECONST',{$ifdef FPCPROCVAR}@{$endif}dir_writeableconst);
 | 
						|
        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.25  2003-03-23 23:20:38  hajny
 | 
						|
    + emx target added
 | 
						|
 | 
						|
  Revision 1.24  2003/01/03 21:25:01  peter
 | 
						|
    * OBJECTCHECKS added, equivalent of -CR
 | 
						|
    * WRITEABLECONST added, equivalent of $J
 | 
						|
 | 
						|
  Revision 1.23  2002/12/07 14:06:20  carl
 | 
						|
    * stricter version / revision checking (also remove some warnings)
 | 
						|
 | 
						|
  Revision 1.22  2002/11/20 11:12:46  mazen
 | 
						|
  + module path is now passed to AddPath to fix relative unit path
 | 
						|
 | 
						|
  Revision 1.21  2002/10/16 19:01:43  peter
 | 
						|
    + $IMPLICITEXCEPTIONS switch to turn on/off generation of the
 | 
						|
      implicit exception frames for procedures with initialized variables
 | 
						|
      and for constructors. The default is on for compatibility
 | 
						|
 | 
						|
  Revision 1.20  2002/10/14 19:43:41  peter
 | 
						|
    * threading switch, defines the symbol FPC_THREADING
 | 
						|
 | 
						|
  Revision 1.19  2002/08/13 18:01:52  carl
 | 
						|
    * rename swatoperands to swapoperands
 | 
						|
    + m68k first compilable version (still needs a lot of testing):
 | 
						|
        assembler generator, system information , inline
 | 
						|
        assembler reader.
 | 
						|
 | 
						|
  Revision 1.18  2002/07/26 21:15:42  florian
 | 
						|
    * rewrote the system handling
 | 
						|
 | 
						|
  Revision 1.17  2002/07/20 17:16:03  florian
 | 
						|
    + source code page support
 | 
						|
 | 
						|
  Revision 1.16  2002/07/16 15:37:58  florian
 | 
						|
    + Directive $EXTERNALSYM added, it is ignored for now
 | 
						|
 | 
						|
  Revision 1.15  2002/05/18 13:34:17  peter
 | 
						|
    * readded missing revisions
 | 
						|
 | 
						|
  Revision 1.14  2002/05/16 19:46:44  carl
 | 
						|
  + defines.inc -> fpcdefs.inc to avoid conflicts if compiling by hand
 | 
						|
  + try to fix temp allocation (still in ifdef)
 | 
						|
  + generic constructor calls
 | 
						|
  + start of tassembler / tmodulebase class cleanup
 | 
						|
 | 
						|
  Revision 1.12  2002/04/07 13:34:20  carl
 | 
						|
  + wdosx target
 | 
						|
 | 
						|
  Revision 1.11  2002/04/04 19:06:05  peter
 | 
						|
    * removed unused units
 | 
						|
    * use tlocation.size in cg.a_*loc*() routines
 | 
						|
 | 
						|
}
 |