mirror of
				https://gitlab.com/freepascal.org/fpc/source.git
				synced 2025-10-29 07:01:44 +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
 | |
| 
 | |
| }
 | 
