From 49738994a8db6e25f1ffb5d754223c1fccc121d9 Mon Sep 17 00:00:00 2001 From: oro06 Date: Thu, 29 Dec 2005 16:07:01 +0000 Subject: [PATCH] *preprocessor can't read files with proc/func declaration git-svn-id: trunk@2078 - --- utils/fprcp/Readme.txt | 2 + utils/fprcp/fprcp.pp | 271 ++++++++++++++++------------------------- utils/fprcp/pasprep.pp | 23 +++- 3 files changed, 126 insertions(+), 170 deletions(-) diff --git a/utils/fprcp/Readme.txt b/utils/fprcp/Readme.txt index 915f67a9f6..5036addb64 100644 --- a/utils/fprcp/Readme.txt +++ b/utils/fprcp/Readme.txt @@ -17,6 +17,8 @@ non-numeric constants; 2) Old versions of windres cannot create .res files; 3) in fprcp also source code written by Lars Fosdal 1987 and released to the public domain 1993 was used +4) updated to accept defines.inc + parser was expecting body for procedure/function declaration files: readme.txt - this file diff --git a/utils/fprcp/fprcp.pp b/utils/fprcp/fprcp.pp index 1e105d9f7d..84c0d3ec0c 100644 --- a/utils/fprcp/fprcp.pp +++ b/utils/fprcp/fprcp.pp @@ -4,7 +4,7 @@ program FreePasResourcePreprocessor; {$endif} {$ifndef fpc}{$N+}{$endif} uses - Comments,PasPrep,Expr + Comments,PasPrep,Expr,Classes {$ifndef win32} ,DOS; type @@ -57,9 +57,12 @@ const var f:file; s:str255; + sValue1, sValue2: String; size,nextpos:longint; buf:pchars; i:longint; + AConstList: TStringList; + function Entry(buf:pchars;Size,fromPos:longint;const sample:str255;casesent:longbool):longbool; var i:longint; @@ -171,30 +174,7 @@ function GetSwitch(const switch:str255):str255; if paramstr(i)='-'+switch then GetSwitch:=paramstr(succ(i)); end; -procedure saveproc(const key,value:str255;CaseSent:longbool);{$ifndef fpc}far;{$endif} - var - c:pReplaceRec; - begin - new(c); - c^.next:=nil; - c^.CaseSentitive:=CaseSent; - getmem(c^.oldvalue,succ(length(key))); - c^.oldvalue^:=key; - getmem(c^.newvalue,succ(length(value))); - c^.newvalue^:=value; - if chainhdr=nil then - begin - chain:=c; - chainhdr:=chain; - ChainLen:=1; - end - else - begin - chain^.next:=c; - chain:=c; - inc(ChainLen); - end; - end; + type Tlanguage=(L_C,L_Pascal); function Language(s:str255):tLanguage; @@ -270,6 +250,11 @@ function Up(const s:str255):str255; n[i]:=upcase(s[i]); Up:=n; end; +procedure saveproc(const key,value:str255;CaseSent:longbool);{$ifndef fpc}far;{$endif} +begin + AConstList.Values[Up(key)]:=Up(Value); +end; + procedure do_C(buf:pchars;size:longint;proc:pointer); type Tpushfunc=procedure(const key,value:str255;CaseSent:longBool); @@ -339,9 +324,9 @@ procedure expandname(var s:str255;path:str255); end; function do_include(name:str255):longbool; var - buf:pchars; - f:file; - size:longint; + bufinclude:pchars; + finclude:file; + sizeinclude:longint; s1:str255; procedure trim; begin @@ -359,19 +344,19 @@ function do_include(name:str255):longbool; s1:=GetSwitch('-path'); expandname(name,s1); end; - assign(f,name); - reset(f,1); - size:=filesize(f); - GetMem(buf,size); - blockread(f,buf^,size); - close(f); + assign(finclude,name); + reset(finclude,1); + sizeinclude:=filesize(finclude); + GetMem(bufinclude,sizeinclude); + blockread(finclude,bufinclude^,sizeinclude); + close(finclude); case Language(name)of L_C: - do_C(buf,size,@saveProc); + do_C(bufinclude,sizeinclude,@saveProc); L_PASCAL: - do_pascal(buf,size,@saveProc); + do_pascal(bufinclude,sizeinclude,@saveProc); end; - FreeMem(buf,size); + FreeMem(bufinclude,sizeinclude); do_include:=true; end; function CheckRight(const s:str255;pos:longint):longbool; @@ -393,18 +378,19 @@ function CheckLeft(const s:str255;pos:longint):longbool; CheckLeft:=not(s[pred(pos)]in['a'..'z','A'..'Z','0'..'9','_']); end; end; -function Evaluate(Equation:Str255):Str255; +function Evaluate(Equation:String):String; var x:double; Err:integer; begin - Eval(Equation,x,Err); - if(Err=0)and(frac(x)=0)then - str(x:1:0,Equation) - else - Equation:=''; - Evaluate:=Equation; - end; + Eval(Equation,x,Err); + if(Err=0)and(frac(x)=0)then + str(x:1:0,Equation) + else + Equation:=''; + Evaluate:=Equation; +end; + type taccel=array[1..100]of pReplaceRec; var @@ -412,7 +398,7 @@ var c:pReplaceRec; j,kk:longint; sss,sst:str255; - MustBeReplaced:longbool; + bNoMore:Boolean; begin if(paramcount=0)or isSwitch('h')or isSwitch('-help')or((paramcount>1)and(GetSwitch('i')=''))then begin @@ -441,130 +427,77 @@ begin if isSwitch('-disable-nested-pascal-comments')then PasNesting:=false; excludeComments(buf,size); - for i:=1 to size do - begin - if entry(buf,size,i,'#include',true)then - do_include(GetWord(buf,size,i+length('#include'),nextpos)); - end; - getmem(Accel,sizeof(pReplaceRec)*ChainLen); - c:=ChainHdr; - i:=0; - while c<>nil do - begin - inc(i); - Accel^[i]:=c; - c:=c^.next; - end; - for i:=1 to pred(Chainlen)do - for j:=succ(i)to Chainlen do - if length(Accel^[j]^.newvalue^)>=length(Accel^[i]^.oldvalue^)then - repeat - MustBeReplaced:=false; - for kk:=1 to length(Accel^[j]^.newvalue^)do - begin - sss:=copy(Accel^[j]^.newvalue^,kk,length(Accel^[i]^.oldvalue^)); - if length(sss)<>length(Accel^[i]^.oldvalue^)then - break - else if sss=Accel^[i]^.oldvalue^ then - begin - MustBeReplaced:=(CheckLeft(Accel^[j]^.newvalue^,kk)and CheckRight(Accel^[j]^.newvalue^,kk-1+ - length(Accel^[i]^.oldvalue^))); - if MustBeReplaced then - break; - end; - end; - if MustBeReplaced then - begin - sss:=Accel^[j]^.newvalue^; - delete(sss,kk,length(Accel^[i]^.oldvalue^)); - insert(Accel^[i]^.newvalue^,sss,kk); - freemem(Accel^[j]^.newvalue,length(Accel^[j]^.newvalue^)); - getmem(Accel^[j]^.newvalue,length(sss)); - Accel^[j]^.newvalue^:=sss; - end; - until not MustBeReplaced; - for j:=1 to Chainlen do - begin - sss:=Evaluate(Accel^[j]^.newvalue^); - freemem(Accel^[j]^.newvalue,length(Accel^[j]^.newvalue^)); - getmem(Accel^[j]^.newvalue,length(sss)); - Accel^[j]^.newvalue^:=sss; - end; - if isSwitch('C')or isSwitch('-Cheader')then - for i:=1 to Chainlen do - begin - if Accel^[i]^.newvalue^<>''then - writeln('#define ',Accel^[i]^.oldvalue^,' ',Accel^[i]^.newvalue^) - end - else - begin - sss:=''; - i:=1; - sss:=''; - while i<=size do + AConstList:=TStringList.Create; + //try + AConstList.BeginUpdate; + //try + //include file + for i:=1 to size do begin - if buf^[i]<>#10 then - sss:=sss+buf^[i] - else - begin - while(sss<>'')and(sss[1]<=#32)do - delete(sss,1,1); - sst:=sss; - for j:=1 to length(sst)do - sst[j]:=upcase(sst[j]); - if pos('#INCLUDE',sst)=0 then - begin - s:=''; - for kk:=1 to length(sss)do - begin - if sss[kk]>#32 then - s:=s+sss[kk] - else if s<>'' then - begin - for j:=1 to ChainLen do - begin - if accel^[j]^.casesentitive then - begin - if(accel^[j]^.oldvalue^=s)and(accel^[j]^.newvalue^<>'')then - begin - s:=accel^[j]^.newvalue^; - break; - end; - end - else - begin - if(accel^[j]^.oldvalue^=Up(s))and(accel^[j]^.newvalue^<>'')then - begin - s:=accel^[j]^.newvalue^; - break; - end; - end; - end; - write(s,' '); - s:=''; - end; - end; - writeln; - sss:=''; - end - else - sss:=''; - end; - inc(i); + if entry(buf,size,i,'#include',true)then + do_include(GetWord(buf,size,i+length('#include'),nextpos)); end; - end; - freemem(Accel,sizeof(pReplaceRec)*ChainLen); - Chain:=ChainHdr; - while Chain<>nil do - begin - c:=Chain; - Chain:=Chain^.next; - if c^.oldvalue<>nil then - freemem(c^.oldvalue,succ(length(c^.oldvalue^))); - if c^.newvalue<>nil then - freemem(c^.newvalue,succ(length(c^.newvalue^))); - dispose(c); - end; - freemem(buf,size); + //finally + AConstList.EndUpdate; //end; + + //replace const-value if needed and evaluate + For i:=0 to (AConstList.Count-1) do begin + sValue1:=AConstList.ValueFromIndex[i]; + repeat + sValue2:=AConstList.Values[sValue1]; + bNoMore:=Length(sValue2)=0; + if (not bNoMore) then sValue1:=sValue2; + until bNoMore; + sValue2:=Evaluate(sValue1); + if Length(sValue2)>0 + then AConstList.ValueFromIndex[i]:=Evaluate(sValue1); + end; + + if isSwitch('C')or isSwitch('-Cheader')then begin + for i:=0 to AConstList.Count-1 + do writeln('#define ',AConstList.Names[i],' ',AConstList.ValueFromIndex[i]); + end else begin + sss:=''; + i:=1; + while i<=size do + begin + if buf^[i]<>#10 then + sss:=sss+buf^[i] + else + begin + while(sss<>'')and(sss[1]<=#32)do + delete(sss,1,1); + sst:=sss; + for j:=1 to length(sst)do sst[j]:=upcase(sst[j]); + if pos('#INCLUDE',sst)=0 then + begin + s:=''; + for kk:=1 to length(sss)do + begin + if sss[kk]>#32 then + s:=s+sss[kk] + else if s<>'' then + begin + sValue1:=AConstList.Values[Up(s)]; + if Length(sValue1)>0 + then write(sValue1,' ') + else write(s,' '); + s:=''; + end; + end; + writeln; + sss:=''; + end + else + sss:=''; + end; + inc(i); + end; + end; + freemem(buf,size); + + //finally + AConstList.Free; //end; + end. diff --git a/utils/fprcp/pasprep.pp b/utils/fprcp/pasprep.pp index af97813150..ff17698a08 100644 --- a/utils/fprcp/pasprep.pp +++ b/utils/fprcp/pasprep.pp @@ -57,6 +57,24 @@ function IsTypeDef(pos:longint):longbool; exit; end; end; +procedure JumpToNext; +var iLastword: Longint; +begin + repeat + iLastword:=GetWord_Pos; + if GetWord_Pos>size then + exit; + GetWord; + i:=GetWord_Pos; + if(LastWord='EXTERNAL')or(LastWord='FORWARD')or(LastWord='INLINE')then + break + else if (LastWord='CONST')then begin + GetWord_Pos:=iLastword; + break; + end; + until false; +end; + procedure JumpToEnd; var mainBegin:str255; @@ -151,13 +169,16 @@ procedure do_consts(savefunc:pointer); begin ClearComments(PasNesting,buf,size); i:=1; + GetWord_Pos:=0; while i<=size do begin old:=GetWord_Pos; GetWord; i:=GetWord_Pos; - if((LastWord='PROCEDURE')or(lastword='FUNCTION')or(lastword='OPERATOR'))and not isTypedef(old)then + if (lastword='OPERATOR')and not isTypedef(old)then JumpToEnd + else if ((LastWord='PROCEDURE')or(lastword='FUNCTION')) and not isTypedef(old) then + JumpToNext else if LastWord='CONST'then Do_Consts(proc) else if LastWord='IMPLEMENTATION'then