URL
https://opencores.org/ocsvn/usb_fpga_2_13/usb_fpga_2_13/trunk
Subversion Repositories usb_fpga_2_13
[/] [usb_fpga_2_13/] [trunk/] [bmp/] [src/] [bmp.pas] - Rev 2
Compare with Previous | Blame | View Log
{*! bmp -- babel macro processor Copyright (C) 2009-2014 ZTEX GmbH. http://www.ztex.de This program is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License version 3 as published by the Free Software Foundation. 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, see http://www.gnu.org/licenses/. !*} { todo: Ausgabe als Eingabe (mehrfache Bearbeitung) } { codes bc_pm : string bc_ob : char bc_cb : char bc_pa : char meta macros: define define(sym) define symb define(m1)(r1) define macro m1 with replacement r1 define(m2)(p2)(r2) define macro m2 with parmaters p2 and replacement r1 udefine uadefine include ifdef/ifndef elifdef/elfndef ifeq/ifneq macros are expanded in the compared strings, but no meta macros, except of \\noexapnd which disbales the expansion elifeq/elifneq else endif nolf error warning disablaeout enableout ignorecase exactcase noexpand disablelineinfo disables line info for next define } {$mode objfpc} {$define USE_SHORTSTRINGS} // shortstrings are two times faster { $define ENABLE_DEBUGOUT} uses dos,strings,textbuf,bmpsys,sysutils; { ******************************************************************** } { ****** constants *************************************************** } { ******************************************************************** } {$ifdef USE_SHORTSTRINGS} type bmpstring = shortstring; {$else} type bmpstring = ansistring; {$endif} const rbufmax = 65535; { must be 2^n-1 ! } maxmacros = 16383; { max amount of macros } maxifs = 4095; { max input files } maxbs = 255; { brace stack } maxoutfiles = 256; { max input files } maxparams = 35; { max amount of macro parameters } bc_pm : bmpstring = '//'; { default for pascal mode } bc_ob : char = '['; { default } bc_cb : char = ']'; { default } bc_pa : char = '#'; { default for pascal mode } bc_lf = #10; bp_icase : boolean = false; { ignore case } {$ifdef WINDOWS} dirsep = '\'; { directory seperator } {$else} dirsep = '/'; { directory seperator } {$endif} enable_hints : boolean = true; { enable hints } printdefs : boolean = false; { print definitions } {$ifdef ENABLE_DEBUGOUT} debugoutput : boolean = false; { debug mode } {$endif} paramids : array[0..maxparams] of char = ('0','1','2','3','4','5','6','7','8','9', { parameters (in that order!) } 'a','b','c','d','e','f','g','h','i','j', 'k','l','m','n','o','p','q','r','s','t', 'u','v','w','x','y','z'); { ****** modes ******************************************************* } const bm_plain = 0; bm_neplain = 1; { no expand plain } bm_comm = 10; { comment } bm_em = 100; { (macro) expanding mode } bm_em_p0 = 101; { zero paramter (#0) } bm_em_pz = bm_em_p0+maxparams; { last paramter } bm_pm = 1000; { programming mode } bm_def = 1100; { define mode } bm_def_sob2 = 1101; { searching 2nd opening bracket } bm_def_sob3 = 1102; { searching 3rd opening bracket } bm_def_scb1 = 1103; { searching 1st closing bracket } bm_def_scb2 = 1104; { searching 2nd closing bracket } bm_def_scb3 = 1105; { searching 3rd closing bracket } bm_def_scbu = 1120; { searching udefine closing bracket } bm_def_scba = 1130; { searching uadefine closing bracket } bm_if = 1200; { if mode } bm_if_scb = 1201; { searching closing bracket } bm_ifn_scb = 1202; { searching closing bracket } bm_if_not = 1203; { marks the ignored part, searching for else } bm_ifeq_sob = 1210; bm_ifneq_sob = 1211; bm_ifeq_scb1 = 1212; bm_ifeq_scb2 = 1213; bm_ifneq_scb1 = 1214; bm_ifneq_scb2 = 1215; bm_ifeq_scb1_ne = 1216; bm_ifeq_scb2_ne = 1217; bm_ifneq_scb1_ne = 1218; bm_ifneq_scb2_ne = 1219; bm_ifb = 1220; bm_inc = 1300; { include mode } bm_inc_scb = 1301; { searching closing bracket } bm_noexpand = 1400; { noexpand mode } bm_noexpand_scb = 1401; { searching closing bracket } bm_err = 1500; { error } bm_err_scb = 1501; { searching closing bracket } bm_warn = 1510; { warning } bm_warn_scb = 1511; { searching closing bracket } bm_outfile_a = 10000; { outfile number } bm_outfile_z = bm_outfile_a+maxoutfiles; bm_invalid = -1; { invalid character } { ******************************************************************** } { ****** helper functions ******************************************** } { ******************************************************************** } function upcase(ch:char):char; { no Umlaute } begin if (ch>='a') and (ch<='z') then result:=chr(ord(ch)-32) else result:=ch; end; function upstr(const s:bmpstring):bmpstring; var i : longint; begin setlength(upstr, length(s)); for i:=1 to length(s) do begin if (s[i]>='a') and (s[i]<='z') then upstr[i]:=chr(ord(s[i])-32) else upstr[i]:=s[i]; end; end; procedure upstr2(var s:shortstring); var i : longint; begin for i:=1 to length(s) do if (s[i]>='a') and (s[i]<='z') then byte(s[i])-=32; end; { ******************************************************************** } { ****** rbufstr ***************************************************** } { ******************************************************************** } type RBufStr = record { string within ring, } rbuf : pchar; { buffer } pt : longint; { where the ring starts } length : longint; { length of the string } end; function rbuf(const rb:rbufstr):bmpstring; var i,j,k : longint; begin k:=rb.length; {$ifdef USE_SHORTSTRINGS} if k>255 then k:=255; {$endif} j:=rb.pt; setlength(result,k); for i:=1 to k do begin result[i]:=rb.rbuf[j and rbufmax]; j+=1; end; end; function cmp_rbuf(const rb:rbufstr; const s:bmpstring):boolean; var i,j : longint; begin result:=false; if rb.length<>length(s) then exit; j:=rb.pt; for i:=1 to rb.length do begin if rb.rbuf[j and rbufmax]<>s[i] then exit; j+=1; end; result:=true; end; function cmpcase_rbuf(const rb:rbufstr; const s:bmpstring):boolean; var i,j : longint; begin result:=false; if rb.length<>length(s) then exit; j:=rb.pt; for i:=1 to rb.length do begin if lowercase(rb.rbuf[j and rbufmax])<>lowercase(s[i]) then exit; j+=1; end; result:=true; end; { ******************************************************************** } { ****** TBabelMacro ************************************************* } { ******************************************************************** } type PBabelMacro=^TBabelMacro; TBabelMacro=record name : bmpstring; { macro name } mmatch_s : array[0..1] of dword; { quick match string (normal, upercase) } mmatch_m : dword; { quick match mask } pn : longint; { number of parameters } rsize : longint; { replacement size } r : ^char; { replacement } li : ^dword; { lnie info } quick : boolean; { quick comparison } enabled : boolean; { set to false to avoid recursions } paramsep : array[0..maxparams] of ansistring; { parameter seperators } end; { ****** freemacro *************************************************** } procedure freemacro(var mac:PBabelMacro); var i : longint; begin if (mac^.r<>nil) and (mac^.rsize>0) then freemem(mac^.r, mac^.rsize); if (mac^.li<>nil) and (mac^.rsize>0) then freemem(mac^.li, mac^.rsize*4); {$ifndef USE_SHORTSTRINGS} mac^.name:=''; {$endif} for i:=1 to maxparams do mac^.paramsep[i]:=''; freemem(mac,sizeof(TBabelMacro)); mac:=nil; end; { ******************************************************************** } { ****** CMacroBuf *************************************************** } { ******************************************************************** } const macrobuf_size = 1024; type CMacroBuf = class(CTextBuf) constructor create(var tb:CTextBuf; m:PBabelMacro; clone:boolean); constructor insert(var mb:CMacroBuf); destructor destroy; override; private mac : PBabelMacro; end; { ****** create ****************************************************** } constructor CMacroBuf.create(var tb:CTextBuf; m:PBabelMacro; clone:boolean); begin if clone then inherited create(tb, m^.r, m^.li, m^.rsize) else inherited create(tb, macrobuf_size); m^.enabled:=false; mac:=m; end; constructor CMacroBuf.insert(var mb:CMacroBuf); var db : CTextBuf; begin inherited create(db, macrobuf_size); last:=mb.last; mb.last:=self; mac:=mb.mac; mb.mac:=nil; mb:=self; end; { ****** destroy ***************************************************** } destructor CMacroBuf.destroy; begin if mac<>nil then mac^.enabled:=true; end; { ******************************************************************** } { ****** CMainBmp **************************************************** } { ******************************************************************** } type CMainBmp=class buf : CTextBuf; macros : array[0..maxmacros] of PBabelMacro; constructor create; destructor destroy; override; procedure run(const mf:ansistring; var fo:text); procedure initsymb(const s:bmpstring); private rbuf : array[0..rbufmax] of char; bufm : array[0..rbufmax] of smallint; li : array[0..rbufmax] of dword; rbp,lastmacro : longint; { buffer pointer } lineInfo : dword; procedure error_int(const t:ansistring); procedure error(const s:ansistring); procedure faterror(const s:ansistring); procedure warning(const s:ansistring); procedure hint(const s:ansistring); function copylaststr(l,mode:longint):rbufstr; { last l continuous chars with mode m } function copylaststr(l:longint):rbufstr; { last l chars } function copylaststr_br(l,mode:longint):bmpstring; { last l chars with mode m, breaks allowed } function matchstr(const s:bmpstring;mode:longint):boolean; function matchstr(const s:bmpstring):boolean; function matchstr(ic:boolean;const s:bmpstring;mode:longint):boolean; function matchstr(ic:boolean;const s:bmpstring):boolean; function matchstr_br(const s:bmpstring;mode:longint):boolean; function matchstr_br(ic:boolean;const s:bmpstring;mode:longint):boolean; function lastmodestr(mode:longint):bmpstring; function lastmodestr1(mode:longint):bmpstring; procedure lastmodestr(mode:longint;var size:longint; var ptc:pchar; var ptli:pdword); procedure lastmodestr1(mode:longint;var size:longint; var ptc:pchar; var ptli:pdword); procedure lastmodestr(mode:longint;var fst,l:longint); procedure setmode(num,om,nm:longint); { om: old mode; nm: new mode} procedure printmacros(const m : array of pbabelmacro; mm:longint); procedure printmacros; {$ifdef ENABLE_DEBUGOUT } procedure debugwrite; {$endif} end; type TS4 = packed record case integer of 0 : ( s : string[4]; ); 1 : ( len : byte; i : dword; ); end; { ****** create ****************************************************** } constructor CMainBmp.create; var i : longint; begin for i:=0 to maxmacros do macros[i]:=nil; lastmacro:=-1; {$ifdef UNIX} initsymb('UNIX'); {$endif} {$ifdef WINDOWS} initsymb('WINDOWS'); {$endif} {$ifdef LINUX} initsymb('LINUX'); {$endif} end; { ****** destroy **************************************************** } destructor CMainBmp.destroy; var i : longint; begin for i:=0 to lastmacro do if macros[i]<>nil then freemacro(macros[i]); end; { ****** run ******************************************************** } procedure CMainBmp.run(const mf:ansistring; var fo:text); var i,mode,j,k,l,ifc : longint; bl,bl_ne : longint; outfile,bm_expand : longint; prevli,ampos : dword; sx,endnoexpand : bmpstring; s4 : array[0..3] of char; i4 : dword absolute s4; tmpbuf : CTextBuf; tmpmbuf : CMacroBuf; amacro : PBabelMacro; writebuf : shortstring; pm_s,pm_m : dword; pm_q : boolean; t4 : TS4; ifs : array[0..maxifs] of byte; ifli : array[0..maxifs] of dword; bli : array[0..maxbs] of dword; disablelineinfo : boolean; label endparse; begin amacro:=nil; t4.s:=copy(' '+bc_pm, length(bc_pm)+1,4); pm_s:=t4.i; pm_m:=$ffffffff shl ((4-min(length(bc_pm),4))*8); pm_q:=length(bc_pm)<=4; writebuf:=''; CFileBuf.create(buf,mf,''); bl:=0; fillchar(bufm, sizeof(bufm), 0); fillchar(rbuf, sizeof(rbuf), #32); fillchar(li, sizeof(li), 0); bufm[0]:=bm_outfile_a; bufm[rbufmax]:=bm_outfile_a+1; rbp:=0; mode:=bm_plain; ifc:=-1; outfile:=1; bm_expand:=bm_plain; disablelineinfo:=false; prevli:=dword(-1); ampos:=0; while (buf<>nil) and (bmp_exit<>bmp_exit_usererror) do begin if buf.d>buf.lastbuf then begin buf.endbuf; if buf.killme then begin tmpbuf:=buf.last; buf.destroy; buf:=tmpbuf; end; end else if buf.buf[buf.d]=#13 then buf.d+=1 else begin {$ifdef ENABLE_DEBUGOUT} if debugoutput then debugwrite; {$endif} i:=bufm[rbp]; if (i<10) and (i>=0) and (outfile>0) then begin j:=ord(writebuf[0])+1; { avoid the range checking } writebuf[0]:=char(j); writebuf[j]:=rbuf[rbp]; if rbuf[rbp]=#10 then begin if (li[rbp]<>prevli+4096) and (lineInfoPattern<>'') then lineInfoStr(fo,li[rbp]); prevli:=li[rbp]; byte(writebuf[0])-=1; writeln(fo,writebuf); writebuf:=''; end; if (j>=255) then begin write(fo,writebuf); writebuf:=''; end; end else if (i>=bm_outfile_a) and (i<=bm_outfile_z) then outfile:=i-bm_outfile_a; rbuf[rbp]:=buf.buf[buf.d]; lineInfo:=buf.li[buf.d]; li[rbp]:=lineInfo; bufm[rbp]:=mode; buf.d+=1; {brackets} if rbuf[rbp]=bc_ob then begin if (bl>=0) and (bl<maxbs) then bli[bl]:=lineInfo; bl+=1; end; if rbuf[rbp]=bc_cb then bl-=1; {if's} if mode<>bm_plain then begin if (mode=bm_pm) and matchstr(bc_pm+'ifdef'+bc_ob,bm_pm) then begin setmode(length(bc_pm+'ifdef'+bc_ob),bm_pm,bm_if); mode:=bm_if_scb; bli[0]:=lineInfo; bl:=1; end; if (mode=bm_pm) and matchstr(bc_pm+'ifndef'+bc_ob,bm_pm) then begin setmode(length(bc_pm+'ifndef'+bc_ob),bm_pm,bm_if); mode:=bm_ifn_scb; bli[0]:=lineInfo; bl:=1; end; if (mode=bm_pm) and matchstr(bc_pm+'ifeq'+bc_ob,bm_pm) then begin setmode(length(bc_pm+'ifeq'+bc_ob),bm_pm,bm_if); mode:=bm_ifeq_scb1; bm_expand:=bm_ifeq_scb1; bli[0]:=lineInfo; bl:=1; end; if (mode=bm_pm) and matchstr(bc_pm+'ifneq'+bc_ob,bm_pm) then begin setmode(length(bc_pm+'ifeq'+bc_ob),bm_pm,bm_if); mode:=bm_ifneq_scb1; bm_expand:=bm_ifneq_scb1; bli[0]:=lineInfo; bl:=1; end; if (mode=bm_if_not) and matchstr(bc_pm+'ifdef'+bc_ob,bm_if_not) then begin setmode(length(bc_pm+'ifdef'+bc_ob),bm_if_not,bm_if); ifc+=1; if ifc>maxifs then faterror('if memory exceeded'); ifli[ifc]:=lineInfo; ifs[ifc]:=2; end; if (mode=bm_if_not) and matchstr(bc_pm+'ifndef'+bc_ob,bm_if_not) then begin setmode(length(bc_pm+'ifndef'+bc_ob),bm_if_not,bm_if); ifc+=1; if ifc>maxifs then faterror('if memory exceeded'); ifli[ifc]:=lineInfo; ifs[ifc]:=2; end; if (mode=bm_if_not) and matchstr(bc_pm+'ifeq'+bc_ob,bm_if_not) then begin setmode(length(bc_pm+'ifeq'+bc_ob),bm_if_not,bm_if); ifc+=1; if ifc>maxifs then faterror('if memory exceeded'); ifli[ifc]:=lineInfo; ifs[ifc]:=2; end; if (mode=bm_if_not) and matchstr(bc_pm+'ifneq'+bc_ob,bm_if_not) then begin setmode(length(bc_pm+'ifneq'+bc_ob),bm_if_not,bm_if); ifc+=1; if ifc>maxifs then faterror('if memory exceeded'); ifli[ifc]:=lineInfo; ifs[ifc]:=2; end; if ((mode=bm_ifeq_scb1) or (mode=bm_ifeq_scb1_ne) or (mode=bm_ifneq_scb1) or (mode=bm_ifneq_scb1_ne)) and (bl=0) then begin bufm[rbp]:=bm_ifb; if (mode=bm_ifeq_scb1) or (mode=bm_ifeq_scb1_ne) then mode:=bm_ifeq_sob else mode:=bm_ifneq_sob; ampos:=lineInfo; bm_expand:=bm_plain; end; if ((mode=bm_ifeq_sob) or (mode=bm_ifneq_sob)) and (rbuf[rbp]=bc_ob) then begin bli[0]:=lineInfo; bl:=1; if mode=bm_ifeq_sob then mode:=bm_ifeq_scb2 else mode:=bm_ifneq_scb2; bm_expand:=mode; end; if ((mode=bm_if_scb) or (mode=bm_ifn_scb)) and (bl=0) then begin sx:=lastmodestr1(mode); if length(sx)<1 then begin warning('empty symbol name'); mode:=bm_pm; end else begin ifc+=1; if ifc>maxifs then faterror('if memory exceeded'); ifli[ifc]:=lineInfo; if mode=bm_if_scb then ifs[ifc]:=0 else ifs[ifc]:=1; i:=lastmacro; while i>=0 do begin if (macros[i]^.name=sx) then begin if mode=bm_if_scb then ifs[ifc]:=1 else ifs[ifc]:=0; i:=0; end; i-=1; end; if ifs[ifc]=0 then mode:=bm_if_not else mode:=bm_pm; end; end; if ((mode=bm_ifeq_scb2) or (mode=bm_ifeq_scb2_ne) or (mode=bm_ifneq_scb2) or (mode=bm_ifneq_scb2_ne)) and (bl=0) then begin i:=0; j:=0; repeat repeat i+=1; k:=bufm[(rbp-i) and rbufmax]; // writeln(stderr,' i=',i,' k=',k,' rbuf=',rbuf[(rbp-i) and rbufmax]); until (i>=rbufmax) or (k=bm_if) or (k=bm_ifeq_scb2) or (k=bm_ifeq_scb2_ne) or (k=bm_ifneq_scb2) or (k=bm_ifneq_scb2_ne); repeat j+=1; l:=bufm[(rbp-j) and rbufmax]; // writeln(stderr,' j=',j,' l=',l,' rbuf=',rbuf[(rbp-j) and rbufmax]); until (j>=rbufmax) or (l=bm_if) or (l=bm_ifeq_scb1) or (l=bm_ifeq_scb1_ne) or (l=bm_ifneq_scb1) or (l=bm_ifneq_scb1_ne); // writeln(stderr,rbp,',',i,',',j,'-->',rbuf[(rbp-i) and rbufmax],'<-->',rbuf[(rbp-j) and rbufmax],'<--'); until (j>=rbufmax) or (l=bm_if) or (k=bm_if) or (rbuf[(rbp-i) and rbufmax]<>rbuf[(rbp-j) and rbufmax]); // writeln(stderr); ifc+=1; if ifc>maxifs then faterror('if memory exceeded'); ifli[ifc]:=lineInfo; if (i=j) = ((mode=bm_ifeq_scb2) or (mode=bm_ifeq_scb2_ne)) then ifs[ifc]:=1 else ifs[ifc]:=0; if ifs[ifc]=0 then mode:=bm_if_not else mode:=bm_pm; bm_expand:=bm_plain; end; if (mode=bm_pm) and matchstr(bc_pm+'else',bm_pm) then begin if ifc<0 then error('else without ifdef'); if ifs[ifc]<>1 then error('internal error 5'); ifs[ifc]:=0; mode:=bm_if_not; end; if (mode=bm_pm) and ( matchstr(bc_pm+'elifdef'+bc_ob,bm_pm) or matchstr(bc_pm+'elifndef'+bc_ob,bm_pm) or matchstr(bc_pm+'elifeq'+bc_ob,bm_pm) or matchstr(bc_pm+'elifneq'+bc_ob,bm_pm) ) then begin if ifc<0 then error('else without ifdef'); if ifs[ifc]<>1 then error('internal error 5'); ifs[ifc]:=2; mode:=bm_if_not; end; if (mode=bm_if_not) and matchstr(bc_pm+'else',bm_if_not) then begin setmode(length(bc_pm+'else'+bc_ob),bm_if_not,bm_if); if ifc<0 then error('else without ifdef') else if ifs[ifc]=0 then begin ifs[ifc]:=1; mode:=bm_pm; end else begin if ifs[ifc]<>2 then error('internal error 6') end; end; if (mode=bm_if_not) and matchstr(bc_pm+'elifdef'+bc_ob,bm_if_not) then begin setmode(length(bc_pm+'elifdef'+bc_ob),bm_if_not,bm_if); if ifc<0 then error('elifdef without ifdef') else if ifs[ifc]=0 then begin ifc-=1; mode:=bm_if_scb; bli[0]:=lineInfo; bl:=1; end else begin if ifs[ifc]<>2 then error('internal error 6a') end; end; if (mode=bm_if_not) and matchstr(bc_pm+'elifndef'+bc_ob,bm_if_not) then begin setmode(length(bc_pm+'elifndef'+bc_ob),bm_if_not,bm_if); if ifc<0 then error('elifndef without ifdef') else if ifs[ifc]=0 then begin ifc-=1; mode:=bm_ifn_scb; bli[0]:=lineInfo; bl:=1; end else begin if ifs[ifc]<>2 then error('internal error 6b') end; end; if (mode=bm_if_not) and matchstr(bc_pm+'elifeq'+bc_ob,bm_if_not) then begin setmode(length(bc_pm+'elifeq'+bc_ob),bm_if_not,bm_if); if ifc<0 then error('elifeq without ifdef') else if ifs[ifc]=0 then begin ifc-=1; mode:=bm_ifeq_scb1; bm_expand:=bm_ifeq_scb1; bli[0]:=lineInfo; bl:=1; end else begin if ifs[ifc]<>2 then error('internal error 6c') end; end; if (mode=bm_if_not) and matchstr(bc_pm+'elifneq'+bc_ob,bm_if_not) then begin setmode(length(bc_pm+'elifneq'+bc_ob),bm_if_not,bm_if); if ifc<0 then error('elifneq without ifdef') else if ifs[ifc]=0 then begin ifc-=1; mode:=bm_ifneq_scb1; bm_expand:=bm_ifneq_scb1; bli[0]:=lineInfo; bl:=1; end else begin if ifs[ifc]<>2 then error('internal error 6d') end; end; if ((mode=bm_if_not) or (mode=bm_pm)) and (matchstr(bc_pm+'endif',bm_if_not) or matchstr(bc_pm+'endif',bm_pm)) then begin if ifc<0 then error('endif without if') else ifc-=1; if (ifc=-1) or (ifs[ifc]=1) then mode:=bm_pm else mode:=bm_if_not; end; if mode=bm_if_not then goto endparse; {define mode} if mode=bm_def_sob2 then begin if rbuf[rbp]=bc_ob then begin mode:=bm_def_scb2; bli[0]:=lineInfo; bl:=1; end else begin mode:=bm_pm; setmode(1,-1,bm_pm); end; end; if mode=bm_def_sob3 then begin if rbuf[rbp]=bc_ob then begin mode:=bm_def_scb3; bli[0]:=lineInfo; bl:=1; end else begin lastmodestr1(bm_def_scb2, macros[lastmacro]^.rsize, macros[lastmacro]^.r, macros[lastmacro]^.li); mode:=bm_pm; setmode(1,-1,bm_pm); end; end; if (mode=bm_def_scb1) and (bl=0) then begin mode:=bm_def_sob2; sx:=lastmodestr1(bm_def_scb1); if length(sx)<1 then begin warning('empty macro name'); mode:=bm_pm; end else initsymb(sx); end; if (mode=bm_def_scb2) and (bl=0) then begin mode:=bm_def_sob3; end; if (mode=bm_def_scb3) and (bl=0) then begin mode:=bm_pm; lastmodestr(bm_def_scb2,i,j); j-=1; k:=1; while k<=j do begin if rbuf[i]=bc_pa then begin if macros[lastmacro]^.pn>=maxparams then error('only '+int2str(maxparams)+' paramters allowed'); if k=j then error(paramids[macros[lastmacro]^.pn+1]+' expected after `'+bc_pa+''', found '+bc_cb) else begin inc(k); i:=(i+1) and rbufmax; if rbuf[i]=paramids[macros[lastmacro]^.pn+1] then inc(macros[lastmacro]^.pn) else error(paramids[macros[lastmacro]^.pn+1]+' expected after `'+bc_pa+''', found '+rbuf[i]); end; end else macros[lastmacro]^.paramsep[macros[lastmacro]^.pn]+=rbuf[i]; i:=(i+1) and rbufmax; k+=1; end; if (macros[lastmacro]^.pn>0) then begin if macros[lastmacro]^.paramsep[0]='' then macros[lastmacro]^.paramsep[0]:=bc_ob; if macros[lastmacro]^.paramsep[macros[lastmacro]^.pn]='' then macros[lastmacro]^.paramsep[macros[lastmacro]^.pn]:=bc_cb; end; for i:=1 to macros[lastmacro]^.pn-1 do if macros[lastmacro]^.paramsep[i]='' then macros[lastmacro]^.paramsep[i]:=bc_cb+bc_ob; lastmodestr1(bm_def_scb3, macros[lastmacro]^.rsize, macros[lastmacro]^.r, macros[lastmacro]^.li); if disablelineinfo then for i:=0 to macros[lastmacro]^.rsize-1 do macros[lastmacro]^.li[i]:=macros[lastmacro]^.li[i] or 2048; disablelineinfo:=false; end; if (mode=bm_def_scbu) and (bl=0) then begin sx:=lastmodestr1(bm_def_scbu); j:=0; if length(sx)<1 then warning('empty symbol name') else begin i:=lastmacro; while i>=0 do begin if macros[i]^.name=sx then begin freemacro(macros[i]); for j:=i to lastmacro-1 do macros[j]:=macros[j+1]; macros[lastmacro]:=nil; dec(lastmacro); j:=-10; i:=0; end; i-=1; end; if j<>-10 then warning('`'+sx+''' not defined'); end; mode:=bm_pm; end; if (mode=bm_def_scba) and (bl=0) then begin sx:=lastmodestr1(bm_def_scba); j:=0; if length(sx)<1 then warning('empty symbol name') else begin i:=0;k:=0; while i<=lastmacro do if macros[i]^.name=sx then begin freemacro(macros[i]); for j:=i to lastmacro-1 do macros[j]:=macros[j+1]; macros[lastmacro]:=nil; dec(lastmacro); k:=-10; end else inc(i); if k<>-10 then warning('`'+sx+''' not defined'); end; mode:=bm_pm; end; {include mode} if (mode=bm_inc_scb) and (bl=0) then begin sx:=lastmodestr1(bm_inc_scb); if length(sx)<1 then warning('empty include file name') else CFileBuf.create(buf,sx, lineInfoStr(lineInfo)+': '); mode:=bm_plain; end; {noexpand mode} if ((mode=bm_pm) or (mode=bm_ifeq_scb1) or (mode=bm_ifeq_scb2) or (mode=bm_ifneq_scb1) or (mode=bm_ifneq_scb2)) and matchstr(bc_pm+'noexpand'+bc_ob,mode) then begin setmode(length(bc_pm+'noexpand'+bc_ob),mode,bm_noexpand); mode:=bm_noexpand_scb; bli[0]:=lineInfo; bl_ne:=bl; bl:=1; end; if (mode=bm_noexpand_scb) and (bl=0) then begin endnoexpand:=lastmodestr1(bm_noexpand_scb); case bm_expand of bm_ifeq_scb1 : mode:=bm_ifeq_scb1_ne; bm_ifeq_scb2 : mode:=bm_ifeq_scb2_ne; bm_ifneq_scb1 : mode:=bm_ifneq_scb1_ne; bm_ifneq_scb2 : mode:=bm_ifneq_scb2_ne; else mode:=bm_neplain; end; ampos:=lineInfo; bl:=bl_ne-1; end; if ((mode=bm_neplain) or (mode=bm_ifeq_scb1_ne) or (mode=bm_ifeq_scb2_ne) or (mode=bm_ifneq_scb1_ne) or (mode=bm_ifneq_scb2_ne)) and (endnoexpand<>'') and matchstr(endnoexpand,mode) then begin setmode(length(endnoexpand),mode,bm_noexpand); case bm_expand of bm_ifeq_scb1, bm_ifeq_scb2, bm_ifneq_scb1, bm_ifneq_scb2 : mode:=bm_expand; else mode:=bm_plain; end; end; {error mode} if (mode=bm_err_scb) and (bl=0) then begin error(lastmodestr1(bm_err_scb)); mode:=bm_plain; bmp_exit:=bmp_exit_usererror; end; {warning mode} if (mode=bm_warn_scb) and (bl=0) then begin warning(lastmodestr1(bm_warn_scb)); mode:=bm_plain; end; {programming mode} if mode=bm_pm then begin if matchstr(bc_pm+bc_pm,bm_pm) then begin setmode(length(bc_pm),bm_pm,bm_plain); mode:=bm_plain; end; if matchstr(bc_lf,bm_pm) then mode:=bm_plain; if matchstr(bc_pm+'define'+bc_ob,bm_pm) then begin setmode(length(bc_pm+'define'+bc_ob),bm_pm,bm_def); mode:=bm_def_scb1; bli[0]:=lineInfo; bl:=1; end; if matchstr(bc_pm+'udefine'+bc_ob,bm_pm) then begin setmode(length(bc_pm+'udefine'+bc_ob),bm_pm,bm_def); mode:=bm_def_scbu; bli[0]:=lineInfo; bl:=1; end; if matchstr(bc_pm+'uadefine'+bc_ob,bm_pm) then begin setmode(length(bc_pm+'uadefine'+bc_ob),bm_pm,bm_def); mode:=bm_def_scba; bli[0]:=lineInfo; bl:=1; end; if matchstr(bc_pm+'nolf',bm_pm) then begin i:=rbp; j:=0; k:=0; while (j<=rbufmax+1-length(bc_lf)) and (k=0) do begin rbp:=(rbp-1) and rbufmax; if matchstr(bc_lf,bm_plain) then begin setmode(length(bc_lf),-1,bm_comm); k:=1; end; j+=1; end; rbp:=i; end; if matchstr(bc_pm+'include'+bc_ob,bm_pm) then begin setmode(length(bc_pm+'include'+bc_ob),bm_pm,bm_inc); mode:=bm_inc_scb; bli[0]:=lineInfo; bl:=1; end; if matchstr(bc_pm+'error'+bc_ob,bm_pm) then begin setmode(length(bc_pm+'error'+bc_ob),bm_pm,bm_err); mode:=bm_err_scb; bli[0]:=lineInfo; bl:=1; end; if matchstr(bc_pm+'warning'+bc_ob,bm_pm) then begin setmode(length(bc_pm+'warning'+bc_ob),bm_pm,bm_warn); mode:=bm_warn_scb; bli[0]:=lineInfo; bl:=1; end; if matchstr(bc_pm+'disableout',bm_pm) then bufm[rbp]:=bm_outfile_a; if matchstr(bc_pm+'enableout',bm_pm) then bufm[rbp]:=bm_outfile_a+1; if matchstr(bc_pm+'ignorecase',bm_pm) then bp_icase:=true; if matchstr(bc_pm+'exactcase',bm_pm) then bp_icase:=false; if matchstr(bc_pm+'disablelineinfo',bm_pm) then disablelineinfo:=true; end; {expanding mode} if ((mode>=bm_em_p0) and (mode<=bm_em_pz)) and (matchstr(bp_icase, amacro^.paramsep[mode-bm_em_p0], mode)) then begin setmode(length(amacro^.paramsep[mode-bm_em_p0])-1,mode,bm_em); if (mode=bm_em_pz) or (mode-bm_em_p0=amacro^.pn) then begin mode:=bm_expand; if amacro^.rsize<0 then error('internal error 2'); if amacro^.rsize>0 then begin tmpmbuf:=CMacroBuf.create(buf, amacro, false); i:=0; while i<amacro^.rsize do begin if tmpmbuf.lastbuf>=macrobuf_size-1 then CMacroBuf.insert(tmpmbuf); if (amacro^.r[i]=bc_pa) and (i+1<amacro^.rsize) then begin inc(i); if amacro^.r[i]=bc_pa then begin while amacro^.r[i]=bc_pa do begin if tmpmbuf.lastbuf>=macrobuf_size-1 then CMacroBuf.insert(tmpmbuf); inc(tmpmbuf.lastbuf); tmpmbuf.buf[tmpmbuf.lastbuf]:=bc_pa; tmpmbuf.li[tmpmbuf.lastbuf]:=amacro^.li[i]; inc(i); end; end else begin l:=-1; repeat inc(l); until (l>amacro^.pn) or (paramids[l]=amacro^.r[i]); if l<=amacro^.pn then begin lastmodestr(bm_em_p0+l,j,k); dec(k); while (k>0) do begin if tmpmbuf.lastbuf>=macrobuf_size-1 then CMacroBuf.insert(tmpmbuf); inc(tmpmbuf.lastbuf); tmpmbuf.buf[tmpmbuf.lastbuf]:=rbuf[j]; tmpmbuf.li[tmpmbuf.lastbuf]:=li[j]; j:=(j+1) and rbufmax; dec(k); end; inc(i); end else begin inc(tmpmbuf.lastbuf); tmpmbuf.buf[tmpmbuf.lastbuf]:=bc_pa; tmpmbuf.li[tmpmbuf.lastbuf]:=amacro^.li[i]; end; end; end else begin inc(tmpmbuf.lastbuf); tmpmbuf.buf[tmpmbuf.lastbuf]:=amacro^.r[i]; tmpmbuf.li[tmpmbuf.lastbuf]:=amacro^.li[i]; inc(i); end; end; end; end else inc(mode); end; end; {plain mode} if mode=bm_expand then begin i:=3; j:=0; k:=rbp; { equal to copylaststr_br(4,bm_expand); } i4:=0; while (i>=0) and (j<=rbufmax) do begin if bufm[k]=bm_expand then begin s4[i]:=rbuf[k]; i-=1; end; k:=(k-1) and rbufmax; j+=1; end; if (mode=bm_plain) and ((i4 xor pm_s) and pm_m=0) and (pm_q or matchstr(bc_pm,bm_plain)) and (matchstr(bc_lf+bc_pm) or (buf.d+buf.d0=length(bc_pm))) then begin mode:=bm_pm; setmode(length(bc_pm),bm_plain,mode); end else begin if bp_icase then begin if (s4[0]>='a') and (s4[0]<='z') then byte(s4[0])-=32; if (s4[1]>='a') and (s4[1]<='z') then byte(s4[1])-=32; if (s4[2]>='a') and (s4[2]<='z') then byte(s4[2])-=32; if (s4[3]>='a') and (s4[3]<='z') then byte(s4[3])-=32; j:=1; end else j:=0; i:=lastmacro; while i>=0 do begin amacro:=macros[i]; if (amacro^.rsize>=0) and (amacro^.enabled) and ((i4 xor amacro^.mmatch_s[j]) and amacro^.mmatch_m=0) and (amacro^.quick or matchstr_br(bp_icase,amacro^.name,bm_expand)) then begin setmode(length(amacro^.name),bm_expand,bm_em); ampos:=lineInfo; if amacro^.paramsep[0]='' then begin if amacro^.rsize>0 then CMacroBuf.create(buf, amacro, true); end else mode:=bm_em_p0; i:=0; end; i-=1; end; end; end; endparse: rbp:=(rbp+1) and rbufmax; end; end; if bmp_exit=0 then case mode of bm_plain, bm_pm, bm_def_sob2, bm_def_sob3, bm_if_not : if ifc>=0 then begin if ifc>0 then sx:='if''s without endif''s at '+lineInfoStr(ifli[0]) else sx:='if without endif at '+lineInfoStr(ifli[0]); for i:=1 to ifc do sx+=', '+lineInfoStr(ifli[i]); error(sx); end; bm_neplain, bm_ifeq_scb1_ne, bm_ifeq_scb2_ne, bm_ifneq_scb1_ne, bm_ifneq_scb2_ne : error('Unexpected end of file, `'+endnoexpand+''' expected for '+bc_pm+'noexpand at '+lineInfoStr(ampos)); bm_em_p0..bm_em_pz : error('Unexpected end of file, `'+amacro^.paramsep[mode-bm_em_p0]+''' expected for '+amacro^.name+' at '+lineInfoStr(ampos)); bm_def_scb1, bm_def_scb2, bm_def_scb3, bm_def_scbu, bm_def_scba, bm_if_scb, bm_ifn_scb, bm_ifeq_scb1, bm_ifeq_scb2, bm_ifneq_scb1, bm_ifneq_scb2, bm_inc_scb, bm_err, bm_err_scb, bm_warn : begin if bl>1 then begin if bl>2 then sx:=', there are unclosed `'+bc_ob+'''s at '+lineInfoStr(bli[1]) else sx:=', there is a unclosed `'+bc_ob+''' at '+lineInfoStr(bli[1]); for i:=2 to bl-1 do sx+=', '+lineInfoStr(bli[i]); end else sx:=' (maybe there are unclosed `'+bc_ob+'''s)'; error('Unexpected end of file, `'+bc_cb+''' expected for `'+bc_ob+''' at '+lineInfoStr(bli[0])+sx); end; bm_ifeq_sob : error('Unexpected end of file, `'+bc_ob+''' expected for '+bc_pm+'ifeq at '+lineInfoStr(ampos)); bm_ifneq_sob : error('Unexpected end of file, `'+bc_ob+''' expected for '+bc_pm+'ifneq at '+lineInfoStr(ampos)); else error('Unexpected end of file ('+int2str(mode)+')'); end; for k:=0 to rbufmax do begin {$ifdef ENABLE_DEBUGOUT } if debugoutput then debugwrite; {$endif} i:=bufm[rbp]; if (i<10) and (i>=0) and (outfile>0) then begin j:=ord(writebuf[0])+1; { avoid the range checking } writebuf[0]:=char(j); writebuf[j]:=rbuf[rbp]; if rbuf[rbp]=#10 then begin if (li[rbp]<>prevli+4096) and (lineInfoPattern<>'') then lineInfoStr(fo,li[rbp]); prevli:=li[rbp]; byte(writebuf[0])-=1; writeln(fo,writebuf); writebuf:=''; end; if j>=255 then begin write(fo,writebuf); writebuf:=''; end; end else if (i>=bm_outfile_a) and (i<=bm_outfile_z) then outfile:=i-bm_outfile_a; rbp:=(rbp+1) and rbufmax; end; write(fo,writebuf); if printdefs then printmacros; end; { ******** initsymb ************************************************** } procedure CMainBmp.initsymb(const s:bmpstring); var s4 : TS4; begin lastmacro+=1; if lastmacro>maxmacros then faterror('Macro memory exceeded'); getmem(macros[lastmacro],sizeof(TBabelMacro)); fillchar( macros[lastmacro]^, sizeof(TBabelMacro), 0 ); s4.s:=copy(' '+s,length(s)+1,4); macros[lastmacro]^.mmatch_s[0]:=s4.i; upstr2(s4.s); macros[lastmacro]^.mmatch_s[1]:=s4.i; macros[lastmacro]^.mmatch_m:=$ffffffff shl ((4-min(length(s),4))*8); macros[lastmacro]^.quick:=length(s)<=4; macros[lastmacro]^.enabled:=true; macros[lastmacro]^.rsize:=-1; macros[lastmacro]^.pn:=0; macros[lastmacro]^.name:=s; end; { ****** error_int ************************************************** } procedure CMainBmp.error_int(const t:ansistring); var i,j,k : longint; tmp : CTextBuf; s : shortstring; begin tmp:=buf; i:=0; while tmp<>nil do begin tmp:=CTextBuf(tmp.last); i+=1; end; s:=''; for j:=1 to i do begin tmp:=buf; for k:=1 to i-j do tmp:=tmp.last; k:=tmp.d; if k>0 then k-=1; writeln(stderr, s, lineInfoStr(tmp.li[k]), ':'); s+=' '; end; writeln(stderr,s,t); end; { ****** hint ******************************************************* } procedure CMainBmp.hint(const s:ansistring); begin if enable_hints then writeln(stderr,'Hint: '+lineInfoStr(lineInfo)+': '+s); end; { ****** warning **************************************************** } procedure CMainBmp.warning(const s:ansistring); begin error_int('Warning: '+s); end; { ****** error ****************************************************** } procedure CMainBmp.error(const s:ansistring); begin error_int('Error: '+s); bmp_exit:=bmp_exit_error; end; { ****** faterror *************************************************** } procedure CMainBmp.faterror(const s:ansistring); begin error_int('Fatal error: '+s); halt(bmp_exit_faterror); end; { ****** copylaststr ************************************************ } function CMainBmp.copylaststr(l,mode:longint):rbufstr; var i,k : longint; begin l:=l and rbufmax; i:=0; k:=rbp; while (i<l) and ((bufm[k]=mode) or (mode<0)) do begin i+=1; k:=(k-1) and rbufmax; end; result.rbuf:=@rbuf; result.pt:=k+1; result.length:=i; end; function CMainBmp.copylaststr(l:longint):rbufstr; begin result:=copylaststr(l,-1); end; function CMainBmp.copylaststr_br(l,mode:longint):bmpstring; var i,j,k : longint; begin {$ifdef USE_SHORTSTRINGS} if l>255 then l:=255; {$endif} i:=0; j:=0; k:=rbp; setlength(result,l); while (i<l) and (j<=rbufmax) do begin if (bufm[k]=mode) or (mode<0) then begin result[l-i]:=rbuf[k]; i+=1; end; k:=(k-1) and rbufmax; j+=1; end; if i<l then result:=copy(result, length(result)-i+1, i); end; { ****** matchstr **************************************************** } function CMainBmp.matchstr(const s:bmpstring; mode:longint):boolean; begin matchstr:=cmp_rbuf(copylaststr(length(s),mode), s); end; function CMainBmp.matchstr(const s:bmpstring):boolean; begin matchstr:=cmp_rbuf(copylaststr(length(s),-1),s); end; function CMainBmp.matchstr(ic:boolean; const s:bmpstring; mode:longint):boolean; begin if ic then matchstr:=cmpcase_rbuf(copylaststr(length(s),mode),s) else matchstr:=cmp_rbuf(copylaststr(length(s),mode),s); end; function CMainBmp.matchstr(ic:boolean;const s:bmpstring):boolean; begin if ic then matchstr:=cmpcase_rbuf(copylaststr(length(s),-1),s) else matchstr:=cmp_rbuf(copylaststr(length(s),-1),s); end; function CMainBmp.matchstr_br(const s:bmpstring; mode:longint):boolean; begin matchstr_br:=copylaststr_br(length(s),mode)=s; end; function CMainBmp.matchstr_br(ic:boolean; const s:bmpstring; mode:longint):boolean; begin if ic then matchstr_br:=upstr(copylaststr_br(length(s),mode))=upstr(s) else matchstr_br:=copylaststr_br(length(s),mode)=s end; { ****** lastmodestr ************************************************* } procedure CMainBmp.lastmodestr(mode:longint; var fst,l:longint); var i,j,k : longint; begin i:=rbp; j:=0; k:=0; while (bufm[i]<>mode) and (j<=rbufmax) do begin i:=(i-1) and rbufmax; j+=1; end; while (bufm[i]=mode) and (j<=rbufmax) do begin i:=(i-1) and rbufmax; j+=1; k+=1; end; i:=(i+1) and rbufmax; fst:=i; l:=k; end; procedure CMainBmp.lastmodestr(mode:longint; var size:longint; var ptc:pchar; var ptli:pdword); var i,j,k : longint; begin lastmodestr(mode,i,j); if j>0 then begin size:=j; getmem(ptc,j); getmem(ptli,j*4); for k:=0 to j-1 do begin ptc[k]:=rbuf[i]; ptli[k]:=li[i]; i:=(i+1) and rbufmax; end; end else begin size:=0; ptc:=nil; ptli:=nil; end; end; function CMainBmp.lastmodestr(mode:longint):bmpstring; var i,j,k : longint; begin lastmodestr(mode,i,j); {$ifdef USE_SHORTSTRINGS} if j>255 then j:=255; {$endif} setlength(lastmodestr,j); for k:=1 to j do begin lastmodestr[k]:=rbuf[i]; i:=(i+1) and rbufmax; end; end; procedure CMainBmp.lastmodestr1(mode:longint; var size:longint; var ptc:pchar; var ptli:pdword); var i,j,k : longint; begin lastmodestr(mode,i,j); j-=1; if j>0 then begin size:=j; getmem(ptc,j); getmem(ptli,j*4); for k:=0 to j-1 do begin ptc[k]:=rbuf[i]; ptli[k]:=li[i]; i:=(i+1) and rbufmax; end; end else begin size:=0; ptc:=nil; ptli:=nil; end; end; function CMainBmp.lastmodestr1(mode:longint):bmpstring; var i,j,k : longint; begin lastmodestr(mode,i,j); j-=1; {$ifdef USE_SHORTSTRINGS} if j>255 then j:=255; {$endif} setlength(lastmodestr1,j); for k:=1 to j do begin lastmodestr1[k]:=rbuf[i]; i:=(i+1) and rbufmax; end; end; { ****** setmode ***************************************************** } procedure CMainBmp.setmode(num,om,nm:longint); var i,j,k : longint; begin k:=rbp; i:=0; j:=0; while (i<num) and (j<=rbufmax) do begin if (bufm[k]=om) or (om<0) then begin i+=1; bufm[k]:=nm; end; j+=1; k:=(k-1) and rbufmax; end; end; { ******** printmacros *********************************************** } procedure CMainBmp.printmacros(const m:array of pbabelmacro; mm:longint); var i,j : longint; begin for j:=0 to mm do begin writeln(stderr,' ----- definition ',j+1,' -----'); writeln(stderr,m[j]^.name); if m[j]^.paramsep[0]<>'' then write(stderr,m[j]^.paramsep[0]); for i:=1 to m[j]^.pn do write(stderr,bc_pa,i,m[j]^.paramsep[i]); if (m[j]^.pn>0) or (m[j]^.paramsep[0]<>'') then writeln(stderr); for i:=0 to m[j]^.rsize-1 do write(stderr,m[j]^.r[i]); if m[j]^.rsize>0 then writeln(stderr); if m[j]^.rsize=0 then writeln(stderr,'<empty>'); writeln(stderr); writeln(stderr); end; end; procedure CMainBmp.printmacros; begin printmacros(macros, lastmacro); end; {$ifdef ENABLE_DEBUGOUT } { ******** debugwrite ************************************************ } procedure CMainBmp.debugwrite; var i : longint; lf : boolean; begin if rbuf[rbp]=#10 then begin writeln; lf:=true; end else lf:=false; if (bufm[rbp]<>bm_invalid) and (rbuf[rbp]<>#13) and (rbuf[rbp]<>#10) then write(rbuf[rbp]); i:=(rbp+1) and rbufmax; if bufm[rbp]<>bufm[i] then begin if not lf then writeln; write(bufm[i]); case bufm[i] of 0..9 : write(' '); 10..99 : write(' '); 200..999 : write(' '); 1000..9999 : write(' '); else write(' '); end; end else if lf then write(' '); end; {$endif} { ********************************************************************* } { ****** main ********************************************************* } { ********************************************************************* } { ****** paramerr ***************************************************** } procedure paramerr(msg:ansistring); begin writeln(stderr,'Usage: '+paramstr(0)+' [<Options>] [<filename1> [<filename2> ...]]'); writeln(stderr,'Options: '); writeln(stderr,' -o <fileneme> Output file'); writeln(stderr,' -p Pascal mode (default), equal to -mm "//" -mo "[" -mc "]" -mp "#"'); writeln(stderr,' -c C mode, equal to -mm "#" -mo "[" -mc "]" -mp "$" -l ''#line %2 "%1"'''); writeln(stderr,' -i Ignore upper/lower case'); writeln(stderr,' -l Line info (default for C mode: ''#line %2 "%1"'')'); writeln(stderr,' -I <directory> Include path'); writeln(stderr,' -D <symbol> Define symbol <symbol>'); writeln(stderr,' -mm <string> Meta macro start string'); writeln(stderr,' -mo <char> Open bracket'); writeln(stderr,' -mc <char> Close bracket'); writeln(stderr,' -mp <char> Parameter character'); //writeln(stderr,' -nh Disable hints'); {$ifdef ENABLE_DEBUGOUT} writeln(stderr,' -do Enable debug output'); {$endif} writeln(stderr,' -dd Print definitions'); writeln(stderr,' -h Help'); if msg<>'' then begin writeln(stderr,msg); halt(bmp_exit_paramerror); end else halt(0); end; { ****** main ********************************************************* } const maxInfilec = 1024; var main : CMainBmp; infile : array[0..maxInfilec-1] of ansistring; i,j,infilec : longint; s,t : ansistring; fo : text; fofn : ansistring; bc_pm_d,bc_ob_d : boolean; bc_cb_d,bc_pa_d : boolean; pasmode,lidef : boolean; begin spath[0]:=''; spathc:=1; main:=CMainBmp.create; fofn:=''; bc_pm_d:=false; bc_ob_d:=false; bc_cb_d:=false; bc_pa_d:=false; pasmode:=true; lidef:=false; infilec:=0; i:=1; while i<=paramcount do begin s:=paramstr(i); if (length(s)>1) and (s[1]='-') then begin if s='-o' then begin if i>=paramcount then paramerr('File name expected after -o'); i+=1; fofn:=paramstr(i); end else if s='-p' then pasmode:=true else if s='-c' then pasmode:=false else if s='-i' then bp_icase:=true else if s='-l' then begin if i>=paramcount then paramerr('String expected after -l'); i+=1; lineInfoPattern:=paramstr(i); {$ifdef WINDOWS} for j:=1 to length(lineInfoPattern) do if lineInfoPattern[j]='\' then lineInfoPattern[j]:='"'; {$endif} lidef:=true; end else if s='-I' then begin if i>=paramcount then paramerr('Path expected after -I'); i+=1; t:=paramstr(i); {$ifdef WINDOWS} for j:=1 to length(t) do if t[j]='/' then t[j]:='\'; {$endif} if t<>'' then begin if t[length(t)]<>dirsep then t+=dirsep; if spathc>=maxspathc then bmp_error('Maximum amount of search paths reached') else begin spath[spathc]:=t; spathc+=1; end; end; end else if s='-D' then begin if i>=paramcount then paramerr('Symbol expected after -D'); i+=1; main.initsymb(paramstr(i)); end else if s='-mm' then begin if i>=paramcount then paramerr('String expected after -mm'); i+=1; bc_pm_d:=true; bc_pm:=paramstr(i); end else if s='-mo' then begin if (i>=paramcount) or (length(paramstr(i+1))<>1) then paramerr('Character expected after -mo'); i+=1; bc_ob_d:=true; bc_ob:=paramstr(i)[1]; end else if s='-mc' then begin if (i>=paramcount) or (length(paramstr(i+1))<>1) then paramerr('Character expected after -mc'); i+=1; bc_cb_d:=true; bc_cb:=paramstr(i)[1]; end else if s='-mp' then begin if (i>=paramcount) or (length(paramstr(i+1))<>1) then paramerr('Character expected after -mp'); i+=1; bc_pa_d:=true; bc_pa:=paramstr(i)[1]; end else if s='-eh' then enable_hints:=false {$ifdef ENABLE_DEBUGOUT} else if s='-do' then debugoutput:=true {$endif} else if s='-dd' then printdefs:=true else if s='-h' then paramerr('') else paramerr('Invalid option: '+s); end else begin if infilec>=maxinfilec then bmp_error('Maximum amount of input files reached') else begin {$ifdef WINDOWS} for j:=1 to length(s) do if s[j]='/' then s[j]:='\'; {$endif} if s='-' then infile[infilec]:='' else infile[infilec]:=s; infilec+=1; end; end; i+=1; end; if pasmode then begin if not bc_pm_d then bc_pm:='//'; if not bc_ob_d then bc_ob:='['; if not bc_cb_d then bc_cb:=']'; if not bc_pa_d then bc_pa:='#'; end else begin if not bc_pm_d then bc_pm:='#'; if not bc_ob_d then bc_ob:='['; if not bc_cb_d then bc_cb:=']'; if not bc_pa_d then bc_pa:='$'; if not lidef then lineInfoPattern:='#line %2 "%1"'; end; if infilec=0 then begin infile[0]:=''; infilec:=1; end; if fofn<>'' then begin try assign(fo,fofn); rewrite(fo); for i:=0 to infilec-1 do main.run(infile[i],fo); close(fo); except bmp_faterror('Error writing to file '+fofn); end; end else for i:=0 to infilec-1 do main.run(infile[i],output); main.destroy; halt(bmp_exit); end.