Return to genpack.pl CVS log

Up to [Synchronet] / sbbs / src / xpdev

Annotation of sbbs/src/xpdev/genpack.pl, revision 1.1

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.