![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to genpack.pl CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Synchronet] / sbbs / src / xpdev|
Return to genpack.pl CVS log | Up to [Synchronet] / sbbs / src / xpdev |
1.1 root 1: #!/usr/bin/perl
2:
3: if($#ARGV != 2) {
4: print <<ENDOFUSAGE;
5: Usage: $0 infile.h outhead.h outprog.c
6:
7: ENDOFUSAGE
8: exit(1);
9: }
10:
11: my ($infile, $outhead, $outc) = @ARGV;
12: open IN,'<',$infile;
13:
14: while (<IN>) {
15: $header .= $_;
16: }
17: close IN;
18:
19: my $defs='';
20: my $protos='';
21: my $functions='';
22:
23: my $count = 0;
24: my @structs = ();
25: while($header =~ m/struct\s+([^\s\r\n]*)[\s\r\n]+{([^}]*)}/gs) {
26: my($name, $def) = ($1,$2);
27: my ($packcode, $unpackcode, $size, @ints) = parse_defs($name, $def);
28: if(defined $size) {
29: $count++;
30: push @structs,"+ $name";
31: $defs .= $size;
32: $protos .= "int pack_$name\_struct(char *buf, struct $name *data);\n";
33: $protos .= "int unpack_$name\_struct(struct $name *data, char *buf);\n";
34: $functions .= "int pack_$name\_struct(char *buf, struct $name *data)\n";
35: $functions .= "{\n";
36: $functions .= "\tchar\t*p;\n";
37: if($#ints >= 0) {
38: $functions .= "\tint\t\t".join(', ',@ints).";\n";
39: }
40: $functions .="\n\tp = buf;\n";
41: $functions .= $packcode;
42: $functions .="\n\treturn((int)(p-buf));\n}\n\n";
43: $functions .= "int unpack_$name\_struct(struct $name *data, char *buf)\n";
44: $functions .= "{\n";
45: $functions .= "\tchar\t*p;\n";
46: if($#ints >= 0) {
47: $functions .= "\tint\t\t".join(', ',@ints).";\n";
48: }
49: $functions .="\n\tp = buf;\n";
50: $functions .= $unpackcode;
51: $functions .="\n\treturn((int)(p-buf));\n}\n\n";
52: }
53: else {
54: push @structs,"! $name";
55: }
56: }
57:
58: if($count) {
59: open HEAD,'>',$outhead;
60: open C,'>',$outc;
61:
62: print HEAD "/* Generated by genpack.pl from $infile on ".(scalar localtime(time))." */\n\n";
63: my $macro = uc($outhead);
64: $macro=~s/[^A-Z0-9]/_/g;
65: print HEAD '#ifndef _INCLUDED_',$macro,"\n";
66: print HEAD '#define _INCLUDED_',$macro,"\n\n";
67: print HEAD "#include \"$infile\"\n#include \"xpendian.h\"\n\n";
68: print HEAD "/* *_SIZE macros are the packed buffer size requred */\n";
69: print HEAD $defs;
70: print HEAD "\n/* Function prototypes */\n";
71: print HEAD "#if defined(__cplusplus)\nextern \"C\" {\n#endif\n";
72: print HEAD $protos;
73: print HEAD "#if defined(__cplusplus)\n}\n#endif";
74: print HEAD "\n\n";
75: print HEAD "#endif /* Do not add anything after this line! */\n";
76: close HEAD;
77:
78: open C,'>',$outc;
79: print HEAD "/* Generated by genpack.pl from $infile on ".(scalar localtime(time))." */\n\n";
80: print C "#include \"$outhead\"\n\n";
81: print C $functions;
82: print C "\n";
83: close C;
84:
85: print "$count structures read successfully\n+ indicates functions were created\n! indicates a failure\n\n";
86: print join("\n", @structs),"\n";
87: }
88: else {
89: print "No structures imported... files not created.\n";
90: }
91:
92: sub parse_defs
93: {
94: my ($sname, $defs)=@_;
95:
96: my $packcode='';
97: my $unpackcode='';
98: my %vars=();
99: my %sizes=();
100:
101: # Remove comments
102: $defs=~s|/\*.*?\*/||gs;
103: my @lines=split(/[\r\n]+/, $defs);
104: foreach my $line (@lines) {
105: my ($p, $u);
106: my @newvars;
107: my $this_size=0;
108: chomp $line;
109: next if($line =~ /^\s*$/);
110: if($line =~ m/^\s*((?:char)|(?:BYTE)|(?:INT16)|(?:WORD)|(?:INT32)|(?:DWORD)|(?:float))\s+([^\s]+)\s*;\s*$/) {
111: my ($type, $name) = ($1, $2);
112: ($p, $u, @newvars) = parse_line(\%sizes, $type, $name, 0);
113: }
114: elsif($line =~ m/^\s*struct\s+([^\s]+)\s+([^\s]+)\s*;\s*$/) {
115: my ($struct, $name) = ($1, $2);
116: ($p, $u, @newvars) = parse_line(\%sizes, $struct, $name, 1);
117: }
118: else {
119: print "Cannot parse: $line\n";
120: return();
121: }
122: if(!defined $u) {
123: return();
124: }
125: @vars{@newvars}=@newvars;
126: $packcode .= $p;
127: $unpackcode .= $u;
128: }
129: my $sizedef = '#define '.uc($sname)."_SIZE\t(";
130: foreach my $key (keys %sizes) {
131: if(defined $sizes{$key}{count} && !defined $sizes{$key}{multiplier}) {
132: if($sizes{$key}{count} == 1) {
133: $sizedef .= "$key + ";
134: }
135: else {
136: $sizedef .= "($key * $sizes{$key}{count}) + ";
137: }
138: }
139: elsif(!defined $sizes{$key}{count} && defined $sizes{$key}{multiplier}) {
140: $sizes{$key}{multiplier} = substr($sizes{$key}{multiplier}, 0, -3);
141: $sizedef .= "($key * ($sizes{$key}{multiplier})) + ";
142: }
143: elsif(defined $sizes{$key}{count} && defined $sizes{$key}{multiplier}) {
144: $sizes{$key}{multiplier} = substr($sizes{$key}{multiplier}, 0, -3);
145: $sizedef .= "($key * ($sizes{$key}{count} + $sizes{$key}{multiplier})) + ";
146: }
147: }
148: $sizedef = substr($sizedef, 0, -3) . ")\n";
149: return($packcode, $unpackcode, $sizedef, sort keys %vars);
150: }
151:
152: sub parse_line
153: {
154: my ($sizes, $type, $name, $struct) = @_;
155: my $tabs = "\t";
156: my $end = '';
157: my %vars=();
158: my $nextint='i';
159: my ($packcode, $unpackcode);
160: my $sizekey;
161:
162: if($struct) {
163: $sizekey = uc($type).'_SIZE';
164: }
165: else {
166: $sizekey = "sizeof($type)";
167: }
168: if($name =~ /\[/) { # Handle arrays!
169: while($name =~ s/\[([^\]]+)\]/;$nextint;/) {
170: my $size = $1;
171: $packcode .= $tabs."for($nextint = 0; $nextint < $size; $nextint++) {\n";
172: $unpackcode .= $tabs."for($nextint = 0; $nextint < $size; $nextint++) {\n";
173: $sizes->{$sizekey}{multiplier} .= "$size * ";
174: $end = "$tabs}\n$end";
175: $tabs .= "\t";
176: $vars{$nextint}=1;
177: $nextint=chr(ord($nextint)+1);
178: }
179: $sizes->{$sizekey}{multiplier} = substr($sizes->{$sizekey}{multiplier}, 0, -3);
180: $sizes->{$sizekey}{multiplier} .= ' + ';
181: $name =~ s/;(.);/[$1]/g;
182: }
183: else {
184: $sizes->{$sizekey}{count}++;
185: }
186: $name = "data->$name";
187: my ($p, $u) = pack_line($type, $name, $struct, $tabs);
188: $p = "$packcode$p$end";
189: $u = "$unpackcode$u$end";
190: return($p, $u, sort keys %vars);
191: }
192:
193: sub pack_line
194: {
195: my ($type, $name, $struct, $tabs)=@_;
196: my $packcode = '';
197: my $unpackcode = '';
198:
199: # ie: *(INT32)p = LE_LONG($name);
200: if(!$struct) {
201: if($type eq 'char') {
202: $packcode .= $tabs."*p = $name;\n";
203: $packcode .= $tabs."p++;\n";
204: $unpackcode .= $tabs."$name = *p;\n";
205: $unpackcode .= $tabs."p++;\n";
206: }
207: elsif($type eq 'BYTE') {
208: $packcode .= $tabs."*(BYTE *)p = $name;\n";
209: $packcode .= $tabs."p++;\n";
210: $unpackcode .= $tabs."$name = *(BYTE *)p;\n";
211: $unpackcode .= $tabs."p++;\n";
212: }
213: elsif($type eq 'INT16') {
214: $packcode .= $tabs."*(INT16 *)p = LE_SHORT($name);\n";
215: $packcode .= $tabs."p += sizeof(INT16);\n";
216: $unpackcode .= $tabs."$name = LE_SHORT(*(INT16 *)p);\n";
217: $unpackcode .= $tabs."p += sizeof(INT16);\n";
218: }
219: elsif($type eq 'WORD') {
220: $packcode .= $tabs."*(WORD *)p = LE_SHORT($name);\n";
221: $packcode .= $tabs."p += sizeof(WORD);\n";
222: $unpackcode .= $tabs."$name = LE_SHORT(*(WORD *)p);\n";
223: $unpackcode .= $tabs."p += sizeof(WORD);\n";
224: }
225: elsif($type eq 'INT32') {
226: $packcode .= $tabs."*(INT32 *)p = LE_LONG($name);\n";
227: $packcode .= $tabs."p += sizeof(INT32);\n";
228: $unpackcode .= $tabs."$name = LE_LONG(*(INT32 *)p);\n";
229: $unpackcode .= $tabs."p += sizeof(INT32);\n";
230: }
231: elsif($type eq 'DWORD') {
232: $packcode .= $tabs."*(DWORD *)p = LE_LONG($name);\n";
233: $packcode .= $tabs."p += sizeof(DWORD);\n";
234: $unpackcode .= $tabs."$name = LE_LONG(*(DWORD *)p);\n";
235: $unpackcode .= $tabs."p += sizeof(DWORD);\n";
236: }
237: elsif($type eq 'float') {
238: $packcode .= $tabs."*(DWORD *)p = LE_LONG(*((DWORD *)&($name)));\n";
239: $packcode .= $tabs."p += sizeof(float);\n";
240: $unpackcode .= $tabs."*(((DWORD *)&($name))) = LE_LONG(*(DWORD *)p);\n";
241: $unpackcode .= $tabs."p += sizeof(DWORD);\n";
242: }
243: else {
244: print "Unhandled type: $type\n";
245: return(undef, undef);
246: }
247: }
248: else {
249: $packcode .= $tabs."p += pack_$type\_struct(p, &($name));\n";
250: $unpackcode .= $tabs."p += unpack_$type\_struct(&($name), p);\n";
251: }
252:
253: return($packcode, $unpackcode);
254: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.