mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-04-06 22:48:07 +02:00

CPU target for inline assembler blocks. In addition to the different CPUs (as listed under 'Supported CPU instruction sets:' in the output of 'fpc -i'), it also supports the special values 'ANY' and 'CURRENT'. 'ANY' means no restrictions (i.e. all instructions are available). 'CURRENT' means the current CPU target (as specified with the '-Cp' command line option). For backward compatibility, the default value is 'ANY' for all CPU targets, except i8086, where it defaults to 'CURRENT'. This directive requires support for the new asd_cpu directive in the assembler writer. This is currently implemented only for NASM, but will be supported in some of the other assembler writers as well (incl. the x86 internal assembler writer). git-svn-id: trunk@33138 -
1858 lines
59 KiB
ObjectPascal
1858 lines
59 KiB
ObjectPascal
{
|
|
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
|
|
|
|
uses
|
|
globtype;
|
|
|
|
const
|
|
switchesstatestackmax = 20;
|
|
|
|
type
|
|
tsavedswitchesstate = record
|
|
localsw: tlocalswitches;
|
|
verbosity: longint;
|
|
pmessage : pmessagestaterecord;
|
|
end;
|
|
|
|
type
|
|
tswitchesstatestack = array[0..switchesstatestackmax] of tsavedswitchesstate;
|
|
|
|
var
|
|
switchesstatestack:tswitchesstatestack;
|
|
switchesstatestackpos: Integer;
|
|
|
|
procedure InitScannerDirectives;
|
|
|
|
implementation
|
|
|
|
uses
|
|
SysUtils,
|
|
cutils,cfileutl,
|
|
globals,systems,widestr,cpuinfo,
|
|
verbose,comphook,ppu,
|
|
scanner,switches,
|
|
fmodule,
|
|
defutil,
|
|
dirparse,link,
|
|
symconst,symtable,symbase,symtype,symsym,
|
|
rabase;
|
|
|
|
{*****************************************************************************
|
|
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;
|
|
recordpendingverbosityswitch(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(current_settings.moduleswitches,sw)
|
|
else
|
|
include(current_settings.moduleswitches,sw);
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure do_localswitch(sw:tlocalswitch);
|
|
var
|
|
state : char;
|
|
begin
|
|
state:=current_scanner.readstate;
|
|
if (sw<>cs_localnone) and (state in ['-','+']) then
|
|
recordpendinglocalswitch(sw,state);
|
|
end;
|
|
|
|
function do_localswitchdefault(sw:tlocalswitch): char;
|
|
begin
|
|
result:=current_scanner.readstatedefault;
|
|
if (sw<>cs_localnone) and (result in ['-','+','*']) then
|
|
recordpendinglocalswitch(sw,result);
|
|
end;
|
|
|
|
|
|
procedure do_message(w:integer);
|
|
begin
|
|
current_scanner.skipspace;
|
|
Message1(w,current_scanner.readcomment);
|
|
end;
|
|
|
|
{*****************************************************************************
|
|
Directive Callbacks
|
|
*****************************************************************************}
|
|
|
|
procedure dir_align;
|
|
var
|
|
hs : string;
|
|
b : byte;
|
|
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
|
|
current_settings.packrecords:=4
|
|
else if (hs='OFF') then
|
|
current_settings.packrecords:=1
|
|
else if m_mac in current_settings.modeswitches then
|
|
begin
|
|
{ Support switches used in Apples Universal Interfaces}
|
|
if (hs='MAC68K') then
|
|
current_settings.packrecords:=mac68k_alignment
|
|
{ "power" alignment is the default C packrecords setting on
|
|
Mac OS X }
|
|
else if (hs='POWER') or (hs='POWERPC') then
|
|
current_settings.packrecords:=C_alignment
|
|
else if (hs='RESET') then
|
|
current_settings.packrecords:=default_settings.packrecords
|
|
else
|
|
Message1(scan_e_illegal_pack_records,hs);
|
|
end
|
|
else
|
|
Message1(scan_e_illegal_pack_records,hs);
|
|
end
|
|
else
|
|
begin
|
|
b:=current_scanner.readval;
|
|
case b of
|
|
1 : current_settings.packrecords:=1;
|
|
2 : current_settings.packrecords:=2;
|
|
4 : current_settings.packrecords:=4;
|
|
8 : current_settings.packrecords:=8;
|
|
16 : current_settings.packrecords:=16;
|
|
32 : current_settings.packrecords:=32;
|
|
else
|
|
Message1(scan_e_illegal_pack_records,tostr(b));
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure dir_a1;
|
|
begin
|
|
current_settings.packrecords:=1;
|
|
end;
|
|
|
|
procedure dir_a2;
|
|
begin
|
|
current_settings.packrecords:=2;
|
|
end;
|
|
|
|
procedure dir_a4;
|
|
begin
|
|
current_settings.packrecords:=4;
|
|
end;
|
|
|
|
procedure dir_a8;
|
|
begin
|
|
current_settings.packrecords:=8;
|
|
end;
|
|
|
|
procedure dir_asmcpu;
|
|
var
|
|
s : string;
|
|
cpu: tcputype;
|
|
found: Boolean;
|
|
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='ANY' then
|
|
current_settings.asmcputype:=cpu_none
|
|
else if s='CURRENT' then
|
|
current_settings.asmcputype:=current_settings.cputype
|
|
else
|
|
begin
|
|
found:=false;
|
|
for cpu:=succ(low(tcputype)) to high(tcputype) do
|
|
if s=cputypestr[cpu] then
|
|
begin
|
|
found:=true;
|
|
current_settings.asmcputype:=cpu;
|
|
break;
|
|
end;
|
|
if not found then
|
|
Message1(scan_e_illegal_asmcpu_specifier,s);
|
|
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
|
|
current_settings.asmmode:=init_settings.asmmode
|
|
else
|
|
if not SetAsmReadMode(s,current_settings.asmmode) then
|
|
Message1(scan_e_illegal_asmmode_specifier,s);
|
|
end;
|
|
|
|
{$if defined(m68k) or defined(arm)}
|
|
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 defined(m68k) or defined(arm)}
|
|
|
|
procedure dir_apptype;
|
|
var
|
|
hs : string;
|
|
begin
|
|
if not (target_info.system in systems_all_windows + [system_i386_os2,
|
|
system_i386_emx, system_powerpc_macos,
|
|
system_arm_nds, system_i8086_msdos] +
|
|
systems_nativent) then
|
|
begin
|
|
if m_delphi in current_settings.modeswitches then
|
|
Message(scan_n_app_type_not_support)
|
|
else
|
|
Message(scan_w_app_type_not_support);
|
|
end
|
|
else
|
|
begin
|
|
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') and not (target_info.system in [system_i8086_msdos]) then
|
|
SetApptype(app_gui)
|
|
else if (hs='CONSOLE') and not (target_info.system in [system_i8086_msdos]) then
|
|
SetApptype(app_cui)
|
|
else if (hs='NATIVE') and (target_info.system in systems_windows + systems_nativent) then
|
|
SetApptype(app_native)
|
|
else if (hs='FS') and (target_info.system in [system_i386_os2,
|
|
system_i386_emx]) then
|
|
SetApptype(app_fs)
|
|
else if (hs='TOOL') and (target_info.system in [system_powerpc_macos]) then
|
|
SetApptype(app_tool)
|
|
else if (hs='ARM9') and (target_info.system in [system_arm_nds]) then
|
|
SetApptype(app_arm9)
|
|
else if (hs='ARM7') and (target_info.system in [system_arm_nds]) then
|
|
SetApptype(app_arm7)
|
|
else if (hs='COM') and (target_info.system in [system_i8086_msdos]) then
|
|
SetApptype(app_com)
|
|
else if (hs='EXE') and (target_info.system in [system_i8086_msdos]) then
|
|
SetApptype(app_cui)
|
|
else
|
|
Message1(scan_w_unsupported_app_type,hs);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure dir_calling;
|
|
var
|
|
hs : string;
|
|
begin
|
|
current_scanner.skipspace;
|
|
hs:=current_scanner.readid;
|
|
if (hs='') then
|
|
Message(parser_e_proc_directive_expected)
|
|
else
|
|
recordpendingcallingswitch(hs);
|
|
end;
|
|
|
|
|
|
procedure dir_checklowaddrloads;
|
|
begin
|
|
do_localswitchdefault(cs_check_low_addr_load);
|
|
end;
|
|
|
|
|
|
procedure dir_checkpointer;
|
|
var
|
|
switch: char;
|
|
begin
|
|
switch:=do_localswitchdefault(cs_checkpointer);
|
|
if (switch='+') and
|
|
not(target_info.system in systems_support_checkpointer) then
|
|
Message1(scan_e_unsupported_switch,'CHECKPOINTER+');
|
|
end;
|
|
|
|
|
|
procedure dir_objectchecks;
|
|
begin
|
|
do_localswitch(cs_check_object);
|
|
end;
|
|
|
|
|
|
procedure dir_ieeeerrors;
|
|
begin
|
|
do_localswitch(cs_ieee_errors);
|
|
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 systems_all_windows+[system_i386_os2,system_i386_emx,
|
|
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_forcefarcalls;
|
|
begin
|
|
if (target_info.system<>system_i8086_msdos)
|
|
{$ifdef i8086}
|
|
or (current_settings.x86memorymodel in x86_near_code_models)
|
|
{$endif i8086}
|
|
then
|
|
begin
|
|
Message1(scan_n_ignored_switch,pattern);
|
|
exit;
|
|
end;
|
|
do_localswitch(cs_force_far_calls);
|
|
end;
|
|
|
|
procedure dir_fatal;
|
|
begin
|
|
do_message(scan_f_user_defined);
|
|
end;
|
|
|
|
procedure dir_fputype;
|
|
begin
|
|
current_scanner.skipspace;
|
|
undef_system_macro('FPU'+fputypestr[current_settings.fputype]);
|
|
if not(SetFPUType(upper(current_scanner.readcomment),current_settings.fputype)) then
|
|
comment(V_Error,'Illegal FPU type');
|
|
def_system_macro('FPU'+fputypestr[current_settings.fputype]);
|
|
end;
|
|
|
|
procedure dir_frameworkpath;
|
|
begin
|
|
if not current_module.in_global then
|
|
Message(scan_w_switch_is_global)
|
|
else if not(target_info.system in systems_darwin) then
|
|
begin
|
|
Message(scan_w_frameworks_darwin_only);
|
|
current_scanner.skipspace;
|
|
current_scanner.readcomment
|
|
end
|
|
else
|
|
begin
|
|
current_scanner.skipspace;
|
|
current_module.localframeworksearchpath.AddPath(current_scanner.readcomment,false);
|
|
end;
|
|
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_imagebase;
|
|
begin
|
|
if not (target_info.system in (systems_windows+systems_wince)) then
|
|
Message(scan_w_imagebase_not_support);
|
|
current_scanner.skipspace;
|
|
imagebase:=current_scanner.readval;
|
|
ImageBaseSetExplicity:=true
|
|
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_localswitch(cs_do_inline);
|
|
end;
|
|
|
|
procedure dir_interfaces;
|
|
var
|
|
hs : string;
|
|
begin
|
|
{corba/com/default}
|
|
current_scanner.skipspace;
|
|
hs:=current_scanner.readid;
|
|
{$ifndef jvm}
|
|
if (hs='CORBA') then
|
|
current_settings.interfacetype:=it_interfacecorba
|
|
else if (hs='COM') then
|
|
current_settings.interfacetype:=it_interfacecom
|
|
else
|
|
{$endif jvm}
|
|
if (hs='DEFAULT') then
|
|
current_settings.interfacetype:=init_settings.interfacetype
|
|
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:=FixFileName(s);
|
|
if ExtractFileExt(s)='' then
|
|
s:=ChangeFileExt(s,target_info.objext);
|
|
current_module.linkotherofiles.add(s,link_always);
|
|
end;
|
|
|
|
procedure dir_linkframework;
|
|
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:=FixFileName(s);
|
|
if (target_info.system in systems_darwin) then
|
|
current_module.linkotherframeworks.add(s,link_always)
|
|
else
|
|
Message(scan_w_frameworks_darwin_only);
|
|
end;
|
|
|
|
procedure dir_linklib;
|
|
type
|
|
tLinkMode=(lm_shared,lm_static);
|
|
var
|
|
s : string;
|
|
quote : char;
|
|
libext,
|
|
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;
|
|
{ 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;
|
|
libname:=FixFileName(libname);
|
|
|
|
{ get linkmode, default is to check the extension for
|
|
the static library, otherwise shared linking is assumed }
|
|
linkmode:=lm_shared;
|
|
if linkModeStr='' then
|
|
begin
|
|
libext:=ExtractFileExt(libname);
|
|
if libext=target_info.staticClibext then
|
|
linkMode:=lm_static;
|
|
end
|
|
else if linkModeStr='STATIC' then
|
|
linkmode:=lm_static
|
|
else if (LinkModeStr='SHARED') or (LinkModeStr='') then
|
|
linkmode:=lm_shared
|
|
else
|
|
Comment(V_Error,'Wrong link mode specified: "'+Linkmodestr+'"');
|
|
|
|
{ add to the list of other libraries }
|
|
if linkMode=lm_static then
|
|
current_module.linkOtherStaticLibs.add(libname,link_always)
|
|
else
|
|
current_module.linkOtherSharedLibs.add(libname,link_always);
|
|
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_pascalmainname;
|
|
var
|
|
s: string;
|
|
begin
|
|
current_scanner.skipspace;
|
|
s:=trimspace(current_scanner.readcomment);
|
|
if assigned(current_module.mainname) and
|
|
(s<>current_module.mainname^) then
|
|
begin
|
|
Message1(scan_w_multiple_main_name_overrides,current_module.mainname^);
|
|
stringdispose(current_module.mainname)
|
|
end
|
|
else if (mainaliasname<>defaultmainaliasname) and
|
|
(mainaliasname<>s) then
|
|
Message1(scan_w_multiple_main_name_overrides,mainaliasname);
|
|
mainaliasname:=s;
|
|
if (mainaliasname<>defaultmainaliasname) then
|
|
current_module.mainname:=stringdup(mainaliasname);
|
|
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
|
|
current_settings.maxfpuregisters:=-1
|
|
else
|
|
Message(scan_e_invalid_maxfpureg_value);
|
|
end
|
|
else
|
|
begin
|
|
l:=current_scanner.readval;
|
|
case l of
|
|
0..8:
|
|
current_settings.maxfpuregisters:=l;
|
|
else
|
|
Message(scan_e_invalid_maxfpureg_value);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure dir_maxstacksize;
|
|
begin
|
|
if not (target_info.system in (systems_windows+systems_wince)) then
|
|
Message(scan_w_maxstacksize_not_support);
|
|
current_scanner.skipspace;
|
|
maxstacksize:=current_scanner.readval;
|
|
MaxStackSizeSetExplicity:=true;
|
|
end;
|
|
|
|
procedure dir_memory;
|
|
var
|
|
l : longint;
|
|
heapsize_limit: longint;
|
|
maxheapsize_limit: longint;
|
|
begin
|
|
{$if defined(i8086)}
|
|
if current_settings.x86memorymodel in x86_far_data_models then
|
|
begin
|
|
heapsize_limit:=655360;
|
|
maxheapsize_limit:=655360;
|
|
end
|
|
else
|
|
begin
|
|
heapsize_limit:=65520;
|
|
maxheapsize_limit:=65520;
|
|
end;
|
|
{$elseif defined(cpu16bitaddr)}
|
|
heapsize_limit:=65520;
|
|
maxheapsize_limit:=65520;
|
|
{$else}
|
|
heapsize_limit:=high(heapsize);
|
|
maxheapsize_limit:=high(maxheapsize);
|
|
{$endif}
|
|
current_scanner.skipspace;
|
|
l:=current_scanner.readval;
|
|
if (l>=1024)
|
|
{$ifdef cpu16bitaddr}
|
|
and (l<=65521) { TP7's $M directive allows specifying a stack size of
|
|
65521, but it actually sets the stack size to 65520 }
|
|
{$else cpu16bitaddr}
|
|
and (l<67107840)
|
|
{$endif cpu16bitaddr}
|
|
then
|
|
stacksize:=min(l,{$ifdef cpu16bitaddr}65520{$else}67107839{$endif})
|
|
else
|
|
Message(scan_w_invalid_stacksize);
|
|
if c=',' then
|
|
begin
|
|
current_scanner.readchar;
|
|
current_scanner.skipspace;
|
|
l:=current_scanner.readval;
|
|
if l>=1024 then
|
|
heapsize:=min(l,heapsize_limit);
|
|
if c=',' then
|
|
begin
|
|
current_scanner.readchar;
|
|
current_scanner.skipspace;
|
|
l:=current_scanner.readval;
|
|
if l>=heapsize then
|
|
maxheapsize:=min(l,maxheapsize_limit)
|
|
else
|
|
Message(scan_w_heapmax_lessthan_heapmin);
|
|
end;
|
|
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_minstacksize;
|
|
begin
|
|
if not (target_info.system in (systems_windows+systems_wince)) then
|
|
Message(scan_w_minstacksize_not_support);
|
|
current_scanner.skipspace;
|
|
minstacksize:=current_scanner.readval;
|
|
MinStackSizeSetExplicity:=true;
|
|
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 current_module.mode_switch_allowed and
|
|
not ((m_mac in current_settings.modeswitches) and (pattern='MACPAS')) then
|
|
Message1(scan_e_mode_switch_not_allowed,pattern)
|
|
else if not SetCompileMode(pattern,false) then
|
|
Message1(scan_w_illegal_switch,pattern)
|
|
end;
|
|
current_module.mode_switch_allowed:= false;
|
|
end;
|
|
|
|
|
|
procedure dir_modeswitch;
|
|
var
|
|
s : string;
|
|
begin
|
|
if not current_module.in_global then
|
|
Message(scan_w_switch_is_global)
|
|
else
|
|
begin
|
|
current_scanner.skipspace;
|
|
current_scanner.readstring;
|
|
s:=pattern;
|
|
if c in ['+','-'] then
|
|
s:=s+current_scanner.readstate;
|
|
if not SetCompileModeSwitch(s,false) then
|
|
Message1(scan_w_illegal_switch,s)
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure dir_namespace;
|
|
var
|
|
s : string;
|
|
begin
|
|
{ used to define Java package names for all types declared in the
|
|
current unit }
|
|
if not current_module.in_global then
|
|
Message(scan_w_switch_is_global)
|
|
else
|
|
begin
|
|
current_scanner.skipspace;
|
|
current_scanner.readstring;
|
|
s:=orgpattern;
|
|
while c='.' do
|
|
begin
|
|
current_scanner.readchar;
|
|
current_scanner.readstring;
|
|
s:=s+'.'+orgpattern;
|
|
end;
|
|
disposestr(current_module.namespace);
|
|
current_module.namespace:=stringdup(s);
|
|
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_optimization;
|
|
var
|
|
hs : string;
|
|
begin
|
|
current_scanner.skipspace;
|
|
{ Support also the ON and OFF as switch }
|
|
hs:=current_scanner.readid;
|
|
if (hs='ON') then
|
|
current_settings.optimizerswitches:=level2optimizerswitches
|
|
else if (hs='OFF') then
|
|
current_settings.optimizerswitches:=[]
|
|
else if (hs='DEFAULT') then
|
|
current_settings.optimizerswitches:=init_settings.optimizerswitches
|
|
else
|
|
begin
|
|
if not UpdateOptimizerStr(hs,current_settings.optimizerswitches) then
|
|
Message1(scan_e_illegal_optimization_specifier,hs);
|
|
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
|
|
current_settings.packenum:=4
|
|
else
|
|
Message1(scan_e_illegal_pack_enum, hs);
|
|
end
|
|
else
|
|
begin
|
|
case current_scanner.readval of
|
|
1 : current_settings.packenum:=1;
|
|
2 : current_settings.packenum:=2;
|
|
4 : current_settings.packenum:=4;
|
|
else
|
|
Message1(scan_e_illegal_pack_enum, pattern);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure dir_minfpconstprec;
|
|
begin
|
|
current_scanner.skipspace;
|
|
if not SetMinFPConstPrec(current_scanner.readid,current_settings.minfpconstprec) then
|
|
Message1(scan_e_illegal_minfpconstprec, pattern);
|
|
end;
|
|
|
|
|
|
procedure dir_packrecords;
|
|
var
|
|
hs : string;
|
|
begin
|
|
{ can't change packrecords setting on managed vm targets }
|
|
if target_info.system in systems_managed_vm then
|
|
Message1(scanner_w_directive_ignored_on_target, 'PACKRECORDS');
|
|
current_scanner.skipspace;
|
|
if not(c in ['0'..'9']) then
|
|
begin
|
|
hs:=current_scanner.readid;
|
|
{ C has the special recordalignmax of C_alignment }
|
|
if (hs='C') then
|
|
current_settings.packrecords:=C_alignment
|
|
else
|
|
if (hs='NORMAL') or (hs='DEFAULT') then
|
|
current_settings.packrecords:=default_settings.packrecords
|
|
else
|
|
Message1(scan_e_illegal_pack_records,hs);
|
|
end
|
|
else
|
|
begin
|
|
case current_scanner.readval of
|
|
1 : current_settings.packrecords:=1;
|
|
2 : current_settings.packrecords:=2;
|
|
4 : current_settings.packrecords:=4;
|
|
8 : current_settings.packrecords:=8;
|
|
16 : current_settings.packrecords:=16;
|
|
32 : current_settings.packrecords:=32;
|
|
else
|
|
Message1(scan_e_illegal_pack_records,pattern);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure dir_packset;
|
|
var
|
|
hs : string;
|
|
begin
|
|
current_scanner.skipspace;
|
|
if not(c in ['1','2','4','8']) then
|
|
begin
|
|
hs:=current_scanner.readid;
|
|
if (hs='FIXED') or (hs='DEFAULT') OR (hs='NORMAL') then
|
|
current_settings.setalloc:=0 {Fixed mode, sets are 4 or 32 bytes}
|
|
else
|
|
Message(scan_e_only_packset);
|
|
end
|
|
else
|
|
begin
|
|
case current_scanner.readval of
|
|
1 : current_settings.setalloc:=1;
|
|
2 : current_settings.setalloc:=2;
|
|
4 : current_settings.setalloc:=4;
|
|
8 : current_settings.setalloc:=8;
|
|
else
|
|
Message(scan_e_only_packset);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
|
|
procedure dir_pic;
|
|
begin
|
|
{ windows doesn't need/support pic }
|
|
if tf_no_pic_supported in target_info.flags then
|
|
message(scan_w_pic_ignored)
|
|
else
|
|
do_moduleswitch(cs_create_pic);
|
|
end;
|
|
|
|
procedure dir_pop;
|
|
|
|
begin
|
|
if switchesstatestackpos < 1 then
|
|
Message(scan_e_too_many_pop);
|
|
|
|
Dec(switchesstatestackpos);
|
|
recordpendinglocalfullswitch(switchesstatestack[switchesstatestackpos].localsw);
|
|
recordpendingverbosityfullswitch(switchesstatestack[switchesstatestackpos].verbosity);
|
|
pendingstate.nextmessagerecord:=switchesstatestack[switchesstatestackpos].pmessage;
|
|
{ Reset verbosity and forget previous pmeesage }
|
|
RestoreLocalVerbosity(nil);
|
|
current_settings.pmessage:=nil;
|
|
{ Do not yet activate these changes, as otherwise
|
|
you get problem idf you put a $pop just right after
|
|
a addition for instance fro which you explicitly truned the overflow check
|
|
out by using $Q- after a $push PM 2012-08-29 }
|
|
// flushpendingswitchesstate;
|
|
end;
|
|
|
|
procedure dir_pointermath;
|
|
begin
|
|
do_localswitch(cs_pointermath);
|
|
end;
|
|
|
|
procedure dir_profile;
|
|
begin
|
|
do_moduleswitch(cs_profile);
|
|
{ defined/undefine FPC_PROFILE }
|
|
if cs_profile in current_settings.moduleswitches then
|
|
def_system_macro('FPC_PROFILE')
|
|
else
|
|
undef_system_macro('FPC_PROFILE');
|
|
end;
|
|
|
|
procedure dir_push;
|
|
|
|
begin
|
|
if switchesstatestackpos > switchesstatestackmax then
|
|
Message(scan_e_too_many_push);
|
|
|
|
flushpendingswitchesstate;
|
|
|
|
switchesstatestack[switchesstatestackpos].localsw:= current_settings.localswitches;
|
|
switchesstatestack[switchesstatestackpos].pmessage:= current_settings.pmessage;
|
|
switchesstatestack[switchesstatestackpos].verbosity:=status.verbosity;
|
|
Inc(switchesstatestackpos);
|
|
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 the name of the main source.
|
|
This should always be defined. }
|
|
if s[1]='*' then
|
|
if Assigned(Current_Module) then
|
|
begin
|
|
delete(S,1,1);
|
|
insert(ChangeFileExt(ExtractFileName(current_module.mainsource),''),S,1 );
|
|
end;
|
|
s:=FixFileName(s);
|
|
if ExtractFileExt(s)='' then
|
|
s:=ChangeFileExt(s,target_info.resext);
|
|
if target_info.res<>res_none then
|
|
begin
|
|
current_module.flags:=current_module.flags or uf_has_resourcefiles;
|
|
if (res_single_file in target_res.resflags) and
|
|
not (Current_module.ResourceFiles.Empty) then
|
|
Message(scan_w_only_one_resourcefile_supported)
|
|
else
|
|
current_module.resourcefiles.insert(FixFileName(s));
|
|
end
|
|
else
|
|
Message(scan_e_resourcefiles_not_supported);
|
|
end;
|
|
|
|
procedure dir_saturation;
|
|
begin
|
|
do_localswitch(cs_mmx_saturation);
|
|
end;
|
|
|
|
procedure dir_safefpuexceptions;
|
|
begin
|
|
do_localswitch(cs_fpu_fwait);
|
|
end;
|
|
|
|
procedure dir_scopedenums;
|
|
begin
|
|
do_localswitch(cs_scopedenums);
|
|
end;
|
|
|
|
function get_peflag_const(const ident:string;error:longint):longint;
|
|
var
|
|
srsym : tsym;
|
|
srsymtable : tsymtable;
|
|
begin
|
|
result:=0;
|
|
if searchsym(ident,srsym,srsymtable) then
|
|
if (srsym.typ=constsym) and
|
|
(tconstsym(srsym).consttyp=constord) and
|
|
is_integer(tconstsym(srsym).constdef) then
|
|
with tconstsym(srsym).value.valueord do
|
|
if signed then
|
|
result:=tconstsym(srsym).value.valueord.svalue
|
|
else
|
|
result:=tconstsym(srsym).value.valueord.uvalue
|
|
else
|
|
message(error)
|
|
else
|
|
message1(sym_e_id_not_found,ident);
|
|
end;
|
|
|
|
procedure dir_setpeflags;
|
|
var
|
|
ident : string;
|
|
begin
|
|
if not (target_info.system in (systems_all_windows)) then
|
|
Message(scan_w_setpeflags_not_support);
|
|
current_scanner.skipspace;
|
|
ident:=current_scanner.readid;
|
|
if ident<>'' then
|
|
peflags:=peflags or get_peflag_const(ident,scan_e_illegal_peflag)
|
|
else
|
|
peflags:=peflags or current_scanner.readval;
|
|
SetPEFlagsSetExplicity:=true;
|
|
end;
|
|
|
|
procedure dir_setpeoptflags;
|
|
var
|
|
ident : string;
|
|
begin
|
|
if not (target_info.system in (systems_all_windows)) then
|
|
Message(scan_w_setpeoptflags_not_support);
|
|
current_scanner.skipspace;
|
|
ident:=current_scanner.readid;
|
|
if ident<>'' then
|
|
peoptflags:=peoptflags or get_peflag_const(ident,scan_e_illegal_peoptflag)
|
|
else
|
|
peoptflags:=peoptflags or current_scanner.readval;
|
|
SetPEOptFlagsSetExplicity:=true;
|
|
end;
|
|
|
|
procedure dir_smartlink;
|
|
begin
|
|
do_moduleswitch(cs_create_smart);
|
|
if (target_dbg.id in [dbg_dwarf2,dbg_dwarf3]) and
|
|
not(target_info.system in (systems_darwin+[system_i8086_msdos])) and
|
|
{ smart linking does not yet work with DWARF debug info on most targets }
|
|
(cs_create_smart in current_settings.moduleswitches) and
|
|
not (af_outputbinary in target_asm.flags) then
|
|
begin
|
|
Message(option_dwarf_smart_linking);
|
|
Exclude(current_settings.moduleswitches,cs_create_smart);
|
|
end;
|
|
{ Also create a smartlinked version, on an assembler that
|
|
does not support smartlink sections like nasm?
|
|
This is not compatible with using internal linker. }
|
|
if ((cs_link_smart in current_settings.globalswitches) or
|
|
(cs_create_smart in current_settings.moduleswitches)) and
|
|
(af_needar in target_asm.flags) and
|
|
not (af_smartlink_sections in target_asm.flags) and
|
|
not (cs_link_extern in current_settings.globalswitches) then
|
|
begin
|
|
DoneLinker;
|
|
Message(option_smart_link_requires_external_linker);
|
|
include(current_settings.globalswitches,cs_link_extern);
|
|
InitLinker;
|
|
end
|
|
end;
|
|
|
|
procedure dir_stackframes;
|
|
begin
|
|
do_delphiswitch('W');
|
|
end;
|
|
|
|
procedure dir_stop;
|
|
begin
|
|
do_message(scan_f_user_defined);
|
|
end;
|
|
|
|
procedure dir_stringchecks;
|
|
begin
|
|
// Delphi adds checks that ansistring and unicodestring are correct in
|
|
// different places. Skip it for now.
|
|
end;
|
|
|
|
{$ifdef powerpc}
|
|
procedure dir_syscall;
|
|
var
|
|
sctype : string;
|
|
begin
|
|
{ not needed on amiga/m68k for now, because there's only one }
|
|
{ syscall convention (legacy) (KB) }
|
|
{ not needed on amiga/powerpc because there's only one }
|
|
{ syscall convention (sysv) (KB) }
|
|
if not (target_info.system in [system_powerpc_morphos]) then
|
|
comment (V_Warning,'Syscall directive is useless on this target.');
|
|
current_scanner.skipspace;
|
|
|
|
sctype:=current_scanner.readid;
|
|
if (sctype='LEGACY') or (sctype='SYSV') or (sctype='SYSVBASE') or
|
|
(sctype='BASESYSV') or (sctype='R12BASE') then
|
|
syscall_convention:=sctype
|
|
else
|
|
comment (V_Warning,'Invalid Syscall directive ignored.');
|
|
end;
|
|
{$endif}
|
|
|
|
procedure dir_targetswitch;
|
|
var
|
|
name, value: string;
|
|
begin
|
|
{ note: *not* recorded in the tokenstream, so not replayed for generics }
|
|
current_scanner.skipspace;
|
|
name:=current_scanner.readid;
|
|
if c='=' then
|
|
begin
|
|
current_scanner.readchar;
|
|
current_scanner.readid;
|
|
value:=orgpattern;
|
|
UpdateTargetSwitchStr(name+'='+value,current_settings.targetswitches,current_module.in_global);
|
|
end
|
|
else if c='-' then
|
|
begin
|
|
current_scanner.readchar;
|
|
UpdateTargetSwitchStr(name+'-',current_settings.targetswitches,current_module.in_global);
|
|
end
|
|
else
|
|
UpdateTargetSwitchStr(name,current_settings.targetswitches,current_module.in_global);
|
|
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_varparacopyoutcheck;
|
|
begin
|
|
if not(target_info.system in systems_jvm) then
|
|
begin
|
|
Message1(scan_w_illegal_switch,pattern);
|
|
exit;
|
|
end;
|
|
do_localswitch(cs_check_var_copyout);
|
|
end;
|
|
|
|
procedure dir_varpropsetter;
|
|
begin
|
|
do_localswitch(cs_varpropsetter);
|
|
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 systems_all_windows+[system_i386_os2,system_i386_emx,
|
|
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;
|
|
val(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;
|
|
val(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;
|
|
val(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;
|
|
|
|
{ delphi compatible warn directive:
|
|
$warn <identifier> on
|
|
$warn <identifier> off
|
|
$warn <identifier> error
|
|
}
|
|
procedure dir_warn;
|
|
var
|
|
ident : string;
|
|
state : string;
|
|
msgstate : tmsgstate;
|
|
i : integer;
|
|
begin
|
|
current_scanner.skipspace;
|
|
ident:=current_scanner.readid;
|
|
current_scanner.skipspace;
|
|
state:=current_scanner.readid;
|
|
|
|
{ support both delphi and fpc switches }
|
|
{ use local ms_on/off/error tmsgstate values }
|
|
if (state='ON') or (state='+') then
|
|
msgstate:=ms_on
|
|
else
|
|
if (state='OFF') or (state='-') then
|
|
msgstate:=ms_off
|
|
else
|
|
if (state='ERROR') then
|
|
msgstate:=ms_error
|
|
else
|
|
begin
|
|
Message1(scanner_e_illegal_warn_state,state);
|
|
exit;
|
|
end;
|
|
|
|
if ident='CONSTRUCTING_ABSTRACT' then
|
|
begin
|
|
recordpendingmessagestate(type_w_instance_with_abstract, msgstate);
|
|
recordpendingmessagestate(type_w_instance_abstract_class, msgstate);
|
|
end
|
|
else
|
|
if ident='IMPLICIT_VARIANTS' then
|
|
recordpendingmessagestate(parser_w_implicit_uses_of_variants_unit, msgstate)
|
|
else
|
|
if ident='NO_RETVAL' then
|
|
recordpendingmessagestate(sym_w_function_result_not_set, msgstate)
|
|
else
|
|
if ident='SYMBOL_DEPRECATED' then
|
|
begin
|
|
recordpendingmessagestate(sym_w_deprecated_symbol, msgstate);
|
|
recordpendingmessagestate(sym_w_deprecated_symbol_with_msg, msgstate);
|
|
end
|
|
else
|
|
if ident='SYMBOL_EXPERIMENTAL' then
|
|
recordpendingmessagestate(sym_w_experimental_symbol, msgstate)
|
|
else
|
|
if ident='SYMBOL_LIBRARY' then
|
|
recordpendingmessagestate(sym_w_library_symbol, msgstate)
|
|
else
|
|
if ident='SYMBOL_PLATFORM' then
|
|
recordpendingmessagestate(sym_w_non_portable_symbol, msgstate)
|
|
else
|
|
if ident='SYMBOL_UNIMPLEMENTED' then
|
|
recordpendingmessagestate(sym_w_non_implemented_symbol, msgstate)
|
|
else
|
|
if ident='UNIT_DEPRECATED' then
|
|
begin
|
|
recordpendingmessagestate(sym_w_deprecated_unit, msgstate);
|
|
recordpendingmessagestate(sym_w_deprecated_unit_with_msg, msgstate);
|
|
end
|
|
else
|
|
if ident='UNIT_EXPERIMENTAL' then
|
|
recordpendingmessagestate(sym_w_experimental_unit, msgstate)
|
|
else
|
|
if ident='UNIT_LIBRARY' then
|
|
recordpendingmessagestate(sym_w_library_unit, msgstate)
|
|
else
|
|
if ident='UNIT_PLATFORM' then
|
|
recordpendingmessagestate(sym_w_non_portable_unit, msgstate)
|
|
else
|
|
if ident='UNIT_UNIMPLEMENTED' then
|
|
recordpendingmessagestate(sym_w_non_implemented_unit, msgstate)
|
|
else
|
|
if ident='ZERO_NIL_COMPAT' then
|
|
recordpendingmessagestate(type_w_zero_to_nil, msgstate)
|
|
else
|
|
if ident='IMPLICIT_STRING_CAST' then
|
|
recordpendingmessagestate(type_w_implicit_string_cast, msgstate)
|
|
else
|
|
if ident='IMPLICIT_STRING_CAST_LOSS' then
|
|
recordpendingmessagestate(type_w_implicit_string_cast_loss, msgstate)
|
|
else
|
|
if ident='EXPLICIT_STRING_CAST' then
|
|
recordpendingmessagestate(type_w_explicit_string_cast, msgstate)
|
|
else
|
|
if ident='EXPLICIT_STRING_CAST_LOSS' then
|
|
recordpendingmessagestate(type_w_explicit_string_cast_loss, msgstate)
|
|
else
|
|
if ident='CVT_NARROWING_STRING_LOST' then
|
|
recordpendingmessagestate(type_w_unicode_data_loss, msgstate)
|
|
else
|
|
if ident='INTF_RAISE_VISIBILITY' then
|
|
recordpendingmessagestate(type_w_interface_lower_visibility, msgstate)
|
|
else
|
|
begin
|
|
i:=0;
|
|
if not ChangeMessageVerbosity(ident,i,msgstate) then
|
|
Message1(scanner_w_illegal_warn_identifier,ident);
|
|
end;
|
|
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
|
|
current_settings.packenum:=1;
|
|
end;
|
|
|
|
procedure dir_z2;
|
|
begin
|
|
current_settings.packenum:=2;
|
|
end;
|
|
|
|
procedure dir_z4;
|
|
begin
|
|
current_settings.packenum:=4;
|
|
end;
|
|
|
|
procedure dir_externalsym;
|
|
begin
|
|
end;
|
|
|
|
procedure dir_nodefine;
|
|
begin
|
|
end;
|
|
|
|
procedure dir_hppemit;
|
|
begin
|
|
end;
|
|
|
|
procedure dir_hugecode;
|
|
begin
|
|
if (target_info.system<>system_i8086_msdos)
|
|
{$ifdef i8086}
|
|
or (current_settings.x86memorymodel in x86_near_code_models)
|
|
{$endif i8086}
|
|
then
|
|
begin
|
|
Message1(scan_n_ignored_switch,pattern);
|
|
exit;
|
|
end;
|
|
do_moduleswitch(cs_huge_code);
|
|
end;
|
|
|
|
procedure dir_hugepointernormalization;
|
|
var
|
|
hs : string;
|
|
begin
|
|
if target_info.system<>system_i8086_msdos then
|
|
begin
|
|
Message1(scanner_w_directive_ignored_on_target, 'HUGEPOINTERNORMALIZATION');
|
|
exit;
|
|
end;
|
|
current_scanner.skipspace;
|
|
hs:=current_scanner.readid;
|
|
case hs of
|
|
'BORLANDC':
|
|
begin
|
|
recordpendinglocalswitch(cs_hugeptr_arithmetic_normalization,'+');
|
|
recordpendinglocalswitch(cs_hugeptr_comparison_normalization,'+');
|
|
end;
|
|
'MICROSOFTC':
|
|
begin
|
|
recordpendinglocalswitch(cs_hugeptr_arithmetic_normalization,'-');
|
|
recordpendinglocalswitch(cs_hugeptr_comparison_normalization,'-');
|
|
end;
|
|
'WATCOMC':
|
|
begin
|
|
recordpendinglocalswitch(cs_hugeptr_arithmetic_normalization,'-');
|
|
recordpendinglocalswitch(cs_hugeptr_comparison_normalization,'+');
|
|
end;
|
|
else
|
|
Message(scan_e_illegal_hugepointernormalization);
|
|
end;
|
|
end;
|
|
|
|
procedure dir_hugepointerarithmeticnormalization;
|
|
begin
|
|
if target_info.system<>system_i8086_msdos then
|
|
begin
|
|
Message1(scanner_w_directive_ignored_on_target, 'HUGEPOINTERARITHMETICNORMALIZATION');
|
|
exit;
|
|
end;
|
|
do_localswitch(cs_hugeptr_arithmetic_normalization);
|
|
end;
|
|
|
|
procedure dir_hugepointercomparisonnormalization;
|
|
begin
|
|
if target_info.system<>system_i8086_msdos then
|
|
begin
|
|
Message1(scanner_w_directive_ignored_on_target, 'HUGEPOINTERCOMPARISONNORMALIZATION');
|
|
exit;
|
|
end;
|
|
do_localswitch(cs_hugeptr_comparison_normalization);
|
|
end;
|
|
|
|
procedure dir_weakpackageunit;
|
|
begin
|
|
end;
|
|
|
|
procedure dir_codealign;
|
|
var
|
|
s : string;
|
|
begin
|
|
current_scanner.skipspace;
|
|
s:=current_scanner.readcomment;
|
|
if not(UpdateAlignmentStr(s,current_settings.alignment)) then
|
|
message(scanner_e_illegal_alignment_directive);
|
|
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 (upper(s)='UTF8') or (upper(s)='UTF-8') then
|
|
current_settings.sourcecodepage:=CP_UTF8
|
|
else if not cpavailable(s) then
|
|
Message1(option_code_page_not_available,s)
|
|
else
|
|
current_settings.sourcecodepage:=codepagebyname(s);
|
|
{ we're not using the system code page now }
|
|
exclude(current_settings.modeswitches,m_systemcodepage);
|
|
exclude(current_settings.moduleswitches,cs_system_codepage);
|
|
include(current_settings.moduleswitches,cs_explicit_codepage);
|
|
end;
|
|
end;
|
|
|
|
procedure dir_coperators;
|
|
begin
|
|
do_moduleswitch(cs_support_c_operators);
|
|
end;
|
|
|
|
|
|
procedure dir_bitpacking;
|
|
begin
|
|
do_localswitch(cs_bitpacking);
|
|
end;
|
|
|
|
procedure dir_region;
|
|
begin
|
|
end;
|
|
|
|
procedure dir_endregion;
|
|
begin
|
|
end;
|
|
|
|
procedure dir_zerobasesstrings;
|
|
begin
|
|
do_localswitch(cs_zerobasedstrings);
|
|
end;
|
|
|
|
|
|
{****************************************************************************
|
|
Initialize Directives
|
|
****************************************************************************}
|
|
|
|
procedure InitScannerDirectives;
|
|
begin
|
|
AddDirective('A1',directive_all, @dir_a1);
|
|
AddDirective('A2',directive_all, @dir_a2);
|
|
AddDirective('A4',directive_all, @dir_a4);
|
|
AddDirective('A8',directive_all, @dir_a8);
|
|
AddDirective('ALIGN',directive_all, @dir_align);
|
|
{$ifdef m68k}
|
|
AddDirective('APPID',directive_all, @dir_appid);
|
|
AddDirective('APPNAME',directive_all, @dir_appname);
|
|
{$endif m68k}
|
|
AddDirective('APPTYPE',directive_all, @dir_apptype);
|
|
AddDirective('ASMCPU',directive_all, @dir_asmcpu);
|
|
AddDirective('ASMMODE',directive_all, @dir_asmmode);
|
|
AddDirective('ASSERTIONS',directive_all, @dir_assertions);
|
|
AddDirective('BOOLEVAL',directive_all, @dir_booleval);
|
|
AddDirective('BITPACKING',directive_all, @dir_bitpacking);
|
|
AddDirective('CALLING',directive_all, @dir_calling);
|
|
AddDirective('CHECKLOWADDRLOADS',directive_all, @dir_checklowaddrloads);
|
|
AddDirective('CHECKPOINTER',directive_all, @dir_checkpointer);
|
|
AddDirective('CODEALIGN',directive_all, @dir_codealign);
|
|
AddDirective('CODEPAGE',directive_all, @dir_codepage);
|
|
AddDirective('COPERATORS',directive_all, @dir_coperators);
|
|
AddDirective('COPYRIGHT',directive_all, @dir_copyright);
|
|
AddDirective('D',directive_all, @dir_description);
|
|
AddDirective('DEBUGINFO',directive_all, @dir_debuginfo);
|
|
AddDirective('DESCRIPTION',directive_all, @dir_description);
|
|
AddDirective('ENDREGION',directive_all, @dir_endregion);
|
|
AddDirective('ERROR',directive_all, @dir_error);
|
|
AddDirective('ERRORC',directive_mac, @dir_error);
|
|
AddDirective('EXTENDEDSYNTAX',directive_all, @dir_extendedsyntax);
|
|
AddDirective('EXTERNALSYM',directive_all, @dir_externalsym);
|
|
AddDirective('F',directive_all, @dir_forcefarcalls);
|
|
AddDirective('FATAL',directive_all, @dir_fatal);
|
|
AddDirective('FPUTYPE',directive_all, @dir_fputype);
|
|
AddDirective('FRAMEWORKPATH',directive_all, @dir_frameworkpath);
|
|
AddDirective('GOTO',directive_all, @dir_goto);
|
|
AddDirective('HINT',directive_all, @dir_hint);
|
|
AddDirective('HINTS',directive_all, @dir_hints);
|
|
AddDirective('HPPEMIT',directive_all, @dir_hppemit);
|
|
AddDirective('HUGECODE',directive_all, @dir_hugecode);
|
|
AddDirective('HUGEPOINTERNORMALIZATION',directive_all,@dir_hugepointernormalization);
|
|
AddDirective('HUGEPOINTERARITHMETICNORMALIZATION',directive_all,@dir_hugepointerarithmeticnormalization);
|
|
AddDirective('HUGEPOINTERCOMPARISONNORMALIZATION',directive_all,@dir_hugepointercomparisonnormalization);
|
|
AddDirective('IEEEERRORS',directive_all,@dir_ieeeerrors);
|
|
AddDirective('IOCHECKS',directive_all, @dir_iochecks);
|
|
AddDirective('IMAGEBASE',directive_all, @dir_imagebase);
|
|
AddDirective('IMPLICITEXCEPTIONS',directive_all, @dir_implicitexceptions);
|
|
AddDirective('INCLUDEPATH',directive_all, @dir_includepath);
|
|
AddDirective('INFO',directive_all, @dir_info);
|
|
AddDirective('INLINE',directive_all, @dir_inline);
|
|
AddDirective('INTERFACES',directive_all, @dir_interfaces);
|
|
AddDirective('L',directive_all, @dir_link);
|
|
AddDirective('LIBEXPORT',directive_mac, @dir_libexport);
|
|
AddDirective('LIBRARYPATH',directive_all, @dir_librarypath);
|
|
AddDirective('LINK',directive_all, @dir_link);
|
|
AddDirective('LINKFRAMEWORK',directive_all, @dir_linkframework);
|
|
AddDirective('LINKLIB',directive_all, @dir_linklib);
|
|
AddDirective('LOCALSYMBOLS',directive_all, @dir_localsymbols);
|
|
AddDirective('LONGSTRINGS',directive_all, @dir_longstrings);
|
|
AddDirective('M',directive_all, @dir_memory);
|
|
AddDirective('MACRO',directive_all, @dir_macro);
|
|
AddDirective('MAXFPUREGISTERS',directive_all, @dir_maxfpuregisters);
|
|
AddDirective('MAXSTACKSIZE',directive_all, @dir_maxstacksize);
|
|
AddDirective('MEMORY',directive_all, @dir_memory);
|
|
AddDirective('MESSAGE',directive_all, @dir_message);
|
|
AddDirective('MINENUMSIZE',directive_all, @dir_packenum);
|
|
AddDirective('MINFPCONSTPREC',directive_all, @dir_minfpconstprec);
|
|
AddDirective('MINSTACKSIZE',directive_all, @dir_minstacksize);
|
|
AddDirective('MMX',directive_all, @dir_mmx);
|
|
AddDirective('MODE',directive_all, @dir_mode);
|
|
AddDirective('MODESWITCH',directive_all, @dir_modeswitch);
|
|
AddDirective('NAMESPACE',directive_all, @dir_namespace);
|
|
AddDirective('NODEFINE',directive_all, @dir_nodefine);
|
|
AddDirective('NOTE',directive_all, @dir_note);
|
|
AddDirective('NOTES',directive_all, @dir_notes);
|
|
AddDirective('OBJECTCHECKS',directive_all, @dir_objectchecks);
|
|
AddDirective('OBJECTPATH',directive_all, @dir_objectpath);
|
|
AddDirective('OPENSTRINGS',directive_all, @dir_openstrings);
|
|
AddDirective('OPTIMIZATION',directive_all, @dir_optimization);
|
|
AddDirective('OV',directive_mac, @dir_overflowchecks);
|
|
AddDirective('OVERFLOWCHECKS',directive_all, @dir_overflowchecks);
|
|
AddDirective('PACKENUM',directive_all, @dir_packenum);
|
|
AddDirective('PACKRECORDS',directive_all, @dir_packrecords);
|
|
AddDirective('PACKSET',directive_all, @dir_packset);
|
|
AddDirective('PASCALMAINNAME',directive_all, @dir_pascalmainname);
|
|
AddDirective('PIC',directive_all, @dir_pic);
|
|
AddDirective('POINTERMATH',directive_all, @dir_pointermath);
|
|
AddDirective('POP',directive_all, @dir_pop);
|
|
AddDirective('PROFILE',directive_all, @dir_profile);
|
|
AddDirective('PUSH',directive_all, @dir_push);
|
|
AddDirective('R',directive_all, @dir_resource);
|
|
AddDirective('RANGECHECKS',directive_all, @dir_rangechecks);
|
|
AddDirective('REFERENCEINFO',directive_all, @dir_referenceinfo);
|
|
AddDirective('REGION',directive_all, @dir_region);
|
|
AddDirective('RESOURCE',directive_all, @dir_resource);
|
|
AddDirective('SATURATION',directive_all, @dir_saturation);
|
|
AddDirective('SAFEFPUEXCEPTIONS',directive_all, @dir_safefpuexceptions);
|
|
AddDirective('SCOPEDENUMS',directive_all, @dir_scopedenums);
|
|
AddDirective('SETPEFLAGS', directive_all, @dir_setpeflags);
|
|
AddDirective('SETPEOPTFLAGS', directive_all, @dir_setpeoptflags);
|
|
AddDirective('SCREENNAME',directive_all, @dir_screenname);
|
|
AddDirective('SMARTLINK',directive_all, @dir_smartlink);
|
|
AddDirective('STACKFRAMES',directive_all, @dir_stackframes);
|
|
AddDirective('STOP',directive_all, @dir_stop);
|
|
AddDirective('STRINGCHECKS', directive_all, @dir_stringchecks);
|
|
{$ifdef powerpc}
|
|
AddDirective('SYSCALL',directive_all, @dir_syscall);
|
|
{$endif powerpc}
|
|
AddDirective('TARGETSWITCH',directive_all, @dir_targetswitch);
|
|
AddDirective('THREADNAME',directive_all, @dir_threadname);
|
|
AddDirective('TYPEDADDRESS',directive_all, @dir_typedaddress);
|
|
AddDirective('TYPEINFO',directive_all, @dir_typeinfo);
|
|
AddDirective('UNITPATH',directive_all, @dir_unitpath);
|
|
AddDirective('VARPARACOPYOUTCHECK',directive_all, @dir_varparacopyoutcheck);
|
|
AddDirective('VARPROPSETTER',directive_all, @dir_varpropsetter);
|
|
AddDirective('VARSTRINGCHECKS',directive_all, @dir_varstringchecks);
|
|
AddDirective('VERSION',directive_all, @dir_version);
|
|
AddDirective('WAIT',directive_all, @dir_wait);
|
|
AddDirective('WARN',directive_all, @dir_warn);
|
|
AddDirective('WARNING',directive_all, @dir_warning);
|
|
AddDirective('WARNINGS',directive_all, @dir_warnings);
|
|
AddDirective('WEAKPACKAGEUNIT',directive_all, @dir_weakpackageunit);
|
|
AddDirective('WRITEABLECONST',directive_all, @dir_writeableconst);
|
|
AddDirective('Z1',directive_all, @dir_z1);
|
|
AddDirective('Z2',directive_all, @dir_z2);
|
|
AddDirective('Z4',directive_all, @dir_z4);
|
|
AddDirective('ZEROBASEDSTRINGS',directive_all, @dir_zerobasesstrings);
|
|
end;
|
|
|
|
end.
|