mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-10-29 17:45:04 +01:00
1157 lines
36 KiB
ObjectPascal
1157 lines
36 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,
|
|
rabase;
|
|
|
|
const
|
|
localswitchesstackmax = 20;
|
|
|
|
var
|
|
localswitchesstack: array[0..localswitchesstackmax] of tlocalswitches;
|
|
localswitchesstackpos: Integer;
|
|
|
|
{*****************************************************************************
|
|
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
|
|
aktpackrecords:=4
|
|
else if (hs='OFF') then
|
|
aktpackrecords:=1
|
|
else if m_mac in aktmodeswitches then
|
|
begin
|
|
{ Support switches used in Apples Universal Interfaces}
|
|
if (hs='MAC68K') then
|
|
aktpackrecords:=2
|
|
else if (hs='POWER') then
|
|
aktpackrecords:=4
|
|
else if (hs='RESET') then
|
|
aktpackrecords:=0
|
|
end
|
|
else
|
|
Message(scan_w_only_pack_records);
|
|
end
|
|
else
|
|
begin
|
|
case current_scanner.readval of
|
|
1 : aktpackrecords:=1;
|
|
2 : aktpackrecords:=2;
|
|
4 : aktpackrecords:=4;
|
|
8 : aktpackrecords:=8;
|
|
16 : aktpackrecords:=16;
|
|
32 : aktpackrecords:=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 SetAsmReadMode(s,aktasmmode) then
|
|
Message1(scan_e_illegal_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, system_powerpc_macos]) 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 if (hs='TOOL') and (target_info.system in [system_powerpc_macos]) then
|
|
apptype:=app_tool
|
|
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,system_i386_netwlibc]) 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;
|
|
DescriptionSetExplicity:=true;
|
|
end;
|
|
|
|
procedure dir_screenname; {ad}
|
|
begin
|
|
if not (target_info.system in [system_i386_netware,system_i386_netwlibc]) 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 not (target_info.system in [system_i386_netware,system_i386_netwlibc]) 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 not (target_info.system in [system_i386_netware,system_i386_netwlibc]) 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_fputype;
|
|
begin
|
|
current_scanner.skipspace;
|
|
if not(SetFPUType(upper(current_scanner.readcomment),false)) then
|
|
comment(V_Error,'Illegal FPU type');
|
|
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_libexport;
|
|
begin
|
|
{not implemented}
|
|
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;
|
|
if scanner.c = '''' then
|
|
begin
|
|
s:= current_scanner.readquotedstring;
|
|
current_scanner.readcomment
|
|
end
|
|
else
|
|
s:= trimspace(current_scanner.readcomment);
|
|
s:=AddExtension(FixFileName(s),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;
|
|
if scanner.c = '''' then
|
|
begin
|
|
libname:= current_scanner.readquotedstring;
|
|
s:= current_scanner.readcomment;
|
|
p:=pos(',',s);
|
|
end
|
|
else
|
|
begin
|
|
s:= current_scanner.readcomment;
|
|
p:=pos(',',s);
|
|
if p=0 then
|
|
libname:=TrimSpace(s)
|
|
else
|
|
libname:=TrimSpace(copy(s,1,p-1));
|
|
end;
|
|
|
|
if p=0 then
|
|
linkmodeStr:=''
|
|
else
|
|
linkmodeStr:=Upper(TrimSpace(copy(s,p+1,255)));
|
|
|
|
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;
|
|
var
|
|
hs : string;
|
|
w : longint;
|
|
begin
|
|
w:=0;
|
|
current_scanner.skipspace;
|
|
{ Message level specified? }
|
|
if c='''' then
|
|
w:=scan_n_user_defined
|
|
else
|
|
begin
|
|
hs:=current_scanner.readid;
|
|
if (hs='WARN') or (hs='WARNING') then
|
|
w:=scan_w_user_defined
|
|
else
|
|
if (hs='ERROR') then
|
|
w:=scan_e_user_defined
|
|
else
|
|
if (hs='FATAL') then
|
|
w:=scan_f_user_defined
|
|
else
|
|
if (hs='HINT') then
|
|
w:=scan_h_user_defined
|
|
else
|
|
if (hs='NOTE') then
|
|
w:=scan_n_user_defined
|
|
else
|
|
Message1(scan_w_illegal_directive,hs);
|
|
end;
|
|
{ Only print message when there was no error }
|
|
if w<>0 then
|
|
begin
|
|
current_scanner.skipspace;
|
|
if c='''' then
|
|
hs:=current_scanner.readquotedstring
|
|
else
|
|
hs:=current_scanner.readcomment;
|
|
Message1(w,hs);
|
|
end
|
|
else
|
|
current_scanner.readcomment;
|
|
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
|
|
aktpackrecords:=-1
|
|
else
|
|
if (hs='NORMAL') or (hs='DEFAULT') then
|
|
aktpackrecords:=0
|
|
else
|
|
Message(scan_w_only_pack_records);
|
|
end
|
|
else
|
|
begin
|
|
case current_scanner.readval of
|
|
1 : aktpackrecords:=1;
|
|
2 : aktpackrecords:=2;
|
|
4 : aktpackrecords:=4;
|
|
8 : aktpackrecords:=8;
|
|
16 : aktpackrecords:=16;
|
|
32 : aktpackrecords:=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_pop;
|
|
|
|
begin
|
|
if localswitchesstackpos < 1 then
|
|
Message(scan_e_too_many_pop);
|
|
|
|
if not localswitcheschanged then
|
|
nextaktlocalswitches:=aktlocalswitches;
|
|
|
|
Dec(localswitchesstackpos);
|
|
nextaktlocalswitches:= localswitchesstack[localswitchesstackpos];
|
|
|
|
localswitcheschanged:=true;
|
|
end;
|
|
|
|
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_push;
|
|
|
|
begin
|
|
if localswitchesstackpos > localswitchesstackmax then
|
|
Message(scan_e_too_many_push);
|
|
|
|
if localswitcheschanged then
|
|
begin
|
|
aktlocalswitches:=nextaktlocalswitches;
|
|
localswitcheschanged:=false;
|
|
end;
|
|
|
|
localswitchesstack[localswitchesstackpos]:= aktlocalswitches;
|
|
Inc(localswitchesstackpos);
|
|
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;
|
|
if scanner.c = '''' then
|
|
begin
|
|
s:= current_scanner.readquotedstring;
|
|
current_scanner.readcomment
|
|
end
|
|
else
|
|
s:= trimspace(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,
|
|
system_i386_netwlibc]) 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 in [system_i386_netware,system_i386_netwlibc]) 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',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_align);
|
|
{$ifdef m68k}
|
|
AddDirective('APPID',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_appid);
|
|
AddDirective('APPNAME',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_appname);
|
|
{$endif m68k}
|
|
AddDirective('APPTYPE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_apptype);
|
|
AddDirective('ASMMODE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_asmmode);
|
|
AddDirective('ASSERTIONS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_assertions);
|
|
AddDirective('BOOLEVAL',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_booleval);
|
|
AddDirective('CALLING',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_calling);
|
|
AddDirective('CODEPAGE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_codepage);
|
|
AddDirective('COPYRIGHT',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_copyright);
|
|
AddDirective('D',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_description);
|
|
AddDirective('DEBUGINFO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_debuginfo);
|
|
AddDirective('DESCRIPTION',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_description);
|
|
AddDirective('ERROR',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_error);
|
|
AddDirective('ERRORC',directive_mac, {$ifdef FPCPROCVAR}@{$endif}dir_error);
|
|
AddDirective('EXTENDEDSYNTAX',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_extendedsyntax);
|
|
AddDirective('EXTERNALSYM',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_externalsym);
|
|
AddDirective('FATAL',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_fatal);
|
|
AddDirective('FPUTYPE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_fputype);
|
|
AddDirective('GOTO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_goto);
|
|
AddDirective('HINT',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_hint);
|
|
AddDirective('HINTS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_hints);
|
|
AddDirective('IOCHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_iochecks);
|
|
AddDirective('IMPLICITEXCEPTIONS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_implicitexceptions);
|
|
AddDirective('INCLUDEPATH',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_includepath);
|
|
AddDirective('INFO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_info);
|
|
AddDirective('INLINE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_inline);
|
|
AddDirective('INTERFACES',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_interfaces);
|
|
AddDirective('L',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_link);
|
|
AddDirective('LIBEXPORT',directive_mac, {$ifdef FPCPROCVAR}@{$endif}dir_libexport);
|
|
AddDirective('LIBRARYPATH',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_librarypath);
|
|
AddDirective('LINK',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_link);
|
|
AddDirective('LINKLIB',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_linklib);
|
|
AddDirective('LOCALSYMBOLS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_localsymbols);
|
|
AddDirective('LONGSTRINGS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_longstrings);
|
|
AddDirective('M',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_memory);
|
|
AddDirective('MACRO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_macro);
|
|
AddDirective('MAXFPUREGISTERS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_maxfpuregisters);
|
|
AddDirective('MEMORY',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_memory);
|
|
AddDirective('MESSAGE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_message);
|
|
AddDirective('MINENUMSIZE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_packenum);
|
|
AddDirective('MMX',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_mmx);
|
|
AddDirective('MODE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_mode);
|
|
AddDirective('NOTE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_note);
|
|
AddDirective('NOTES',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_notes);
|
|
AddDirective('OBJECTCHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_objectchecks);
|
|
AddDirective('OBJECTPATH',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_objectpath);
|
|
AddDirective('OPENSTRINGS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_openstrings);
|
|
AddDirective('OUTPUT_FORMAT',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_output_format);
|
|
AddDirective('OVERFLOWCHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_overflowchecks);
|
|
AddDirective('PACKENUM',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_packenum);
|
|
AddDirective('PACKRECORDS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_packrecords);
|
|
{$IFDEF TestVarsets}
|
|
AddDirective('PACKSET',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_packset);
|
|
{$ENDIF}
|
|
AddDirective('POP',directive_mac, {$ifdef FPCPROCVAR}@{$endif}dir_pop);
|
|
AddDirective('PROFILE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_profile);
|
|
AddDirective('PUSH',directive_mac, {$ifdef FPCPROCVAR}@{$endif}dir_push);
|
|
AddDirective('R',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_resource);
|
|
AddDirective('RANGECHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_rangechecks);
|
|
AddDirective('REFERENCEINFO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_referenceinfo);
|
|
AddDirective('RESOURCE',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_resource);
|
|
AddDirective('SATURATION',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_saturation);
|
|
AddDirective('SCREENNAME',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_screenname);
|
|
AddDirective('SMARTLINK',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_smartlink);
|
|
AddDirective('STACKFRAMES',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_stackframes);
|
|
AddDirective('STATIC',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_static);
|
|
AddDirective('STOP',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_stop);
|
|
AddDirective('THREADING',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_threading);
|
|
AddDirective('THREADNAME',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_threadname);
|
|
AddDirective('TYPEDADDRESS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_typedaddress);
|
|
AddDirective('TYPEINFO',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_typeinfo);
|
|
AddDirective('UNITPATH',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_unitpath);
|
|
AddDirective('VARSTRINGCHECKS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_varstringchecks);
|
|
AddDirective('VERSION',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_version);
|
|
AddDirective('WAIT',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_wait);
|
|
AddDirective('WARNING',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_warning);
|
|
AddDirective('WARNINGS',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_warnings);
|
|
AddDirective('WRITEABLECONST',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_writeableconst);
|
|
AddDirective('Z1',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_z1);
|
|
AddDirective('Z2',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_z2);
|
|
AddDirective('Z4',directive_all, {$ifdef FPCPROCVAR}@{$endif}dir_z4);
|
|
end;
|
|
|
|
begin
|
|
localswitchesstackpos:= 0;
|
|
end.
|
|
{
|
|
$Log$
|
|
Revision 1.43 2004-09-04 21:18:47 armin
|
|
* target netwlibc added (libc is preferred for newer netware versions)
|
|
|
|
Revision 1.42 2004/08/31 22:07:04 olle
|
|
+ compiler directives which take filenames/paths, get these trimmed, and
|
|
also support quotes.
|
|
|
|
Revision 1.41 2004/08/22 10:17:27 peter
|
|
* support $RESOURCE
|
|
|
|
Revision 1.40 2004/08/16 11:34:25 olle
|
|
+ added directive LibExport for macpas, which does nothing atm
|
|
|
|
Revision 1.39 2004/07/06 09:41:46 olle
|
|
* fixes compilation on 1.0.*
|
|
|
|
Revision 1.38 2004/07/05 21:49:43 olle
|
|
+ macpas style: exit, cycle, leave
|
|
+ macpas compiler directive: PUSH POP
|
|
|
|
Revision 1.37 2004/06/20 08:55:30 florian
|
|
* logs truncated
|
|
|
|
Revision 1.36 2004/06/16 20:07:09 florian
|
|
* dwarf branch merged
|
|
|
|
Revision 1.35 2004/05/19 23:29:56 peter
|
|
* $message directive compatible with delphi
|
|
|
|
Revision 1.34 2004/05/11 22:51:34 olle
|
|
* Performanceimprovement
|
|
|
|
Revision 1.33 2004/05/11 18:30:50 olle
|
|
+ mode macpas: support for Apples align directives
|
|
|
|
Revision 1.32.2.1 2004/05/03 14:59:57 peter
|
|
* no dlltool needed for win32 linking executables
|
|
|
|
}
|