+}
+
+sub parse_progs($$)
+{
+ my ($fh, $lnofh) = @_;
+
+ my %p = ();
+
+ print STDERR "Parsing header...\n";
+ $p{header} = parse_section $fh, DPROGRAMS_T, 0, undef, 1;
+
+ if (defined $lnofh) {
+ print STDERR "Parsing LNO...\n";
+ my $lnoheader = parse_section $lnofh, LNOHEADER_T, 0, undef, 1;
+ eval {
+ die "Not a LNOF"
+ if $lnoheader->{lnotype} != unpack 'V', 'LNOF';
+ die "Not version 1"
+ if $lnoheader->{version} != 1;
+ die "Not same count of globaldefs"
+ if $lnoheader->{numglobaldefs} != $p{header}{numglobaldefs};
+ die "Not same count of globals"
+ if $lnoheader->{numglobals} != $p{header}{numglobals};
+ die "Not same count of fielddefs"
+ if $lnoheader->{numfielddefs} != $p{header}{numfielddefs};
+ die "Not same count of statements"
+ if $lnoheader->{numstatements} != $p{header}{numstatements};
+ $p{lno} = [parse_section $lnofh, LNO_T, 24, undef, $lnoheader->{numstatements}];
+ eval {
+ $p{lno} = [parse_section $lnofh, LNO_T, 24, undef, $lnoheader->{numstatements} * 2];
+ $p{cno} = [splice $p{lno}, $lnoheader->{numstatements}];
+ print STDERR "Cool, this LNO even has column number info!\n";
+ };
+ } or warn "Skipping LNO: $@";
+ }
+
+ print STDERR "Parsing strings...\n";
+ $p{strings} = get_section $fh, $p{header}{ofs_strings}, $p{header}{numstrings};
+ $p{getstring} = sub
+ {
+ my ($startpos) = @_;
+ my $endpos = index $p{strings}, "\0", $startpos;
+ return substr $p{strings}, $startpos, $endpos - $startpos;
+ };
+
+ print STDERR "Parsing globals...\n";
+ $p{globals} = [parse_section $fh, DGLOBAL_T, $p{header}{ofs_globals}, undef, $p{header}{numglobals}];
+
+ print STDERR "Parsing globaldefs...\n";
+ $p{globaldefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_globaldefs}, undef, $p{header}{numglobaldefs}];
+
+ print STDERR "Range checking globaldefs...\n";
+ for(0 .. (@{$p{globaldefs}}-1))
+ {
+ my $g = $p{globaldefs}[$_];
+ die "Out of range name in globaldef $_"
+ if $g->{s_name} < 0 || $g->{s_name} >= length $p{strings};
+ my $name = $p{getstring}->($g->{s_name});
+ die "Out of range ofs $g->{ofs} in globaldef $_ (name: \"$name\")"
+ if $g->{ofs} >= $p{globals};
+ }
+
+ print STDERR "Parsing fielddefs...\n";
+ $p{fielddefs} = [parse_section $fh, DDEF_T, $p{header}{ofs_fielddefs}, undef, $p{header}{numfielddefs}];
+
+ print STDERR "Range checking fielddefs...\n";
+ for(0 .. (@{$p{fielddefs}}-1))
+ {
+ my $g = $p{fielddefs}[$_];
+ die "Out of range name in fielddef $_"
+ if $g->{s_name} < 0 || $g->{s_name} >= length $p{strings};
+ my $name = $p{getstring}->($g->{s_name});
+ die "Out of range ofs $g->{ofs} in fielddef $_ (name: \"$name\")"
+ if $g->{ofs} >= $p{header}{entityfields};
+ }
+
+ print STDERR "Parsing statements...\n";
+ $p{statements} = [parse_section $fh, DSTATEMENT_T, $p{header}{ofs_statements}, undef, $p{header}{numstatements}];
+
+ print STDERR "Parsing functions...\n";
+ $p{functions} = [parse_section $fh, DFUNCTION_T, $p{header}{ofs_functions}, undef, $p{header}{numfunctions}];
+
+ print STDERR "Range checking functions...\n";
+ for(0 .. (@{$p{functions}} - 1))
+ {
+ my $f = $p{functions}[$_];
+ die "Out of range name in function $_"
+ if $f->{s_name} < 0 || $f->{s_name} >= length $p{strings};
+ my $name = $p{getstring}->($f->{s_name});
+ die "Out of range file in function $_"
+ if $f->{s_file} < 0 || $f->{s_file} >= length $p{strings};
+ my $file = $p{getstring}->($f->{s_file});
+ die "Out of range first_statement in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
+ if $f->{first_statement} >= @{$p{statements}};
+ if($f->{first_statement} >= 0)
+ {
+ die "Out of range parm_start in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
+ if $f->{parm_start} < 0 || $f->{parm_start} >= @{$p{globals}};
+ die "Out of range locals in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
+ if $f->{locals} < 0 || $f->{parm_start} + $f->{locals} > @{$p{globals}};
+ die "Out of range numparms $f->{numparms} in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
+ if $f->{numparms} < 0 || $f->{numparms} > 8;
+ my $totalparms = 0;
+ for(0..($f->{numparms}-1))
+ {
+ die "Out of range parm_size[$_] in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
+ unless { 0 => 1, 1 => 1, 3 => 1 }->{$f->{parm_size}[$_]};
+ $totalparms += $f->{parm_size}[$_];
+ }
+ die "Out of range parms in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
+ if $f->{parm_start} + $totalparms > @{$p{globals}};
+ die "More parms than locals in function $_ (name: \"$name\", file: \"$file\", first statement: $f->{first_statement})"
+ if $totalparms > $f->{locals};
+ }
+ }
+
+ print STDERR "Range checking statements...\n";
+ for my $ip(0 .. (@{$p{statements}}-1))
+ {
+ my $s = $p{statements}[$ip];
+ my $c = checkop $s->{op};