1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378137913801381138213831384138513861387138813891390139113921393139413951396139713981399140014011402140314041405140614071408140914101411141214131414141514161417141814191420142114221423142414251426142714281429143014311432143314341435143614371438143914401441144214431444144514461447144814491450145114521453145414551456145714581459146014611462146314641465146614671468146914701471147214731474147514761477147814791480148114821483148414851486148714881489149014911492149314941495149614971498149915001501150215031504150515061507150815091510151115121513151415151516151715181519152015211522152315241525152615271528152915301531153215331534153515361537153815391540154115421543154415451546154715481549155015511552155315541555155615571558155915601561156215631564156515661567156815691570157115721573157415751576157715781579158015811582158315841585158615871588158915901591159215931594159515961597159815991600160116021603160416051606160716081609161016111612161316141615161616171618161916201621162216231624162516261627162816291630163116321633163416351636163716381639164016411642164316441645164616471648164916501651165216531654165516561657165816591660166116621663166416651666166716681669167016711672167316741675167616771678167916801681168216831684168516861687168816891690169116921693169416951696169716981699170017011702170317041705170617071708170917101711171217131714171517161717171817191720172117221723172417251726172717281729173017311732173317341735173617371738173917401741174217431744174517461747174817491750175117521753175417551756175717581759176017611762176317641765176617671768176917701771177217731774177517761777177817791780178117821783178417851786178717881789179017911792179317941795179617971798179918001801180218031804180518061807180818091810181118121813181418151816181718181819 |
- {
- 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_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 (paratargetdbg 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
- 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);
- 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('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.
|