fpc/compiler/scandir.pas
nickysn 06b9789928 + implemented a new {$ASMCPU XXX} directive, allowing to specify a different
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 -
2016-02-29 22:25:25 +00:00

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.