{ $Id$ Copyright (c) 1998-2000 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_MAXFPUREGISTERS,_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, {$IFDEF Testvarsets} _DIR_PACKSET, {$ENDIF} _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', 'MAXFPUREGISTERS', 'MEMORY', 'MESSAGE', 'MINENUMSIZE', 'MMX', 'MODE', 'NOTE', 'NOTES', 'OBJECTPATH', 'OPENSTRINGS', 'OUTPUT_FORMAT', 'OVERFLOWCHECKS', 'PACKENUM', 'PACKRECORDS', {$IFDEF testvarsets} 'PACKSET', {$ENDIF} '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; if path<>'' then path:=path+';'; path:=FindFile(name+ext,path+current_scanner^.inputfile^.path^+';.'+DirSep,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); {$IFDEF NEWST} current_module^.linkotherofiles. insert(new(Plinkitem,init(s,link_allways))); {$ELSE} current_module^.linkotherofiles. insert(s,link_allways); {$ENDIF NEWST} 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; {$IFDEF NEWST} current_module^.linkOtherSharedLibs. insert(new(Plinkitem,init(orgpattern,link_allways))); {$ELSE} current_module^.linkOtherSharedLibs. insert(orgpattern,link_allways); {$ENDIF} 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_maxfpuregisters(t:tdirectivetoken); var l : longint; hs : string; begin current_scanner^.skipspace; if not(c in ['0'..'9']) then begin hs:=current_scanner^.readid; if (hs='NORMAL') or (hs='DEFAULT') then aktmaxfpuregisters:=-1 else Message(scan_e_invalid_maxfpureg_value); end else begin l:=current_scanner^.readval; case l of 0..8: aktmaxfpuregisters:=l; else Message(scan_e_invalid_maxfpureg_value); end; end; end; procedure dir_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; {$ifdef testvarsets} procedure dir_setalloc(t:tdirectivetoken); var hs : string; begin current_scanner^.skipspace; if not(c in ['1','2','4']) then begin hs:=current_scanner^.readid; if (hs='FIXED') or ((hs='DEFAULT') OR (hs='NORMAL')) then aktsetalloc:=0 {Fixed mode, sets are 4 or 32 bytes} else Message(scan_w_only_packset); end else begin case current_scanner^.readval of 1 : aktpackenum:=1; 2 : aktpackenum:=2; 4 : aktpackenum:=4; else Message(scan_w_only_packset); end; end; end; {$ENDIF} 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_MAXFPUREGISTERS} dir_maxfpuregisters, {_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, {$IFDEF TestVarsets} {_DIR_PACKSET} dir_packset, {$ENDIF} {_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.76 2000-02-28 17:23:57 daniel * Current work of symtable integration committed. The symtable can be activated by defining 'newst', but doesn't compile yet. Changes in type checking and oop are completed. What is left is to write a new symtablestack and adapt the parser to use it. Revision 1.75 2000/02/14 20:58:43 marco * Basic structures for new sethandling implemented. Revision 1.74 2000/02/09 13:23:03 peter * log truncated Revision 1.73 2000/01/14 14:28:40 pierre * avoid searching of include file in start dir first Revision 1.72 2000/01/07 01:14:37 peter * updated copyright to 2000 Revision 1.71 2000/01/04 15:15:53 florian + added compiler switch $maxfpuregisters + fixed a small problem in secondvecn 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 }