#!/usr/bin/perl -w
#
# 2002/05/10 @kl  zapcode2.pl:  generate ZAP sysmod from assembly listing
#
#                 Input (on STDIN): IFOX00 assembly listing with carriage
#                 control characters; output (on STDOUT):  generated sysmod
#                 with VER and REP statements.

sub DEBUG { 0 } ;  # 1 for debugging messages

  my $savecard = '';            # saved SMP comment card

print "/* $0 */\n";

#
#  Template fields are:
#
#   validad    - "0" if LOC column contains valid address
#   addr       - value of LOC column
#   data       - all 16 hex digits from OBJECT CODE column
#   data1      - first 4 hex digits from OBJECT CODE column
#   space      - " " if OBJECT CODE is string data longer than two bytes
#   data2      - second 4 hex digits from OBJECT CODE column if OBJECT CODE
#                represents an instruction
#   data3      - third 4 hex digits from OBJECT CODE column if OBJECT CODE
#                represents an instruction
#   seq        - STMT sequence number if line is instruction or data
#   smp        - "*SMP" if line is comment containing SMP MCS or SPZAP
#                control statements
#   comm       - comment text on instruction or data
#   zapcard    - text of SMP MCS or SPZAP control statement if smp
#                is equal to "*SMP"
#   inst       -
#   ver        - "VER" if statement is to be generated as SPZAP VER,
#                "REP" if statement is to be generated as SPZAP REP
#
  my $template = '@1  A1  @1  A6  @8  A16 @8 A4';  # validad addr data data1
  $template   .= '@12 A1  @13 A4 @18 A4 @35 A5';   # space data2 data3 seq
  $template   .= '@41 A4  @41 A52';  # A43         # smp comm
  $template   .= '@45 A71 @50 A3 @109 A3';         # zapcard inst ver
  $template   .= '@56 A60';                        # zapcont

#
#  Read assembly listing from STDIN.
#
  my @listing = <>;
  chomp @listing;

#
#  Build the date for REWORK.
#
  my ($yy, $mm, $dd) = (localtime(time()))[5,4,3];
  my $dateRework = sprintf "%04d%02d%02d", $yy+1900, $mm+1, $dd;

#
#  Loop through records in assembler listing.
#
  foreach (@listing) {

  #
  #  Pad the record on the right with blanks to a length of 132.
  #
    my $inline = substr $_ . ' ' x 132, 0, 132;

  #
  #  Split the record into individual fields.
  #
    my ($validad, $addr, $data, $data1,
        $space, $data2, $data3,
        $seq, $smp, $comm, $zapcard,
        $inst, $ver, $zapcont)  = unpack $template, $inline;

  #
  #  Display some values if debugging.
  #
    if (DEBUG) {
      print "****DEBUG validad=<$validad> addr=<$addr> data=<$data> data1=<$data1> ";
      print "****DEBUG space=<$space> data2=<$data2> data3=<$data3> seq=<$seq> ";
      print "****DEBUG smp=<$smp> comm=<$comm> zapcard=<$zapcard> inst=<$inst> ver=<$ver>\n";
      print "****DEBUG zapcont=<$zapcont>\n";
    }

  #
  #  If a "*SMP" comment statement continuation is in progress,
  #  append the continuation text to the saved text, write the
  #  text to the output file, and continue with the next line
  #  of the assembler listing.
  #
    if ($savecard) {
      print "$savecard$zapcont\n";
      $savecard = '';
      next;
    }   # end if ($savecard)

  #
  #  If the original source statement is an assembler comment
  #  beginning with "*SMP", then the rest of the statement is
  #  either an SMP MCS statement or an SPZAP control statement.
  #  In either case the text following "*SMP" will be copied
  #  verbatim to the output file, with one exception:  if an
  #  SMP "REWORK()" parameter is encountered, the current date
  #  will be substituted for whatever was specified.  Note that
  #  if the statement has a continuation character in column 72,
  #  we won't print it now; instead, it will be saved and
  #  prepended to its continuation.
  #
    if ($smp eq '*SMP') {
      my ($x1, $x2) = ($zapcard =~ /^(.+?REWORK\s*\()\s*\d+\s*(\).*$)/);
      $zapcard = "$x1$dateRework$x2" if (defined $x1 and defined $x2);
      if  (substr  (($zapcard . ' ' x 67) , 67, 1) eq ' ') {
        print "$zapcard\n";
      } else {
        $savecard = substr($zapcard, 0, 67);
      }  # end if (no continuation)
      next;
    }

  #
  #  We don't process any other assembler comments.  If one
  #  is found, loop back to look at the next line of the listing.
  #
    next if ($smp =~ /^\*/);

  #
  #  Quit when the assembler "END" statement is encountered.
  #
    last if $inst eq 'END';

  #
  #  If the STMT fields doesn't contain a valid statement number
  #  and the LOC field isn't a valid address, then this isn't a
  #  source statement.  In that case, loop back to look the next
  #  listing line.
  #
    next if ($seq !~ /^\d+$/ and $validad !~ /^\s*\d+$/);

  #
  #  Skip to the next line if the LOC field is empty.
  #
    next if $addr eq '';
    next if $addr eq '      ';

  #
  #  Select the SPZAP operation based on comment text at the
  #  end of the source statement.  Note that the operation
  #  set here will carry over into subsequent statements
  #  until a new operation is encountered.  This is intended
  #  to handle the case of verifies for PRINT DATA generated
  #  data that runs onto multiple lines of listing.
  #
    $op = 'VER' if $ver eq 'VER';
    $op = 'REP' if $ver eq 'REP';

  #
  #  If the OBJECT CODE field doesn't contain a space after the
  #  first four hex digits, then the current line is data,as
  #  opposed to an instruction.  Generate VER or REP statement
  #  using data from the current line.
  #
    next unless defined($op);
    if ($space ne '') {
      # goto dataline
      printf "%-3s %-4s %-16s %s\n", $op, $addr, $data, $comm;
    }

    elsif ($data1 eq '') {next}

    elsif ($data2 eq '') {
      # rep1
      printf "%-3s %-4s %-4s             %s\n", $op, $addr, $data1, $comm;
    }

    elsif ($data3 eq '') {
      # rep2
      printf "%-3s %-4s %-4s,%-4s        %s\n", $op, $addr, $data1, $data2, $comm;
    }

    else {
      printf "%-3s %-4s %-4s,%-4s,%-4s   %s\n", $op, $addr, $data1, $data2, $data3, $comm;
    }

  }

#
#  trim():  Subroutine to remove leading and trailing white space.
#
sub trim {
  my ($input) = @_;
  $input =~ s/^\s+//;
  $input =~ s/\s+$//;
  return $input;
}
__END__
OPTIONS S=72;
DATA _NULL_;
INFILE LISTING;
RETAIN TYPE;
INPUT
     @2 VALIDAD ? 1.
     @2 ADDR $6.
     @9 DATA $16.
     @9 DATA1 $4.
     @13 SPACE $1.
     @14 DATA2 $4.
     @19 DATA3 $4.
     @36 SEQ ? 5.
     @42 SMP $CHAR4.
     @42 COMM $CHAR43.
     @46 ZAPCARD $CHAR71.
     @51 INST $3.
     @110 VER $3.
     ;
_ERROR_=0; * SO ERRORS WON'T BE PRINTED;
FILE SMPZAP;
IF INST EQ 'END' THEN GO TO END_IT;
IF SEQ EQ . AND VALIDAD EQ . THEN DELETE;
IF SMP EQ '*SMP' THEN PUT @1 ZAPCARD $CHAR71.;
IF ADDR EQ '      ' THEN DELETE;
IF VER EQ 'VER' THEN TYPE='VER ';
IF VER NE 'VER' AND INST NE '   ' THEN TYPE='REP ';
IF SPACE NE ' ' THEN GOTO DATALINE;
IF DATA1 EQ '    ' THEN DELETE;
IF DATA2 EQ '    ' THEN GOTO REP1;
IF DATA3 EQ '    ' THEN GOTO REP2;
PUT TYPE ADDR DATA1
   @16 ',' DATA2
   @21 ',' DATA3
   @29 COMM $CHAR43.;
RETURN;
REP1:    PUT TYPE ADDR DATA1
             @29 COMM $CHAR43.;
         RETURN;
REP2:    PUT TYPE ADDR DATA1
             @16 ',' DATA2
             @29 COMM $CHAR43.;
         RETURN;
DATALINE: PUT TYPE ADDR DATA
             @29 COMM $CHAR43.;
          RETURN;
END_IT:   RIGHTNOW=DATETIME( );
          PUT @1 '* ' RIGHTNOW DATETIME.;
          STOP;
##    print "$addr $data  $comm\n";
#     print "$addr $data1  $comm\n";
#     print "$addr $data1,$data2  $comm\n";
#     print "$addr $data1,$data2,$data3  $comm\n";
__END__
=begin=
  my $template = '';
  $template .= '@1   A6  ';   # validad
  $template .= '@8   A16 ';   # data
  $template .= '@8   A4  ';   # data1
  $template .= '@12  A1  ';   # space
  $template .= '@13  A4  ';   # data2
  $template .= '@18  A4  ';   # data3
  $template .= '@35  A5  ';   # seq
  $template .= '@41  A4  ';   # smp
  $template .= '@41  A52 ';   # comm
  $template .= '@45  A71 ';   # zapcard
  $template .= '@50  A3  ';   # inst
  $template .= '@109 A3  ';   # ver
=cut=

=begin=
    $validad  = trim($validad);
    $addr     = trim($addr);
    $data     = trim($data);
    $data1    = trim($data1);
    $space    = trim($space);
    $data2    = trim($data2);
    $data3    = trim($data3);
    $seq      = trim($seq);
    $smp      = trim($smp);
    $comm     = trim($comm);
    $zapcard  = trim($zapcard);
    $inst     = trim($inst);
    $ver      = trim($ver);
=cut=

