#!/usr/bin/perl # # icd-c >>>>>" # fields that flag subrecords. This backwards scan is done to satisfy C's # need for having things defined before they are used; the ICD is backwards # from C's viewpoint, since it puts definitions after their uses. After this # scan, a top-down scan is done to try to recognize the top-level records # (whose order doesn't matter to C). # # Some editing of the file may be necessary. Lines starting with '#' are # ignored, so you can comment out incompleted portions of the file. Within # fields other than the "U(*)" type fields, stuff within parens is usually # treated as comment and discarded; you can use this feature to preserve info # that you want this program to ignore. # # A useful kludge: If an input line starts with "END", it will be treated as # end-of-file. This can be useful during initial tests to cut down on the # amount of input. It may also be used to trim away final stuff that isn't # quite defined yet, since such stuff tends to be at the tail of the file. # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - push(@INC,'sh','../sh'); require 'cmagic.pl'; require 'cname.pl'; require "timewheel.pl"; &init(); # Assorted global initialization. # Open our output files: open(C,">cm4_record.c") || die "### Can't write to cm4_record.c [$!]\n"; open(F,">cm4_fields.h") || die "### Can't write to cm4_fields.h [$!]\n"; open(E,">icd.err") || die "### Can't write to icd.err [$!]\n"; open(L,">icd.log") || die "### Can't write to icd.log [$!]\n"; open(M,">cm4_record.h") || die "$0 ### Can't write to cm4_record.h [$!]\n"; open(O,">icd.can") || die "### Can't write to icd.can [$!]\n"; open(T,">icd.t") || die "### Can't write to icd.t [$!]\n"; # Unbuffer some of these files for debugging purposes: #select(E); $| = 1; #select(L); $| = 1; select(M); $| = 1; #select(O); $| = 1; select(STDOUT); $|=1; &boilerplate1(); # Initialize the output files. print L "===================================================\n"; # Now gobble up the input, line at a time: print STDERR "\b*\tReading ICD file ...\n"; print L "Pass 1 [input]\n"; while (<>) { # Eat the input line at a time. $line++; # Count lines of input. print C "/* ICD line $line */\n"; s/\s+$//; # Strip away final white stuff. next if /^#/; # Ignore lines with '#' in column 1. @fld = split(' *\t *'); # Break the line apart at TABs. next unless @fld; # Skip blank lines. last # Kludge to truncate processing. if $fld[1] eq 'END'; &canon(); # Canonicalize the fields. &line(); # Attempt to parse the line. } print L "===================================================\n"; # Second pass, in which we wander around in the %flds spreadsheet, looking for # stuff to anyalyze and translate to C. First, we hit all the sub-record flags # that were spotted in the canon routine during initial input. print L "Pass 2 [subrecords]\n"; &subrecords(); print L "===================================================\n"; print L "Pass 2 [toprecords]\n"; &toprecords(); print L "===================================================\n"; print L "Pass 3 [defrecords]\n"; &defrecords(); &boilerplate2(); # Finish up the output files. exit 0; # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Fill in some initial boilerplate in the output files: sub boilerplate1 { print C "#include \"dbg.h\"\n"; print C "#include \"cm4_record.h\"\n"; print C "\n"; print F "#ifndef cm4_field_h\n"; print F "#define cm4_field_h\n"; print F "\n"; print M "#ifndef cm4_record_h\n"; print M "#define cm4_record_h\n"; print M "\n"; print M "#include \"abbr.h\"\n"; print M "#include \"cm4_hdr.h\"\n"; # print M "#include \"cm4_msgtyp.h\"\n"; print M "\n"; print M "#define XXX int\n"; print M "\n"; } # - - - - - - - - - - - - - - - - - - - - - - - - - - # # Fill in some final boilerplate in the output files: # # - - - - - - - - - - - - - - - - - - - - - - - - - - # sub boilerplate2 { print STDERR "\b*\tDone with ICD.\n"; print C "main() {\n"; print C "\texit(0);\n"; print C "}\n"; print F "\n"; print F "#endif\n"; print M "\n"; print M "#define CM4_MSGMAX $maxsiz\n"; print M "\n"; print M "#endif\n"; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Canonicalize the current line. We run thru the fields, and make some simple # # transformations. We reduce assorted "comment" fields to a single '-', which # # serves as a placeholder, but should generally be ignored elsewhere. The end # # result is also put into %flds, the entire spreadsheet, for later perusal # # when we need to look back. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # sub canon { local($c,$f); printf L "Line %2d has %2d fields --------------------------\n", $line, $#fld; if ($fld[1] =~ s/^([Dd]eleted*\s+)//) { printf L "Line %3d col %2d: Delete of \"%s\" ...\n", $line, $c, $fld[1]; if ($fld[1] =~ s/\s+([ 0-9\/]*)$//) { printf L "Line %3d col %2d: Delete of \"%s\" recognized (%s).\n", $line, $c, $fld[1], $1; $delete{$1} = $2; } else { printf E "Line %3d col %2d: Ignoring apparent delete.\n",$line, $c; printf L "Line %3d col %2d: Ignoring apparent delete.\n",$line, $c; } $fld[1] = ''; } if ($fld[1] =~ s/^([Uu]pdated*\s+)//) { printf L "Line %3d col %2d: Update of \"%s\" ...\n", $line, $c, $fld[1]; if ($fld[1] =~ s/\s+([ 0-9\/]*)$//) { printf L "Line %3d col %2d: Update of \"%s\" recognized (%s).\n", $line, $c, $fld[1], $1; $update{$1} = $2; } else { printf E "Line %3d col %2d: Ignoring apparent update.\n",$line, $c; printf L "Line %3d col %2d: Ignoring apparent update.\n",$line, $c; } $fld[1] = ''; } if ($fld[1] =~ s/^([Aa]dded\s+)//) { printf L "Line %3d col %2d: Add of \"%s\" ignored.\n", $line, $c, $fld[1]; $fld[1] = ''; } for ($c=1; $c <= $#fld; $c++) { # Debug display of the raw input. $f = $fld[$c]; printf L "Line %3d col %2d: < \"%s\"\n", $line, $c, $f; $f =~ s/^\s+//; # Strip out initial spaces. $f =~ s/[*\s]+$//; # Strip out final spaces and asterisks. $f =~ s/^"\s*(.*)\s*"$/\1/; # Strip away quotes. $f =~ s/""/"/g; # Reduce pairs of quotes. $f =~ s/\s*\([Nn]ote.*//g; # Strip away (note ...) comments. $f =~ s/^[Rr]ecord\s*\d+:.*//g; # Wipe out "record N: ..." comments. if ($f =~ /^\*+\s*/) { # Initial asterisks flag comments. printf L "Line %3d col %2d: Drop \"%s\"\n", $line, $c, $f; $f = '-'; } elsif ($f =~ /^[Nn]ote\s+/) { printf L "Line %3d col %2d: Drop \"%s\"\n", $line, $c, $f; $f = '-'; } elsif ($f =~ /(Add|No)\s+MIB\s+Object/) { printf L "Line %3d col %2d: Drop \"%s\"\n", $line, $c, $f; $f = ''; } elsif ($f =~ /Add MIB Object/) { printf L "Line %3d col %2d: Drop \"%s\"\n", $line, $c, $f; $f = ''; } elsif ($f =~ /No MIB Object/) { printf L "Line %3d col %2d: Drop \"%s\"\n", $line, $c, $f; $f = ''; } elsif ($f =~ /name change from/) { # Pure kludgery. printf L "Line %3d col %2d: Drop \"%s\"\n", $line, $c, $f; $f = ''; } elsif ($f =~ $recfld) { printf L "Line %3d col %2d: Subrecord flag.\n",$line, $c; push(@subflags,"$line:$c"); &timewheel(); $f = $recfld; # Make them all the same length. } if ($f ne $fld[$c]) { # Was anything changed? printf L "Line %3d col %2d: > \"%s\"\n", $line, $c, $f; $fld[$c] = $f; } $SS{$line,$c} = $f; # The entire spreadsheet. $cols[$line] = $c # Note max column in each line. if ($cols[$line] < $c); } print O "@fld\n"; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # This routine runs thru the list of def-record positions in @defflags, # # looking at each of the entries in %flds, and deciding whether to produce a # # struct for the def-record. Note that we scan the list backwards; this is # # necessary to ensure that defrecords are generated before their references. # # This works as long as the spreadsheet always has the references before the # # record definitions. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # sub defrecords { local($row,$col,$rr,$cc); # The position of a def-record flag. local($rec,$drec); local($aln,$daln); local($dmp,$ddmp); local($siz,$dsiz); local($defs,$ff); local($ddev,$dprt,$dptp,$dev,$prt,$ptp); local($lo,$hi); # Rows suspected of containing record defs. print STDERR "\b*\tDefined records ...\n"; print M "/*\n"; print M "* Defined records:\n"; print M "*/\n"; $hi = $line; for ($row = $line; $row > $line - 100; $row --) { for ($col = 1; $col <= $cols[$row]; $col ++) { $ff = $SS{$row,$col}; if ($ff =~ /List of (.*) message types/) { $lo = $row + 1; print L "Defined records start at row $row col $col.\n"; $drec = &cname($Rec . $1); # C record name. $daln = &cname($Aln . $1); # C alignment symbol. $dpad = &cname($Pad . $1); # C pad symbol. $ddmp = &cname($Dmp . $1); # C dump routine.. $dsiz = &cname($Siz . $1); # C size symbol. $ddev = &cname($Dev . $1); # C size symbol. $dprt = &cname($Prt . $1); # C size symbol. $dptp = &cname($Ptp . $1); # C size symbol. for ($rr = $lo; $rr <= $hi; $rr ++) { last if (!$SS{$rr,$col}); &timewheel(); for ($cc = 1; $cc <= $cols[$rr]; $cc ++) { $ff = $SS{$rr,$cc}; if ($ff =~ /\s*(.+)\s*/) { ++$defs; $rec = &cname($Rec . $1); $aln = &cname($Aln . $1); $dmp = &cname($Dmp . $1); $siz = &cname($Siz . $1); print M "#define $rec $drec\n"; print M "#define $aln $daln\n"; print M "#define $siz $dsiz\n"; print M "#define $dmp $ddmp\n"; } else { print L "Row $rr col $cc no match: \"$ff\"\n"; } } } } else { print L "Row $row col $col no match: \"$ff\"\n"; } } } print L "Done with $defs defined records starting at row $row col $col.\n"; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Global initialization of arrays, lists and tables. The main reason for this # # routine is to reduce the clutter at the top of the program. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # sub init { # First, some simple variables: $, = "\t"; # The printf field separator. $" = "\t"; # The string field separator. $[ = 1; # Base-1 indexing is most convenient in this program. $mibvar = '[#a-z][-^#_a-z0-9]*[A-Z][-_#A-Za-z0-9]+'; $recfld = '>>>>>'; # Indicates sub-record definition. $state = 'init'; # What sort of stuff are we looking at right now? $Rec = 'CM4_'; # Prefix for record struct name. $Dmp = 'DM4_'; # Prefix for dump routine name. $Typ = 'CT4_'; # Prefix for message-type symbol. $Aln = 'CA4_'; # Prefix for record-alignment symbol. $Pad = 'CP4_'; # Prefix for record-alignment symbol. $Siz = 'CS4_'; # Prefix for record-size symbol. $Dev = 'Cd4_'; # Prefix for Device field name. $Prt = 'Cp4_'; # Prefix for Port field name. $Ptp = 'Ct4_'; # Prefix for PortType field name. $Str = '_CM4_'; # Prefix for C structure name. $Off = 'CO4_'; # Prefix for field offset. $Len = 'CL4_'; # Prefix for field length. # Next, some global tables, mostly for documentation: %recalign = (); # Byte alignment for records, if known. %recdone = (); # Names and positions of records that we've produced. %recsize = (); # Byte count for records, if known. # And finally, some global lists: %eim32kludge = ( "PortFaults", 1, "EIMPortFaultMask", 1, ); %sfm72kludge = ( "SFMInputPortFaults", 1, "SFMInputPortFaultMask", 1, "SFMOutputPortFaults", 1, "SFMOutputPortFaultMask", 1, ); @subflags = (); # List of "row:col" positions where $recfld was found. @topflags = (); # List of "row:1" positions where main records were found. @Itype = ( # Signed integer types. 'char','I16','','I32','','','','I64', ); @Utype = ( # Unsigned integer types supported by C. 'byte','U16','','U32','','','','U64', ); %DevKeys = ( # Names of DeviceID key fields. "CMID", 1, "DeviceID", 1, "NodeID", 1, "SFMID", 1, "VPCI", 1, ); %PortKeys = ( # Names of PortID key fields. "PortID", 1, "SFMOutputPortID", 1, "SFMPortID", 1, "SFMoutputPortID", 1, "SourcePortID", 1, ); %PtypeKeys = ( # Names of PortType key fields. "PortType", 1, "SFMPortType", 1, ); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # The current input line has been broken into fields in $fld; this routine # # determines what sort of line it is, and invokes an appropriate routine to # # process it. This is a somewhat ad-hoc operation, depending on what we can # # find to characterize a line of the spreadsheet. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # sub line { local($f,$size); if ($fld[1] =~ /^name changed/i) { printf L "Line %3d col %2d: Name change ignored.\n",$line, 1; $fld[1] = '-'; } elsif ($fld[1] =~ /^\(.*\)/) { printf L "Line %3d col %2d: Parenthesized comment ignored.\n",$line, 1; ; } elsif ($fld[1] =~ /^([A-Z].*)\.(notify|request|reply)/) { print L "Recognized new record [$1 $2 [notify|request|reply]\n"; push(@topflags,"$line:1"); &timewheel(); } elsif ($fld[1] =~ /(.*) \((\d*) [Bb]ytes\)/) { print L "Recognized new record [$1 $2 bytes].\n"; push(@topflags,"$line:1"); &timewheel(); } elsif (($fld[1] =~ /(.*\.progress)/) || ($fld[1] =~ /(.*\.request)/) || ($fld[1] =~ /(.*\.reply)/) ) { print L "Recognized new record [$1 [progress|request|reply]\n"; push(@topflags,"$line:1"); &timewheel(); } elsif (($fld[1] =~ /\s*Byte position/) || ($fld[2] =~ /^bytes \d/)) { print L "We are in a top-level record.\n"; } elsif (($fld[1] =~ /\s*Message field data type/) || ($fld[2] =~ /^[Cc]har\(\d/)) { } elsif ($fld[3] =~ /"\d+",\s*"\d+",\s*"\d+"/) { # Kludge: multiple message type codes. print L "Recognized type-kludge in field 3.\n"; } elsif (!($fld[1] || $fld[2] || $fld[3])) { print L "Possible subrec line [flds 1-3 empty]\n"; } else { printf L "Line %2d not recognized line format.\n", $line; } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Locate the data for the field whose name is at ($row,$col). The return # # value is a LIST (type, multiplier, desciption, offset, size, align). As an # # aside, this routine notes the offset and length of the field, and writes # # #define symbols for the variable(s) to the file F. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # sub recfield { local($row,$col) = @_; local($r,$c); # Somewhere near ($row,$col). local($f,$x); # Field's contents. local($type) = 'XXX'; local($mult, $desc, $oset, $size, $align, $const, $indx); local($desc,$vars); local($l,$o,$t,$tv,$v); # For offset/length symbols. $desc = "[$row,$col]"; # Default description is position in input. for ($r = $row-1; $r > $row-5; $r--) { # Look backward at most 10 rows. last if (!($f = $SS{$r,$col})); if ($f =~ /^($mibvar)[*#]*$/) { # Likely MIB-variable name? print L "Row $r col $col: \"$f\" is MIB variable.\n"; if ($f =~ /-$/) { # Hyphenated name? $x = $SS{$r+1,$col}; # Pick off the continuation. $f =~ s/-$/$x/; # Join the two names. } $f =~ s/-+/_/g; # Convert hyphens to underscores. ($const, $x) = &cmagic($f); # Capitalized magic symbol. $desc = "$desc $f"; $vars = "$vars $f"; } } for ($r = $row+1; $r < $row+10; $r++) { # Look forward at most 10 rows. if ($f = $SS{$r,$col}) { print L "Row $r col $col: \"$f\"\n"; if ($f =~ /^U\((\d+)\)$/) { print L "Row $r col $col: \"$f\" is U($1)\n"; if ($type = $Utype[$size = $align = $1]) { last; # It's a C integer type. } else { print L "Row $r col $col: U($1) not supported by C.\n"; $type = 'byte'; # Convert to byte array. $size = 1; $mult = $1; $align = 1; print L "Row $r col $col: U($1) converted to ${type}[$size]\n"; } } elsif ($f =~ /^(\d)+\s*\[U\s*\((\d+)\)\s*\]$/) { print L "Row $r col $col: \"$f\" is $1[U($2)\]\n"; $type = $Utype[$size = $align = ($2 || 4)] || 'XXX'; $mult = $1; $indx = "[$mult]" if $mult > 1; last; } elsif ($f =~ /^chars*\((\d+)\)$/i) { print L "Row $r col $col: \"$f\" is char()\n"; $type = 'char'; $size = 1; $mult = $1; $indx = "[$mult]" if $mult > 1; last; } elsif ($f =~ /^bitstring*\((\d+)\)$/i) { print L "Row $r col $col: \"$f\" is char()\n"; $type = 'byte'; $size = 1; $mult = $1; $indx = "[$mult]" if $mult > 1; last; } elsif ($f =~ /^(\d+)\s*\[bitstring*\((\d+)\)\s*\]$/i) { print L "Row $r col $col: \"$f\" is char()\n"; $type = 'byte'; $size = 1; $mult = $1 * $2; $indx = "[$mult]" if $mult > 1; last; } elsif ($f =~ /^bytes\s*(\d+)-(\d+)$/i) { $oset = $1 - 1; $size = $2 - $oset; print L "Row $r col $col: Offset $oset size $size.\n"; } elsif ($f =~ /^(\d+)-(\d+)$/i) { $oset = $1 - 1; $size = $2 - $oset; print L "Row $r col $col: Offset $oset size $size.\n"; } else { print L "Bad $r col $col: \"$f\"\n"; } } } if ($recname =~ /_progress$/) { $t = 'P_'; } elsif ($recname =~ /_request$/) { $t = 'R_'; } if ($t && $vars) { for $v (split(/\s/,$vars)) { if ($v =~ /^\w+$/) { $tv = "$t$v"; if (!(($recname =~ /_progress$/) || ($recname =~ /_request/))) { print L "-- $tv suppressed in $recname\n"; print F "/* $tv suppressed in $recname */\n"; } elsif ($off{$tv} || $len{$tv}) { print L "-- $tv suppressed in $recname; already has off=$off{$tv} len=$len{$tv}\n"; print F "/* $tv suppressed in $recname; already has off=$off{$tv} len=$len{$tv} */\n"; } elsif (($o = $oset) && ($l = $mult || $size)) { $off{$tv} = $o; $len{$tv} = $l; print L "#define $Off$tv $o\n"; print L "#define $Len$tv $l\n"; print F "#define $Off$tv $o\t/* $recname */\n"; print F "#define $Len$tv $l\t/* $recname */\n"; } else { print L "Missing off for $tv\n" if (!$o); print L "Missing len for $tv\n" if (!$l); } } } } ($type, $mult, $desc, $oset, $size, $align, $const, $indx, $vars); } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -# # Locate the fields for the record whose header starts at ($row,$col). This # # routine will produce the declarations for each field encountered. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -# sub recfields { local($row,$col) = @_; local($r, $c); # Somewhere near ($row,$col). local($f); # Field's contents. local($offset); # Offset to current field. local($name); # Field's C name and type. local($type) = 'XXX'; # Field's type, if known. local($const); # Constant "magic" symbol. local($desc,$vars); # Comments and variable names for the field. local($mult); # Size, if field is array. local($indx); # Dimensions, if field is array. local($os, $oset); # Offset of field, from input and calculated. local($pad); # Pad bytes needed for C's alignment rules. local($rname); # Record that contains the field (not implemented yet). local($size); # Size of field, in bytes. local($alfld,$alrec); # Alignment of field and record: 0=unaligned, or power of 2. $oset = $alfld = $alrec = $size = 0; for ($c=$col+1; $c <= $cols[$row]; $c++) { $f = $SS{$row,$c}; $f =~ s/\s*\(.*\)\s*//g; # Treat parenthesized stuff as comment. print L "Row $row col $c: \"$f\"\n"; next unless ($f); # Skip over null fields. last if ($f =~ $recfld); # Stop if we hit a sub-record. if ($f =~ /^sw/) { # Stop if field looks like a MIB variable. print E "Row $row col $c: \"$f\" invalid field name\n"; last; } $name = &cname($f); if ($name =~ /(\d*)\s*(.*)([Rr]ecords*)$/) { $name = &cname($2); print L "Found a sub-record field \"$name\"\n"; $mult = $1; $indx = "[$mult]" if $mult > 1; $type = &cname("$Rec$2"); $size = $recsize{$type}; $alfld = $recalign{$type}; $const = ''; $desc = "[$row,$c]"; $rname = $name . '.'; # We don't know how to do this yet. if ($offname{"$Off$name"}) { print E "Row $row col $c: \"$Off$name\" already defined.\n"; } else { print M "#define $Off$name $oset\t/* Offset */\n"; $offname{"$Off$name"} ++; } } else { ($type, $mult, $desc, $os, $size, $alfld, $const, $indx, $vars) = &recfield($row,$c); if ($recname =~ /^[a-z]/) { $rname = "$recname.$name"; } else { $rname = $name; } } printf M " %-4s %s", $type, $name; if ($indx) { # Was an explicit index string generated? if ($indx eq '[32]' && $eim32kludge{$name}) { print M "[4][8]"; # Replace [32] with [4][8] for these fields. } elsif ($indx eq '[72]' && $sfm72kludge{$name}) { print M "[9][8]"; # Replace [72] with [9][8] for these fields. } else { print M "$indx"; # Field is array. } } elsif ($mult) { # Is the field repeated $mult times? if ($mult == 32 && $eim32kludge{$name}) { print M "[4][8]"; # Replace [32] with [4][8] for these fields. } elsif ($mult == 72 && $sfm72kludge{$name}) { print M "[9][8]"; # Replace [72] with [9][8] for these fields. } else { print M "[$mult]"; # Field is array. } } $size *= $mult if $mult > 1; # Total field size. print M ";\t/* "; print M "$oset:$size"; print M " $desc" if $desc; print M " */"; $RecDkey{$rec} = $name if ($DevKeys{$name} && !$RecDkey{$rec}); # Note DeviceID field. $RecPkey{$rec} = $name if ($PortKeys{$name} && !$RecPkey{$rec}); # Note PortID field. $RecTkey{$rec} = $name if ($PtypeKeys{$name} && !$RecTkey{$rec}); # Note PortType field. if ($alfld) { if ($oset % $alfld) { # Does the field have an alignment? printf E "Line %3d col %3d: Misaligned field $name in $rec.\n", $row, $c; printf E "Line %3d col %3d: Field %s is type %d size %d align %d.\n", $row, $c, $name, $type, $size, $alfld; print M "\t/* MISALIGNED */" } $alrec = $alfld if ($alfld > $alrec); # Rec alignment is max of fields. } print M "\n"; print T "$vars $recname $const $rname\n" if $vars && $const && $rname; $oset += $size; # Offset to next field. } if ($alrec) { $recalign{$rec} = $alrec; # Byte alignment for records, if known. if ($pad = $oset % $alrec) { print E "Line %3d col %3d: %d bytes pad needed.\n"; print M " char PAD[$pad];\t/* Pad to multiple of $alrec */\n"; $recpad{$rec} = $pad; } } if ($oset) { $recsize{$rec} = $oset; # Note size of record. } else { printf E "Line %3d col %3d: ### No fields in $rec.\n", $row, $c; print M " XXX filler;\n"; } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # This routine runs thru the list of sub-record positions in @subflags, # # looking at each of the entries in %flds, and deciding whether to produce a # # struct for the sub-record. Note that we scan the list backwards; this is # # necessary to ensure that subrecords are generated before their references. # # This works as long as the spreadsheet always has the references before the # # record definitions. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # sub subrecords { local($row,$col); # The position of a sub-record flag. local($i,$j); print STDERR "\b*\tSub-records ...\n"; print M "/*\n"; print M "* Sub-records:\n"; print M "*/\n"; for ($i = $#subflags; $i > 0; $i--) { &timewheel(); $subflag = $subflags[$i]; ($row, $col) = split(':',$subflag); print L "Check sub-record flag in ($row,$col) ...\n"; &recdef($row,$col); $j = $i; print L "Done with subflags[$i]\n"; } print L "Done with subflags, i=$i j=$j\n"; } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # This routine runs thru the list of top-record positions in @topflags, # # looking at each of the entries in %flds, and deciding whether to produce a # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # struct for the toprecord. sub toprecords { local($row,$col); # The position of a top-record flag. local($i); print STDERR "\b*\tMain records ...\n"; print M "/*\n"; print M "* Main records:\n"; print M "*/\n"; print M "\n"; for $topflag (@topflags) { &timewheel(); ($row, $col) = split(':',$topflag); print L "Check top-record flag in ($row,$col) ...\n"; &recdef($row,$col); } } # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # # Analyze the record name or sub-record flag found in $SS{$row,$col}. We look # # backward for the name of a sub-record; if we find it (or this is a # # top-level record), we put out the header for the C struct, and call # # subfields to figure out the fields. No return value for now. # # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - # sub recdef { local($row,$col) = @_; local($rec,$str,$siz); # C type, struct and size names. local($dev,$pad,$port,$ptype); local(@recs); # Kludge to handle multi-name records. local($suff); # Final part of complex record name. local($r, $x); # Look upward for the record's name: if ($col > 1) { # Column is positive for sub-records. print L "Row $row col $col: Look for subrec name ...\n"; for ($r=$row-1; $r > 0 && $r > $row-50; $r--) { if ($SS{$r,$col} =~ /(\d*)\s*(.*)\s+([Rr]ecords*)$/) { print L "Found $1 $2 $3 in ($r,$col)\n"; print L "Row $row col $col: Subrec \"$2\" ...\n"; @recs = ($2); # Single sub-record name. last; } } } else { # It's a top-level record. $x = $SS{$row,1}; if ($SS{$row+1,1} =~ /^\(Deleted\s+\d+/) { print L "Row $row col $col: Ignore deleted record $x.\n"; # print E "Row $row col $col: Ignore deleted record $x.\n"; return; } if ($SS{$row,3} =~ /(Message\s*Type)\s*"*(\d+)"*$/) { print L "Row $row col 3: Change \"$SS{$row,3}\" to \"$1\"\n"; $SS{$row,3} = $1; } if ($x =~ /(.*,.*)-(Status.request)/) { $suff = $2; @recs = split(/\s*,\s*/,$1); foreach (@recs) { $_ .= '-' . $suff; print L "Row $row col $col: Message \"$_\" ...\n"; } } else { print L "Row $row col $col: Message \"$x\" ...\n"; @recs = ($x); } } print L "Row $row col $col: recs=(@recs)\n"; for (@recs) { next if /^\s*$/; $recname = &cname($_); # Root of record name (bare name from ICD). $rec = &cname($Rec . $_); # C record (type) name (with CM4_ prefix). print L "Produced $rec ...\n"; if ($x = $recdone{$rec}) { print L "Already produced $rec at $x.\n"; $recdone{$rec} = "$subflag, $x"; # Mark this record as done. print E "Duplicate record $rec at $subflag, $x\n"; } else { $str = &cname($Str . $_); # C struct for this record. print M "#define $rec struct $str\n"; print M "$rec {\t/* [$row,$col] */\n"; &recfields($row,$col); # Analyze its fields. print M "};\n"; if ($x = $recalign{$rec}) { ($algn = $rec) =~ s/^CM/CA/; print M "#define $algn $x\t/* Alignment */\n"; } if ($x = $recsize{$rec}) { ($siz = $rec) =~ s/^CM/CS/; print M "#define $siz $x\t/* Size */\n"; $maxsiz = $x if $x > $maxsiz; } if ($x = $recpad{$rec}) { ($pad = $rec) =~ s/^CM/CP/; print M "#define $pad $x\t/* Pad */\n"; } if ($x = $RecDkey{$rec}) { ($dev = $rec) =~ s/^CM/Cd/; print M "#define $dev $x\t/* DeviceID */\n"; } if ($x = $RecPkey{$rec}) { ($prt = $rec) =~ s/^CM/Cp/; print M "#define $prt $x\t/* PortID */\n"; } if ($x = $RecTkey{$rec}) { ($ptp = $rec) =~ s/^CM/Ct/; print M "#define $ptp $x\t/* PortType */\n"; } print M "\n"; $recdone{$rec} = $subflag; # Mark this record as done. } } }