{ $Id$ Copyright (c) 1998 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. **************************************************************************** } const directivelen=15; type directivestr=string[directivelen]; tdirectivetoken=( _DIR_NONE, _DIR_ALIGN,_DIR_APPTYPE,_DIR_ASMMODE,_DIR_ASSERTIONS, _DIR_BOOLEVAL, _DIR_D,_DIR_DEBUGINFO,_DIR_DEFINE,_DIR_DESCRIPTION, _DIR_ELSE,_DIR_ENDIF,_DIR_ERROR,_DIR_EXTENDEDSYNTAX, _DIR_FATAL, _DIR_GOTO, _DIR_HINT,_DIR_HINTS, _DIR_I,_DIR_I386_ATT,_DIR_I386_DIRECT,_DIR_I386_INTEL,_DIR_IOCHECKS, _DIR_IF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_INCLUDE,_DIR_INCLUDEPATH, _DIR_INFO,_DIR_INLINE, _DIR_L,_DIR_LIBRARYPATH,_DIR_LINK,_DIR_LINKLIB,_DIR_LOCALSYMBOLS, _DIR_LONGSTRINGS, _DIR_M,_DIR_MACRO,_DIR_MEMORY,_DIR_MESSAGE,_DIR_MINENUMSIZE,_DIR_MMX,_DIR_MODE, _DIR_NOTE,_DIR_NOTES, _DIR_OBJECTPATH,_DIR_OPENSTRINGS,_DIR_OUTPUT_FORMAT,_DIR_OVERFLOWCHECKS, _DIR_PACKENUM,_DIR_PACKRECORDS, _DIR_R,_DIR_RANGECHECKS,_DIR_REFERENCEINFO, _DIR_SATURATION,_DIR_SMARTLINK,_DIR_STACKFRAMES,_DIR_STATIC,_DIR_STOP, _DIR_TYPEDADDRESS,_DIR_TYPEINFO, _DIR_UNDEF,_DIR_UNITPATH, _DIR_VARSTRINGCHECKS,_DIR_VERSION, _DIR_WAIT,_DIR_WARNING,_DIR_WARNINGS, _DIR_Z1,_DIR_Z2,_DIR_Z4 ); const firstdirective=_DIR_NONE; lastdirective=_DIR_Z4; directive:array[tdirectivetoken] of directivestr=( {12345678901234567890 (To determine longest string.)} '', 'ALIGN', 'APPTYPE', 'ASMMODE', 'ASSERTIONS', 'BOOLEVAL', 'D', 'DEBUGINFO', 'DEFINE', 'DESCRIPTION', 'ELSE', 'ENDIF', 'ERROR', 'EXTENDEDSYNTAX', 'FATAL', 'GOTO', 'HINT', 'HINTS', 'I', {12345678901234567890 (To determine longest string.)} 'I386_ATT', 'I386_DIRECT', 'I386_INTEL', 'IOCHECKS', 'IF', 'IFDEF', 'IFNDEF', 'IFOPT', 'INCLUDE', 'INCLUDEPATH', 'INFO', 'INLINE', 'L', 'LIBRARYPATH', 'LINK', 'LINKLIB', 'LOCALSYMBOLS', 'LONGSTRINGS', 'M', {12345678901234567890 (To determine longest string.)} 'MACRO', 'MEMORY', 'MESSAGE', 'MINENUMSIZE', 'MMX', 'MODE', 'NOTE', 'NOTES', 'OBJECTPATH', 'OPENSTRINGS', 'OUTPUT_FORMAT', 'OVERFLOWCHECKS', 'PACKENUM', 'PACKRECORDS', 'R', 'RANGECHECKS', 'REFERENCEINFO', 'SATURATION', 'SMARTLINK', {12345678901234567890 (To determine longest string.)} 'STACKFRAMES', 'STATIC', 'STOP', 'TYPEDADDRESS', 'TYPEINFO', 'UNDEF', 'UNITPATH', 'VARSTRINGCHECKS', 'VERSION', 'WAIT', 'WARNING', 'WARNINGS', 'Z1', 'Z2', 'Z4' ); function Get_Directive(const hs:string):tdirectivetoken; var i : tdirectivetoken; begin for i:=firstdirective to lastdirective do if directive[i]=hs then begin Get_Directive:=i; exit; end; Get_Directive:=_DIR_NONE; end; {------------------------------------------- IF Conditional Handling -------------------------------------------} var preprocpat : string; preproc_token : ttoken; procedure preproc_consume(t : ttoken); begin if t<>preproc_token then Message(scan_e_preproc_syntax_error); preproc_token:=current_scanner^.readpreproc; end; function read_expr : string;forward; function read_factor : string; var hs : string; mac : pmacrosym; len : byte; begin if preproc_token=_ID then begin if preprocpat='NOT' then begin preproc_consume(_ID); hs:=read_expr; if hs='0' then read_factor:='1' else read_factor:='0'; end else begin mac:=pmacrosym(macros^.search(hs)); hs:=preprocpat; preproc_consume(_ID); if assigned(mac) then begin if mac^.defined and assigned(mac^.buftext) then begin if mac^.buflen>255 then begin len:=255; Message(scan_w_marco_cut_after_255_chars); end else len:=mac^.buflen; {$ifndef TP} {$ifopt H+} setlength(hs,len); {$else} hs[0]:=char(len); {$endif} {$else} hs[0]:=char(len); {$endif} move(mac^.buftext^,hs[1],len); end else read_factor:=''; end else read_factor:=hs; end end else if preproc_token=_LKLAMMER then begin preproc_consume(_LKLAMMER); read_factor:=read_expr; preproc_consume(_RKLAMMER); end else Message(scan_e_error_in_preproc_expr); end; function read_term : string; var hs1,hs2 : string; begin hs1:=read_factor; while true do begin if (preproc_token=_ID) then begin if preprocpat='AND' then begin preproc_consume(_ID); hs2:=read_factor; if (hs1<>'0') and (hs2<>'0') then hs1:='1'; end else break; end else break; end; read_term:=hs1; end; function read_simple_expr : string; var hs1,hs2 : string; begin hs1:=read_term; while true do begin if (preproc_token=_ID) then begin if preprocpat='OR' then begin preproc_consume(_ID); hs2:=read_term; if (hs1<>'0') or (hs2<>'0') then hs1:='1'; end else break; end else break; end; read_simple_expr:=hs1; end; function read_expr : string; var hs1,hs2 : string; b : boolean; t : ttoken; w : integer; l1,l2 : longint; begin hs1:=read_simple_expr; t:=preproc_token; if not(t in [_EQUAL,_UNEQUAL,_LT,_GT,_LTE,_GTE]) then begin read_expr:=hs1; exit; end; preproc_consume(t); hs2:=read_simple_expr; if is_number(hs1) and is_number(hs2) then begin valint(hs1,l1,w); valint(hs2,l2,w); case t of _EQUAL : b:=l1=l2; _UNEQUAL : b:=l1<>l2; _LT : b:=l1l2; _GTE : b:=l1>=l2; _LTE : b:=l1<=l2; end; end else begin case t of _EQUAL : b:=hs1=hs2; _UNEQUAL : b:=hs1<>hs2; _LT : b:=hs1hs2; _GTE : b:=hs1>=hs2; _LTE : b:=hs1<=hs2; end; end; if b then read_expr:='1' else read_expr:='0'; end; {------------------------------------------- Directives -------------------------------------------} function is_conditional(t:tdirectivetoken):boolean; begin is_conditional:=(t in [_DIR_ENDIF,_DIR_IFDEF,_DIR_IFNDEF,_DIR_IFOPT,_DIR_IF,_DIR_ELSE]); end; procedure dir_conditional(t:tdirectivetoken); var hs : string; mac : pmacrosym; found : boolean; state : char; oldaktfilepos : tfileposinfo; begin oldaktfilepos:=aktfilepos; while true do begin current_scanner^.gettokenpos; case t of _DIR_ENDIF : begin current_scanner^.poppreprocstack; end; _DIR_ELSE : begin current_scanner^.elsepreprocstack; end; _DIR_IFDEF : begin current_scanner^.skipspace; hs:=current_scanner^.readid; mac:=pmacrosym(macros^.search(hs)); if assigned(mac) then mac^.is_used:=true; current_scanner^.addpreprocstack(pp_ifdef,assigned(mac) and mac^.defined,hs,scan_c_ifdef_found); end; _DIR_IFOPT : begin current_scanner^.skipspace; hs:=current_scanner^.readid; if (length(hs)>1) then Message(scan_w_illegal_switch) else begin state:=current_scanner^.ReadState; if state in ['-','+'] then found:=CheckSwitch(hs[1],state); end; current_scanner^.addpreprocstack(pp_ifopt,found,hs,scan_c_ifopt_found); end; _DIR_IF : begin current_scanner^.skipspace; { start preproc expression scanner } preproc_token:=current_scanner^.readpreproc; hs:=read_expr; current_scanner^.addpreprocstack(pp_if,hs<>'0',hs,scan_c_if_found); end; _DIR_IFNDEF : begin current_scanner^.skipspace; hs:=current_scanner^.readid; mac:=pmacrosym(macros^.search(hs)); if assigned(mac) then mac^.is_used:=true; current_scanner^.addpreprocstack(pp_ifndef,not(assigned(mac) and mac^.defined),hs,scan_c_ifndef_found); end; end; { accept the text ? } if (current_scanner^.preprocstack=nil) or current_scanner^.preprocstack^.accept then break else begin current_scanner^.gettokenpos; Message(scan_c_skipping_until); repeat current_scanner^.skipuntildirective; t:=Get_Directive(current_scanner^.readid); until is_conditional(t); current_scanner^.gettokenpos; Message1(scan_d_handling_switch,'$'+directive[t]); end; end; aktfilepos:=oldaktfilepos; end; procedure dir_define(t:tdirectivetoken); var hs : string; bracketcount : longint; mac : pmacrosym; macropos : longint; macrobuffer : pmacrobuffer; begin current_scanner^.skipspace; hs:=current_scanner^.readid; mac:=pmacrosym(macros^.search(hs)); if not assigned(mac) then begin mac:=new(pmacrosym,init(hs)); mac^.defined:=true; Message1(parser_m_macro_defined,mac^.name); macros^.insert(mac); end else begin Message1(parser_m_macro_defined,mac^.name); mac^.defined:=true; { delete old definition } if assigned(mac^.buftext) then begin freemem(mac^.buftext,mac^.buflen); mac^.buftext:=nil; end; end; mac^.is_used:=true; if (cs_support_macro in aktmoduleswitches) then begin { key words are never substituted } if is_keyword(hs) then Message(scan_e_keyword_cant_be_a_macro); { !!!!!! handle macro params, need we this? } current_scanner^.skipspace; { may be a macro? } if c=':' then begin current_scanner^.readchar; if c='=' then begin new(macrobuffer); macropos:=0; { parse macro, brackets are counted so it's possible to have a $ifdef etc. in the macro } bracketcount:=0; repeat current_scanner^.readchar; case c of '}' : if (bracketcount=0) then break else dec(bracketcount); '{' : inc(bracketcount); #26 : current_scanner^.end_of_file; end; macrobuffer^[macropos]:=c; inc(macropos); if macropos>maxmacrolen then Message(scan_f_macro_buffer_overflow); until false; { free buffer of macro ?} if assigned(mac^.buftext) then freemem(mac^.buftext,mac^.buflen); { get new mem } getmem(mac^.buftext,macropos); mac^.buflen:=macropos; { copy the text } move(macrobuffer^,mac^.buftext^,macropos); dispose(macrobuffer); end; end; end; end; procedure dir_undef(t:tdirectivetoken); var hs : string; mac : pmacrosym; begin current_scanner^.skipspace; hs:=current_scanner^.readid; mac:=pmacrosym(macros^.search(hs)); if not assigned(mac) then begin mac:=new(pmacrosym,init(hs)); Message1(parser_m_macro_undefined,mac^.name); mac^.defined:=false; macros^.insert(mac); end else begin Message1(parser_m_macro_undefined,mac^.name); mac^.defined:=false; { delete old definition } if assigned(mac^.buftext) then begin freemem(mac^.buftext,mac^.buflen); mac^.buftext:=nil; end; end; mac^.is_used:=true; end; procedure dir_message(t:tdirectivetoken); var w : tmsgconst; begin case t of _DIR_STOP, _DIR_FATAL : w:=scan_f_user_defined; _DIR_ERROR : w:=scan_e_user_defined; _DIR_WARNING : w:=scan_w_user_defined; _DIR_HINT : w:=scan_h_user_defined; _DIR_NOTE : w:=scan_n_user_defined; _DIR_MESSAGE, _DIR_INFO : w:=scan_i_user_defined; end; current_scanner^.skipspace; Message1(w,current_scanner^.readcomment); end; procedure dir_moduleswitch(t:tdirectivetoken); var sw : tmoduleswitch; state : char; begin sw:=cs_modulenone; case t of _DIR_GOTO : sw:=cs_support_goto; _DIR_MACRO : sw:=cs_support_macro; _DIR_INLINE : sw:=cs_support_inline; _DIR_SMARTLINK : sw:=cs_create_smart; _DIR_STATIC : sw:=cs_static_keyword; end; state:=current_scanner^.readstate; if (sw<>cs_modulenone) and (state in ['-','+']) then begin if state='-' then aktmoduleswitches:=aktmoduleswitches-[sw] else aktmoduleswitches:=aktmoduleswitches+[sw]; end; end; procedure dir_localswitch(t:tdirectivetoken); var sw : tlocalswitch; state : char; begin sw:=cs_localnone; {$ifdef SUPPORT_MMX} case t of _DIR_MMX : sw:=cs_mmx; _DIR_SATURATION : sw:=cs_mmx_saturation; end; {$endif} state:=current_scanner^.readstate; if (sw<>cs_localnone) and (state in ['-','+']) then begin if state='-' then aktlocalswitches:=aktlocalswitches-[sw] else aktlocalswitches:=aktlocalswitches+[sw]; end; end; procedure dir_include(t:tdirectivetoken); var hs : string; path : dirstr; name : namestr; ext : extstr; hp : pinputfile; i : longint; found : boolean; begin current_scanner^.skipspace; hs:=current_scanner^.readcomment; i:=length(hs); while (i>0) and (hs[i]=' ') do dec(i); Delete(hs,i+1,length(hs)-i); if hs='' then exit; if (hs[1]='%') then begin { case insensitive } hs:=upper(hs); { remove %'s } Delete(hs,1,1); if hs[length(hs)]='%' then Delete(hs,length(hs),1); { save old } path:=hs; { first check for internal macros } if hs='TIME' then hs:=gettimestr else if hs='DATE' then hs:=getdatestr else if hs='FILE' then hs:=current_module^.sourcefiles^.get_file_name(aktfilepos.fileindex) else if hs='LINE' then hs:=tostr(aktfilepos.line) else if hs='FPCVERSION' then hs:=version_string else if hs='FPCTARGET' then hs:=target_cpu_string else hs:=getenv(hs); if hs='' then Message1(scan_w_include_env_not_found,path); { make it a stringconst } hs:=''''+hs+''''; current_scanner^.insertmacro(path,@hs[1],length(hs)); end else begin hs:=FixFileName(hs); fsplit(hs,path,name,ext); { look for the include file 1. specified path,path of current inputfile,current dir 2. local includepath 3. global includepath } found:=false; path:=FindFile(name+ext,path+';'+current_scanner^.inputfile^.path^+';.',found); if (not found) then path:=current_module^.localincludesearchpath.FindFile(name+ext,found); if (not found) then path:=includesearchpath.FindFile(name+ext,found); { shutdown current file } current_scanner^.tempcloseinputfile; { load new file } hp:=new(pinputfile,init(path+name+ext)); current_scanner^.addfile(hp); if not current_scanner^.openinputfile then Message1(scan_f_cannot_open_includefile,hs); Message1(scan_t_start_include_file,current_scanner^.inputfile^.path^+current_scanner^.inputfile^.name^); current_scanner^.reload; { process first read char } case c of #26 : current_scanner^.reload; #10, #13 : current_scanner^.linebreak; end; { register for refs } current_module^.sourcefiles^.register_file(hp); end; end; procedure dir_description(t:tdirectivetoken); begin if not (target_info.target in [target_i386_os2,target_i386_win32]) then Message(scan_w_decription_not_support); { change description global var in all cases } { it not used but in win32 and os2 } current_scanner^.skipspace; description:=current_scanner^.readcomment; end; procedure dir_version(t:tdirectivetoken); var major, minor : longint; error : integer; begin if not (target_info.target in [target_i386_os2,target_i386_win32]) 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 and os2 } current_scanner^.skipspace; { we should only accept Major.Minor format } current_scanner^.readnumber; major:=0; minor:=0; valint(pattern,major,error); if error<>0 then begin Message1(scan_w_wrong_version_ignored,pattern); exit; end; if c='.' then begin current_scanner^.readchar; current_scanner^.readnumber; valint(pattern,minor,error); if error<>0 then begin Message(scan_w_wrong_version_ignored); exit; end; dllmajor:=major; dllminor:=minor; dllversion:=tostr(major)+'.'+tostr(minor); end else dllversion:=tostr(major); end; end; procedure dir_linkobject(t:tdirectivetoken); var s : string; begin current_scanner^.skipspace; s:=AddExtension(FixFileName(current_scanner^.readcomment),target_info.objext); current_module^.linkotherofiles.insert(s,link_allways); end; procedure dir_resource(t:tdirectivetoken); var s : string; begin current_scanner^.skipspace; s:=AddExtension(FixFileName(current_scanner^.readcomment),target_info.resext); if target_info.res<>res_none then current_module^.resourcefiles.insert(FixFileName(s)) else Message(scan_e_resourcefiles_not_supported); end; procedure dir_linklib(t:tdirectivetoken); begin current_scanner^.skipspace; current_scanner^.readstring; current_module^.linkOtherSharedLibs.insert(orgpattern,link_allways); end; procedure dir_outputformat(t:tdirectivetoken); begin if not current_module^.in_global then Message(scan_w_switch_is_global) else begin current_scanner^.skipspace; if set_string_asm(current_scanner^.readid) then aktoutputformat:=target_asm.id else Message(scan_w_illegal_switch); end; end; procedure dir_unitpath(t:tdirectivetoken); begin if not current_module^.in_global then Message(scan_w_switch_is_global) else begin current_scanner^.skipspace; current_module^.localunitsearchpath.AddPath(current_scanner^.readcomment,false); end; end; procedure dir_includepath(t:tdirectivetoken); 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_librarypath(t:tdirectivetoken); 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_objectpath(t:tdirectivetoken); 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_mode(t:tdirectivetoken); begin if not current_module^.in_global then Message(scan_w_switch_is_global) else begin current_scanner^.skipspace; current_scanner^.readstring; if pattern='DEFAULT' then aktmodeswitches:=initmodeswitches else if pattern='DELPHI' then aktmodeswitches:=delphimodeswitches else if pattern='TP' then aktmodeswitches:=tpmodeswitches else if pattern='FPC' then aktmodeswitches:=fpcmodeswitches else if pattern='OBJFPC' then aktmodeswitches:=objfpcmodeswitches else if pattern='GPC' then aktmodeswitches:=gpcmodeswitches else Message(scan_w_illegal_switch); end; end; procedure dir_packrecords(t:tdirectivetoken); var hs : string; begin current_scanner^.skipspace; if not(c in ['0'..'9']) then begin hs:=current_scanner^.readid; if (hs='C') then aktpackrecords:=packrecord_C else if (hs='NORMAL') or (hs='DEFAULT') then aktpackrecords:=packrecord_2 else Message(scan_w_only_pack_records); end else begin case current_scanner^.readval of 1 : aktpackrecords:=packrecord_1; 2 : aktpackrecords:=packrecord_2; 4 : aktpackrecords:=packrecord_4; 8 : aktpackrecords:=packrecord_8; 16 : aktpackrecords:=packrecord_16; 32 : aktpackrecords:=packrecord_32; else Message(scan_w_only_pack_records); end; end; end; procedure dir_packenum(t:tdirectivetoken); var hs : string; begin if t in [_DIR_Z1,_DIR_Z2,_DIR_Z4] then begin aktpackenum:=ord(pattern[2])-ord('0'); exit; end; current_scanner^.skipspace; if not(c in ['0'..'9']) then begin hs:=current_scanner^.readid; if (hs='NORMAL') or (hs='DEFAULT') then aktpackenum:=4 else Message(scan_w_only_pack_enum); end else begin case current_scanner^.readval of 1 : aktpackenum:=1; 2 : aktpackenum:=2; 4 : aktpackenum:=4; else Message(scan_w_only_pack_enum); end; end; end; procedure dir_apptype(t:tdirectivetoken); var hs : string; begin if target_info.target<>target_i386_win32 then Message(scan_w_app_type_not_support); if not current_module^.in_global then Message(scan_w_switch_is_global) else begin current_scanner^.skipspace; hs:=current_scanner^.readid; if hs='GUI' then apptype:=at_gui else if hs='CONSOLE' then apptype:=at_cui else Message1(scan_w_unsupported_app_type,hs); end; end; procedure dir_wait(t:tdirectivetoken); var had_info : boolean; begin had_info:=(status.verbosity and V_Info)<>0; { this message should allways appear !! } status.verbosity:=status.verbosity or V_Info; Message(scan_i_press_enter); readln; If not(had_info) then status.verbosity:=status.verbosity and (not V_Info); end; procedure dir_asmmode(t:tdirectivetoken); var s : string; begin current_scanner^.skipspace; s:=current_scanner^.readid; If Inside_asm_statement then Message1(scan_w_no_asm_reader_switch_inside_asm,s); if s='DEFAULT' then aktasmmode:=initasmmode else if not set_string_asmmode(s,aktasmmode) then Message1(scan_w_unsupported_asmmode_specifier,s); end; procedure dir_oldasmmode(t:tdirectivetoken); begin If Inside_asm_statement then Message1(scan_w_no_asm_reader_switch_inside_asm,directive[t]); {$ifdef i386} case t of _DIR_I386_ATT : aktasmmode:=asmmode_i386_att; _DIR_I386_DIRECT : aktasmmode:=asmmode_i386_direct; _DIR_I386_INTEL : aktasmmode:=asmmode_i386_intel; end; {$endif i386} end; procedure dir_delphiswitch(t:tdirectivetoken); var sw,state : char; begin case t of _DIR_ALIGN : sw:='A'; _DIR_ASSERTIONS : sw:='C'; _DIR_BOOLEVAL : sw:='B'; _DIR_DEBUGINFO : sw:='D'; _DIR_IOCHECKS : sw:='I'; _DIR_LOCALSYMBOLS : sw:='L'; _DIR_LONGSTRINGS : sw:='H'; _DIR_OPENSTRINGS : sw:='P'; _DIR_OVERFLOWCHECKS : sw:='Q'; _DIR_RANGECHECKS : sw:='R'; _DIR_REFERENCEINFO : sw:='Y'; _DIR_STACKFRAMES : sw:='W'; _DIR_TYPEDADDRESS : sw:='T'; _DIR_TYPEINFO : sw:='M'; _DIR_VARSTRINGCHECKS : sw:='V'; else exit; end; { c contains the next char, a + or - would be fine } state:=current_scanner^.readstate; if state in ['-','+'] then HandleSwitch(sw,state); end; procedure dir_memory(t:tdirectivetoken); var l : longint; begin current_scanner^.skipspace; l:=current_scanner^.readval; if l>1024 then stacksize:=l; current_scanner^.skipspace; if c=',' then begin current_scanner^.readchar; current_scanner^.skipspace; l:=current_scanner^.readval; if l>1024 then heapsize:=l; end; if c=',' then begin current_scanner^.readchar; current_scanner^.skipspace; l:=current_scanner^.readval; { Ignore this value, because the limit is set by the OS info and shouldn't be changed by the user (PFV) } end; end; procedure dir_setverbose(t:tdirectivetoken); var flag, state : char; begin case t of _DIR_HINTS : flag:='H'; _DIR_WARNINGS : flag:='W'; _DIR_NOTES : flag:='N'; else exit; end; { support ON/OFF } state:=current_scanner^.ReadState; SetVerbosity(flag+state); end; type tdirectiveproc=procedure(t:tdirectivetoken); const directiveproc:array[tdirectivetoken] of tdirectiveproc=( {_DIR_NONE} nil, {_DIR_ALIGN} dir_delphiswitch, {_DIR_APPTYPE} dir_apptype, {_DIR_ASMMODE} dir_asmmode, {_DIR_ASSERTION} dir_delphiswitch, {_DIR_BOOLEVAL} dir_delphiswitch, {_DIR_D} dir_description, {_DIR_DEBUGINFO} dir_delphiswitch, {_DIR_DEFINE} dir_define, {_DIR_DESCRIPTION} dir_description, {_DIR_ELSE} dir_conditional, {_DIR_ENDIF} dir_conditional, {_DIR_ERROR} dir_message, {_DIR_EXTENDEDSYNTAX} dir_delphiswitch, {_DIR_FATAL} dir_message, {_DIR_GOTO} dir_moduleswitch, {_DIR_HINT} dir_message, {_DIR_HINTS} dir_setverbose, {_DIR_I} dir_include, {_DIR_I386_ATT} dir_oldasmmode, {_DIR_I386_DIRECT} dir_oldasmmode, {_DIR_I386_INTEL} dir_oldasmmode, {_DIR_IOCHECKS} dir_delphiswitch, {_DIR_IF} dir_conditional, {_DIR_IFDEF} dir_conditional, {_DIR_IFNDEF} dir_conditional, {_DIR_IFOPT} dir_conditional, {_DIR_INCLUDE} dir_include, {_DIR_INCLUDEPATH} dir_includepath, {_DIR_INFO} dir_message, {_DIR_INLINE} dir_moduleswitch, {_DIR_L} dir_linkobject, {_DIR_LIBRARYPATH} dir_librarypath, {_DIR_LINK} dir_linkobject, {_DIR_LINKLIB} dir_linklib, {_DIR_LOCALSYMBOLS} dir_delphiswitch, {_DIR_LONGSTRINGS} dir_delphiswitch, {_DIR_M} dir_memory, {_DIR_MACRO} dir_moduleswitch, {_DIR_MEMORY} dir_memory, {_DIR_MESSAGE} dir_message, {_DIR_MINENUMSIZE} dir_packenum, {_DIR_MMX} dir_localswitch, {_DIR_MODE} dir_mode, {_DIR_NOTE} dir_message, {_DIR_NOTES} dir_setverbose, {_DIR_OBJECTPATH} dir_objectpath, {_DIR_OPENSTRINGS} dir_delphiswitch, {_DIR_OUTPUT_FORMAT} dir_outputformat, {_DIR_OVERFLOWCHECKS} dir_delphiswitch, {_DIR_PACKENUM} dir_packenum, {_DIR_PACKRECORDS} dir_packrecords, {_DIR_R} dir_resource, {_DIR_RANGECHECKS} dir_delphiswitch, {_DIR_REFERENCEINFO} dir_delphiswitch, {_DIR_SATURATION} dir_localswitch, {_DIR_SMARTLINK} dir_moduleswitch, {_DIR_STACKFRAMES} dir_delphiswitch, {_DIR_STATIC} dir_moduleswitch, {_DIR_STOP} dir_message, {_DIR_TYPEDADDRESS} dir_delphiswitch, {_DIR_TYPEINFO} dir_delphiswitch, {_DIR_UNDEF} dir_undef, {_DIR_UNITPATH} dir_unitpath, {_DIR_VARSTRINGCHECKS} dir_delphiswitch, {_DIR_VERSION} dir_version, {_DIR_WAIT} dir_wait, {_DIR_WARNING} dir_message, {_DIR_WARNINGS} dir_setverbose, {_DIR_Z1} dir_packenum, {_DIR_Z2} dir_packenum, {_DIR_Z4} dir_packenum ); {------------------------------------------- Main switches handling -------------------------------------------} procedure handledirectives; var t : tdirectivetoken; p : tdirectiveproc; hs : string; begin current_scanner^.gettokenpos; current_scanner^.readchar; {Remove the $} hs:=current_scanner^.readid; if parapreprocess then begin t:=Get_Directive(hs); if not(is_conditional(t) or (t=_DIR_DEFINE) or (t=_DIR_UNDEF)) then begin preprocfile^.AddSpace; preprocfile^.Add('{$'+hs+current_scanner^.readcomment+'}'); exit; end; end; Message1(scan_d_handling_switch,'$'+hs); if hs='' then Message1(scan_w_illegal_switch,'$'+hs); { Check for compiler switches } while (length(hs)=1) and (c in ['-','+']) do begin HandleSwitch(hs[1],c); current_scanner^.readchar; {Remove + or -} if c=',' then begin current_scanner^.readchar; {Remove , } { read next switch, support $v+,$+} hs:=current_scanner^.readid; if (hs='') then begin if (c='$') and (m_fpc in aktmodeswitches) then begin current_scanner^.readchar; { skip $ } hs:=current_scanner^.readid; end; if (hs='') then Message1(scan_w_illegal_directive,'$'+c); end else Message1(scan_d_handling_switch,'$'+hs); end else hs:=''; end; { directives may follow switches after a , } if hs<>'' then begin t:=Get_Directive(hs); if t<>_DIR_NONE then begin p:=directiveproc[t]; {$ifndef TP} if assigned(p) then {$else} if @p<>nil then {$endif} p(t); end else Message1(scan_w_illegal_directive,'$'+hs); { conditionals already read the comment } if (current_scanner^.comment_level>0) then current_scanner^.readcomment; { we've read the whole comment } aktcommentstyle:=comment_none; end; end; { $Log$ Revision 1.70 1999-12-20 23:23:30 pierre + $description $version Revision 1.69 1999/12/02 17:34:34 peter * preprocessor support. But it fails on the caret in type blocks Revision 1.68 1999/11/24 11:39:53 pierre * asmmode message was placed too early Revision 1.67 1999/11/12 11:03:50 peter * searchpaths changed to stringqueue object Revision 1.66 1999/11/06 14:34:26 peter * truncated log to 20 revs Revision 1.65 1999/10/30 12:32:30 peter * fixed line counter when the first line had #10 only. This was buggy for both the main file as for include files Revision 1.64 1999/09/27 23:38:17 peter * bracket support for macro define Revision 1.63 1999/09/20 16:39:02 peter * cs_create_smart instead of cs_smartlink * -CX is create smartlink * -CD is create dynamic, but does nothing atm. Revision 1.62 1999/09/03 10:00:49 peter * included the 1.60 version of Pierre which was lost ! Revision 1.61 1999/09/02 18:47:46 daniel * Could not compile with TP, some arrays moved to heap * NOAG386BIN default for TP * AG386* files were not compatible with TP, fixed. Revision 1.60 1999/08/31 15:55:45 pierre + tmacrosym.is_used set Revision 1.59 1999/08/05 16:53:10 peter * V_Fatal=1, all other V_ are also increased * Check for local procedure when assigning procvar * fixed comment parsing because directives * oldtp mode directives better supported * added some messages to errore.msg Revision 1.58 1999/08/04 13:03:03 jonas * all tokens now start with an underscore * PowerPC compiles!! Revision 1.57 1999/07/26 14:55:36 florian * $mode gives now a warning if an unknown mode keyword follows Revision 1.56 1999/07/23 16:05:27 peter * alignment is now saved in the symtable * C alignment added for records * PPU version increased to solve .12 <-> .13 probs Revision 1.55 1999/07/16 10:04:36 peter * merged Revision 1.54 1999/07/03 00:29:58 peter * new link writing to the ppu, one .ppu is needed for all link types, static (.o) is now always created also when smartlinking is used Revision 1.53.2.1 1999/07/16 09:53:06 peter * ignore maxheapsize Revision 1.53 1999/06/02 22:44:18 pierre * previous wrong log corrected Revision 1.52 1999/06/02 22:25:48 pierre * changed $ifdef FPC @ into $ifndef TP Revision 1.51 1999/04/07 14:36:45 pierre + better preproc stack checking and report Revision 1.50 1999/03/31 13:55:20 peter * assembler inlining working for ag386bin Revision 1.49 1999/03/26 00:05:44 peter * released valintern + deffile is now removed when compiling is finished * ^( compiles now correct + static directive * shrd fixed Revision 1.48 1999/03/25 16:55:34 peter + unitpath,librarypath,includepath,objectpath directives Revision 1.47 1999/02/22 13:07:05 pierre + -b and -bl options work ! + cs_local_browser ($L+) is disabled if cs_browser ($Y+) is not enabled when quitting global section * local vars and procedures are not yet stored into PPU }