paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 17:20:30 +02:00
Code Issues Packages Projects Releases Wiki Activity

+ -s for string writing

Browse Source 
* some small cleanups
This commit is contained in:
peter 1999-11-23 09:42:18 +00:00
parent 8049831c3f
commit cebc42c1e4
1 changed files with 323 additions and 206 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

215
utils/data2inc.pp
View File

@ -28,14 +28,6 @@
An arbitrary binary file can get converted to constants. In this mode An arbitrary binary file can get converted to constants. In this mode
only one constant per include file is possible. only one constant per include file is possible.
This program has been working for three weeks now, all major bugs are fixed I
hope. A different kind of (possible) problems are the amounts of memory
allocated for the temporary buffer (MaxBuffersize variable), which
is now initialised to 256000 bytes (for textfile type, per record), and 1 MB
maximum for binary files. Also the program has to be compiled with a large
enough heap (-CH parameter of FPC) to allow this. This is the case without
modifying the default ppc386.cfg or adding -Ch parameters.
This program is distributed in the hope that it will be useful, This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
@ -47,11 +39,15 @@ uses strings;
CONST CONST
version='0.99.13'; version='0.99.13';
{ ************ maxbufsize = 1024*1024; { 1 mb buffer }
type
TOutputMode=(OutByte,OutChar,OutString);
{*****************************************************************************
Simple service routines. These are copied from EPasStr. Simple service routines. These are copied from EPasStr.
The program doesn't use EPasStr, because I want it to function *****************************************************************************}
BEFORE EPasStr is compiled, and distributable without XTDFPC.}
TYPE CHARSET=SET OF CHAR; TYPE CHARSET=SET OF CHAR;
@ -145,7 +141,9 @@ BEGIN
END; END;
{---- End EPasStr routines ----} {*****************************************************************************
Parsing helpers
*****************************************************************************}
FUNCTION XlatString(Var S : String):BOOLEAN; FUNCTION XlatString(Var S : String):BOOLEAN;
{replaces \xxx in string S with #x, and \\ with \ (escaped) {replaces \xxx in string S with #x, and \\ with \ (escaped)
@ -225,15 +223,17 @@ VAR
Inname, { Name of input file } Inname, { Name of input file }
OutName, { Name of output (.inc) file } OutName, { Name of output (.inc) file }
BinConstName : string; { (-b only) commandline name of constant } BinConstName : string; { (-b only) commandline name of constant }
ArrayByte, {TRUE when output of ARRAY OF BYTE is desired OutputMode : TOutputMode; { Output mode (char,byte,string) }
ARRAY OF CHAR otherwise}
I_Binary : BOOLEAN; { TRUE is binary input, FALSE textual } I_Binary : BOOLEAN; { TRUE is binary input, FALSE textual }
MsgTxt : pchar; { Temporary storage of data } MsgTxt : pchar; { Temporary storage of data }
msgsize : longint; { Bytes used in MsgTxt } msgsize : longint; { Bytes used in MsgTxt }
maxbufsize : LONGINT; {Bytes allocated for MsgTxt}
C : CHAR; C : CHAR;
{*****************************************************************************
WriteCharFile
*****************************************************************************}
{Dump the contents of MsgTxt (msgsize bytes) to file T (which has been opened), {Dump the contents of MsgTxt (msgsize bytes) to file T (which has been opened),
using CONSTNAME as the name of the ARRAY OF CHAR constant} using CONSTNAME as the name of the ARRAY OF CHAR constant}
procedure WriteCharFile(var t:text;constname:string); procedure WriteCharFile(var t:text;constname:string);
@ -280,6 +280,11 @@ begin
Writeln(T); Writeln(T);
end; end;
{*****************************************************************************
WriteByteFile
*****************************************************************************}
{Dump the contents of MsgTxt (msgsize bytes) to file T (which has been opened), {Dump the contents of MsgTxt (msgsize bytes) to file T (which has been opened),
using CONSTNAME as the name of the ARRAY OF BYTE constant} using CONSTNAME as the name of the ARRAY OF BYTE constant}
procedure WriteByteFile(var t:text;constname:string); procedure WriteByteFile(var t:text;constname:string);
@ -302,7 +307,6 @@ procedure WriteByteFile(var t:text;constname:string);
var var
cidx,i : longint; cidx,i : longint;
p : pchar; p : pchar;
begin begin
Writeln('Writing constant: ',constname,' to file '#39,outname,#39); Writeln('Writing constant: ',constname,' to file '#39,outname,#39);
{Open textfile} {Open textfile}
@ -333,6 +337,113 @@ begin
Writeln(T); Writeln(T);
end; end;
{*****************************************************************************
WriteStringFile
*****************************************************************************}
procedure WriteStringFile(var t:text;constname:string);
const
maxslen=240; { to overcome aligning problems }
function l0(l:longint):string;
var
s : string[16];
begin
str(l,s);
while (length(s)<5) do
s:='0'+s;
l0:=s;
end;
var
slen,
len,i : longint;
p : pchar;
start,
quote : boolean;
begin
Writeln('Writing constant: ',constname,' to file '#39,outname,#39);
{Open textfile}
writeln(t,'{$ifdef Delphi}');
writeln(t,'const '+constname+' : array[0..',msgsize div maxslen,'] of string[',maxslen,']=(');
writeln(t,'{$else Delphi}');
writeln(t,'const '+constname+' : array[0..',msgsize div maxslen,',1..',maxslen,'] of char=(');
write(t,'{$endif Delphi}');
{Parse buffer in msgbuf and create indexs}
p:=msgtxt;
slen:=0;
len:=0;
quote:=false;
start:=true;
for i:=1 to msgsize do
begin
if slen>=maxslen then
begin
if quote then
begin
write(t,'''');
quote:=false;
end;
write(t,',');
slen:=0;
inc(len);
end;
if (len>70) or (start) then
begin
if quote then
begin
write(t,'''');
quote:=false;
end;
if slen>0 then
writeln(t,'+')
else
writeln(t);
len:=0;
start:=false;
end;
if (len=0) then
write(t,' ');
if (ord(p^)>=32) and (p^<>#39) then
begin
if not quote then
begin
write(t,'''');
quote:=true;
inc(len);
end;
write(t,p^);
inc(len);
end
else
begin
if quote then
begin
write(t,'''');
inc(len);
quote:=false;
end;
write(t,'#'+chr(ord(p^) div 100+48)+chr((ord(p^) mod 100) div 10+48)+chr(ord(p^) mod 10+48));
inc(len,3);
end;
{ start a new line when a #0 or #10 is found }
if p^ in [#0,#10] then
start:=true;
inc(slen);
inc(p);
end;
if quote then
write(t,'''');
writeln(t,'');
writeln(t,');');
end;
{*****************************************************************************
Parser
*****************************************************************************}
FUNCTION SpecialItem(S : String):LONGINT; FUNCTION SpecialItem(S : String):LONGINT;
{ This procedure finds the next comma, (or the end of the string) { This procedure finds the next comma, (or the end of the string)
but comma's within single or double quotes should be ignored. but comma's within single or double quotes should be ignored.
@ -355,6 +466,7 @@ BEGIN
SpecialItem:=DataItem; SpecialItem:=DataItem;
END; END;
{ Handles reading and processing of a textual file} { Handles reading and processing of a textual file}
procedure DoFile; procedure DoFile;
var var
@ -369,7 +481,6 @@ var
PROCEDURE ParseError; PROCEDURE ParseError;
{Extremely simple errorhandler} {Extremely simple errorhandler}
BEGIN BEGIN
Writeln('Error in line : ',Line, ' Somewhere near :',#39,S1,#39); Writeln('Error in line : ',Line, ' Somewhere near :',#39,S1,#39);
Close(InfIle); Close(Outfile); Close(InfIle); Close(Outfile);
@ -379,7 +490,6 @@ END;
PROCEDURE FixDec; PROCEDURE FixDec;
{ Reads decimal value starting at S1[1]. { Reads decimal value starting at S1[1].
Value in I3, number of digits found in I1} Value in I3, number of digits found in I1}
BEGIN BEGIN
I1:=1; I1:=1;
WHILE ((S1[I1]>#47) AND (S1[I1]<#58)) AND (I1<=Length(S1)) DO WHILE ((S1[I1]>#47) AND (S1[I1]<#58)) AND (I1<=Length(S1)) DO
@ -390,9 +500,7 @@ BEGIN
I3:=0; I3:=0;
FOR I2:=1 TO I1 DO FOR I2:=1 TO I1 DO
I3:=(I3*10)+ ORD(S1[I2])-48; I3:=(I3*10)+ ORD(S1[I2])-48;
{Calc no of bytes(1,2 or 4) required from no of digits found} {Calc no of bytes(1,2 or 4) required from no of digits found}
IF (I1<3) THEN IF (I1<3) THEN
I2:=1 I2:=1
ELSE ELSE
@ -413,7 +521,6 @@ END;
PROCEDURE DoChar; PROCEDURE DoChar;
{ Reads a #xxx constant at S1[1], and puts it in msgtxt array. { Reads a #xxx constant at S1[1], and puts it in msgtxt array.
Deletes #xxx constant from S1} Deletes #xxx constant from S1}
BEGIN BEGIN
Delete(S1,1,1); Delete(S1,1,1);
FixDec; FixDec;
@ -427,9 +534,8 @@ PROCEDURE DoQuote;
(always ' or "), any char except the quotechar is allowed between two (always ' or "), any char except the quotechar is allowed between two
quotechars. quotechars.
Deletes quoted textstring incl quotes from S1} Deletes quoted textstring incl quotes from S1}
VAR
VAR C : Char; C : Char;
BEGIN BEGIN
C:=S1[1]; C:=S1[1];
Delete(S1,1,1); Delete(S1,1,1);
@ -451,7 +557,6 @@ PROCEDURE FixHex(base2:LONGINT);
Parameter = 2Log of base (1,3 or 4 corresponding to base 2,8 and 16) Parameter = 2Log of base (1,3 or 4 corresponding to base 2,8 and 16)
Constant is processed, the number of digits estimated (1,2 or 4 bytes) and Constant is processed, the number of digits estimated (1,2 or 4 bytes) and
the value is appended to msgtxt accordingly} the value is appended to msgtxt accordingly}
BEGIN BEGIN
I3:=0; I3:=0;
I2:=1; I2:=1;
@ -519,10 +624,14 @@ PROCEDURE FlushMsgTxt; {Flush MsgTxt array}
BEGIN BEGIN
IF msgsize>0 THEN {In memory? Then flush} IF msgsize>0 THEN {In memory? Then flush}
BEGIN BEGIN
IF ArrayByte THEN case outputmode of
WriteByteFile(outfile,Varname) OutByte :
ELSE WriteByteFile(outfile,Varname);
OutChar :
WriteCharFile(outfile,varname); WriteCharFile(outfile,varname);
OutString :
WriteStringFile(outfile,varname);
end;
msgsize:=0; msgsize:=0;
END; END;
END; END;
@ -538,12 +647,10 @@ begin
{$I+} {$I+}
if ioresult<>0 then if ioresult<>0 then
begin begin
WriteLn('*** message file '+inname+' not found ***'); WriteLn('file '+inname+' not found');
exit; exit;
end; end;
{Create output file} {Create output file}
assign (outfile,outname); assign (outfile,outname);
rewrite(outfile); rewrite(outfile);
msgsize:=0; msgsize:=0;
@ -572,7 +679,6 @@ begin
CASE S1[1] OF {Select field type} CASE S1[1] OF {Select field type}
#39,'"','#' : DoTextual; { handles textual aggregates #39,'"','#' : DoTextual; { handles textual aggregates
e.g. #124"142"#123'sdgf''ads'} e.g. #124"142"#123'sdgf''ads'}
'$' : BEGIN {Handle $xxxx hex codes} '$' : BEGIN {Handle $xxxx hex codes}
Delete(S1,1,1); Delete(S1,1,1);
RTrim(S1,' '); RTrim(S1,' ');
@ -635,11 +741,11 @@ begin
BEGIN BEGIN
FlushMsgTxt; FlushMsgTxt;
I1:=1; I1:=1;
ArrayByte:=FALSE; OutputMode:=OutChar;
IF S[2]='$' THEN {Flag for ARRAY OF BYTE?} IF S[2]='$' THEN {Flag for ARRAY OF BYTE?}
BEGIN BEGIN
INC(I1); INC(I1);
ArrayByte:=TRUE; OutputMode:=OutByte;
END; END;
Delete(S,1,I1); Delete(S,1,I1);
VarName:=S; VarName:=S;
@ -659,6 +765,10 @@ begin
end; end;
{*****************************************************************************
Binary File
*****************************************************************************}
procedure DoBinary; procedure DoBinary;
var var
Infile : File; Infile : File;
@ -666,34 +776,37 @@ var
i : longint; i : longint;
begin begin
Writeln('processing file : ',inname); Writeln('processing file : ',inname);
{Read the message file} { Read the file }
assign(infile,inname); assign(infile,inname);
{$I-} {$I-}
reset(infile,1); reset(infile,1);
{$I+} {$I+}
if ioresult<>0 then if ioresult<>0 then
begin begin
WriteLn('*** message file '+inname+' not found ***'); WriteLn('file '+inname+' not found');
exit; exit;
end; end;
assign (outfile,outname);
rewrite(outfile);
{ First parse the file and count bytes needed } { First parse the file and count bytes needed }
msgsize:=FileSize(InFile); msgsize:=FileSize(InFile);
IF Msgsize>1048576 THEN
msgsize:=1048576;
Getmem(msgtxt,msgsize); Getmem(msgtxt,msgsize);
BlockRead(InFile,msgTxt[0],msgsize,i); BlockRead(InFile,msgTxt[0],msgsize,i);
close(infile);
IF I<>msgsize THEN IF I<>msgsize THEN
BEGIN BEGIN
Writeln('Error while reading file',inName); Writeln('Error while reading file',inName);
HALT(1); HALT(1);
END; END;
IF ArrayByte THEN { Output }
WriteByteFile(outfile,BinconstName) assign (outfile,outname);
ELSE rewrite(outfile);
case outputmode of
OutByte :
WriteByteFile(outfile,BinconstName);
OutChar :
WriteCharFile(outfile,BinconstName); WriteCharFile(outfile,BinconstName);
close(infile); OutString :
WriteStringFile(outfile,BinconstName);
end;
Close(Outfile); Close(Outfile);
end; end;
@ -717,6 +830,7 @@ var
writeln('<Options> can be :'); writeln('<Options> can be :');
writeln(' -B File to read is binary.'); writeln(' -B File to read is binary.');
writeln(' -A array of byte output (default is array of char)'); writeln(' -A array of byte output (default is array of char)');
writeln(' -S array of string output');
writeln(' -V Show version'); writeln(' -V Show version');
writeln(' -? or -H This HelpScreen'); writeln(' -? or -H This HelpScreen');
writeln; writeln;
@ -727,7 +841,7 @@ var
begin begin
I_binary:=FALSE; I_binary:=FALSE;
ArrayByte:=FALSE; OutputMode:=OutChar;
FIles:=0; FIles:=0;
for i:=1to paramcount do for i:=1to paramcount do
begin begin
@ -738,7 +852,8 @@ begin
delete(para,1,2); delete(para,1,2);
case ch of case ch of
'B' : I_Binary:=TRUE; 'B' : I_Binary:=TRUE;
'A' : Arraybyte:=TRUE; 'A' : OutputMode:=OutByte;
'S' : OutputMode:=OutString;
'V' : begin 'V' : begin
Writeln('Data2Inc ',version,' (C) 1999 Peter Vreman and Marco van de Voort'); Writeln('Data2Inc ',version,' (C) 1999 Peter Vreman and Marco van de Voort');
Writeln; Writeln;
@ -767,9 +882,7 @@ begin
end; end;
begin begin
MaxBufSize:=100000;
GetPara; GetPara;
IF I_Binary THEN IF I_Binary THEN
DoBinary DoBinary
ELSE ELSE
@ -777,7 +890,11 @@ begin
end. end.
{ {
$Log$ $Log$
Revision 1.1 1999-11-09 14:40:50 peter Revision 1.2 1999-11-23 09:42:18 peter
+ -s for string writing
* some small cleanups
Revision 1.1 1999/11/09 14:40:50 peter
* initial version * initial version
} }