#! /usr/bin/perl -w
#
# PROGRAM: ftor.pl
#  AUTHOR: Doug du Boulay  ddb@crystal.uwa.edu.au
#    DATE: Nov 1999
# PURPOSE:
#         This script attempts to convert what could loosely be
#         described as "unstructured spaghetti style fortran" into 
#         more structured, block delimited, fortran code. 
#         I.e. it aims to convert the following coded constructs:
#         a   if (a) x,y,z          # arithmetic IF (a<0 a==0 a>0)
#         b   do x i=1,n          
#         c   goto  (w,x,y,z),a     # computed GOTO/SWITCH a=1..4
#         d   goto  x               # basic GOTO
#         into a supposedly easier to understand RATIONALIZED FORTRAN77 MACRO 
#         language (RATMAC - something akin to RATFOR)
#         with the equivalent constructs:     
#         a   if (a<0)
#             $(
#             # statements here
#             $)
#             elseif (a==0)
#             $(
#             # statements here
#             $)
#             else#   i.e. a>0
#             $(
#             # statements here
#             $)
#
#         b1  do  i=1,
#             $(
#             # statements here
#             $)
#         b2  do  i=1,20,2; statement
#
#         d   REPEAT 
#             $(
#             # statements here
#             NEXT
#             # statements here
#             BREAK
#             $)
#
#         The way it does this is by building a program flow
#         data structure describing the fortran program flow
#         for each subroutine. Then it parses the data structure
#         to do the conversion.
#         The ratmac file.r produced should be preprocessed
#         with rfpunx.x to regenerate fortran77 for compilation.
#         Supposedly, by strapping a different back end on it
#         you could convert to some other language, if you could
#         be bothered ...
#         
#
#WARRANTY: Nope. If it doesn't work for me, there's no
#          way its ever gunna work for you! 
#         
package ftor;
use strict ;
#no strict 'subs';

#global package variables
my $level;
my $stack;
#my $lineInfo; 		# ptr to accumulated line info
my @bmode ;
my %labeledLineCode;
my %labeledLines;
my %branches;
my $nextImpendingLabel;
my @branchList;
my @numberList;
my $commentRec;
my $OUTFILE;
my @declarations;
my $h;
my $headerline;
my $subname;
my $subargs;
my $ForcedJumps;   # a global temp
my $declnum;
my @statements;
my $statlnum;
my $tlabmax;
my $noPathToNext;
my $SkipRepeat;
my $statefunc;
my $dropthru;
my $ConsumedTheLine;

# this is the debugging information that will actually be printed
my  $debug = 
    1<< 0  # file line number status       
  | 1<< 1  # unused twiddle bits                               
  | 1<< 2  # unused twiddle bits                               
# | 1<< 3  #    prescan basic                           
# | 1<< 4  #    prescan intermediate                    
# | 1<< 5  #    prescan heavy,                          
# | 1<< 6  #    prescan full,                           
  | 1<< 7  # data structure formation basic             
  | 1<< 8  # data structure formation intermediate      
  | 1<< 9  # data structure formation heavy             
  | 1<<10  # data structure formation full              
  | 1<<11  #   basic undo                              
# | 1<<12  #   freeze/thaw heavy
# | 1<<13  #   freeze/thaw full
  | 1<<14  # data structure  manipulation basic
  | 1<<15  # data structure formation intermediate
  | 1<<16  # data structure formation heavy
  | 1<<17  # data structure formation full
# | 1<<18  #
# | 1<<19  #
# | 1<<20  # output file printing
# | 1<<21  # output file printing  intermediate
# | 1<<22  # output file printing  heavy 
# | 1<<23  # output file printing  full
  | 1<<24  #
  | 1<<25 ;# essential debug info

#  $debug   = 33550211 ;# assume strong debugging
#  $debug   = 17821571 ;# strong debugging but clean printing
# e.g.  ftor.pl -D33554431    # dump the lot
# e.g.  ftor.pl -D33548163    # dump most, skip junk
# e.g.  ftor.pl -D33550211    # very useful
# e.g.  ftor.pl -D17821571    # dump most, but clean printing
# e.g.  ftor.pl -D50331648    # essential dump printing

my $repeatLoops= 1 ; # look for repeat loops by default

# process command line args
while (@ARGV && ($_ = $ARGV[0], /^-/)) {
   shift;
   last if /^--$/;     # retain all args after --
   if (/^-D(.*)/) { $debug = $1 ;  }
   if (/^-r([^ ]*)/) { $repeatLoops= 0;}#don't attempt to resolve repeat loops
   if (/^-help/ || /^-h(\s*)/) {
        usage();
        exit 0;
   }
}
if (not @ARGV ) {usage(); exit 1;}

sub usage {
   print STDERR "$0 converts fortran files.f to RATMAC files.r\n\n";
   print STDERR "usage: $0 [-Dn] [-r] [-h] [--] file1.f ...\n";
   print STDERR "  -D[n]      set debug level ('n' is a 32 bit int)\n";
   print STDERR "  -r         switches of 'repeat' loop interpolation\n";
   print STDERR "  -h         this help message\n\n";
}


# sequential processing of all files specified - or stdin 
#my $input = *fh00 ;         # kludged file handle
my $filename;
FILE: foreach $filename  (@ARGV) {
#   $input++ ;             # increment file handle for next file
   unless (open fh00, $filename) {
      print STDERR "can't open $filename: $!\n";
      next FILE;
   }
DEBUG(0,"FTOR: $filename  opened for reading. \n");
   $OUTFILE = \*STDOUT ;      # print current statement

     $statlnum=0;          # initialize
     $declnum=0;           # initialize
     @statements   = ( ) ; # initialize
     @declarations = ( ) ; # initialize
my   $begin=0;             # initialize file processing status



LINE: while(<fh00>) {  # get next  ARGV line & store in  $_

# If a primary program flow line is encountered then the current
# processing status is switched to "$begin = 1", in search of
# global or local declarations and DATA assignments.

      if ( m/^\s+(subroutine|function|program)\s+(\w[^\s\(]*)\s*(\(.*\))*\s*(\!.*)*$/i ){
         # found a new subroutine 
         $headerline = $_ ;     # save whole line
         my $blocktype= $1 ;
         $subname  = $2 ;
         $subargs  = $3 ;
         my $comment  = $4 ;
         $begin    = 1  ;
         $statlnum = 0;          # initialize
DEBUG(0,"$subname \n");
         next LINE ;
      }

# If $begin state is zero then we are between procedures
# The default action here is just to dump such "between" statements
# to standard output (STDOUT). In fact, probably these lines will
# be comments and should be processed as such

      if ($begin eq 0) {# default action between subroutines
	 s/^c/#/i;      # hopefully just comments ...
         print $OUTFILE $_ ;
      }


# If $begin state is one then we are processing declarations, BUT
# on the lookout for the first hint of active code ($begin = 2)
# Accumulate all declarations (and initial comments) for later processing

      if ( $begin == 1 ) {                # look for variable declarations
         if ( m/^\s+(common|equivalence|dimension|integer|double|character|real|data|logical|implicit)/i ||
            m/^ {5}\S/  ||
            m/^\s*$/    ||
            m/^\s*!.*$/ ||
            m/^[cC]/ )  {
            $declarations[$declnum++]= {
               'stat' => $_,       # save the statement
               'line' => $.,       # actual line number in file
               'type' => 'decl',   # preassume type of line
               'labeled'=> 0,        # assume an unlabeled line
               'label'=> 0,        # assume an unlabeled line
               'aline' => $declnum # apparent line
            } ;   # save for posterity
            if (m/^\s+data/i ){#   found a line continuation character
               $declarations[$declnum-1]{'type'}= 'data'
            }
            if (m/^     \S/ ){#   found a line continuation character
               $declarations[$declnum-1]{'type'}= 'lcont'
            }
         }
         else {                # end of declarations and comments
            processdecls() ;   # process them
            $begin++ ;         # signal end of declarations
            # go on and do $begin==2 to procees first line to trip
         } 
      }              

# Reading and processing active code - UNTIL we strike an "END"
# statement. That acts as a trigger to process the entire 
# subroutines source code and resets the state ($begin=0) to
# scanning for the next primary flow control statements
# (FUNCTION/SUBROUTINE etc)

      if ($begin eq 2 )  {
         $statements[$statlnum++]= { 
               'stat' => $_,       # save the statement
               'line' => $.,       # actual line number in file
               'type' => 'stat',   # preassume type of line
               'labeled'=> 0,      # assume an unlabeled line
               'extra'=> 0,        # assume no continuation lines
               'label'=> 0,        # assume an unlabeled line
               'aline' => $statlnum # apparent line
         } ;   # save for posterity

         if ( m/^\s+end\s+(\!.*)*$/i ){  # end of statement block
            processstats() ;         # reduce fortran statements to RATMAC
            $begin = 0 ;             # reset process state
            @statements   = ( ) ;    # reinitialize
            @declarations = ( ) ;    # reinitialize
            $declnum=0;              # reinitialize
            $statlnum = 0 ;
         }
      }

# Nothing else that is worth polling for - unless you have
# global DATA block initializations.
     
   } # end of line reading loop for current file
   close fh00;

}    # end of loop over all input files


sub RealLine {
   my $lineindex = shift;
   return $. - $statlnum + $lineindex +1;
}

sub DEBUG {
     my $dlev= shift;
     if (not ($debug & 1<<$dlev) ) { return;}
     my $string = shift ;
     if ($dlev <7) { 
        print STDERR $string ;
     }
#     elsif ($dlev ==10) { 
#        print STDERR $string ;
#     }
     elsif ($dlev <20) { 
        my $levl = sprintf("%-2.1d: %-5.1d# ",$level, RealLine($h) );
        my $indent   = "   " x $level ;
        print STDERR $levl . $indent .$string ;
     }
     elsif ($dlev<25) {
        print $OUTFILE "\#" .$string ;
     }
     else {
        print $OUTFILE "\#" x 70 ."\n" ;
        print $OUTFILE "\#" . " " x 70 . "\n" ;
        print $OUTFILE "\# " .$string ;
        print $OUTFILE "\#" . " " x 70 . "\n" ;
        print $OUTFILE "\#" x 70 ."\n" ;
    }
}


##########################################################
# That's it. The rest of this file consists of the various
# statement processing subroutines
##########################################################


sub   processdecls  {
DEBUG(3,"declarations: $declnum \n");
}



sub   processstats  {
   $tlabmax = 87001 ;
   firstparse() ;    # extract line numbers
   secondparse() ;   # extract program flow control statements
   buildParseTree(); # Build subroutine Flow structure
                                     # print procedure block title 
   printHeader() ;                   # dump the subroutine header
   printStats(0,@declarations);        # dump the declaration statements
   printParseTree(0,$stack,0);       # Dump a copy of procedure $stack[]

# exit at end of first subroutine - delete this when it works properly
#DEBUG(3,"Conversion terminated after first subroutine \n") ;
#exit ;
}



##########################################################
# Extract all line labels and construct an associative array
# %labeledLineCode whose keys are the line labels.
#
# To complement this we also construct a less elaborate
# associative array %labeledLines indexed by line numbers
# of the labelled lines
##########################################################

sub   firstparse  {
DEBUG(4," statements: $statlnum \n") ;
   %labeledLineCode = ( ) ;                      # initialize a hash table
   %labeledLines = () ;
###   $lineInfo = [] ;                            # extra info for each line
   for(my $i=0;$i<$statlnum;$i++) {            # search for block line numbers
      my $line = $statements[$i]{'stat'} ;
      my ($word) = ($line =~ m/^([ \d]{0,5})\s*/ ) ;
      
      if ( $word =~ m/(\d+)/ ) {          # at least one digit
         $statements[$i]{'labeled'}  = 1; # line is labeled 
         $statements[$i]{'label'}  = $1;  # this is the label
         $statements[$i]{'labref'} = 0;   # references to label
         my $linrec = { 'index' => $i ,   # create a new record 
                     'jump'  => {}, 
                     'goto'  => {}, 
                     'do'    => {},
                     'if'    => {},
                     'ifexp' => {},
                     'temp'  => {},
                     'format'=> {},# read/write statements - format may be a var
                     'read'  => {},# err=label1,end=label2  statement 
                     'refInfo'=>[]  # this is built as we parse the flow tree 
         } ;
         $labeledLineCode{$1} = $linrec;  # list copy and force it to be a hash
         $labeledLines{$i} = $1  ;         # create reverse list index
         my $val = $labeledLineCode{$1}{'index'} ;
DEBUG(5,"line $val : stat numbr $1 \n"); # actually $i+1
###         IncrLineInfo($i);
      }


      if ($line =~ m/^..... \s*format\s*\(/i ){
             $statements[$i]{'type'} = 'format' ;
             $statements[$i]{'labref'} += 100; # increment reference count
      }
      if ($line =~ m/^[cC]/){# found a comment statement
             $statements[$i]{'type'} = 'comment'
      }
      elsif ($line =~ m/^..... \s*continue(\s+$|$)/i ){
             # found a "continue" statement
             $statements[$i]{'type'} = 'continue'
      }
      elsif ($line =~ m/^.....\S/ ){#   found a line continuation character
             $statements[$i]{'type'} = 'lcont'
      }

   }
}

   

##########################################################
# Extract all program flow control statements for the
# procedure and log them in the associative array
# %branches - indexed by line number.
#
# These record statements of form: 
#     a   if (a) x,y,z          'if'
#     b   do x i=1,..           'do'
#     c   goto  (w,x,y,z),a     'goto'
#     d   goto  x               'jump'  unconditonal branch
#
# Typically each record has the following 'keyed' attributes: 
#       'type' => 'if' or 'do' or 'goto' or 'jump'
#       'jump' => [ ]    - a list of target line labels
#       'jlnm' => [ ]    - a list of line numbers of targeted labels
#       'cats' => N      - Number of (un)conditional categories 
#
# WARNING: there is a defficiency here because any of these
#         statements may be labelled, and turn out to be a
#         REPEAT statement also. so there are potentially
#         multiple modes for each branch. We could get around this by 
#         making each reference an array ...
#
##########################################################

sub   secondparse  {


   %branches = ( ) ;                    # initialize a hash table
   for(my $i=0;$i<$statlnum;) {     # search for statement block delimiters
      $_ = $statements[$i]{'stat'} ;
      my $k= $i+1;
      while ($k<$statlnum and $statements[$k]{'type'} eq 'lcont') {# line continues
         #should strip end of line ! comments if present
	 s/\s*$//; # strip trailing blanks
         $_= $_ . substr($statements[$k]{'stat'},6);#concat, strip lead
         $k++;
      }
      $statements[$i]{'extra'} = $k-$i-1;


      # should look ahead for multi line continuation and concatenate !
      # 

      my $type = 0;                       # initialize
      my @jumps;
      my $rec;

      if (m/\s+if\s*\((.+\.(lt|le|eq|ne|ge|gt)\..+)\)\s*go\s*to\s+(\d+)/i ){ 
         # should ignore logic and trap pure boolean args also
DEBUG(5,"$_ \n");
         my $expr = $1;
         $type = 'ifexp' ;                # an explicit "IF"
         @jumps = ($3 );                  # list of length one
         $expr =~ s/\.lt\./</ig;
         $expr =~ s/\.le\./<=/ig ;
         $expr =~ s/\.eq\./==/ig ;
         $expr =~ s/\.gt\./>/ig ;
         $expr =~ s/\.ge\./>=/ig ;
         $expr =~  s/\.ne\./!=/ig ;
         $rec = { 'type' => 'ifexp',    # its an 'ifexp' record
                  'jump' => [@jumps], 
                  'jlnm' => [] ,        # initialize branch pt line numbers
                  'expr' => $expr ,        # initialize branch pt line numbers
                  'cats' => 1           # count the categories?
         };
      }
      elsif (m/\s+if\s*\((.*)\)\s*(\d*\s*,\s*\d*\s*,\s*\d*)\s*/i ) { # found an "if" statement
         $type = 'if' ;
         my $expr = $1 ;
         @jumps = eval  '(' . $2 . ')' ;
         my @cond  = ('<','==','>') ;        # an 'if < elsif = else ' statement
         if    ($jumps[0] eq $jumps[1] && $jumps[0] ne $jumps[2]){
                @jumps = @jumps[1,2] ; @cond = ('<=','>') ;    #if <= else 
         }elsif($jumps[0] eq $jumps[2] && $jumps[0] ne $jumps[1]){ 
                @jumps = @jumps[0,1] ; @cond = ('!=','==') ;    #if != else ==
         }elsif($jumps[1] eq $jumps[2] && $jumps[0] ne $jumps[1]){ 
                @jumps = @jumps[0,1] ; @cond = ('<','>=') ;     #if < else >=
         }elsif($jumps[0] eq $jumps[1] && $jumps[0] eq $jumps[2]){ 
DEBUG(0,"rediculous input line: $i: $_ \n"); 
                                 # convert line to a goto & reinsert
         }

         my @sexpr = split /-/ , $expr ;  # split expression "if (a-b) x,y,z"
         my $ifa = $expr ; my $ifb = '0' ;   # fallback values
         if ( scalar(@sexpr) == 2 ) {   # rearrange simple expressions
            if ( $expr =~ m/[\d.][^eEdD]-\d/ ) { ; } # not floating point num
            else {
               my $op = $sexpr[0] =~ tr/(/(/ ; # count open parenthesis
               my $cp = $sexpr[0] =~ tr/)/)/ ; # count closed parenthesis
               if ($op eq $cp ) {           # rearange the expression
                   $ifa = $sexpr[0] ;
                   $ifb = $sexpr[1] ;
               }
            }
         }  
         $rec = { 'type' => 'if',       # its an 'if' record
                  'jump' => [@jumps ],  # copy the code pointers
                  'jlnm' => [ ],         # initialize branch pt line numbers
                  'cats' => scalar(@cond) ,  # count the categories?
                  'expr' => $expr,      # 
                  'ifa'  => $ifa ,      # first param
                  'ifb'  => $ifb ,      # second param
                  'cond' => [@cond ]   # copy the conditions 
         } ;
      }
      elsif (m/\s+go\s*to\s*(\d+)\s*/i ) { # found a "go to numb" statement
         $type = 'jump' ;
         @jumps = ($1 );                  # list of length one
         $rec = { 'type' => 'jump',       # its a 'jump' record
                  'jump' => [@jumps], 
                  'jlnm' => [] ,        # initialize branch pt line numbers
                  'cats' => scalar(@jumps)    # count the categories?
         }
      }
      elsif (m/\s+go\s*to\s*(\(.*\))\s*,\s*(.*)\s*\!*.*/i ) { # found a "go to (x,y,z),expr" 
         $type = 'goto'  ;
         @jumps = eval  $1  ;
         my $expr = $2 ;
         my @cond = [] ;                    #initialize null list
         for (my $k=1;$k<=@jumps;$k++){push @cond, $k ; } # make list of numbers
         $rec = { 'type' => 'goto',    # its a 'goto' record
                  'jump' => [@jumps],  # copy the jump line nums 
                  'jlnm' => [],        # initialize branch pt line numbers
                  'cond' => [@cond ],  # copy the 'if expr==' conditions 
                  'expr' => $expr,   # copy the 'expr' 
                  'cats' => scalar(@jumps)    # count the categories?
         } ;
      }
      elsif (m/\s+do\s+(\d+)\s+/i ) {   # found a "do" statement
         @jumps = ($1 );                # list of length one
         $type = 'do' ;
         $rec = { 'type' => 'do',     # its a 'do' record
                  'jump' => [@jumps], # only one of em'
                  'jlnm' => [],       # initialize branch pt line numbers
                  'cats' => 1         # count the categories
         }
      }
      
      if ($type ne 0 ) {              # for any "if" "goto" do matches
         $statements[$i]{'type'} = $type; 

         foreach my $label  (@jumps) {   # for each jump -get actual line num
            my $line = $labeledLineCode{$label}{'index'} ; 
            push @{$rec->{'jlnm'}} , $line ; # save in record
                  # references to label
            $statements[$line]{'labref'} += 1; # increment reference count
         }
DEBUG(5,"$type: @{$rec->{'jlnm'}}: @{$rec->{'jump'}}: $rec->{'cats'}\n");

         $branches{$i} =  [$rec];     # copy pointer to a hash

         foreach my $lnm ( @jumps ) {    # for multiple line numbers
            $labeledLineCode{$lnm}{$type}{$i} = 1 ; # save numb+flag in a hash
         }


      }
      $i = $k;
   }   # end of loop over all statments in current structured block

DEBUG(3,"***********************************************\n") ;

}





##########################################################
#
# buildParseTree:  This is the guts of the program. It builds a 
#
#          PROGRAM FLOW DATA STRUCTURE 
#          ---------------------------
# 
# Every active code statement in the subroutine is now sequentially 
# revisited and assigned to a multileveled structured record
# The first i.e. toplevel record is accessed from the variable 
# $stack ( a pointer to a list of closed program flow blocks).
# The program flow blocks themselves contain arrays of sub flow blocks
# etc.

# The first (toplevel) statement is accessed from the 'stats' 
# record  statement array of the first 
# array element pointed to by the $stack variable: 
#  @{$stack}[0]{'stats'}[0]  or  $stack->[0]{'stats'}[0] 
#   
# All preliminary (non DATA) initializations before 
# any conditional code would be found in subsequent array
# indices: $stack->[0]{'stats'}[1] etc.
#
# The first conditional or looping statement would be identified 
# from record $stack->[1]{'block'}
# Depending on the type of 'block', record [1] may have one or more sub records 
# for different conditionals. 
#
# A  DO loop block has the following record:
#     'block'    => 'do',  # type of block
#     'line'     => $stat, # the actual conditional('do') statement 
#     'master'   => $h,    # actual line number 
#     'begun'    => 1,     # state automatically set (bitmapped state)
#     'active'   => 1,     # state automatically set (bitmapped state)
#     'ended'    => 0,     # not finished yet        (bitmapped state)
#     'done'     => 0,     # not finished yet        termination flag
#     'jump'     => [$1],  # not a jump but the terminal line label
#     'termlabel'=> [$1 ], # copy path number
#     'termline' => [],    # the actual terminal line number
#     'stats'    => []     # Array of substructure (blocks within 'do') records
#      ^^^^^??????? (should be 'do'?)
#
# A JUMP block has the following record
#
#    'block'  => 'jump',       # type of block (unconditional jump)
#    'master' => $h,           # actual line number
#    'type'   => $curJumpType, # save class record (forward/back/break/next)
#    'jump'   => [@path] }     # copy the branch labels
#    Obviously a JUMP bloc has no substructure records
#
# An IF block has the following well defined record
#
#     'block' => 'if',      # type of block  (an 'if')
#     'master'=> $h,        # actual line number
#     'begun' => 0,         # no current state set 
#     'active'   => 0,      # no active state
#     'ended'    => 0,      # not finished yet
#     'done'     => 0,      # not finished yet
#     'jump'  => [@path],   # copy path numbers
#     'cond'    =>{},       # gateway to the sublevel heirarchy
#
#          {'cond'}{State}{'plabs'}{LineLabel} = [1, 100,10000 ] 
#                   State is actually a 32 bit binary key to the active state
#                   LinLabel is the line label that induced this state
#                   the penultimate array lists binary wise, the conditions 
#                   contributing to this state, in separate form. 
#          {'cond'}{State}{'class'} elem of [term,dropthru,...]
#          {'cond'}{State}{'label'} line label of first change to this state
#          {'cond'}{State}{'line'}  corresponding line number
#          {'cond'}{State}{'cstats'}  sublevel statement blocks herein
#           if the State changes, a whole new sub cat is created
#           so for freezing only a list of current State keys is needed!
#
#          
              # being the active states (binary)
#
# A GOTO block has the following variable record
#
#     'block' => 'goto',    # type of block
#     'master' => $h,       # master record pointer
#     'begun' => 0,         # no current state set
#     'active'   => 0,      #  no active state
#     'ended'    => 0,      # not finished yet
#     'done'    => 0,      # not finished yet
#     'jump' => [@path],    # copy branch labels
#     'cond' => {  }        # initialize an empty hash of possible states      
#                           # Up to 32 conditionals keyed by 32 bit integer
#
# A REPEAT block may be created under some circumstances
#
#     'block'   => 'REPEAT', # type of block
#     'jump'    => [$tlabel],# maximum loop line number
#     'termline'=> [$max] ,  # label at terminus unknown
#     'begun'   => 0,        # fully open ???
#     'active'  => 0,      #  no active state
#     'ended'   => 0,      # not finished yet
#     'done'    => 0,      # not finished yet
#     'stats'   => []} ;     # no statements
#
# Any actual statements  are recorded in a STATS block
#     'block' => 'stats', # a record of simple statements
#     'stats' => [],      # the ACTUAL statements in a list
#
# Inaccessible code and comments get loaded into a temporary  COMM record
#     'block' => 'comm', # a record of comments
#     'stats' => [] }    # a null list of comments and inaccessible statements
#
#
# To keep track of the current state of all the various sublevels
# we use a list of block mode records, indexed by sublevel 
# but which refer only to the currently open blocks.
# As sublevels are closed they are forgotten and the @bmode list
# shrinks.
# Each $bmode[level] record has the following keyed attributes
#    {'top'}  # pointer back to first record of THIS level
#    {'sub'}  # pointer to top of current active SUBlevel record array
#    {'el'}   # pointer to last block record of DS at current level
#    {'oblk'} # pointer to last open {'block'}== 'stats' in sublevel??
#
#  essentially {'oblk'} = {'el'}{'stats'} where {'el'}{'block'}=='stats' 
#      e.g.
#                 level               level+1
#                 _____
#[level]{'top'}->|cstat|
#                |do   |
#                |if   |               
#                |...  |  goto cond1          <--- [level]{'sub'}
#[level]{'el'}-> |goto | ------------> -----  <--- [level+1]{'top'}
#                 -----  \            |cstat| -------> -----
#                          \          |...  |         |stats| <--[level]{'oblk'}
#                            \        |...  |          -----
#                              \      |goto | <--- [level+1]{'el'}
#                                \     -----  
#                         cond2    \   _____ 
#                                   ->|     |
#                                     |     |
#                                     |     |
#                                      ----- 
#
#
#   Extra relevant keys:
#      +  'dropthru' == closing $label of all if/goto conds
#      +  'forced'   == [{'block' => $statptr,
#     		          'label' => $label,
#		          'level' => $level,
#		          'cond'  => $forcedptr} ];
#                    == a list of unfulfilled labels from a backtrack() 
#      +  'fixitup'
#      +  'contig'
#
##########################################################

sub  buildParseTree {

   @branchList =(sort {$a <=> $b} keys %branches);#actual branch pt line numbers
   @numberList =(sort {$a <=> $b} keys %labeledLines);# actual branch pt line numbers

DEBUG(4,"branch list: @branchList \n");
DEBUG(4,"corresponding lines: @numberList \n");

   $stack = [ {'block'=> 'root',
               'stats'=> [] } ] ;       # reference to  Data Structure array
   # initial comments and statements should go straight into this first
   #           'stats' list

   $commentRec=0;                        # initialize null comment record
   @bmode = ( ); # a null list of hashes
   $level = 0;                           # current nesting level
   $bmode[$level]{'top'}  = $stack;      # pointer to top of Data structure
   $bmode[$level]{'el'}   = $stack->[0];   # pointer to top level record of DS
   $bmode[$level]{'sub'}  = undef;      # reset sub level statement pointr
   $bmode[$level]{'oblk'} = $stack->[0]{'stats'} ; # pointer to first open block
   $noPathToNext = 0;                   # path to first statement exists


   $SkipRepeat = 0 ;                    # no undorepeat as yet
###   parseTheLine(0,0,0,95);  # debug to line number ...
   parseTheLine(0,0,0,$statlnum-1);  ######  
DEBUG(4,"@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@\n") ;
}


sub parseTheLine {
   my $i = shift;     # initialize list pointers
   my $j = shift;
      $h = shift;
   my $lastline = shift;
LINE: for( ;$h<=$lastline;$h++) {     # search for statement block delimiters

      $ConsumedTheLine=0;
      my $CurrState = {                   # save state of relevant vars
                  'h'     =>$h,
                  'i'     =>$i,
                  'j'     =>$j,
                  'statefunc'    => $statefunc,
                  'dropthru'     => $dropthru,
                  'noPathToNext' => $noPathToNext,
                  'level'        =>$level,
      };

      $statefunc = 'addToBlock' ;    # general purpose statement
      $dropthru = 'no' ;

      if ($noPathToNext > 0) {
           # last line indicated no path to this line
           ++$noPathToNext; # 
      }
      



#  For each line check first if it is labelled and process the line
#  label FIRST - because for each line 
#
#  LABEL  Do something exotic
#  
#  it can always be rewritten as
#
#  LABEL' CONTINUE : forward branch point
#  LABEL" CONTINUE : backward branch point
#          Do something exotic
#
#
#  If the line is labelled, we have to check if it 
#  terminates an old block or initiates a new block of 
#  active program code --- or both!!.
#

# CHECK THE LINE LABELS
      if ($i <scalar(@numberList)){
      if ($h >= $numberList[$i] ) {      # struck a line number

         $nextImpendingLabel = $i+1;

         my $label =  $labeledLines{$h} ;   # recover the label id
#         IncrLineInfo($h);
#         SetLineInfoField('label',$label);

         # create new item to record the statement sublevel
         # this will simply be over written if backtracking so no problem
         $labeledLineCode{$label}{'level'} = $level ; 
         my $stat = $statements[$h]{'stat'}  ;
         my $cont = 0   ;
         if  ($stat =~ m/\s+continue\s+/i) {$cont = 1 ;}
      
         if(scalar(keys %{$labeledLineCode{$label}{'do'}})   == 0 &&
            scalar(keys %{$labeledLineCode{$label}{'if'}})   == 0 &&
            scalar(keys %{$labeledLineCode{$label}{'ifexp'}})   == 0 &&
            scalar(keys %{$labeledLineCode{$label}{'goto'}}) == 0 &&
            scalar(keys %{$labeledLineCode{$label}{'temp'}}) == 0 &&
            scalar(keys %{$labeledLineCode{$label}{'jump'}}) == 0 ) {
                 # could safely ignore any line label analysis here 
            if  ($stat =~ m/\s+format\s*\(/i ) {  ; # ignore FORMAT) statments
# could be required for READ(ERR=200,...) statements also 
#               SetLineInfoField('essentialLabel',1);
            } else {     # could conditionally delete line label 
#               SetLineInfoField('irrelevantLabel',1);
DEBUG(7,"No ref to line labeled: $label \n") ;
            }
         }
         else { 
#            SetLineInfoField('labrefs',$label);
            my $frozen; 
            if ($SkipRepeat == 0 and  potentialRepeat($label,$h) ) { 
              $frozen =  deepFreeze($CurrState) ;
            }

# search for references back through the stack of open 'flow' blocks
# iterate back over all parent levels looking for line label matches.

            my $prelevel = $level ;
LEVEL:      for (my $lev=$level; $lev>=0;$lev--) {
               my $tmpr = $bmode[$lev]{'el'};   # a temp pointer to current item
               my $notmember = 1 ;
               my $k ;
               foreach $k ( @{$tmpr->{'jump'}} ) {
                  if ($label eq $k ) { $notmember = 0 ; 
                    last ; } # no matching statement
               }
               if ( $notmember == 1  ){  next LEVEL ; } #no match so check prev


               if ($tmpr->{'block'} eq 'if' ) { 
                   ModifyIfCondStatus($lev,$label, $tmpr);
               } 
               elsif ($tmpr->{'block'} eq 'ifexp' ) { 
                   ModifyIfExpCondStatus($lev,$label, $tmpr);
               } 
               elsif ($tmpr->{'block'} eq 'goto' ) {
                   ModifyGotoCondStatus($lev,$label, $tmpr);
               }  

               elsif ($tmpr->{'block'} eq 'do' ) {   #  record is part of a 'do'
                   ModifyDoCondStatus($lev,$label, $tmpr);
               }

               elsif ($tmpr->{'block'} eq 'REPEAT') {# record terminates REPEAT?
                   ModifyRepeatCondStatus($lev,$label, $tmpr );
		   # safety catch
                   if ($SkipRepeat ==-1){# current line is already taken care of
                      $SkipRepeat = 0;   # reset flag to normal
                      if ($j <scalar(@branchList)&&  $h >= $branchList[$j] ) {
                          $j++; # current line was also a branching statement
                      }
                      $i++; next LINE;
                   } # get next line and continue as normal
               }

               # else we could actually be skipping blatant JUMP statements here
   
            } # end of loop over levels


            # Catch and interpret otherwise unresolved jump targets

            TreatBackwardReferences($label,$frozen); #  for repeat loops

            # its a jump target. There has to be a path to the next statement
            # unless this is also a branch statement which we can over ride
            # below

            $noPathToNext=0; #  assume it isn't a branch statement

         }           # end of 'its a referenced statement number'
         $i++ ;      # used this line number so point to consecutive
      }}             # end of 'if a numbered statement'

      #
      #  EXAMINE BRANCHING STATEMENTS
      #  ----------------------------
      #

      # a line number AND a branching statement ??
      if ($j <scalar(@branchList)){
      if ($h >= $branchList[$j] ) {     # struck a branching statement

         my $clmode = $branches{$h}[0]{'type'}; #  get mode of current line
	 if (not defined $clmode) {
          
DEBUG(10," j  $j:,h $h  \n" );
DEBUG(10,"$branches{$h}[0]\n" );
            my @jnk1 = (keys %{$branches{$h}[0]});
DEBUG(10,"$h; @jnk1 ; $branches{$h}[0]{'type'}\n" );
           $clmode = 'crap'; # introduced broken line construct?
        }


         if    ($clmode eq 'if'   ) {
            StartANewIfBlock();
         }
         elsif ($clmode eq 'ifexp') {
            StartANewIfExpBlock();
         }
         elsif ($clmode eq 'goto' ) {
            StartANewGotoBlock();
         }
         elsif ($clmode eq 'do'   ) {
            StartANewDoBlock();
         }
         elsif ($clmode eq 'jump' ) {  # an unconditional branch point


            my @path = @{$branches{$h}[0]{'jump'}} ; # pointer to branch point labels
            my $label = $path[0] ;                  # get destination line label
            my $index = $labeledLineCode{$label}{'index'} ;


            if ($index < $h) {           # JUMPING BACKWARDS!
               # reset current state pointer to stop adding to current block
               BackwardJumpMode($label);
            }

            else  {                      # JUMPING FORWARDS!
               #$statefunc = 'ignoreState' ;         # a branch flow statement
               #$noPathToNext = 1;      # no possible path to next statement
               ForwardJumpMode($label);
               # return back to upper recursion level
               if ($SkipRepeat ==-1) {$SkipRepeat = 0; $j++; next LINE;} 
               # reset current state pointer to stop adding to current block
            }

            # also if the next statement is unlabelled there can be no
            # path to it and warnings should be issued.



         }
         $j++ ;       # increment  to next branch statement
      }}


      if ($statefunc ne 'ignoreState' ) { # for all untreated statements
         consumeTheLine(); # probably should split func into consume+endBlock
      } 
      else { 
         $h += $statements[$h]{'extra'}; # should be taken care of ...
      }
   }   # end of loop over all statements in subroutine
}



#
#  ADD RESIDUAL STATEMENTS TO CURRENT OR NEW STATEMENT BLOCK
#  --------------------------------------------------------------
#
sub  consumeTheLine() {

   if ($statefunc eq 'dontAddButEnd' ) { # from ifexp
            $statefunc = 'endBlock' ; 
   }
   elsif ( $noPathToNext > 1){ ;      # no path to this statement
DEBUG(7,"Add to Comment rec: $statements[$h]{'stat'}\n");
         # if $noPathToNext ==2, then this is the first inaccessible line
            if ( $commentRec ==0 ) {    # no comment rec exists
                                                  # create a new comment record
               $commentRec = { 'block' => 'comm', # a record of comments
                               'corupt' => 0,     # assume ok
                               'stats' => [],     # a null list of statements
               } ;                                # a reference to a record
            }
            # add comments to temporary comment record buffer
            push @{$commentRec->{'stats'}}, $statements[$h]; 

            if ($h >= $statlnum - 1 &&
               $statements[$h]{'stat'} =~ m/^......[eE][nN][dD]\s+$/  ) {

               #push @{$bmode[$level]{'top'}} ,  $commentRec; # copy pointer 
               push @{$bmode[0]{'top'}} ,  $commentRec; # copy pointer 
               $commentRec->{'block'}='stats'; # override this!
               $commentRec=0 ;               # reset to null
DEBUG(7,"No path to END statement on line $h : $level \n");

               return;
               #next LINE;

            } elsif ($statements[$h]{'stat'} =~ m/^[^cC]/ ) {
                $commentRec->{'corupt'} = 1; # flag as broken
DEBUG(7,"No path to active statement line $h : \n  $statements[$h]{'stat'}\n");
            }
   }




   elsif (not defined $bmode[$level]{'el'}  ) {   # no currently active record
                                              #  so  create a new one
      my $statrec =  { 'block' => 'stats', # a record of simple statements
                          'stats' => [],      # a null list of statements
      } ;                               # a reference to a record

      if ($commentRec !=0 ) { 
         push @{$bmode[$level]{'top'}} ,  $commentRec; # copy pointer 
         $commentRec=0 ;               # reset to null
      }

DEBUG(7,"STATS   block for $statements[$h]{'stat'}");
            # push new ref onto array pointed to by top
      push @{$bmode[$level]{'top'}} ,  $statrec; 
      $bmode[$level]{'el'} = $statrec; 
      $bmode[$level]{'oblk'} = $bmode[$level]{'el'}{'stats'} ;

      # add statements to newly opened record
      push @{$bmode[$level]{'oblk'}}, $statements[$h]; 
      while ($h< $statlnum-1 and $statements[$h+1]{'type'} eq 'lcont') {
          # suck up any line continuations
          push @{$bmode[$level]{'oblk'}}, $statements[++$h]; 
      }
   }


   # else simply add the statement to the current open record
   else  { 
      push @{$bmode[$level]{'oblk'}}, $statements[$h];
      while ($h<$statlnum-1 and $statements[$h+1]{'type'} eq 'lcont') {
          # suck up any line continuations
          push @{$bmode[$level]{'oblk'}}, $statements[++$h]; 
      }
   }


   # closing sublevel statement blocks
   if ($statefunc eq 'endBlock' ) {
      my $blktype = $bmode[$level]{'el'}{'block'} ;
DEBUG(7,"Ending the block of type $blktype at level $level \n") ;

      $bmode[$level]{'el'} = undef ; # flag as no currently active record
      if ($level >0 ) {
         $level-- ;                  # back to enclosing block
         while($level>=0 ) {           # check for closed parents ??

            if ( levelStateFinished($level) ) { # parent is closed!
DEBUG(8,"Parent block at $level is closed \n");
#DEBUG(8," ZZZ $bmode[$level]{'el'}{'block'} :$bmode[$level]{'el'}{'ended'} :$bmode[$level]{'el'}{'done'} \n");

               $bmode[$level]{'el'} = undef ; # flag as no currently active record
               if ( levelStateFinished($level-1) ) { # parent is closed!
                  my $l1=$level-1;
DEBUG(8,"Parent block $bmode[$l1]{'el'}{'block'} at $l1 is closed \n");
#DEBUG(8," ZZZ $bmode[$l1]{'el'}{'block'} :$bmode[$l1]{'el'}{'ended'} :$bmode[$level-1]{'el'}{'done'} \n");
                  $#bmode=$level; # delete last level entry
                  $level-- ;
                  next ;
               }
            }
            last;     #
         }
         $bmode[$level]{'el'} = undef ; # flag as no currently active record
      }
DEBUG(7,"expecting new level $level block\n");
           
   }
   $ConsumedTheLine=1;
}


#   $lineInfo->[] is an updated array of augmented line printing info
#   designed to collapse under revertToState, Undo REPEAt etc.
# unfortunately it was a crap idea and keels over if a ref to a label
# is encountered before the actual label

sub ModifyLabelStatus{
   my $line  = shift; # this line
   my $level = shift; # at current level
   my $label = shift; # points to THIS label
   my $result= shift; # in this fashion
   my $block = shift; # from this origin?
#DEBUG(7,"modifying label $label status for block $block->{'block'}: level $level\n");
   
   my $arr = $labeledLineCode{$label}{'refInfo'}; #copy array pointer
   push @{$arr} , {
      'statement'=>$line ,
      'level'    =>$level ,
      'result'   =>$result,#'forgedContinue','essentialLabel','irrelevantLabel'
      'block'  => $block ,
     } ;
}

sub DestroyLabelInfoBackToLine {
   my $line = shift;
DEBUG(7,"ERASING LineInfo from $h back to $line\n");
   foreach my $lab (keys %labeledLineCode) {
      my $labarray = $labeledLineCode{$lab}{'refInfo'};# pointer to array
      my $k=-1;
      foreach my $lineRef (@{$labarray}) {
        $k++;
        if ($lineRef->{'statement'}>$line) {
   $#{$labarray}=$k-1;   # truncate the array back to <$line
           last;
        }
      }
   }
}




#
# short test  for potential REPEAT statements. 
# If no chance of REPEAT then we can reduce freeze 
# instances as much as possible, - giving some modicum of efficiency
#
sub potentialRepeat {    #i.e future references back to here
   my $label = shift;
   my $currLine = shift;
   # check all classes of brancing statements to see if they 
   # reference the current $label
   foreach my $key ('if','goto','jump','ifexp') {
      my @jmp = keys %{$labeledLineCode{$label}{$key}} ;
      foreach my $index (@jmp ) {  # for each line number
         if ($index > $currLine){# there is a future back ref to this line label
            return 1;            # so potentially a repeat here
         }
      }
   }
   return 0 ;                    # no likelihood what so ever
}


# freeze the current state of the parse tree, for backtracking
# Since nothing is ever deleted from this tree except when
# undoRepeat is activated, we don't need to save the contents,
# just the uppermost array indices etc
sub  deepFreeze {
DEBUG(11,"Possible REPEAT. Freezing state for potential UNDO\n");
   my $CurrState = shift ;
   my $lev ;
   my $ss = [];  # savestate - top level is a list
   for ($lev=0 ; $lev<=$level;$lev++) {
      my $lpt= $bmode[$lev] ;
      $ss->[$lev]={ 'top'  =>undef,    # point to start of array for level
                  'el'   =>undef,    # points to last elem of array for level
                  'sub'  =>undef,    # point to active sub level of level 
                  'oblk' =>undef,   # points to actual statement list
                  'bmode'=>$lpt,
                };
DEBUG(12,"XXX level $lev\n");
      if (not defined $lpt->{'top'}) { last ; }# should be debugging this inactive level
      $ss->[$lev]{'top'}=  $lpt->{'top'} ; 
#      if ($lpt->{'el'} == undef) { last ; } 
      $ss->[$lev]{'el'}=  $lpt->{'el'} ;   # save pointer to top of array
#      if ($lpt->{'sub'} == undef) { last ; }
      $ss->[$lev]{'sub'}=  $lpt->{'sub'} ;  # save pointer to subitem
#      $ss->[$lev]{'cstatlen'}= scalar(@{$lpt->{'sub'}}); # num of entries
      if (defined @{$lpt->{'sub'}}) {
         $ss->[$lev]{'cstatlen'}= scalar(@{$lpt->{'sub'}}); # num of entries
      } else {
         $ss->[$lev]{'cstatlen'}= undef ;
      }
#      if ($lpt->{'oblk'} == undef){ last ; }
      $ss->[$lev]{'oblk'}=  $lpt->{'oblk'}; # save pointer to actual statements
      if (defined @{$lpt->{'oblk'}}) {
         $ss->[$lev]{'statlen'}= scalar(@{$lpt->{'oblk'}}); # num of entries
      } else {
         $ss->[$lev]{'statlen'}= undef ;
      }
#DEBUG(12,"XXX $ss->[$lev]{'top'}:$ss->[$lev]{'el'}:$ss->[$lev]{'sub'}:$ss->[$lev]{'oblk'}\n");

 # potentially room for confusion because we are merging bmode and struct info.
 # Watchout for key name clashes if redesigning this ...
      my $llpt= $lpt->{'el'};
      foreach my $bkey (keys %{$llpt}) {
         if (not ref($llpt->{$bkey}) ) {  # i.e. a scalar 
            $ss->[$lev]{$bkey}= $llpt->{$bkey}; # copy scalars
DEBUG(12,"XXX    $bkey : $ss->[$lev]{$bkey}\n");
         }
         elsif (ref($llpt->{$bkey}) eq 'ARRAY' ) {
            if ($bkey ne 'stats') { # skip sublevel gateway
               $ss->[$lev]{$bkey}= [@{$llpt->{$bkey}}]; # array copy of jumps
DEBUG(12,"XXX    $bkey : @{$ss->[$lev]{$bkey}}\n");
            }
	    else {
               $ss->[$lev]{$bkey}= $llpt->{$bkey}; # copy array pointer
DEBUG(12,"XXX    $bkey : @{$llpt->{$bkey}}\n");
            }
         }
         elsif (ref($llpt->{$bkey}) eq 'HASH') { # only for if/goto cond blocks
               $ss->[$lev]{$bkey} = $llpt->{'cond'}; # copy hash reference
               foreach my $llkey (keys %{$llpt->{'cond'}})  {
                    $ss->[$lev]{'condkeys'}{$llkey}= 1; # copy state keys
DEBUG(12,"XXX       $bkey :$llkey: $ss->[$lev]{'condkeys'}{$llkey}\n");
               }
#    $ss->[$lev]{'condkeys'}= [keys %{$llpt->{'cond'}}]; # copy state keys
               # if there is more than one state
               # those early states should never be modified again and
               # only the current state may be appended to.
               # The current state is indicated by {'sub'} pointing to 
               # {'cond'}{State}{'cstats'} . That should be dealt with 
               # by the next sub level. However 'oblk' should be saved. Right?
               #  'oblk' points to {'cond'}{State}{'cstats'}[n]{'stats'}[]
               # that should be taken care of by 'statlen' and 'cstatlen'
         }
      }
   }
   $lev=$level;
if ($lev >=0) {
DEBUG(12,"XXX $ss->[$lev]{'top'}:$ss->[$lev]{'el'}:$ss->[$lev]{'sub'}:$ss->[$lev]{'oblk'}\n");
}
   $ss->[0]{'CurrState'}= $CurrState; # savestate - top level is a list
   return $ss ;  # return pointer to the coppied struct
}


# Unthaw previously frozen state
# used only for backtracking after a wrong REPEAT assumption was previously made
sub  revertToState {
   my $ss = shift; # recover pointer to top of tree
   my $mxlev = scalar(@{$ss});
   my $lev = $ss->[0]{'CurrState'}{'level'}; 
DEBUG(11," Reverting to State : maxlevel $mxlev: $lev\n");
   for ($lev=0 ; $lev<$mxlev;$lev++) {
DEBUG(11,"\nXXX level $lev\n");
      my $cpt= $bmode[$lev] ; #current pointer
      my $opt= $ss->[$lev]  ; #original pointer
      
      # if $cpt->{'top'} != $opt->{'top'} then all $cpt is thrown away here!
      $cpt->{'top'} = $opt->{'top'}; #   lose all trace of subsequents
      $cpt->{'el'}  = $opt->{'el'};   #   copy pointer to @{$opt->{'top'}} 
      $cpt->{'sub'} = $opt->{'sub'}; # 
      $cpt->{'oblk'}= $opt->{'oblk'}; # 
DEBUG(12,"\nXXX   $cpt->{'top'}: $cpt->{'el'}: $cpt->{'sub'}: $cpt->{'oblk'}\n");
      unless (ref( $opt->{'top'}))    { next; } # nothing more to do!

           
DEBUG(12,"\nXXX  top1 @{$cpt->{'top'}}\n");
DEBUG(12,"\nXXX  topx $cpt->{'el'}\n");
      my $val;         # pop and throw away subsequents ...
      while ( ($val= pop @{$cpt->{'top'}}) !=  $cpt->{'el'} and 
                $#{$cpt->{'top'}} >= 0 ) { ; }
      if (defined $val) { push @{$cpt->{'top'}} , $val ;}
DEBUG(12,"\nXXX  top2 @{$cpt->{'top'}}\n");
      
      if (defined  $opt->{'sub'} and defined $opt->{'oblk'} ) { 

         if ($#{$cpt->{'oblk'}} < $opt->{'statlen'}-1) {
DEBUG(12,"\n\n      SHIT! where did that go?\n");
         } else  {
         	   # trim the subsequents from the stat array
              $#{$cpt->{'oblk'}} = $opt->{'statlen'}-1;
         }
      }

      my $tpt= $opt->{'el'} ;
      my $key ; 
      my $cstatlen =$opt->{'cstatlen'} ;
      my $statlen  =$opt->{'statlen'};
      my $condkeys =$opt->{'condkeys'};
      foreach $key (keys %{$opt}) { 
	 if    ($key eq 'cstatlen') {next; }
	 elsif ($key eq 'statlen')  {next; }
	 elsif ($key eq 'sub') {next; }         # can be -1
	 elsif ($key eq 'oblk') {next; }
	 elsif ($key eq 'top') {next; }
	 elsif ($key eq 'el') {next; }
	 elsif ($key eq 'condkeys') {next; }
	 elsif ($key eq 'bmode') {next; }
	 elsif ($key eq 'CurrState') {next; }
	 my $ref = ref( $opt->{$key}) ;
         if (not $ref ) {  
            $cpt->{'el'}{$key} =  $opt->{$key}; 
DEBUG(12,"XXX    $key : $cpt->{'el'}{$key}\n");
         }
         elsif ($ref eq "ARRAY") {
            if ($key eq 'stats') {          # for do/REPEAT
                $cpt->{'el'}{$key} =  $opt->{$key}; 
		# the 'stat' array (if it exists) contains all sublevels
		while (scalar(@{$opt->{$key}}) > $cstatlen) {
                    pop @{$opt->{$key}};    # inefficient?
                }
DEBUG(12,"XXX    $key : @{$opt->{$key}}\n");
            } else {
               $cpt->{'el'}{$key} =  [@{$opt->{$key}}]; # list copy
DEBUG(12,"XXX    $key : @{$cpt->{'el'}{$key}}\n");
            }
         }
         elsif ($ref eq "HASH") {
            if ($key eq 'cond') {
               $cpt->{'el'}{$key} =  $opt->{$key}; #copy hash pointer
DEBUG(12,"XXX    $key : $tpt->{$key}\n");
      	       foreach my $ckey (keys %{$opt->{$key}}){# coppied  condition list
                  if ( not exists ${$condkeys}{$ckey} ) {
                     delete $opt->{$key}{$ckey} ;
                  }
                  else {
DEBUG(12,"XXX       $ckey :  $opt->{$key}{$ckey}\n");
                  }
               }
            }
	    else  {
               $cpt->{'el'}{$key} =  $opt->{$key}; #copy hash pointer
DEBUG(12,"XXX      unidentified : $key : $opt->{$key}\n");
            }
                
         }
	 else {
DEBUG(12,"XXX      unidentified : $key : $tpt->{$key}\n");
         }
      }
   }

    
     my $SavedVars = $ss->[0]{'CurrState'}; 
     # reset global variables
     $level        = $SavedVars->{'level'}; 
     $statefunc    = $SavedVars->{'statefunc'};
     $dropthru     = $SavedVars->{'dropthru'} ;
     $noPathToNext = $SavedVars->{'noPathToNext'} ;
}



##  if ($statefunc eq 'preEndBlock' ) 
sub  PreEndBlock {
   # close all currently terminated  branch blocks
   $bmode[$level]{'el'}   = undef ; # terminated the 'if' sublevel
   $bmode[$level]{'sub'}  = undef ; # certainly no sub record
   $bmode[$level]{'oblk'} = undef ; # consequently no open stat list
           # terminated the 'if' (or GOTO ???)  also
   
   while ($level>0 && $bmode[$level-1]{'el'}{'done'} == 1){ 
DEBUG(7,"popping level $level\n");
      $level--;   # close the current sub level 'if condition'
      $bmode[$level]{'el'}   = undef ; # terminated the 'if' also
      $bmode[$level]{'sub'}  = undef ; # certainly no sub record
      $bmode[$level]{'oblk'} = undef ; # consequently no open stat list
   }
   # then add terminating statement to new record 
}





#The current line label matches some part of a parent 'if' statement
sub  ModifyIfCondStatus {

   my $lev = shift;
   my $label = shift;
   my $tmpr =shift ;
   CheckCondContiguous($tmpr,$commentRec);

   my @tmpl = @{$tmpr->{'jump'}};     # cast pointer to array
   my $pre = $tmpr->{'active'} ;      # save initial active state
   my $prebegun = $tmpr->{'begun'} ;  # save initial state     
   my $fin =  0;
   my $actlist = { };                 # initialize null hash
#have to copy the $pre  hash and append the new $label:$actlist  key:value pair
   if ($pre != 0 ) {                 # copy the $pre hash
      my $xltmp= $tmpr->{'cond'}{$pre}{'plabs'} ; # pnt to hash
      foreach my $key (keys %{$xltmp} ) {        
         # copy active arrays
         $actlist->{$key} = [ @{$xltmp->{$key}} ];
      }
   }
   my $refcnt=0;
   for (my $k=0;$k<scalar(@tmpl);$k++) {  # loop over conditions
      $fin += 2**$k;               # construct final state
      if ($label eq $tmpl[$k] ) {# label is relevent to this 'if'
         # OR  a 3 bit binary state flags
         $refcnt++;
         $tmpr->{'active'} = $tmpr->{'active'} | 1<<$k;
         $tmpr->{'begun'}  = $tmpr->{'begun'}  | 1<<$k;
         push @{$actlist->{$label}}, $k ;
         ModifyLabelStatus($h,$level,$label,'unnecessary',$tmpr);
      }
   }
#     $tmpr->{'cond'}{State}{'plabs'}{LineLabel} = [1, 100,10000 ] 
              # being the active states (binary)

#   $statements[$labeledLineCode{$label}{'index'}]{'labref'} -=$refcnt;



   if (( $tmpr->{'active'}|$tmpr->{'ended'}) == $fin){

      my $state = $tmpr->{'active'} ;  # local pointer
      $tmpr->{'dropthru'} =  $label ; # drop-thru line label
      $dropthru = 'yes' ;

     if ($pre==0) {     # no statement block to close
                        # this labeled line constitutes a null 
                        # statement block which  effectively terminates 
                        # the 3 state or 2 state parent 'if' statement.

        $tmpr->{'cond'}{$state} = { # build a dummy state hash
                'plabs' =>{}, #save pointer to new hash of hash
                'class' =>'term',# retain cond as type goto 
                'label' =>$label, # branch label (not current labl!!)
                'line'  =>$h,    # save pointer to newly alloc hash
                'cstats'=>[],    # no conditional statements
              };                 # finish current record
     }
     elsif ($prebegun != $fin)  {
                        # this labeled line representd the merging  of 
                        # all possible test conditions and effectively 
                        # terminates the 3 state or 2 state parent 'if' 
                        # statement.
        $tmpr->{'cond'}{$state} = { # build a dummy state hash
                'plabs' =>{}, #save pointer to new hash of hash
                'class' =>'null',# retain cond as type goto 
                'label' =>$label, # branch label (not current labl!!)
                'line'  =>$h,    # save pointer to newly alloc hash
                'cstats'=>[],    # no conditional statements
               };                 # finish current record
     }

#     ModLineInfoField('unrequLabelCount',$refcnt);

     $tmpr->{'ended'} |=  $state ;
     $tmpr->{'active'} = 0 ;

     $tmpr->{'done'} = 1 ; # flag as finished

DEBUG(7,"$label terminates an if: state $pre -> $tmpr->{'begun'} : @tmpl\n") ;
     if ($lev >= $level-1) { # ignore sublev 'stat' rec if exists
        if (not defined $bmode[$level]{'oblk'} and 
                $lev == $level ) {  ;#finished but not even open!
           $bmode[$level]{'el'}  = undef; # finish if record,start new one
        }
        else { 
           $statefunc = 'preEndBlock';  # ending this 'if' record
           PreEndBlock(); 
        }
                   # this labeled line is a "branch to" line,
                   # so unless it is a GOTO statement etc, there is a
                   # definite path to the next statement
                   $noPathToNext = 0;
     }
     else {
DEBUG(7,"$label CHRIST ALMIGHTY! Who wrote this SHIT?\n");
DEBUG(7,"Terminating level: $lev while sublevel: $level-1 still active!\n");
DEBUG(7,"Backtracking to fix\n");

        backtrack($lev,$level-1)  ;
        $level=$level+1;
        $statefunc = 'preEndBlock';  # ending this 'if' record
        PreEndBlock(); 
     }
   }

   #  starting a new 'if' condition
   else {

      my $class = 'blok' ; # default 
      if ($pre != 0) {     # appending new code within an already
         $class= 'multi' ; # open if condition
         $tmpr->{'cond'}{$pre}{'class'}=$class;# reset first also
      } else  {
#         ModLineInfoField('unrequLabelCount',$refcnt);
      }
      my $state = $tmpr->{'active'} ;  # local pointer
      $tmpr->{'cond'}{$state} = { # 
              'plabs'  => $actlist, #save pointer to new hash of hash
              'class'  => $class,
              'label'  => $label,
              'line'   => $h,   #save pointer to newly alloc hash
              'cstats' => [],   # the conditional statements
            };                   # finish current record

      $bmode[$level]{'sub'} = $tmpr->{'cond'}{$state}{'cstats'} ;
      $bmode[$level]{'oblk'}= undef ; # no record exists yet

DEBUG(7,"$label changes 'if' state from $pre to $tmpr->{'active'}\n") ;
      if ($pre <= 0 ) {          # if no current sublevel
         $level++ ;              # make a new sublevel
         $bmode[$level]{'top'}  = $bmode[$level-1]{'sub'};
         # set a pointer to new statement block
         $bmode[$level]{'el'}   = undef ; # no element here
         $bmode[$level]{'sub'}  = undef ;
         $bmode[$level]{'oblk'} = undef ;
      }

      $statefunc = 'startNewBlock';   # begining a block
      $noPathToNext = 0;    # now assured  but what to do with prev?

   }

}

#The current line label matches some part of a parent 'if' statement
sub  ModifyIfExpCondStatus {

   my $lev = shift;
   my $label = shift;
   my $tmpr =shift ;
   CheckCondContiguous($tmpr,$commentRec);

   my @tmpl = @{$tmpr->{'jump'}};     # cast pointer to array
   my $pre = $tmpr->{'active'} ;      # save initial active state
   my $prebegun = $tmpr->{'begun'} ;  # save initial state     
   my $fin =  0;
   my $actlist = { };                 # initialize null hash
#have to copy the $pre  hash and append the new $label:$actlist  key:value pair
   if ($pre != 0 ) {                 # copy the $pre hash
      my $xltmp= $tmpr->{'cond'}{$pre}{'plabs'} ; # pnt to hash
      foreach my $key (keys %{$xltmp} ) {        
         # copy active arrays
         $actlist->{$key} = [ @{$xltmp->{$key}} ];
      }
   }
   my $refcnt=0;
   for (my $k=0;$k<scalar(@tmpl);$k++) {  # loop over conditions
      $fin += 2**$k;               # construct final state
      if ($label eq $tmpl[$k] ) {# label is relevent to this 'if'
         # OR  a 3 bit binary state flags
         $refcnt++;
         $tmpr->{'active'} = $tmpr->{'active'} | 1<<$k;
         $tmpr->{'begun'}  = $tmpr->{'begun'}  | 1<<$k;
         push @{$actlist->{$label}}, $k ;
         ModifyLabelStatus($h,$level,$label,'unnecessary',$tmpr);
      }
   }
#     $tmpr->{'cond'}{State}{'plabs'}{LineLabel} = [1, 100,10000 ] 
              # being the active states (binary)

#   $statements[$labeledLineCode{$label}{'index'}]{'labref'} -=$refcnt;



   if (( $tmpr->{'active'}|$tmpr->{'ended'}) == $fin){

      my $state = $tmpr->{'active'} ;  # local pointer
      $tmpr->{'dropthru'} =  $label ; # drop-thru line label
      $dropthru = 'yes' ;

     if ($pre==0) {     # no statement block to close
                        # this labeled line constitutes a null 
                        # statement block which  effectively terminates 
                        # the 3 state or 2 state parent 'if' statement.

        $tmpr->{'cond'}{$state} = { # build a dummy state hash
                'plabs' =>{}, #save pointer to new hash of hash
                'class' =>'term',# retain cond as type goto 
                'label' =>$label, # branch label (not current labl!!)
                'line'  =>$h,    # save pointer to newly alloc hash
                'cstats'=>[],    # no conditional statements
              };                 # finish current record
     }
     elsif ($prebegun != $fin)  {
                        # this labeled line representd the merging  of 
                        # all possible test conditions and effectively 
                        # terminates the 3 state or 2 state parent 'if' 
                        # statement.
        $tmpr->{'cond'}{$state} = { # build a dummy state hash
                'plabs' =>{}, #save pointer to new hash of hash
                'class' =>'null',# retain cond as type goto 
                'label' =>$label, # branch label (not current labl!!)
                'line'  =>$h,    # save pointer to newly alloc hash
                'cstats'=>[],    # no conditional statements
               };                 # finish current record
     }

#     ModLineInfoField('unrequLabelCount',$refcnt);

     $tmpr->{'ended'} |=  $state ;
     $tmpr->{'active'} = 0 ;

     $tmpr->{'done'} = 1 ; # flag as finished

DEBUG(7,"$label terminates an if: state $pre -> $tmpr->{'begun'} : @tmpl\n") ;
     if ($lev >= $level-1) { # ignore sublev 'stat' rec if exists
        if (not defined $bmode[$level]{'oblk'} and 
                $lev == $level ) {  ;#finished but not even open!
           $bmode[$level]{'el'}  = undef; # finish if record,start new one
        }
        else { 
           $statefunc = 'preEndBlock';  # ending this 'if' record
           PreEndBlock(); 
        }
                   # this labeled line is a "branch to" line,
                   # so unless it is a GOTO statement etc, there is a
                   # definite path to the next statement
                   $noPathToNext = 0;
     }
     else {
DEBUG(7,"$label CHRIST ALMIGHTY! Who wrote this SHIT?\n");
DEBUG(7,"Terminating level: $lev while sublevel: $level-1 still active!\n");
DEBUG(7,"Backtracking to fix\n");

        backtrack($lev,$level-1)  ;
        $level=$level+1;
        $statefunc = 'preEndBlock';  # ending this 'if' record
        PreEndBlock(); 
     }
   }

   #  starting a new 'if' condition
   else {

      my $class = 'blok' ; # default 
      if ($pre != 0) {     # appending new code within an already
         $class= 'multi' ; # open if condition
         $tmpr->{'cond'}{$pre}{'class'}=$class;# reset first also
      } else  {
#         ModLineInfoField('unrequLabelCount',$refcnt);
      }
      my $state = $tmpr->{'active'} ;  # local pointer
      $tmpr->{'cond'}{$state} = { # 
              'plabs'  => $actlist, #save pointer to new hash of hash
              'class'  => $class,
              'label'  => $label,
              'line'   => $h,   #save pointer to newly alloc hash
              'cstats' => [],   # the conditional statements
            };                   # finish current record

      $bmode[$level]{'sub'} = $tmpr->{'cond'}{$state}{'cstats'} ;
      $bmode[$level]{'oblk'}= undef ; # no record exists yet

DEBUG(7,"$label changes 'if' state from $pre to $tmpr->{'active'}\n") ;
      if ($pre <= 0 ) {          # if no current sublevel
         $level++ ;              # make a new sublevel
         $bmode[$level]{'top'}  = $bmode[$level-1]{'sub'};
         # set a pointer to new statement block
         $bmode[$level]{'el'}   = undef ; # no element here
         $bmode[$level]{'sub'}  = undef ;
         $bmode[$level]{'oblk'} = undef ;
      }

      $statefunc = 'startNewBlock';   # begining a block
      $noPathToNext = 0;    # now assured  but what to do with prev?

   }

}




#The current line label matches some part of a parent 'goto' statement
sub  ModifyGotoCondStatus {

     my $lev = shift;
     my $label = shift;
     my $tmpr =shift ;
#  

                  CheckCondContiguous($tmpr,$commentRec);
                  $statefunc = 'startNewBlock';   # begining a block

                  my @tmpl = @{$tmpr->{'jump'}};     # cast pointer to array
                  my $pre  = $tmpr->{'active'} ;      # save initial state     
                  my $prebegun = $tmpr->{'begun'} ;  # save initial state     
                  my $fin     =  0;
                  my $actlist = { };                # null hash
#have to copy the $pre hash and append the new $label:$actlist  key:value pair
                  if ($pre != 0 ) {                 # copy the $pre hash
                     my $xltmp = $tmpr->{'cond'}{$pre}{'plabs'} ; # pnt to hash
                     foreach my $key (keys %{$xltmp} ) {        
                        # copy active arrays
                        $actlist->{$key} = [ @{$xltmp->{$key}} ];
                     }
                  }

                  my $refcnt=0;
                  for (my $k=0;$k<scalar(@tmpl);$k++) {  # loop over conditions
                     $fin += 2**$k;               # construct final state
                     if ($label eq $tmpl[$k] ) {# label is relevent to this GOTO
                        $refcnt++;
                        # OR  a 3 bit binary state flags
                        $tmpr->{'active'} = $tmpr->{'active'} | 1<<$k;
                        $tmpr->{'begun'}  = $tmpr->{'begun'}  | 1<<$k;
                        push  @{$actlist->{$label}}, $k ;
                        ModifyLabelStatus($h,$level,$label,'unnecessary',$tmpr);
                     }
                  }
###                  $statements[$labeledLineCode{$label}{'index'}
###                                ]{'labref'} -=$refcnt;


                  if (( $tmpr->{'active'} | $tmpr->{'ended'}) == $fin){

                     my $state = $tmpr->{'active'} ;  # local pointer
                     $tmpr->{'dropthru'} =  $label ; # drop-thru line label

                     if ($pre == 0) {     # no statement block to close
                        # this labeled line constitutes a null 
                        # statement block which  effectively terminates 
                        # the 3 state or 2 state parent 'if' statement.

                        $tmpr->{'cond'}{$state} = { # build a dummy state hash
                           'plabs' =>{}, #save pointer to new hash of hash
                           'class' =>'term',# retain cond as type goto 
                           'label' =>$label, # branch label (not current labl!!)
                           'line'  =>$h,    # save pointer to newly alloc hash
                           'cstats'=>[],    # no conditional statements
                        };                 # finish current record
                     } 
                     elsif ($prebegun != $fin)  {
                        # this labeled line representd the merging  of 
                        # all possible test conditions and effectively 
                        # terminates the 3 state or 2 state parent 'if' 
                        # statement.
                        $tmpr->{'cond'}{$state} = { # build a dummy state hash
                           'plabs' =>{}, #save pointer to new hash of hash
                           'class' =>'null',# retain cond as type goto 
                           'label' =>$label, # branch label (not current labl!!)
                           'line'  =>$h,    # save pointer to newly alloc hash
                           'cstats'=>[],    # no conditional statements
                        };                 # finish current record
DEBUG(7," BUILT 'cond' NULL GOTO : $label : $prebegun : $fin \n") ;
DEBUG(7,"          $pre :  @tmpl \n");
                     }
#                  ModLineInfoField('unrequLabelCount',$refcnt);

                     $tmpr->{'ended'} |=  $state ;
                     $tmpr->{'active'} = 0 ;
                     $tmpr->{'done'} = 1 ; # flag as finished
                     #
                     # this labeled line represents the merging  of 
                     # all possible GOTO statement flows 
                     # 
DEBUG(7,"$label terminates a goto: state: $tmpr->{'begun'}\n") ;
                     if ($lev >= $level-1) { # ignore sublev 'stat' rec
                        if ((not defined $bmode[$level]{'oblk'}) and 
                            $lev == $level ) {  ;#finished but not even open!
                           $bmode[$level]{'el'}=undef;#end if record&start new 1
DEBUG(7,"$label: dummy close sublevel \n") ;

                        }
                        else { 
DEBUG(7,"$label: do preEndBlock \n") ;
                           $statefunc = 'preEndBlock'; # ending this 'if' record
                           PreEndBlock(); 
                        }
                        $noPathToNext = 0;
                     }
                     else {
DEBUG(7,"$label CHRIST ALMIGHTY! Who wrote this SHIT?\n") ;
DEBUG(7,"Terminated GOTO level: $lev while sublevel: $level still active!\n");
                     }
                  }
                  #  starting a new 'GOTO' condition
                  else {

                     $statefunc = 'startNewBlock';   # begining a new block ??
                     $noPathToNext = 0 ; ##### definite path to next stat ...?

                     if ($lev == $level) {
                        
                        my $class = 'blok' ; 
                        if ($pre != 0) {  # appending new code within an already
                           $class= 'multi' ; # open if condition
                           $tmpr->{'cond'}{$pre}{'class'}=$class;# reset first 
                        } else  {
#                  	   ModLineInfoField('unrequLabelCount',$refcnt);
			}
                        my $state = $tmpr->{'active'} ;  # local pointer
                        $tmpr->{'cond'}{$state} = { # 
                          'plabs'  => $actlist,#save pointer to new hash of hash
                          'class'  => $class,
                          'label'  => $label,
                          'line'   => $h,   #save pointer to newly alloc hash
                          'cstats' => [],   # the conditional statements
                        };                  # finish current record
                        $bmode[$level]{'sub'} = $tmpr->{'cond'}{$state}{'cstats'};
                        $bmode[$level]{'oblk'} = undef ; # no record exists yet

DEBUG(7,"$label changes 'goto' state: $tmpr->{'active'}\n") ;
                        if ($pre <= 0 ) {          # if no current sublevel
DEBUG(10,"preparing a new sublevel \n") ;
                           $level++ ;              # make a new sublevel
                           $bmode[$level]{'top'}  = $bmode[$level-1]{'sub'};
                           # set a pointer to new statement block
                           $bmode[$level]{'el'}   = undef ; # no element here
                           $bmode[$level]{'sub'}  = undef ;
                           $bmode[$level]{'oblk'} = undef ;
                        }
                        $noPathToNext = 0;    # assured path to next 
                     }
                     else {
DEBUG(7,"$label CHRIST ALMIGHTY! Who wrote this SHIT?\n") ;
DEBUG(7,"Dropping in on sublevel: $level from level: $lev !: state $tmpr->{'active'}\n") ;

DEBUG(7,"If $level was a 'made up' REPEAT, then there may be a way out...\n") ;
                     }

                  }
}




sub ModifyDoCondStatus {   #  a 'do' label statment - close the statment block
   my $lev = shift;
   my $label = shift;
   my $tmpr  = shift ;

DEBUG(7,"$label:  terminates do at level $lev\n") ;
   if ($lev+1 < $level and $bmode[$lev+1]{'el'}->{'done'}!=1) {
DEBUG(7,"SOMETHING IS TRAGICALLY WRONG! \n") ;
DEBUG(7,"Do $label at level $lev terminated while at level $level!\n") ;
   }
   $tmpr->{'ended'} = 1 ; # flag as finished
   $tmpr->{'done'} = 1 ; # flag as finished
   ModifyLabelStatus($h,$lev,$label,'unnecessary',$tmpr);

#   IncrLineInfoField('unrequLabelCount');
###   $statements[$labeledLineCode{$label}{'index'}]{'labref'} -=1;
   # close the "do" loop
   $statefunc = 'endBlock';# block ending. label noted. 
                                   # Now interpreto
#   if (not $ConsumedTheLine) {
#      consumeTheLine() ;
#   }
   $noPathToNext = 0;      # definite path to next statement
}


sub ModifyRepeatCondStatus {#a 'REPEAT' label statment- close the statment block
   my $lev = shift;
   my $label = shift;
   my $tmpr  = shift ;
   $tmpr->{'ended'} = 1 ; # flag first component of construct finished
   # Essentially, at this point we have just struck the last reference
   # to the top of this repeat loop.
   # Because of that, the current line is either a  
   # 'goto', 'if', 'ifexp', or an explicit 'jump'.

   # The terminal label of a REPEAT will generally be a 
   # 'made up' label specially crafted to bring us here.
   # Consequently it is classed as unnecessary
   ModifyLabelStatus($h,$lev,$label,'unnecessary',$tmpr);

   # quite likely this was a virtual label and the actual 
   # statement block at this level is not finished yet.
DEBUG(7,"REPEAT $label at level $lev seems to be terminated!\n") ;

   # but if it is finished ...
   if ($lev+1 == $level) { #if the current level and the REPEAT coincide
   	# close the "REPEAT" loop
   	$statefunc = 'endBlock';# block ending. label noted. 
        $tmpr->{'done'} = 1 ; # flag as finished  
        # this line points backwards!
        $noPathToNext = 1;      # no path to next statement
DEBUG(7,"REPEAT at level $lev is now effectively closed!\n") ;
        # Of course, at this point we have no indication whatsoever
        # as to the class of the current backwards referring line.
        # If it is a composite 'if' or 'goto' then 
        # sadly all of the alternative conditional states will be embedded
        # in what is otherwise a fully terminated 'REPEAT'
        return;
   }

   # Otherwise ..., we are deeply embedded in sub,sub structure
   my $cnt = {'if'=>0,'goto'=>0,'ifthen'=>0,'do'=>0,'REPEAT'=>0};
   my $slev = 0; # save temp level
   for(my $llev=$level; $llev>$lev;$llev--) {
      if ((not defined $bmode[$llev]{'el'}) or 
                       $bmode[$llev]{'el'}{'block'} eq 'stats' or 
                       $bmode[$llev]{'el'}{'done'} == 1 ) {
DEBUG(10,"  lev $llev ---something missing?\n");
         next;
      }  # sublevels finished
DEBUG(10,"  lev $llev :$bmode[$llev]{'el'}:$bmode[$llev]{'el'}{'block'} \n") ;
      my $type =  $bmode[$llev]{'el'}{'block'} ;
      $cnt->{$type} += 1;                 # increment the count
      $slev = $llev ;
   }

   # special case of "crossed" Repeat statements. 
   # try to remove the lowest level one
   # error correction mode!

   if ($cnt->{'if'}==0 && $cnt->{'goto'}==0 &&$cnt->{'ifthen'}==0 &&
         $cnt->{'do'}==0     && $cnt->{'REPEAT'}==1) {
      DEBUG(7,"SOMETHING IS TRAGICALLY WRONG at level $slev! \n") ;
DEBUG(7,"REPEAT $label at level $lev terminated while at level $level!\n") ;
      UndoRepeatMode($slev);
DEBUG(7," After $slev backtracking \n") ;
      return;

   }
   
   # otherwise 
   if ($cnt->{'do'}==0 && $cnt->{'REPEAT'}==0) {
   # we should replace this line with a 'NEXT' statement
DEBUG(7,"Building NEXT statement here (potentially)!\n") ;
   # This should be applied when the actual branching statement class
   # is invoked
   }
   

   # Presumably then before the source retreats back to the REPEAT parent level
   # subsequent statements can be appended with a "BREAK" instruction

DEBUG(7,"virtual label ? $label:  terminates REPEAT at level $lev\n") ;
                                  
}




 
#  TreatBackwardReferences :  Attempts to further delimit chunks of code
#                         in order to eliminate line labels
#
#  Any line label may be the start of a REPEAT style loop 
#  back referenced from further down in the code sequence -e.g.
#
#                 LABEL CONTINUE       { start of block
#                       .....
#                       GOTO LABEL     } end of block
#
#   or an arbitrary block of delimited code - e.g.
#                       GOTO LABEL
#                       .....
#                       GOTO xxx    
#                 LABEL CONTINUE       {  start of block
#                       .....
#                       GOTO zzz       }  end of block
#
#   or 
#                       Do  XXXX i=1,3 {  start of block
#                       .....
#                 XXX   continue       }  end of block - loop terminus
#                 LABEL CONTINUE       remove this irrelevant label
#                 Internal loop references to LABEL may be reducible to 
#                 BREAK statements within the LOOP. It all depends on the 
#                 complexity ...
#                
#   or                 arbitrary labeled continue statements
#                 LABEL continue       pointless
#
#   but NOT 
#
#                       GOTO LABEL
#                       .....
#                 LABEL CONTINUE       no block starts here
#                       .....
#                       GOTO zzz      { }  end of block
#
#

            
sub TreatBackwardReferences {    #i.e future references back to here
   my $label = shift;
   my $SaveState = shift;

   # check all classes of brancing statements to see if they 
   # reference the current $label

   my @forwd = (0,0,0,0) ;
   my @bakwd = (0,0,0,0) ;
   my @bakjmp ;
   my $max = 0;
               
   for (my $k=0;$k<4 ;$k++) {
      my @jmp;
      if    ($k == 0 )
           {@jmp = keys %{$labeledLineCode{$label}{'if'}}; }
      elsif ($k == 1 )
           {@jmp = keys %{$labeledLineCode{$label}{'goto'}}; }
      elsif ($k == 2 )
           {@jmp = keys %{$labeledLineCode{$label}{'jump'}}; }
      elsif ($k == 3 )
           {@jmp = keys %{$labeledLineCode{$label}{'ifexp'}}; }

      foreach my $index (@jmp ) {             # for each line number
         if ( $index > $h ) { 
            $bakwd[$k]++ ;
            if ($max < $index ) {$max = $index ; }
         }
         else               { $forwd[$k]++ }
      }
   }
   #            if          goto        jump      ifexp
   my $sbak = $bakwd[0] + $bakwd[1] + $bakwd[2] +$bakwd[3];
   my $sfor = $forwd[0] + $forwd[1] + $forwd[2] +$forwd[3];


   # if there are any backwards references then this could start a REPEAT loop

   if ($sbak > 0 and $repeatLoops != 0) {
      if ($SkipRepeat == 1) {$SkipRepeat = 0 ; return;} # skip first instance

      if ($sfor >0) { 
#         SetLineInfoField('essentialLabel',1); # branch forward to here
#         SetLineInfoField('forgedContinue',1); # branch forward to here
#         IncrLineInfo($h) ;                    # start the repeat
#         SetLineInfoField('irrelevantLabel',1);# cant put a label here
      }

#!!!!! there is no quality control here at all!
# there should at least be a test for whether this violates parent REPEAT loops

#!!!!!!!!!!!!!!!
      my ($type,$lev) = ParentType($level); #only for immediate parent? 
      if ($type ne 'root') {
         #check if 'jump' violates parent LOOP closure
## I thought  briefly that you may be able to tell if a contnuous
## REPEAT violates a parent /if/goto thread, but 
## sadly it isn't the case because you don't know at this point if the 
## current parent conditional thread doesn't 'drop' into the next thread cond.
##  consequently we have to implement a backtracking method elsewhere
##CVIEW("Check if loop terminus $label violates parent $type $lev integrity\n");
##CVIEW("BETWEEN HERE");
##       my $closed = closedTest($lev ,$label) ; 
##CVIEW(" closed?: @{$closed}: type $type : level $lev\n");
##CVIEW("AND  HERE");
      }


         # should split statement into 2 parts 
         # first part is a dummy CONTINUE target
         # second part is the repeat loop
      my $tlabel;
      if (exists $labeledLines{$max} ) { ;     
           $tlabel = $labeledLines{$max} ;
DEBUG(10,"REPEAT  labeled line exists $tlabel \n");
      } else {
DEBUG(10,"REPEAT  labeled line doesn't exist - creating \n");

            my $realLineNum= RealLine($max);
DEBUG(7,"$label : creating new temporary label:  $tlabmax : line $realLineNum \n") ;
            $tlabel = $tlabmax ;
            my $linrec = { 
                'index' => $max ,  # create a new record 
                'jump'  => { }, 
                'goto'  => { }, 
                'do'    => { },
                'if'    => { },
                'ifexp' => { },
                'temp'  => {$max => 1 } } ;
            $labeledLineCode{$tlabmax} =  $linrec ; 

                         # list copy and force it to be a hash
            $labeledLines{$max} = $tlabmax ;  
                         # create reverse list index
            $tlabmax++ ;
            my $l;
            for ($l=0; $l<= $#numberList && $numberList[$l]< $max ;$l++) {;}
            @numberList = (@numberList[0..($l-1)], $max, 
                           @numberList[$l..($#numberList)]  ) ;
      } 
#                  'begun'   =>$bmode[$level]{'el'}{'begun'}  
#                  'active'  =>$bmode[$level]{'el'}{'active'} 
#                  'ended'   =>$bmode[$level]{'el'}{'ended'} 
#                  'done'    =>$bmode[$level]{'el'}{'done'} 
#                  'jump'    =>$bmode[$level]{'el'}{'jump'} 
#                  'cond'    =>$bmode[$level]{'el'}{'cond'} 

      #  mark it up as  a new 'REPEAT' statement
      my $flowitem= { 'block'  => 'REPEAT', # type of block
                   'tpt'       => $label,     # take off point label
                   'jump'      => [$tlabel], # max loop line number
                   'ojump'     => [$tlabel], # copy path labels
                   'termline'  => [$max] ,#label at terminus unknown
                   'begun'     => 1,        # repeat is pre started
                   'active'    => 1,        # fully open ???
                   'ended'     => 0,        # not ended yet
                   'done'      => 0,        # not ended yet
                   'NeedsBreak'=> 1,        # by default
                   'undo'      => $SaveState, #for undoing the damage if requ
                   'master'    => $h,
                   'stats' => []} ;      # no statements
      push @{$bmode[$level]{'top'}}, $flowitem; # add to cur stack 
      $bmode[$level]{'el'}         = $flowitem; # point to cur record 
      $bmode[$level]{'sub'} = $flowitem->{'stats'} ; # reset current statement pointr 

DEBUG(7,"REPEAT:  implied at level $level\n");

      # REPEAT loops are self starting!
      $level++;                         # increment the level now
      $bmode[$level]{'top'} = $flowitem->{'stats'}; # point to cur record
      $bmode[$level]{'el'}  = undef;      # point to null record
      $bmode[$level]{'oblk'}= undef ;     # reset current statement pointr
                                        # no statement block is open
      $noPathToNext = 0;                  # statement block should be open
      $statefunc = 'startNewBlock' ;    # a branch flow statement

   }



   elsif ($sfor > 0 ) {      # a jump foward to this point exists

  # more likely than not there is just a single forward reference to 
  # the current $label - but the number doesn't matter

#      if($sbak == 0 ){   # only forward jumps to here exist
#      multiple  forward jumps to this point may occur
##        if ($sfor ==1 && $forwd[0] == 1 ) {  }
#           # label acessed from  a single 'if' statement
#DEBUG("$label: ALERT single forward jump to here \n") ;
#
#          if ( $bmode[$level]{'el'} !=undef) {
#print STDERR "$bmode[$level]{'el'}{'block'}, @{$bmode[$level]{'el'}{'jump'}}\n";
#          } else {
#print STDERR "$bmode[$level]{'el'}\n";
#          }
#print STDERR "openblock $bmode[$level]{'oblk'} \n" ;
#print STDERR "current level top  $bmode[$level]{'top'} \n" ;
#print STDERR "sub $bmode[$level]{'sub'}, @{$bmode[$level]{'sub'}} \n" ;
#          if ( $bmode[$level]{'sub'} !=undef) {
#             foreach $blk (@{$bmode[$level]{'sub'}})  {
#                $blk1= $blk->{'block'};
#                if ($blk1 ne 'stats' and $blk1 ne 'comm') {
#print STDERR  " $blk->{'block'} @{$blk->{'jump'}} \n" ;
#                }
#                else {print STDERR  " $blk1 \n" ;}
#             }
#          }
#      }


#  this can't be invoked until we know the current line is not an
# 'if' or 'goto'

#   #  mark it up as  a new 'sublk' statement
#   $flowitem= { 'block'     => 'sublk', # type of block
#                'jump'      => [], # max loop line number
#                'termline'  => [] ,  #label at terminus unknown
#                'begun'     => 1,        # repeat is pre started
#                'active'    => 1,        # fully open ???
#                'ended'     => 0,        # not ended yet
#                'done'      => 0,        # not ended yet
#                'stats' => []} ;      # no statements
#   push @{$bmode[$level]{'top'}}, $flowitem; # add to cur stack 
#   $bmode[$level]{'el'}         = $flowitem; # point to cur record 
#   $bmode[$level]{'sub'} = $flowitem->{'stats'} ; # reset current statement pointr 

#DEBUG(" 'sublk' invoked at level $level for $label\n");
#
#   # REPEAT loops are self starting!
#   $level++;                         # increment the level now
#   $bmode[$level]{'top'} = $flowitem->{'stats'}; # point to cur record
#   $bmode[$level]{'el'}  = undef;      # point to null record
#   $bmode[$level]{'oblk'}= undef ;     # reset current statement pointr
#                                        # no statement block is open
#   $noPathToNext = 0;                  # statement block is open
#   $statefunc = 'startNewBlock' ;    # a branch flow statement
#

   # this line MAY terminate an if or GOTO 
   # or MAY simply be an intermediate step
#   DEBUG("$label: WARNING this is a forward jump terminus \n") ;
   }


}





sub StartANewIfBlock {

   my @path = @{$branches{$h}[0]{'jump'}} ; #  cond 1 label
   my $flowitem= { 'block' => 'if',     # type of block
                'master' => $h,      # master record pointer
                 'contig' => 0,      # assume not contiguous'if'block1
                 'active' => 0,      # no current state set
                 'begun' => 0,       # no current state set
                 'ended' => 0,       # not ended block yet
                 'done'  => 0,       # not ended block yet
                 'dropthru'  => 0,   # drop-thru line label
                 'ojump' => [@path], # copy path labels
                 'jump'  => [@path], # copy path numbers
                 'cond' => { }
   };                                 # finish current record
                       
DEBUG(7,"IF at level $level: @path \n");
   push @{$bmode[$level]{'top'}}, $flowitem; # add to cur stack
   $bmode[$level]{'el'}         = $flowitem; #   point to cur record
   $bmode[$level]{'sub'}  = undef ;   # reset current statement pointr
   $bmode[$level]{'oblk'} = undef ;   # reset current statement pointr
   $statefunc = 'ignoreState' ;    # a branch flow statement
   $noPathToNext = 1;                # no statement block is open
   assessJumpContinuity($level-1,$flowitem);# check jumps - adjust state

   if ($flowitem->{'done'} == 1) {
DEBUG(7,"ending IF block immediately\n") ;
      $level-- ;
#               $statefunc = 'EndBlock' ;    # pre ended statement flow
#               $statefunc = 'preEndBlock' ;    # pre ended statement flow
#               can't use preEndBlock , or endBlock because  no sublevels
#               are active
   }
   else {
       # search back up the heirarchy for 
       # parent IFs that this may modify the term conditions for
LEVEL1:         for (my $lev=$level; $lev>=0;$lev--) {
          my $tmpr = $bmode[$lev]{'el'};# a temp pointer to curent item
          my $blk = $tmpr->{'block'} ;
          if ($blk ne 'if' and $blk ne 'goto') {last ; }
          # break on first non 'if' or 'goto'
   
          # else should reset the max line num for this sub element
          # the new number should register  a change of state when
          # it is encountered later...
#                   my $maxlnm = $tmpr->{'block'} ;
#                   my $active  = $tmpr->{'active'} ;
#                   my @jumps = @{$tmpr->{'jump'}}; 
#                   my $active  = $tmpr->{'cond'}{$active}{'plabs'|'class'|label|line|cstats'} ;
#                   #which state is currently active and how do we change it
#                   # and what picks up the  change ?????
       }
####???????
   }
}



sub StartANewIfExpBlock {

   my @path = @{$branches{$h}[0]{'jump'}} ; #  cond 1 label
   my $flowitem= { 'block' => 'ifexp',     # type of block
                'master' => $h,      # master record pointer
                 'contig' => 0,      # assume not contiguous'if'block1
                 'active' => 0,      # no current state set
                 'begun' => 0,       # no current state set
                 'ended' => 0,       # not ended block yet
                 'done'  => 0,       # not ended block yet
                 'dropthru' => 0,   # drop-thru line label
                 'negateAndBreak' => 0,   # invert cond for simplicity ?
                 'ojump' => [@path], # copy path labels
                 'jump'  => [@path], # copy path numbers
                 'cond' => { }
   };                                 # finish current record
                       
DEBUG(7,"IFEXP at level $level: @path \n");
   push @{$bmode[$level]{'top'}}, $flowitem; # add to cur stack
   $bmode[$level]{'el'}         = $flowitem; #   point to cur record
   $bmode[$level]{'sub'}  = undef ;   # reset current statement pointr
   $bmode[$level]{'oblk'} = undef ;   # reset current statement pointr
   # state should not override upper level criteria
   ##$statefunc = 'ignoreState' ;    # a branch flow statement
   ##$noPathToNext = 0;                # no statement block is open
   assessJumpContinuity($level-1,$flowitem);# check jumps - adjust state
    my $savestate = $statefunc;
   if ($flowitem->{'done'} == 1) {
DEBUG(7,"ending IFEXP block immediately\n") ; # obvious as there is NO block!
      # don't have to worry about levels either
      # and can't use preEndBlock , or endBlock because  no sublevels
      # are active
      if     ($savestate eq 'endBlock' and 
              $bmode[$level-1]{'el'}{'block'} eq 'REPEAT' and
              $flowitem->{'cond'}{1}{'class'} eq 'NEXT') {
DEBUG(7,"Negate IFEXP and Break\n") ; # obvious as there is NO block!
         $flowitem->{'negateAndBreak'} = 1;
         $bmode[$level-1]{'el'}{'NeedsBreak'} = 0;
      }
      else {$bmode[$level]{'el'}=undef;} # flag to start another statment block
   }
   else {
      # fudge a label for the default drop-thru non-jump case
      push @{$flowitem->{'ojump'}}, -9999;
      push @{$flowitem->{'jump'}}, -9999;
      # make beleive we hit the fudged label
      ModifyIfExpCondStatus($level,-9999, $flowitem);
   }
   if ($savestate eq 'endBlock') {
       $statefunc = 'dontAddButEnd';
   } else {
       $statefunc = 'ignoreState' ;  # now ignore this line
       $noPathToNext = 0;           # all statements are possible
   }
}






sub   StartANewGotoBlock {
            my @path = @{$branches{$h}[0]{'jump'}}; # pointer to branch point labels
            my $flowitem= { 'block' => 'goto',    # type of block
                         'contig' => 0,      # assume not contiguous'if'block1
                         'master'=> $h,      # master record pointer
                         'begun' => 0,       # no current state set
                         'active'=> 0,       # no current state set
                         'ended' => 0,       # not ended block yet
                         'done'  => 0,       # not ended block yet
                          'dropthru'  => 0,  # drop-thru line label
                         'ojump' => [@path], # copy path labels
                         'jump'  => [@path], # copy branch labels
                         'cond'  => {  }     # initialize an empty hash        
                                             # to contain all possible if ==
            };                               # finish current record
            
DEBUG(7,"GOTO at level $level:  @path \n") ;
            push @{$bmode[$level]{'top'}}, $flowitem; # add to cur stack
            $bmode[$level]{'el'}         = $flowitem; #   point to record
            $bmode[$level]{'sub'}  = undef ;   # reset current statement pointr
            $bmode[$level]{'oblk'} = undef ;      # reset current statement pointr
            $statefunc = 'ignoreState' ;    # a branch flow statement
            $noPathToNext = 1;                   # no statement block is open
            assessJumpContinuity($level-1,$flowitem);# check jumps - adjust state
            if ($flowitem->{'done'} == 1) {
DEBUG(7,"ending GOTO block immediately\n") ;
               $level-- ;
#               $statefunc = 'preEndBlock' ;    # pre ended statement flow
#               can't use preEndBlock , or endBlock because  no sublevels
#               are active
                 # should check the level also
            }
}


sub StartANewDoBlock {
            my $stat = $statements[$h]{'stat'}  ;
            $stat =~ s/(\s+)do\s+(\d+)\s+(.*)/$1do $3/i  ; # strip number
            my $flowitem= { 'block'    => 'do',   # type of block
                         'line'     => $stat,  # 
                         'master'   => $h,     # master record pointer
                         'begun'    => 1,      # state automatically set
                         'active'   => 1,      # state automatically set
                         'ended'    => 0,      # not ended block yet
                         'done'     => 0,         # not ended block yet
                         'jump'     => [$2],   #
                         'ojump' => [$2], # copy path labels
                         'termlabel' => [$2 ],  # copy path number
                         'termline'  => [$labeledLineCode{$2}{'index'}], 
                         'stats'     =>  []     # initialize an empty hash        
            };                                 # finish new record

DEBUG(7,"DO   at level $level: termlabel @{$flowitem->{'jump'}} \n") ;
            push @{$bmode[$level]{'top'}}, $flowitem; #  add to cur stack
            # terminate curent active record
            $bmode[$level]{'el'}   =       $flowitem; # point to new record
            $bmode[$level]{'sub'}  =  $flowitem->{'stats'} ; # reset current statement pointr
            $bmode[$level]{'oblk'} =  undef; # point to cur record
            # do loops are self starting!
            $level++;                         # increment the level now
            $bmode[$level]{'top'} = $flowitem->{'stats'}; # point to cur record
            $bmode[$level]{'el'}   = undef;      # point to null record
            $bmode[$level]{'sub'}  = undef;      # reset sub level statement pointr
            $bmode[$level]{'oblk'} = undef;     # reset current statement pointr
            $noPathToNext = 0;             # statement block will be open
            $statefunc = 'ignoreState' ;    # a branch flow statement


}



# determine for this backward jump what the true type should be

sub  GetBackwardJumpType {
   my $curline = shift;
   my $target  = shift;
   my $level  = shift;

   my ($type,$lev) = ParentType($level); #only for immediate parent? 
   # this shouldn't happen
   if ($type eq 'root' ) { return 'goto';}  #no  alternative?

   my $interveningLoops = 0;
   my $foundLoop=0;
   for (my $llev=$lev; $llev>=0;$llev--) {
      my $tmpr = $bmode[$llev]{'el'}; # a temp pointer to current item
      my $blk =$tmpr->{'block'};
               
DEBUG(7,"$blk:$tmpr->{'master'}\n") ;
      if ($blk eq 'do' or $blk eq 'REPEAT') { # a looping construct
         if ($labeledLines{$tmpr->{'master'}} == $target) {
            $foundLoop=1;
	    last ;
         }
         $interveningLoops++; 
      }
   }
DEBUG(7,"looking good : $foundLoop: $interveningLoops\n") ;
   if ($foundLoop==1 and $interveningLoops==0) {
       return 'NEXT';  # definitively!
   }

   return 'goto';# the only alternative
}


sub crap {
   # in a DO/REPEAT/WHILE/FOR loop it could correspond to 
   # a BREAK/LAST or NEXT/CONTINUE statement - depending on the
   # location of the labelled branch point
   my $curJumpType='goto';  # assume no changes
   my $impendingNewBlock = 0;
   my $greater;
   my $lev;
   if ($greater != 0) { 
      # there is another branch to this $target further on in the code
      # Essentially this is a potential NEXT statement
      
      # First: check to see if next impending label, alters the 
      # immediate parent status in any way. 
      my $nextlab = $labeledLines{$numberList[$nextImpendingLabel]} ; 
      my $tmpr = $bmode[$lev]{'el'};   # a temp pointer to current item
      my $blk =$tmpr->{'block'};
      if ($blk eq 'if' or $blk eq 'goto') {
DEBUG(7,"so far so good : $nextlab: \n");
         my $k ;
         foreach $k ( @{$tmpr->{'jump'}} ) {
            if ($nextlab eq $k ) { $impendingNewBlock = 1 ; 
                last ; } 
         }
DEBUG(7,"  $impendingNewBlock \n");
         if ($impendingNewBlock) { # parent if/goto will start new cond

         }
      }

      
      # search for a possible route to continue ...
      #    look back for FORCED goto's matching the nearest impending 
      #    labeled branch to point
###      my $sfunc = attemptingToFixFlow($llev);
   }
   #   it may also act as the statement block terminator of a REPEAT 
   #   or loop statement if the labelled branch point precedes 
   #   the current GOTO
   else               { $curJumpType = 'loop terminal' ; }


}



sub  BackwardJumpMode {
   my $label = shift;
   my $curline = $h;
   #
   # We enter this code on an explicit unconditional
   #  go to $label
   # where the label is backwards, i.e. already encountered in the code. 
   # From this point there is no direct route forward.

   #
   #  get the list of all other explicit goto $labels (by reference).
   my @path = @{$branches{$h}[0]{'jump'}} ; # pointer to branch point labels
   # there should only be one???? == $label

DEBUG(7,"JUMP Unconditional back to $path[0] = $label ??\n") ;


   # this is what we will be using
   my $flowitem= { 'block'  => 'jump',       # type of block
                'master' => $curline,           # master record pointer
                'begun'  => 1,            # state automatically set
                'active' => 1,            # state automatically set
                'ended'  => 1,            # pre ended block 
                'done'   => 1,         # not ended block yet
                'bodgeyFlow'  => 0,         # not ended block yet
                'type'   => 'goto', # fill this in shortly
                'jump'   => [@path]       # copy branch labels
   };                                     # finish current record

  
   my $curJumpType= GetBackwardJumpType($h,$label,$level);
   $flowitem->{'type'} = $curJumpType;
   if ($curJumpType eq 'NEXT') {

      ModifyLabelStatus($h,$level,$label,'unnecessary',$flowitem);
      if ($statefunc eq 'endBlock' and
         $bmode[$level-1]{'el'}{'block'} eq 'REPEAT' and
         $bmode[$level-1]{'el'}{'done'} eq 1 ) {
DEBUG(7," HHHHHHHH skipping backward GOTO \n");
          $bmode[$level-1]{'el'}{'NeedsBreak'}= 0;
         # note that the $flowitem was not appended to $bmode 
         # and yet was used here by ModifyLabel... 
         # no need for an added 'jump' - its taken care of by 'REPEAT'
         $statefunc = 'dontAddButEnd';
         return ;  
      }
   } else {
      ModifyLabelStatus($h,$level,$label,'essential',$flowitem);
   }




   # look at raw data for all explicit jumps to  $target
   my $jump = $labeledLineCode{$label}{'jump'};  #pointer to line number keys
   my $greater = 0 ; 
   my $lesser = 0 ; #
   foreach my $line (keys %{$jump} ) {  # scan keys 
      if ($line > $curline){$greater= 1;} # jump cmnd further in subroutine
      if ($line < $curline){$lesser = 1;} # jump routine earlier in subroutine
   }
                  

   if ($greater == 0) {            # no further backward jumps to this label
      push @{$bmode[$level]{'top'}}, $flowitem; # add to cur stack
      my ($type,$lev) = ParentType($level); #only for immediate parent? 
      DeactivateSublevel($lev,$label); 
      $level-- ;  # retreat back to parent 'if' or 'goto'
      if (MultiWayFinished($level)) {
         Finalize($level);
         $statefunc = 'dontAddButEnd';
         $noPathToNext = 1;      # no possible path to next statement
         return;
      }
   }

   else {   # have to go back and identify loop level of 'REPEAT'
            # we have the line label:         $label
            # which points to  line sequence: $index 
      my $repLev = $labeledLineCode{$label}{'level'} ; 
DEBUG(7,"This line terminates this level($level), but shouldn't terminate \n") ;
DEBUG(7,"its parent REPEAT at level $repLev \n");

      # there are more back references to $label further in the code
      # so this shouldn't terminate the program flow.
      # however, progress can only be made if control can be shifted to 
      # the next active statement and it is labeled, from somewhere 
      # back in the foregoing code
      
      my $nextLabLine = $numberList[$nextImpendingLabel];
      my $nextLab = $labeledLines{$nextLabLine} ; 
      my $i=0;
      # skip labeled format statements
      while ($statements[$nextLabLine] eq 'format'){
         $nextLabLine = $numberList[$nextImpendingLabel+$i];
      	 $nextLab = $labeledLines{$nextLabLine} ; 
         $i++;
      }
      for (my $l=$h+1;$l<$nextLabLine;$l++){
	 if ($statements[$l]{'type'} eq 'stat') {
	 DEBUG(0,"There is no path to this line:$statements[$l]{'stat'} \n") ;
            exit 1;
         }
      }

DEBUG(7,"next label is $nextLab \n") ;

               
      for (my $k=0;$k<4 ;$k++) {
         my @jmp;
         if    ($k == 0 )
              {@jmp = keys %{$labeledLineCode{$nextLab}{'if'}}; }
         elsif ($k == 1 )
              {@jmp = keys %{$labeledLineCode{$nextLab}{'goto'}}; }
         elsif ($k == 2 )
              {@jmp = keys %{$labeledLineCode{$nextLab}{'jump'}}; }
         elsif ($k == 3 )
              {@jmp = keys %{$labeledLineCode{$nextLab}{'ifexp'}}; }
   
         foreach my $index (@jmp ) {             # for each line number
            if ( $index < $h and $index > $bmode[$repLev]{'el'}{'master'}) {
               # somewhere within the immediate past level there is a 
               # jump to the next label
               # so add this jump to the stack
               push @{$bmode[$level]{'top'}}, $flowitem; # add to cur stack
                $flowitem->{'bodgeyFlow'} = 1; 
               $bmode[$level]{'el'}  = undef;  # await the next statement block
DEBUG(7,"I HAVE REFUSED TO POP THIS LEVEL! \n") ;
   $statefunc = 'ignoreState' ;         # a branch flow statement
   $noPathToNext = 1;      # no possible path to next statement
               return ;
            }
         }
      }


      # probably should check all labeled line levels from $index to $h
      # to see if the active level actually went below $repLev

#      # create new keyed item and recast the parent as a 'REPEAT'
#      $labeledLineCode{$label}{'type'} = 'REPEAT' ; 

      # Close off all current levels beyond the parent
      # reset as top level 
      $level = $repLev;
      push @{$bmode[$level]{'top'}}, $flowitem; # add to cur stack
      $bmode[$level]{'el'}   = undef;      # can add nothing to this
      $bmode[$level]{'sub'}  = undef;      # reset sub level statement pointr
      $bmode[$level]{'oblk'} = undef ;     # reset current statement pointr

   }

   $statefunc = 'ignoreState' ;         # a branch flow statement
   $noPathToNext = 1;      # no possible path to next statement
}


sub MultiWayFinished {
   # just got here from an explicit JUMP
   my $lev = shift;
   my $blk = $bmode[$lev]{'el'};
   my $type = $blk->{'block'};
DEBUG(0,"WWWWWWW $lev $type $blk->{'done'} \n");
   if ($type ne 'if' and $type ne 'goto') {return 0 ;}
   if ($blk->{'done'} ){return 1;}
   my @temp  = (@{$blk->{'jump'}});   # copy branch labels
   my $begun = $blk->{'begun'};       # current state
   my $ended = $blk->{'ended'};       # current state

DEBUG(0,"WWWWWWW begun $begun \n");
DEBUG(0,"WWWWWWW ended $ended \n");
   #reset all prev active 'branch to' labels with the goto label
   my $started = 0;
   my $num = scalar(@temp);
   for (my $k=0;$k<scalar(@temp);$k++) { # for all branch labels
      if ( $begun & (2**$k) ) { $started++ ;}   # test all set bits
   }
   if ($started == $num) { return 1;}  # the real reason we came here!
   return 0;
}

sub Finalize {
   my $lev = shift;
   my $blk = $bmode[$lev]{'el'};
   my $type = $blk->{'block'};
DEBUG(0,"WWWWWWW $lev $type \n");
   if ($blk->{'done'}) {return ;}
   if ($type ne 'if' and $type ne 'goto') {return  ;}

   my $begun = $blk->{'begun'};       # current state
   my $ended = $blk->{'ended'};       # current state
   my $outstanding = $begun ^ $ended ; 
   my @temp  = (@{$blk->{'jump'}});   # copy branch labels
   my $states   = $blk->{'cond'} ; 
   my @keylist  = keys %{$states} ;
   my $nstates = scalar(@keylist) ;

   # reverse sort states according to line number - highest line first
   my @treat = sort {$states->{$b}{'line'}<=>$states->{$a}{'line'}} keys 
                                   %{$states}  ;
   for my $key (@treat) {
      if ($key & $outstanding) {
         
         my $target ;
         for (my $k=0;$k<scalar(@temp);$k++) { # for all branch labels
            my $mask = 1<<$k;
            if ($key & $mask) { $target = $k; last;}
         }
         $target= $temp[$target]; # get target label from 'jump' list
         my $l = -1;  # fudge a line number here !
    
         # ideally could use BuildJump - but too much fluffing about
         # before and after
	 my $flowitem =  { 
                'block'  => 'jump',  # type of block
                'master' => $l,      # master record pointer
                'begun'  => 1,       # state automatically set
                'active' => 1,       # state automatically set
                'ended'  => 1,       # pre ended block
                'done'   => 1,       # pre ended block
                'jump'   => [$target], # copy path number
         };                          # finish new record
	 push @{$states->{$key}{'cstats'}},  $flowitem;
         ModifyLabelStatus($l,$lev+1,$target,'essential',$flowitem);
         $outstanding ^= $key ;    # taken care of this one
         $blk->{'ended'} ^= $key;  #force the end
      }  
   }  
   if ($blk->{'ended'} != $blk->{'begun'}) {
DEBUG(0,"BUGGER broken finalize() level $lev $type :done $blk->{'done'}\n");
   }
   $blk->{'done'} = 1; # taken care of that !

}




#
#  Identify the closest significant parent type and level.
#
sub ParentType {
   my $lev = shift;
   if ($lev<0) { return ('top',0);}     # dummy  type
   my $type = '';
   if (defined $bmode[$lev]{'el'} ) {
       $type = $bmode[$lev]{'el'}{'block'} ; 
DEBUG(8,"$lev: $type : %$bmode[$lev]{'el'} \n");
       # if currently in a statement block
       if ($type eq 'stats') { $lev -=  1;} 
   } 
   else { 
DEBUG(8,"UhOh! $lev : $statements[$h]{'stat'} \n");
       $lev -= 1; 
   }
   if ($lev < 0 ) { return ( 'root',-1);}
   $type = $bmode[$lev]{'el'}{'block'} ; 
   return ($type, $lev) ;
}


sub DeactivateSublevel {
   my $lev   = shift;
   my $target  = shift;
DEBUG(7,"KKKKK  $lev : $bmode[$lev]{'el'}  \n");
   my $keys = scalar(keys %{$bmode[$lev]{'el'}});
   if ($keys <1) {
      DEBUG(7,"WARNING  level $lev is not currently defined \n");
      return ;
   }
   my $state = $bmode[$lev]{'el'}{'active'};      # get state of statement
   my @temp  = (@{$bmode[$lev]{'el'}{'jump'}});   # copy branch labels
DEBUG(8,"state $state : @temp  \n");

   #reset all prev active 'branch to' labels with the goto label
   for (my $k=0;$k<scalar(@temp);$k++) { # for all branch labels
      if ( $state & (2**$k) ) {       # test all set bits
DEBUG(7,"resetting expected line number to: $target \n") ;
         $bmode[$lev]{'el'}{'jump'}[$k] = $target; 
	 if ($target <= $bmode[$lev]{'el'}{'master'}) {
            # target line precedes this state
            $bmode[$lev]{'el'}{'ended'} |= 1<<$k ;# finished state
         }
      }
   }
   $bmode[$lev]{'el'}{'active'} = 0 ;# reset active state to 0
   $bmode[$lev]{'oblk'}=undef ;         #  flag as no current block
}




sub ForwardJumpMode {
   my $label = shift;
   my $index = $labeledLineCode{$label}{'index'} ;
   my @path  = @{$branches{$h}[0]{'jump'}} ; # pointer to branch point labels

   # current open block is of type: ...
#########################
## have to check all parent loops up to the first wholly enclosing loop
## where known, or if it goes out of the loop, it may be a loop BREAK
## statement, otherwise there is nothing we can do.
## should add in a dummy LOOP record where recognizable.

DEBUG(8,"XXXXXXXXX\ForwardJumpMode() \n");

   my ($type,$lev) = ParentType($level); #only for immediate parent? 
   if ($type eq 'root' ) {
      my $flowitem = BuildJump($level,$label); # interupt the current flow
      ModifyLabelStatus($h,$level,$label,'essential',$flowitem);
      return ; 
   } # can't eliminate this 

   
DEBUG(7,"Check if forward jump to $label violates parent integrity\n");

DEBUG(10,"BETWEEN HERE\n");
#      my $closed = closedTest($lev ,$label) ; 
   my $closed = jumpBreaksParentTest($lev ,$label) ; 
DEBUG(10," breaks parent test?: @{$closed}: type $type : level $lev\n");
DEBUG(10,"AND  HERE\n");

   my $mllev;
   if ($type eq 'REPEAT' && ${$closed}[0] >=0 ) { 
            $mllev= ${$closed}[0];
   } else { $mllev = $lev;}
  

   # Violates parents parent etc
   # have to try and deactivate intermediates

   for (my $llev=$lev;$llev>=$mllev;$llev--) {

       $type = $bmode[$llev]{'el'}{'block'} ; 
       # try to eliminate this GOTO/IF
       if ( $type eq 'if' or $type eq 'goto' ) {
               
          # simple test for if next label belongs to parent 'if'
          # if not then it must be a long jump
          my $nextlab = $labeledLines{$numberList[$nextImpendingLabel]} ; 
          my $match=0;
          foreach my $lab ( @{$bmode[$llev]{'el'}{'jumps'}} ) {
                 if ($lab == $nextlab) { $match=1; last;}
          }

#      if (${$closed}[0] >=0 or $match==0) {} # jump CAN NOT be eliminated  !!
          if (${$closed}[0] >=0 ) { # jump CAN NOT be eliminated  !!
DEBUG(7,"Discontinuity. Unconditional FORWARD jump to $label\n");
DEBUG(7,"goto $label at level $level breaks parent $type state at level ${$closed}[0]\n");
             my $sfunc = attemptingToFixFlow($llev);
             if ($sfunc ne 'fixed') {
                #shut down the currently active state of this 'if'/'goto'
                my $state=$bmode[$llev]{'el'}{'active'};#get state of statement
                $bmode[$llev]{'el'}{'ended'} |= $state;
                $bmode[$llev]{'el'}{'active'} = 0 ;# reset active state to 0
                $statefunc = 'ignoreState'  ;
                $noPathToNext = 1; 
DEBUG(10,"shut down level $llev :$bmode[$llev]{'el'}{'block'} \n") ;
DEBUG(10,"                      :$bmode[$llev]{'el'}{'done'} \n") ;
DEBUG(10,"                      :@{$bmode[$llev]{'el'}{'jump'}} \n") ;
DEBUG(10,"active                :$bmode[$llev]{'el'}{'active'} \n") ;
DEBUG(10,"ended                 :$bmode[$llev]{'el'}{'ended'} \n") ;
DEBUG(10,"begun                 :$bmode[$llev]{'el'}{'begun'} \n") ;
            }

            my $flowitem = BuildJump($level,$label); # interupt the current flow
            ModifyLabelStatus($h,$level,$label,'essential',$flowitem);
            if ($sfunc ne 'fixed') { $level-- ; }# retreat back up to parent

         } # end of explicit jump is mandatory 

         else { #  jump can potentially be elminated 
                #  i.e. its a local jump rather than a long jump
DEBUG(7,"local JUMP Unconditional FORWARDS in if/goto to $label line $index\n") ;
                  
             DeactivateSublevel($llev,$path[0]);
             $level-- ;  # retreat back to parent 'if' or 'goto'
DEBUG(7," OOOOOO $llev : $level\n");
	
             if (MultiWayFinished($level)) {
                Finalize($level);
                $statefunc = 'dontAddButEnd';
                $noPathToNext = 1;      # no possible path to next statement
                return;
             }

         }


      }  # end of 'if' or 'goto'

      else {     # JUMP within DO or REPEAT
         if ($type eq  'do' or  $type eq  'REPEAT'  ) {
DEBUG(7,"JUMP within $type LOOP \n") ;
         } 

         if ($type eq 'REPEAT' and  $mllev <$llev) {
DEBUG(7,"Unconditional forward JUMP breaks $type LOOP \n") ;
            my $mtype = $bmode[$mllev]{'el'}{'block'} ; 
            if ($mtype eq 'if' or $mtype eq 'goto') {
DEBUG(7,"Unconditional forward JUMP breaks parent $mtype LOOP \n") ;
	        UndoRepeatMode($llev);
DEBUG(7," After $llev backtracking, Not bothering with parent $mllev\n") ;
                return;
            }

         }
	 elsif ($type eq 'ifexp') {
DEBUG(7,"JUMP within 'ifexp' block. Impending block terminal?\n") ;
            # has to be a jump of some form
            my $flowitem = BuildJump($level,$label); # interupt the current flow
            $statefunc = 'ignoreState' ; # a branch flow statement
            $noPathToNext = 1;           # statement block is closed

            # see if this forward jump can be mapped to a NEXT
            # - only for the first parent loop construct
            for (my $xllev=$lev-1;$xllev>0;$xllev--) {
               my $ltype = $bmode[$xllev]{'el'}{'block'} ; 
               if    ($ltype eq 'do' ) {
                  if ($bmode[$xllev]{'el'}{'termline'}[0] != $index){ last;}
                  if ($statements[$index]{'type'} ne 'continue'){last;}
                  # the do terminal statement is $label continue;
                  # the jump to $label is therefore equivalent to a 'NEXT'
DEBUG(7,"treating jump label $label as level $xllev : do-NEXT\n") ;
                  ModifyLabelStatus($h,$level,$label,'unnecessary',$flowitem);
                  $flowitem->{'type'}='NEXT';
                  return;
               }
               elsif ($ltype eq 'REPEAT' ) {
                  if ($bmode[$xllev]{'el'}{'termline'}[0] != $index){ last;}
                  if ($statements[$index]{'type'} ne 'jump'){last;}
                  # the REPEAT terminal statement is $label goto $top
                  # the jump to $label is therefore equivalent to a 'NEXT'
DEBUG(7,"treating jump label $label as as level $xllev : REPEAT-NEXT\n") ;
                  ModifyLabelStatus($h,$level,$label,'unnecessary',$flowitem);
                  $flowitem->{'type'}='NEXT';
                  return;
               }
            }
            # probably we should check for break stats also!
DEBUG(7,"treating jump label $label as essential\n") ;
            ModifyLabelStatus($h,$level,$label,'essential',$flowitem);
	 }
         else {     # just one level - $mllev==$llev ??
	    if($type eq 'REPEAT' and unavoidableExternalBranchInRepeat($llev)) {
	        UndoRepeatMode($llev); # forget REPEAT
                return;
            }

            my @temp =(@{$bmode[$llev]{'el'}{'jump'}});# copy branch labels
            my $flowitem = BuildJump($level,$label); # interupt the current flow
            ModifyLabelStatus($h,$level,$label,'essential',$flowitem);
            $statefunc = 'ignoreState' ; # a branch flow statement
            $noPathToNext = 1;           # statement block is closed

            my $tmplabel =$bmode[$llev]{'el'}{'jump'}[0];#find repeat term label
            my $maxline = $labeledLineCode{$tmplabel}{'index'}; # get line numb

            if ($h >= $maxline) {  # its the final bit
                 # the current line has gone beyond loop end
                 # so this is an appropriate place to actually terminate
                --$level ;  # pop a level??
            }  
            else {
               # its just crapped program flow
	       my $sfunc=attemptingToFixFlow($llev);
	       if ($sfunc ne 'fixed') {
DEBUG(8,"$type $tmplabel:  $maxline < $h  : REFUSING to pop this level \n") ;
               }
            }  
         }
      }
   } # end of loop over levels
}


sub unavoidableExternalBranchInRepeat {
    my $llev = shift;
    my $levlen = $#{$bmode[$llev]{'sub'}} ; # length of level
    my @blks  = @{$bmode[$llev]{'sub'}} ; # length of level

    # check previous blocks at this level
    for (my $i=0; $i<scalar(@blks); $i++){
	my $type = $blks[$i]->{'block'};
	# this is a temporary fudge until I can think 
        # how to do it properly
        if ($type ne 'comm' and $type ne 'stats') {return 0;}
    } 
    return 1;
}



sub attemptingToFixFlow {  # (crapped program flow)
   my $llev = shift;
#  e.g. we have a situation like this:                               
#     ___________sublevel start______________
#     |                                     |
#     |                                     |
#     -if-                                  |
#        |                                  |
#        |                                  |
#        --if-                              |
#            |                              |
#            |                              |
#            --if-                          |
#                |  GOTO z  (Backtrack Forced Goto)
#                |                          |
#            -----                          |
#            |                              |
#            |                              |
#        -----                              |
#        |                                  |
#        |                                  |
#     ----                                  |
#     |                                     |
#     GOTO XXX (break  3 levels out)        | (just built y/n?)                 
#  =========   (brick wall)                 | <- (we are currently here)
#     Z continue (at same level)            |
#     |                                     |
#     |                                     |
#     |                                     |
#     |__________sublevel finish____________
#                                  
# For simple cases, this could potentially be rearranged more succinctly as: 
#                                  
#     ___________sublevel start______________
#     |                                     |
#     |                                     |
#     -if-                                  |
#        |                                  |
#        |                                  |
#        GOTO XXX (break  3 levels out)     |
#     ----                                  |
#     Z continue (at same level)            |
#     |                                     |
#     |__________sublevel finish____________


# we need a more general pattern matcher!!!
DEBUG(0,"thinking to fix crapped program flow \n");
#????????????????????????
# e.g. xry240.f line 272 : goto 69 
#????????????????????????
             my $levlen = $#{$bmode[$llev]{'sub'}} ; # length of level
             # check if a previous current-level entry exists
             if ($levlen >0) {
                my $prev = ${$bmode[$llev]{'sub'}}[$levlen-1];
                if ($prev->{'block'} eq 'comm') {
DEBUG(10,"skipping previous comment block  \n");
                   $prev = ${$bmode[$llev]{'sub'}}[$levlen-2];
                }
                my $curr = ${$bmode[$llev]{'sub'}}[$levlen];
##DEBUG(10,"Bugger: try rewriting this cond block !!! $closed :@{$closed}\n") ;
DEBUG(10,"Bugger: try rewriting this cond block !!!\n") ;
DEBUG(10,"prev block type  = $prev->{'block'} \n");
                if ($curr->{'block'} eq 'stats' and 
                      $curr->{'stats'}[0]{'labeled'} ) {
                   my $blkStartLab = $curr->{'stats'}[0]{'label'} ;
DEBUG(10," label for first line of curr stats block = $blkStartLab \n");
                   if ($prev->{'block'} eq 'stats') {
                      ##$sfunc = 'endBlock';
DEBUG(10,"Just ignore this potential stuff up! ") ;
                   }
                   else {
DEBUG(10,"jump : @{$prev->{'jump'}}\n") ;
#DEBUG(10,"ojump : @{$prev->{'ojump'}}\n") ;
DEBUG(10,"active: $prev->{'active'}\n") ;
DEBUG(10,"ended : $prev->{'ended'}\n") ;
DEBUG(10,"begun : $prev->{'begun'}\n") ;
DEBUG(10,"FORCED: 1+$#{$prev->{'forced'}}\n");
#DEBUG(10,"FORCED: $prev->{'forced'}[0]{'label'}, at lev $prev->{'forced'}[0]{'level'}\n") ;
#    my $ptr= { 'block' => $statptr,
#               'label' => $label,
#               'level' => $level,
#               'cond'  => $forcedptr};
# could try looking ahead for a missed drop through jump label
#(1)look ahead for next label: 
#(2) compare it with the previous conditional,recursively
# recursively parse $prev looking to rearrange such that $blklab isn't dropped 
# thru-to ....
#(3) on match, rewrite previous as an 'ifif' composite
#(4) prepare for new.

DEBUG(7," Popping current stats block and stuffing in prior IF \n") ;
                      $prev->{'fixitup'} = 
                        [ pop  @{$bmode[$llev]{'sub'}} ] ; # pop stats block off
                      $bmode[$llev]{'oblk'} = undef;  
#                      $bmode[$llev]{'el'} = undef;
#                      $bmode[$llev]{'sub'}= undef;

DEBUG(10,"$llev  $bmode[$llev]{'el'}{'block'} : @{$bmode[$llev]{'el'}{'jump'}}\n");
DEBUG(10,"$llev  $bmode[$llev]{'sub'}\n");
DEBUG(10,"$llev  $bmode[$llev]{'top'}\n");
#DEBUG(10,"$llev  $bmode[$llev]{'oblk'}\n");
DEBUG(10,"$level  $bmode[$level]{'el'}{'block'}\n");
#DEBUG(10,"$level  $bmode[$level]{'sub'}\n");
DEBUG(10,"$level  $bmode[$level]{'top'}\n");
DEBUG(10,"$level  $bmode[$level]{'oblk'}\n");
                      $bmode[$level]{'el'}   = undef;
                      $bmode[$level]{'sub'}  = undef;
                      $bmode[$level]{'oblk'} = undef;
                      $noPathToNext=1;
DEBUG(8,"REJIGGER THIS $level,$llev!!!\n");
                   $bmode[$llev]{'el'}{'done'}= 0; #####fudged forced

                   return 'fixed';      #####POSITIVE RESULT!
                   }
                } 
             }
   ### elsewise, all results negative 
   return 'notfixed';
   
# look ahead for next starting label and check for unfulfilled backmatch

#   Extra relevant keys:
#      +  'dropthru' == closing $label of all if/goto conds
#      +  'forced'   == [{'block' => $statptr,
#     		          'label' => $label,
#		          'level' => $level,
#		          'cond'  => $forcedptr} ];
#                    == a list of unfulfilled labels from a backtrack() 
#      +  'fixitup'
#      +  'contig'

#    my $ptr= { 'block' => $statptr,
#               'label' => $label,
#               'level' => $level,
#               'cond'  => $forcedptr};
#    push @{$ForcedJumps} , $ptr ; 
#
#            my @temp =(@{$bmode[$llev]{'el'}{'jump'}});# copy branch labels
#            BuildJump($level,$label);  # interupt the current flow
#            $statefunc = 'ignoreState' ; # a branch flow statement
#            $noPathToNext = 1;           # statement block is closed
#
#           my $tmplabel =$bmode[$llev]{'el'}{'jump'}[0];#find repeat term label
#            my $maxline = $labeledLineCode{$tmplabel}{'index'}; # get line numb

}





sub UndoRepeatMode { # erase the made up REPEAT  at level $llev
DEBUG(11,"vvvvvvvvvvvvvvvvvvvvvvvvvBacktrackinvvvvvvvvvvvvvvvvvvvvvvvvvvvv  \n") ;
   my $llev = shift;

DEBUG(11,"At this point have to back track and Erase broken REPEAT \n") ;
DEBUG(11,"Set cleanup flag also? \n") ;

   my $type = $bmode[$llev]{'el'}{'block'} ; 
DEBUG(11,"level $llev type is $type \n") ;

   my $state = $bmode[$llev]{'el'}{'undo'} ; 
DEBUG(12,"state:  $state ; @{$state}") ;
#   my @keys = (keys %{$state});  # save before it is deleted!
#DEBUG(12,"keys @keys ") ;
   my $SaveState = $state->[0]{'CurrState'}; # save ref in case it is deleted!
   my $curlinenum = $h;  # save before it is deleted!
DEBUG(12,"cur line  $curlinenum ") ;

DEBUG(12,"zzz  $SaveState ") ;
   my @keys = (keys %{$SaveState});  # save before it is deleted!
DEBUG(12,"keys @keys ") ;
DEBUG(12," h $SaveState->{'h'} \n") ;
DEBUG(12," i $SaveState->{'i'} \n") ;
DEBUG(12," j $SaveState->{'j'} \n") ;
   revertToState($state) ;

   DestroyLabelInfoBackToLine($SaveState->{'h'});

   $SkipRepeat =1; # ensure the fudged REPEAT is skipped on first line of undo
   parseTheLine(
              $SaveState->{'i'},       # $i
              $SaveState->{'j'},       # $j
              $SaveState->{'h'},       # $h start line number
              $curlinenum        # finish on current line number
   );
   undef $state ;
   undef $SaveState ;
   $h = $curlinenum; # reset for return
   $SkipRepeat =-1; # because parseTheLine just took care of the current line
                    # we don't have to, so skip-it  back up in parent
DEBUG(11,"^^^^^^^^^^^^^^^^^^^^EndOfBacktrackin^^^^^^^^^^^^^^^^^^^^^^^^^^^^^  \n") ;
}



sub BuildJump {
   my $level = shift;
   my $target = shift;
   # this is an unconditional discontinuity in the program flow

DEBUG(7,"Discon. Adding unconditional FORWARD jump to $target at level $level\n");
   # Terminate the current flow and add a new single element 
   my $flowitem= { 'block'  => 'jump',  # type of block
                'master' => $h,      # master record pointer
                'begun'  => 1,       # state automatically set
                'active' => 1,       # state automatically set
                'ended'  => 1,       # pre ended block
                'done'   => 1,       # pre ended block
                'jump'   => [$target], # copy path number
   };                                # finish new record
 
   push @{$bmode[$level]{'top'}}, $flowitem; # add to cur stack
   $bmode[$level]{'el'}   = undef;# no record to add to 
   $bmode[$level]{'sub'}  = undef;# reset sub level statement pointr
   $bmode[$level]{'oblk'} = undef;# reset current statement pointr
                               # no statement block is open
   return $flowitem;
}








#
#  Check for zero intermediate code between "if/goto" statement 
#  and the first actual branch point line label
#  if intervening code exists then 'contig'==0
#
sub CheckCondContiguous {
   my $blockPtr = shift ;
   my $comRec   = shift ;
   if ($blockPtr->{'begun'} == 0 ) { #havent begun any 'if' block
      if ( $comRec == 0 && $h <= $blockPtr->{'master'}+1) {
             $blockPtr->{'contig'} = 1;
      }
      elsif ( $comRec != 0  && $comRec->{'corupt'}==0){
          if ( $h <= $blockPtr->{'master'}+ 1 +
                 scalar(@{$comRec->{'stats'}}) ) {
             $blockPtr->{'contig'} = 1;
          }
      }
      #  if $blockPtr->{'contig'} == 0 it severly restricts
      #  any cleaning up of the original source code
   }
}

 

# check for an   if () if () 
# and reduce to  an  if (a and b) or 
# and reduce to  an  if (a or  b) or 

sub backtrack { 
   my $l1 = shift (@_) ;   # get level 1
   my $l2 = shift (@_) ;   # get level 2
   my $savelevel= $level ;
   $level = $l1 ;

DEBUG(11,"vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv \n");
DEBUG(12,"closed parent level $l1 \n");
DEBUG(12,"      type:   $bmode[$l1]{'el'}{'block'} \n");
DEBUG(12,"      ojump:  @{$bmode[$l1]{'el'}{'ojump'}} \n");
DEBUG(12,"      done:   $bmode[$l1]{'el'}{'done'} \n");
DEBUG(12,"      ended:  $bmode[$l1]{'el'}{'ended'} \n");
DEBUG(12,"      active: $bmode[$l1]{'el'}{'active'} \n");
DEBUG(12,"      begun:  $bmode[$l1]{'el'}{'begun'} \n");

# parent levl was closed by current label

DEBUG(11,"open progeny  $l2 \n");
DEBUG(12,"      type:   $bmode[$l2]{'el'}{'block'} \n");
DEBUG(12,"      ojump:  @{$bmode[$l2]{'el'}{'ojump'}} \n");
DEBUG(12,"      done:   $bmode[$l2]{'el'}{'done'} \n");
DEBUG(12,"      ended:  $bmode[$l2]{'el'}{'ended'} \n");
DEBUG(12,"      active: $bmode[$l2]{'el'}{'active'} \n");
DEBUG(12,"      begun:  $bmode[$l2]{'el'}{'begun'} \n");
DEBUG(11," !!!!!!     look for \$noncritviol ??? \n");

# Have to convert any outstanding goto label attributes to jumps
# The theory is that we can go back and set the if 1006,1008 1008 item
# to a long jump now we know the parentsparent if loop is closed.

# have to recurse down data structure closing any open goto/jumps
# i.e. the "if (a) label has to have a new 'cond' which is a 'jump' to ...

#   DestroyLabelInfoBackToLine($SaveState->{'h'}); #????

    #initialize, get them, all, Stuff them  in the current 'el'  and 
    # scoot ;
    $ForcedJumps = [];                            # point to new empty list
    partialParseTree($l1,  [$bmode[$l1]{'el'}] ); # build forced list 
    $bmode[$l1]{'el'}{'forced'} = $ForcedJumps ;  # add new hash element

my $entries = scalar(@{$ForcedJumps});
DEBUG(11,"Forced jumps: $entries \n");

##$level =  $savelevel ;
DEBUG(11,"dropping back out to level: $level and not prev $savelevel\n");
DEBUG(11,"^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ \n");


# also maybe we have to rewrite te way labels are searched from child back up to# parent and reverse it to be parent down to children. ???

# if we can do that sensibly and close off all sublevels cleanly,
# then when we hit the GOTO 69\n 1008 label we can jump back and reconfigure

}


# recursively trace the parse tree, invoking unresolved links
sub  partialParseTree {
   my $lev = shift ;
   my $tmp = shift ;
   my $statptr ;
   my $stat  ;
   if (!defined @{$tmp}) {
DEBUG(9,"       Nothing in this block\n");    
      return;
   }
   $level = $lev ;

   my $numstat = scalar(@{$tmp}) ;
DEBUG(9,"       level $lev  blocks $numstat \n");    
   my $i = 0;

   foreach $statptr ( @{$tmp} ){                   # start with the 'top' record
      $i++; 
DEBUG(9,"         block $i type: $statptr->{'block'}  \n"); 

      if ($statptr->{'block'} eq 'top') {
#         printStats(@{$statptr->{'stats'}});           # dump the statements
      }
      elsif ($statptr->{'block'} eq 'comm') {          # pre statement comments
#         printStats(@{$statptr->{'stats'}});           # dump the statements
      }
      elsif ($statptr->{'block'} eq 'stats') {
#         printStats(@{$statptr->{'stats'}});           # dump the statements
      }
      elsif ($statptr->{'block'} eq 'REPEAT') {  #parse pointer to array of recs
         partialParseTree($lev+1,$statptr->{'stats'});
      }
      elsif ($statptr->{'block'} eq 'do' ) {
        # if this is not 'done' it needs a MAJOR rethink!
          partialParseTree($lev+1,$statptr->{'stats'}); 
      }
      elsif ($statptr->{'block'} eq 'jump' ) {
         # no sub levels, just a print statement 
         # it could be a "break" or "next" statement also ...
      }
      elsif ($statptr->{'block'} eq 'ifexp' ) { ;  # explicit if
         # this will always "branch" somewhere else 
         # maybe it should be converted to 'if!exp' form ...
DEBUG(9,"block: 'explicit if' \n");
      }


      elsif ($statptr->{'block'} eq 'if' ) { ;
DEBUG(9,"block: 'if' @{$statptr->{'jump'}} \n");

          # traverse any sublevels and fix unreferenced
          # do this first to avoid unnecessary traverses
          foreach my $condptr ( keys(%{$statptr->{'cond'}}) ){ 
              my $tmpptr = $statptr->{'cond'}{$condptr};
DEBUG(9,"     : label : $tmpptr->{'label'}:$condptr  \n");
              partialParseTree($lev+1,$tmpptr->{'cstats'}); 
          }

          # If not terminated, then terminate
          if (! $statptr->{'done'} ) { 
             forceGoto($statptr);
             $statptr->{'done'} = 1; #assume its all finished now. It should be!
          }

#         expandIfBlock($lev,$statptr); 
      }


      elsif ($statptr->{'block'} eq 'goto' ) { ;
DEBUG(9,"block: 'goto' \n");

          # traverse any sublevels and fix unreferenced
          # do this first to avoid unnecessary traverses
          foreach my $condptr ( keys(%{$statptr->{'cond'}}) ){ 
              my $tmpptr = $statptr->{'cond'}{$condptr};
DEBUG(9,"     : label : $tmpptr->{'label'}:$condptr  \n");
              partialParseTree($lev+1,$tmpptr->{'cstats'}); 
          }

          # If not terminated, then terminate
          if (! $statptr->{'done'} ) { 
             forceGoto($statptr);
             $statptr->{'done'} = 1; #assume its all finished now. It should be!
          }
      }
   }
   --$level  ;
   
}




#
# Force any currently unresolved branch statments to be "fgoto" types
#
sub  forceGoto {
   my $statptr = shift;
   my $k = -1 ;
DEBUG(10,"forceGoto()\n");
   foreach my $labl ( @{$statptr->{'jump'}} )  {
      my $state = 1<<(++$k) ; # temp local variable
      if (($state & $statptr->{'begun'}) == 0) {
         # state hasn't been invoked yet
         my $fstate = BuildDummyCondState($statptr,$state,$labl,$h,$k,'fgoto');
         ModifyLabelStatus($h,$level,$labl,'essential',$statptr);
         my $ptr= { 'block' => $statptr,
               'label' => $labl,
               'level' => $level,
               'cond'  => $fstate};
         push @{$ForcedJumps} , $ptr ; 
      }
   }
}




sub BuildDummyCondState {        # build a dummy if/goto conditional jump packet
    my $statptr = shift;
    my $state   = shift;
    my $label   = shift;
    my $line    = shift;
    my $sequ    = shift;
    my $mode    = shift;

    # state hasn't been invoked yet
    $statptr->{'begun'} |= $state ;
    $statptr->{'ended'} |= $state ;
    # now treat it as invoked and ended

#### NOTE : look back over the label list for repeated labels
####        if this is a repeated 'goto label' match. 

    my $createNew = 1;
    my $tempcond ;
    my $conds = $statptr->{'cond'} ; # look at preinvoked conds
    my @keylist = keys %{$conds} ;
    foreach my $cond (keys %{$conds} ) {
       if ($conds->{$cond}{'label'} eq $label) { 
          $tempcond = $cond ;
          # have to reset the $cond and completely replace {'cond'}
          $createNew = 0;
          last ;
       }
    }

    if ($mode eq 'goto') { # ensure it is needed
       my $statIdx = $labeledLineCode{$label}{'index'};
      # if line doesn't backwards label a REPEAT, then
      # it could be interchangable with a NEXT statement ...
###      $statements[$statIdx]->{'InfoRef'}{'unrequLabelCount'}=1000 ; 
    }

    my $forcedStateptr;
    if ( $createNew == 1)  {
       $statptr->{'cond'}{$state} = {   # build a dummy state hash
              'plabs' =>{$label => [$sequ] }, #save pointer to new hash of hash
              'class' =>$mode, # retain cond as type "forced goto "
              'label' =>$label,# branch label (not current labl!!)
              'line'  =>$line, # save pointer to newly alloc hash
              'sequ'  =>$sequ, # save sequence in label list (fudge)
              'cstats'=>[],    # no conditional statements
      };                         # finish current record
      $forcedStateptr = $statptr->{'cond'}{$state};
DEBUG(7,"converting $statptr->{'block'} $label to a JUMP   \n");
    }

    else {
          # have to reset the $cond and completely replace {'cond'}
          my $tempptr = delete  $conds->{$tempcond};  # delete old key
          my $cond = $tempcond | (1<< $sequ) ; 
          $conds->{$cond}= $tempptr ;              # replace with new key
          push @{$tempptr->{'plabs'}{$label}}, $sequ ;
DEBUG(7,"appending to existing cond $statptr->{'block'} $label  \n");
          $forcedStateptr = $conds->{$cond};

    }
    return $forcedStateptr;
}





# assessJumpContinuity: This subroutine checks that all the 
# 'branch to' labels in the current GOTO and IF are within
# the limits of any parent loops.
#

sub  assessJumpContinuity { # only called from 'IF' and 'GOTO' and IFEXP
   my $lev  = shift ; 
##   if ($lev<0) {return ;} # no parents to violate  ####
   my $flowitem = shift ; 
   my $numjumps= scalar (@{$flowitem->{'jump'}}) ;
   my @accum  ;          # declare a null array
DEBUG(8,"assessJumpContinuity() from level $lev \n");
   my $parentBlockEnded = 1; # assume true
   my  @brokenlist ;
   my ($ptype,$plev) = ParentType($lev);   #only for immediate parent? 
   my $k = -1 ;
   my $fin =  0;
   my $count =  0;


   foreach my $labl ( @{$flowitem->{'jump'}} )  {
      $fin += 2 ** (++$k);               # construct final state

      # recurse back up the data structure to check if 'jump' 
      # breaches  parent LOOP boundaries/closure
      my $closed ;
      if ($lev>=0) {
         $closed = closedTest($lev ,$labl,$flowitem->{'block'}) ; 
      }
      else { $closed = [-1,-1] ;}

      push @accum, $closed ;   # accumulate closures for all conditions
DEBUG(9,"retval is @{$closed}\n");

      if (${$closed}[0] >= 0 ) { # only critical forward violations here ...
      
         my $maxlev = ${$closed}[0] ;
         my $critviol = 0;            # initialize critical violation count
         my $noncritviol = 0;         # initialize non critical count
         for (my $viol=1; $viol <= $#{$closed} ; $viol++ ) {
            my $viollev = ${$closed}[$viol] ;
            if ( $viollev >= 0 ) {
               my $violblok = $bmode[$viollev]{'el'}{'block'} ;
               if ($violblok ne 'if' and $violblok ne 'goto' ) {
                  $critviol++ ;
               }
               else {
###                  $noncritviol++ ;  # closed test has been rewritten for this
                  $critviol++ ; 
               } 
            }
         }
         if ( $critviol == 0 ) {
            # this $labl non critically violates the terminal labeled branch 
            # point referenced by a parent "if" or "goto" block statement
            # The end point of such a block is currently unknown  - 
            # so we have some degree of freedom  of treatment at this point.
            # To this end we can leave this label on the "expected" list
            # -- until shit happens elsewhere.
            DEBUG(7,"AWAITING a termination criteria for ");
            DEBUG(7," $bmode[$maxlev]{'el'}{'block'}: level $maxlev\n");
#????????????????????????

            next ;
         }
         

         ++$count ;
DEBUG(7,"label $labl breaks level @{$closed} block continuity! \n");

         # definitely breaks a loop 
         # flag these states as definititely satisfied via explicit 'JUMP'
         # 
         my $state = 1<<$k ; # temp local variable
         BuildDummyCondState($flowitem,$state,$labl,$h,$k,'goto');
         ModifyLabelStatus($h,$level,$labl,'essential',$flowitem);

         
# we just modified the child. We could also check if the
# parent may need modifying also ...

         # could build a dummy JUMP statement also but the evidence
         # is now all logged - by an empty active code block for the condition

      }




      else { # its not rigidly closed, but may need redirection ...
          my $label = $labl ;           # get destination line label
          my $index = $labeledLineCode{$label}{'index'} ;
DEBUG(8,"further assessing conditional jumps \n");
 
          if ($index < $h) {           # JUMPING BACKWARDS!
             # ordinarily this is only activated by explicit "goto" statements
             my $state = 1<<$k ; # temp local variable
             my $curJumpType= GetBackwardJumpType($h,$label,$level);
             if ($curJumpType eq 'NEXT') {
DEBUG(7,"backward jump:  implied NEXT\n");
                 BuildDummyCondState($flowitem,$state,$labl,$h,$k,'NEXT');
                 ModifyLabelStatus($h,$level,$labl,'unnecessary',$flowitem);
             } else {
DEBUG(7,"backward jump:  making an explicit GOTO\n");
                BuildDummyCondState($flowitem,$state,$labl,$h,$k,'goto');
                ModifyLabelStatus($h,$level,$labl,'essential',$flowitem);
             }

             # BackwardJumpMode($label);
          }
          else  {                      # JUMPING FORWARDS!
             # ordinarily this is only activated by explicit "goto" statements
             # ForwardJumpMode($label);
DEBUG(7,"it's a forward jump. Make extra check of parent condit blocks \n");
             if ($ptype eq 'if' or $ptype eq  'goto' or $ptype eq 'ifexp'){
                    # if parent is an if
# EXAMPLE 
#      go to (2006,2005),lorp       <---- the parent
# 2006 if (n1-2) 1015,1016,1016
#       we are here  ^^^^^  and have to reset the parents 2006 to 1016
#                           under certain circumstances. Why?
#                           Because conditionally branching to 1015 breaks 
#                           the parents parent, and conditionally branching to
#                           to 1016 inactivates the current 2006 block
# 2005 if (n1-3) 1015,1016,1016
# 1016 if (n1-n1max) 77,77,1015
                my $range = maxLineJumpForLevel($plev) ;
DEBUG(9,"  parent $ptype:$plev: @{$closed}:$index: @{$range}  \n");
                if ($index > $range->[1] && $range->[1]> $range->[0]) { 
				# exceeds last known 'if' branch pt
                   my $fixit = {
                           'id'     => $k ,
                           'index'  => $index,
                           'newlab' => $label  
                   } ;
                   push @brokenlist , $fixit ;
                }
                else  {
                   $parentBlockEnded = 0; # False - continuity preserved
                }
             }
             else { $parentBlockEnded = 0; # False - continuity preserved
             }
          }
      }

   }


   if ($count >= scalar( @{$flowitem->{'jump'}} ) and
       $flowitem->{'block'} ne 'ifexp') {
      my $count2=0; 
      my $ptr ;
      # check if all jumps breach same first parent
      # @accum is a lst of pointers to closures for all jump conditions
      foreach $ptr ( @accum )  {
         if ($ptr->[0] == $accum[0]->[0]) { ++$count2 ; }
      }

      # all jumps are breached by the same parent level
      if ($count2 == $count ) {
         my $lev2 = $accum[0]->[0] ; # violated parent level          
         my $range = maxLineJumpForLevel($lev2) ;
         my $lidxmax = $range->[0] ;

########      if ($index > $lidxmax && $index <  $range->[1] ) { }

         if ($lidxmax >  $flowitem->{'master'} ) {
DEBUG(9,"$lev2: $bmode[$lev2]{'el'}{'block'}: $bmode[$lev2]{'el'}{'active'} \n");
            # flag parents currently active levels as ended
            $bmode[$lev2]{'el'}{'ended'} |=  $bmode[$lev2]{'el'}{'active'} ;
            # and inactive the parent 
            $bmode[$lev2]{'el'}{'active'} =  0 ;

DEBUG(7,"Could RETHINK level $lev2 flow struct for child at $level\n");
DEBUG(7,"compared $lidxmax  and $flowitem->{'master'}\n");
            my $line1 = RealLine($lidxmax);
            my $line2 = RealLine($flowitem->{'master'});
DEBUG(7,"or  $line1  and $line2 \n");
         }
         else {
DEBUG(7,"Definitely RETHINK level $lev2 flow struct for child at $level\n");
DEBUG(7,"compared $lidxmax  and $flowitem->{'master'}\n");
            my $line1 = RealLine($lidxmax);
            my $line2 = RealLine($flowitem->{'master'});
DEBUG(7,"or  $line1  and $line2 \n");

#   current line is an IF or a GOTO 
# CHECK HERE IF ALL jumps and current line >= parent block limits

DEBUG(7,"loop continuity violated for $bmode[$lev]{'el'}{'block'}: level $lev\n");

# then redefine parent if possible ...???
      
# current thoughts are that we can just duplicate the existing fortran 
# structure for now,  but try to modify at dumping time for elegance
# - just as long as the parents are terminated cleanly and collapse at some 
# further point in the code ...???
         }





      }

   }


   elsif ($parentBlockEnded and $#brokenlist>=0) {  # not terminated - just deactivated
                                # i.e. awaiting a termination criterion
      # sort according to closest to current code line 
      my @newbrokelist = sort {$a->{'index'}<=>$b->{'index'}} @brokenlist ;
DEBUG(7,"Me fixum gooood! jumps beyond parent Block end \n");
      
DEBUG(7,"brokenlist:@brokenlist \n");
DEBUG(7,"newbrokelist:@newbrokelist \n");
      # add primary goto   - the first is probably of type 'term' ???
      BuildDummyCondState($flowitem,
          1<<$newbrokelist[0]{'id'},  # $state
          $newbrokelist[0]{'newlab'}, # $labl,
          $h,
          $newbrokelist[0]{'id'},     # $k,
          'term');         # potential 'term' but just make it a goto
      ModifyLabelStatus($h,$level,$newbrokelist[0]{'newlab'},'essential',$flowitem);
      # should add some code to check status when 'term' is used ...

      # add secondary goto statements . None of the rest can be 'term' types
      #  so they must be just plain 'goto'
      for(my $z=1;$z<scalar(@newbrokelist);$z++) { 
            BuildDummyCondState($flowitem,
                1<<$newbrokelist[0]{'id'},  # $state
                $newbrokelist[0]{'newlab'}, # $labl,
                $h,
                $newbrokelist[0]{'id'},     # $k,
                'goto');                   # just make it a goto/jump
          ModifyLabelStatus($h,$level,$newbrokelist[0]{'newlab'},'essential',$flowitem);
      }

      DeactivateSublevel($lev,$newbrokelist[0]{'newlab'});  # --  of parent
      if ($level > $lev + 1) {
DEBUG(7," level mismatch error: \
    retreating from child level $level to parent $lev\n");
      }
      $flowitem->{'done'} = 1 ;   # treat current child as totally satisfied
#      $level = $lev; # retreat back to parent 'if' or 'goto'
   }
 
   if ($fin == $flowitem->{'ended'}) { # all branches were terminal
      # all jump targets break a parent loop so ...
      $flowitem->{'done'} = 1 ;    # treat as if totally satisfied
   }
}




sub  jumpBreaksParentTest  {
   my  $lev   = shift ;    # current depth level
   my  $label = shift ;    # branch to line label
   my $lidxmax=0 ;         # initialize
   my  $retval= [-1] ;     # undecided closure state (reference to list )
   my  $child = $bmode[$lev+1]{'el'}{'block'} ;
   my  $index = $labeledLineCode{$label}{'index'} ;
   my $realIndex =RealLine($index);

DEBUG(8,"jumpBreaksParentTest() for line $realIndex labeled $label on line \n");
   while ( $lev >= 0){    # loop back up through higher levels
DEBUG(10,"checking level $lev ; $bmode[$lev]{'el'}{'block'};@{$bmode[$lev]{'el'}{'ojump'}} \n");
      if (levelStateFinished($lev) ) {
           push @{$retval}, -1 ;
           $lev-- ; 
DEBUG(10,"level prefinished?? \n");
           next ;          # ignore prefinished parents for now
      } 
      my $range = maxLineJumpForLevel($lev) ;
      my @realRange = map(RealLine($_) , @{$range} );

      $lidxmax = $range->[0] ;   # have to fix this up !!!
DEBUG(10,"not finished $lev : critical range is @realRange \n");

      if ($index > $lidxmax && $index <  $range->[1] ) {
DEBUG(7,"loop continuity violated for $bmode[$lev]{'el'}{'block'}: level $lev\n");

         push @{$retval}, $lev ;
         if (${$retval}[0] == -1){ ${$retval}[0]=$lev ;}# save deepest
#         $retval=$lev  ; # definitely not closed
         return $retval

#         # code jumps parent bounds
#         if ($bmode[$lev]{'el'}{'block'} eq 'REPEAT' or 
#             $bmode[$lev]{'el'}{'block'} eq 'do' ) {
#DEBUG(9,"$child $labeledLines{$index}: line $index: level  $lev: @{$bmode[$lev]{'el'}{'jump'}}: max line number  $lidxmax  \n" );
#             $retval=$lev  ; # definitely not closed
#             return $retval ;
#         }
#
#         if ($index+1 == $lidxmax )  { # what about intermediate comments?  
#DEBUG(9,"GOTO $label: is a potential break statement \n") ;
#         }
      }
      else {
         push @{$retval}, -1 ;
      }

      $lev-- ;
   }
   return $retval ;

}
#
#  closedTest(level,linenumber): This  subroutine assesses 
#       likelihood of statement block closure 
#
sub closedTest  {
   my  $lev   = shift ;    # current depth level
   my  $label = shift ;    # branch to line label
   my  $flowtype = shift ; # Type of sub elem
   my $lidxmax=0 ;         # initialize
   my  $retval= [-1] ;     # undecided closure state (reference to list )
   my  $child = $bmode[$lev+1]{'el'}{'block'} ;
   my  $index = $labeledLineCode{$label}{'index'} ;
   my $realIndex = RealLine($index);

DEBUG(8,"closedTest() for line $realIndex labeled $label on line \n");
   while ( $lev >= 0){    # loop back up through higher levels
DEBUG(10,"checking level $lev \n");
        # 'do' is special because its term label applies AFTER its
        # corresponding label, instead of BEFORE as is the case for all other
        # labels
      if (levelStateFinished($lev) and
            ( $bmode[$lev]{'el'}{'block'} ne 'do' or
             ( $bmode[$lev]{'el'}{'block'} eq 'do' and 
               $h> $bmode[$lev]{'el'}{'termline'} )) ) { 
           push @{$retval}, -1 ;
           $lev-- ; 
           next ;          # ignore prefinished parents for now
      } 

      my $range = maxLineJumpForLevel($lev) ;
      my @realRange = map(RealLine($_) , @{$range} );
      $lidxmax = $range->[0] ;   # have to fix this up !!!
DEBUG(10,"not finished $lev : critical range is @realRange \n");

      if ( ($index > $lidxmax and $index <  $range->[1])  or 
           ($index > $lidxmax and  $flowtype ne 'jump') ) {
DEBUG(7,"loop continuity violated for $bmode[$lev]{'el'}{'block'}: level $lev\n");

         push @{$retval}, $lev ;
         if (${$retval}[0] == -1){ ${$retval}[0]=$lev ;}# save deepest
#         $retval=$lev  ; # definitely not closed
         return $retval

#         # code jumps parent bounds
#         if ($bmode[$lev]{'el'}{'block'} eq 'REPEAT' or 
#             $bmode[$lev]{'el'}{'block'} eq 'do' ) {
#DEBUG("$child $labeledLines{$index}: line $index: level  $lev: @{$bmode[$lev]{'el'}{'jump'}}: max line number  $lidxmax  \n" );
#             $retval=$lev  ; # definitely not closed
#             return $retval ;
#         }
#
#         if ($index+1 == $lidxmax )  { # what about intermediate comments?  
#DEBUG("GOTO $label: is a potential break statement \n") ;
#         }
      }
      else {
         push @{$retval}, -1 ;
      }

      $lev-- ;
   }
##   $idxmax = $lidxmax ;
   return $retval ;

}

#
sub levelStateFinished {
   my  $lev   = shift ;    # current depth level
   if ($lev<0) {return 0}
   if ($bmode[$lev]{'el'}{'block'} eq 'if'   or 
       $bmode[$lev]{'el'}{'block'} eq 'goto' or
       $bmode[$lev]{'el'}{'block'} eq 'do'     ) {
      if ($bmode[$lev]{'el'}{'done'} == 1 ) {   
         return  1 ;
      }
   }
   elsif ($bmode[$lev]{'el'}{'block'} eq 'REPEAT') {
      if ($bmode[$lev]{'el'}{'ended'} == 1 ) {   
         return  1 ;
      }
      if ($bmode[$lev]{'el'}{'done'} == 1 ) {   
         return  1 ;
      }
   }
   return 0 ;
}


#  maxLineJumpForLevel :  Returns a line number range, within which
#  any labeled line branch points are GUARANTEED to violate 
#  continuity of the current block.
#
# What is the maximum line number currently 'jumped' to at this level?
# It is used only to decide if a jump statement violates a parent level
#
# fix to return a pointer to an array  [min,max] range for violations

sub maxLineJumpForLevel  {
   my $lev1 = shift ; 
   my $idxmax=-1 ;    # initialize to void
   my  $retval ;     # return a reference to an array
   my (@crap)= (keys %{$bmode[$lev1]{'el'}});
   if (not defined @crap ) {
      DEBUG(7,"WARNING  level $lev1 is not currently defined \n");
      $retval = [9999999, -1]; # no lines exist in this range !
      return $retval;
   }
#DEBUG(7,"ABCD $bmode[$lev1]{'el'}:@crap:$bmode[$lev1]{'el'}{'block'}:$bmode[$lev1]{'el'}{'ojump'}\n");
   my @jumps  = (@{$bmode[$lev1]{'el'}{'ojump'}});# copy original branch labels
   my $type = $bmode[$lev1]{'el'}{'block'} ;

   # block starting points
   if ($type eq 'goto' or $type eq 'if' ) {
      my $begun  = $bmode[$lev1]{'el'}{'begun'};
      my $ended  = $bmode[$lev1]{'el'}{'ended'};
      my $active  = $bmode[$lev1]{'el'}{'active'};
#
# Lets explain this. If we have:
#
#    GOTO (a,b,c,d,e,f,g) z
# a
#    goto h        : a ended
# b
#    goto h        : b ended
# c                : c active
#*   goto x : unconditionally branch to x
# d
#    goto h        : d not begun
# e
# x         : branch point 
#    goto h        : e not begun
# f
#    goto h        : f not begun
# g                : g not begun
# h         : final collection point
#    then the goto x within c has a MaxLineJump for sub level
#    corresponding to d - but if x was beyond g then there would be none!
#    Potentially, by comparing 'jumps' and 'ojumps', may be able to work out
#    the value of h also ...
#
      #  Some condition must have been begun or we wouldn't be here
      my $min    = $bmode[$lev1]{'el'}{'master'} ; #line number of 'if'/'goto'
      my $max    = 9999999;      # arbitrarily large subroutine line number
      my $maxposs = $min;
      my $k = -1 ;
      my $jmp;
      foreach $jmp (@jumps) {
         $k++;
         if ( $ended & ( 1 << $k) ) { next ;} # state has already been invoked
                                              # as 'jump' to
                                              # also excludes known long-jumps
         if ( $active & ( 1 << $k) ) {        # in a currently active block
             #get an upper line number limit on the beginning of
             # the currently active condition
            my $idx1 = $labeledLineCode{$jmp}{'index'} ;
            if ( $idx1 > $min) {$min = $idx1 ; } 
# i get the feeling $mn is redundant ...
            next ;
         } 
#         elsif ($begun & ( 1 << $k) ) {   # begun but not active
#             # implies waiting on the 'if' completion line number.
#             #get a lower line number limit on the beginning of
#             # the currently active condition
#             # find the minimum, uncompleted
#            my $idx1 = $labeledLineCode{$jmp}{'index'} ;
#            if ( $idx1 < $max && $idx1 >$min ) {$max = $idx1 ; }
#            next ;
#         }
         # else - not even begun yet
         # this line number starts a new condtion, further in the code
         # and what we want is the closest line number ahead of the current 
         # 'if'/'goto' condition
         my $idx1 = $labeledLineCode{$jmp}{'index'} ;
         if ($idx1 >$maxposs) {$maxposs=$idx1;}
                               # ^^^^ assumes that we correctly identified
                               #  that it wasn't a  long-jump ...
         if ( $idx1 > $min && $idx1 <$max ) {$max = $idx1 ; }
      }
# maybe should return $max -1 as the max line number ?
# Or what if $label refers to line $max ?? then what ??
      $retval =[$max, $maxposs]; # label in this range would violate continuity
   }

# for DO or REPEAT loops we want the END of the loop
   elsif ($type eq 'do' or $type eq 'REPEAT' or $type eq 'ifexp' ) {
      foreach my $jmp (@jumps) {   # although there should only be one !
         my $idx1 = $labeledLineCode{$jmp}{'index'} ;
         if ( $idx1 > $idxmax) {$idxmax = $idx1 ; }
      }
      $retval =[$idxmax, 9999999 ]; # labeled line in this range would 
                                    # violate continuity
   }
   else {  #cant be any limits so 
      $retval =[9999999, -1]; # no lines exist in this range !
DEBUG(7,"WARNING block type $type has no valid max branch line number\n");
   }
   return  $retval ;
}



##################################################################
# 
# The following routines dump the contents of the carefully 
# assembled data structure. Ideally a significant amount of
# program code analysis should go on during the dumping with
# look ahead nested searches for recognisable conditions.
# None of that happens currently!
#
##################################################################

sub  printHeader {
   $_=$headerline ; 
   s/^     .// ;    # cull leading white space 
   print $OUTFILE "systemheader\:\($subname\)\#\n";
   print $OUTFILE "#" x 72 . "\n" ;
   print $OUTFILE "#" . " " x 70 . "#\n" ;
   print $OUTFILE "#" . " " x 32 . "$subname\n" ;
   print $OUTFILE "#" . " " x 70 . "#\n" ;
   print $OUTFILE "#" x 72 . "\n" ;
   print $OUTFILE $_ ;
}

sub  lineLabelRequired {
   my $line= shift;
   if ($line->{'type'} eq 'decl')   {return 1;} # don't mess with decls
   if ($line->{'type'} eq 'data')   {return 1;} # don't mess with data
   if ($line->{'labeled'} == 0) {return 0;} # no label so not required
   if ($line->{'label'} <0) {return 0;} #  fudged label = -999 not used
   if ($line->{'type'} eq 'format') {return 1;} # probably essential
   my $label  =$line->{'label'};
   my $refcnt =$line->{'labref'};
   my $refs   =$labeledLineCode{$label}->{'refInfo'};
   my $res  =$#{$refs}+1;
   if ($res <$refcnt) {
DEBUG(25,"unresolved reference to label $label<$refcnt:$res>\n# treating as essential! \n");    
      return 1;
   }
   
DEBUG(20," label $label : ref $refcnt : resolved $res \n");    
   my $result;
   foreach my $ref (@{$refs}) {
      $result = $ref->{'result'}; 
DEBUG(20," $result\n"); 
      if ($result eq 'essential') { return 1;} # go no further
   }
   return 0;   

}

sub  printStats {
   my $skipFirstLineLabel = shift ;
   my $maxlin= scalar(@_) ;          # number of lines in argument array
   if (!$maxlin) {return; }          # nothing to print 
   my $cur = "" ;
   my $l = 0;
   my $skip =0;
   foreach my $line ( @_ ) {            # get next line packet
      if ($skip >0) { $skip--; next; }  # skip next data/format lines
      $_ = $line->{'stat'};
      my $type = $line->{'type'} ;
      if (not lineLabelRequired($line) or $skipFirstLineLabel) {
          s/^(\s*\d+)/{' 'x length($1)}/e; # strip line number
          $skipFirstLineLabel=0; # reset
      }
      if ($type eq 'data') {
         if ($cur ne "" ) { print $OUTFILE $cur ; } # print current statement
         $skip = doData($line) ;
         $cur = "";
         next;
      }
      if ($type eq 'format') {
         if ($cur ne "" ) { print $OUTFILE $cur ; } # print current statement
         $skip = doFormat($line) ;
         $cur = "";
         next;
      }
      s/\.lt\./</ig;
      s/\.le\./<=/ig ;
      s/\.eq\./==/ig ;
      s/\.gt\./>/ig ;
      s/\.ge\./>=/ig ;
      s/\.ne\./!=/ig ;
      s/\.not\./!/ig ;
      s/\.and\./&/ig ;
      s/\.or\./\\/ig ;
      
      if (m/^\s+continue\s*$/i ) {next;} # skip blank continue lines
      $l++;                          # increment line count
      #if (m/^[0-9 ]....[^ ]/ ) { }   # sixth char indicates next line continues
      if ($type eq 'lcont'){# sixth char indicates next line continues

         $cur =~ s/\s*$/\$\#\n/ ;    # append continue digraph $# to current
         if (! s/^     .// ){    # cull white space and continue flags from next
            my  ($label , $cont) = (m/^(.....)(.)/) ;  
            s/^(.....)./$1 / ;       # cull potential continue flag 
         }
      }
      elsif (! s/^(c|C)/\#/ ) {      # not a comment
          s/^\s+// ;                 # cull leading white space from next
      }

      if ($maxlin == $l) {           # terminal line of block
        if (m/^(.....).\s*[continue]\s+/i) { 
          my $ln = $1;
        }
      }

      if ($cur ne "" ) { print $OUTFILE $cur ; } # print current statement
      $cur = $_ ;                    # save next statement

   }

   print $OUTFILE $cur ;                      # print current statement
}

sub  doData {
   my $line = shift;
   my $lnum = $line->{'aline'} +1  ;
   $_ = substr($line->{'stat'},6);
   my $skip=0;
   while ($lnum <$declnum and $declarations[$lnum]{'type'} eq 'lcont'){ 
      $skip++;
      chomp; # strip trailing newline
      #concatenate and strip leading 6 chars
      $_ .= substr($declarations[$lnum]{'stat'}, 6);
      $lnum++;
   }
   (my $pre,my $fmt,my $post) = m/(^[^\/]*\/)(.*)(\/[^\/]*$)/ ;
   my $out="";
   my $lev =1;
   while (1) {
     if ($fmt =~m/\G([\,\/])/gc)      {$out.=$1;  next;}
     if ($fmt =~m/\G(\d*\/)/gc)  {$out.=$1; $lev =1-$lev; next;}
     if ($fmt =~m/\G(\()/gc)  {$out.=$1;  next;}
     if ($fmt =~m/\G(\))/gc)  {$out.=$1;  next;}
     if ($fmt=~m/\G(\d+)h/gci){
        $out .= '"'.substr($fmt,pos($fmt),$1).'"';
        pos($fmt) += $1 ; 
        my $nc = substr($fmt,pos($fmt),1);
#        if ($nc ne ',' and $nc ne '/' ) {$out .= ',';}
        next;
     }
     if ($fmt =~m/\G'([^']*)'/gci){$out.='"'.$1.'"'; next;}
     if ($fmt =~m/\G(\d*i\d+)/gci){$out.=$1; next;}
     if ($fmt =~m/\G(\d*a\d+)/gci){$out.=$1; next;}
     if ($fmt =~m/\G(\d+x)/gci){$out.=$1; 
        if (substr($fmt,pos($fmt),1) ne ',') {$out .= ',';}
           next;
     }
     if ($fmt =~m/\G(\d*[def]\d+.\d*)/gci){$out.=$1; next;}
     if ($fmt =~m/\G(\s+)/gci){$out.=$1; next;}
     if ($fmt =~m/\G(\d+)/gci){$out.=$1; next;}  # pure data integer
     if ($fmt =~m/\G$/gci){last;}
     my $val = pos($fmt) ;
     print STDERR "BARRRF in format at pos $val in $fmt \n $out\n";
     exit 1;
   }
   $_ =  $pre . $out . $post;
   while (length($_)>72) {
      print $OUTFILE substr($_,0,69) ."\$#\n" ;
      $_ = substr($_,69) ;
   }
   print $OUTFILE $_ ;
   return $skip;
}
sub  doFormat {
   my $line = shift;
   my $lnum = $line->{'aline'} +1 ;
   $_ = $line->{'stat'};
   my $skip=0;
   while ($lnum <$statlnum and $statements[$lnum]{'type'} eq 'lcont'){ 
      $skip++;
      chomp; # strip trailing newline
      #concatenate and strip leading 6 chars
      $_ .= substr($statements[$lnum]{'stat'}, 6) ;
      $lnum++;
   }
   # render hollerith crap to strings and split line at appropriate place
   (my $pre,my $fmt,my $post) = m/(^[^\(]*)(\(.*\))([^\)]*$)/ ;
   my $out="";
   my $lev =0;
   while (1) {
     if ($fmt =~m/\G([\,\/])/gc)      {$out.=$1;  next;}
     if ($fmt =~m/\G(\d*\()/gc)  {$out.=$1; $lev++; next;}
     if ($fmt =~m/\G(\))/gc)  {$out.=$1; $lev--; next;}
     if ($fmt=~m/\G(\d+)h/gci){
        $out .= '"'.substr($fmt,pos($fmt),$1).'"';
        pos($fmt) += $1 ; 
        if ($fmt=~m/\G(\s*[,\)])/gc){ $out.=$1;}
	else                        {$out .= ',';}
        next;
     }
     if ($fmt =~m/\G'([^']*)'/gci){$out.='"'.$1.'"'; next;}
     if ($fmt =~m/\G(\d*i\d+)/gci){$out.=$1; next;}
     if ($fmt =~m/\G(\d*a\d+)/gci){$out.=$1; next;}
     if ($fmt =~m/\G(\d+x)/gci){$out.=$1; 
        if ($fmt=~m/\G(\s*[,\)])/gc){$out.=$1;}
	else                        {$out .= ',';}
	next;
     }
     if ($fmt =~m/\G(\d*[def]\d+.\d*)/gci){$out.=$1; next;}
     if ($fmt =~m/\G(\s+)/gci){$out.=$1; next;}
     if ($fmt =~m/\G$/gci){last;}
     my $val = pos($fmt) ;
     print STDERR "BARRRF in format at pos $val in $fmt \n $out\n";
     exit 1;
   }
   $_ =  $pre . $out . $post;
   while (length($_)>72) {
      print $OUTFILE substr($_,0,69) ."\$#\n" ;
      $_ = substr($_,69) ;
   }
   print $OUTFILE $_ ;
   return $skip;
}



# recursively descend the parse tree, converting as we go
sub  printParseTree {
   my $lev = shift ;
   my $tmp = shift ;
   my $skipFirstLineLabel = shift ;
   my $statptr ;
   my $stat  ;
   my $numstat = scalar(@{$tmp}) ;
DEBUG(20,"       level $lev  blocks $numstat \n");    
   my $i = 0;

   foreach $statptr ( @{$tmp} ){                   # start with the 'top' record
      $i++; 
DEBUG(20,"         block $i type: $statptr->{'block'}  \n"); 

      if ($statptr->{'block'} eq 'top') {  # dump the statements
         printStats(0,@{$statptr->{'stats'}});
      }
      elsif ($statptr->{'block'} eq 'root') {
         printStats(0,@{$statptr->{'stats'}});
      }
      elsif ($statptr->{'block'} eq 'comm') {          # pre statement comments
         printStats(0,@{$statptr->{'stats'}});
      }
      elsif ($statptr->{'block'} eq 'stats') {
         printStats($skipFirstLineLabel,@{$statptr->{'stats'}});
          $skipFirstLineLabel=0; # reset
      }
      elsif ($statptr->{'block'} eq 'REPEAT') {
         my $line = $statements[$statptr->{'master'}];
         if (not lineLabelRequired($line) ){
            print $OUTFILE "REPEAT\#\n" ; 
         } else {
            print $OUTFILE "$statptr->{'tpt'} CONTINUE\#\nREPEAT\#\n" ; 
         }
         print $OUTFILE "\$\(\#\n" ; 
                    #parse pointer to array of recs
         printParseTree($lev+1,$statptr->{'stats'},1);
         if ($statptr->{'NeedsBreak'} == 1){
            print $OUTFILE "BREAK\#\n";# the goto top should already be invoked
         }
         print $OUTFILE "\$\)\#\n" ; 
      }
      elsif ($statptr->{'block'} eq 'do' ) {
         $_ = $statptr->{'line'} ;                    # the 'do' line
         my $line = $statements[$statptr->{'master'}];
         if (not lineLabelRequired($line) ){
	    s/^......//;  #strip leading line number and continuation
	 } else { 
	    my $label = m/^(.....)/ ;
            if ($label ne '     '){ print $OUTFILE "$label continue\n"; }
            s/^......//; # strip leading label etc 
         } 

         if (singleLineStat(@{$statptr->{'stats'}}) == 1) {
             s/(.*)\s*$/$1\;/ ;              # strip end of line
             my $lin = $statptr->{'stats'}[0]{'stats'}[0]{'stat'} ;
# really have to check before deleting the line label ...
             $lin =~ s/^......//;
             print $OUTFILE $_ . $lin ;              # contract the line
         }
         else {
            print $OUTFILE $_ ;     # dump the 'do' line
            print $OUTFILE "\$\(\#\n" ; 
            if (scalar(@{$statptr->{'stats'}}) ) {
               # parse pointer to array of recs
               printParseTree($lev+1,$statptr->{'stats'},0); 
            }
            print $OUTFILE "\$\)\#\n" ; 
         }
      }
      elsif ($statptr->{'block'} eq 'jump' ) {
         # no sub levels, just a print statement 
	 if ($statptr->{'type'} eq 'NEXT') {
            print $OUTFILE "NEXT\n" ; 
         } else {
            print $OUTFILE "goto $statptr->{'jump'}[0]\n" ; 
         }
      }
      elsif ($statptr->{'block'} eq 'ifexp' ) { ;  # explicit if
DEBUG(20,"block: 'explicit if' \n");
         expandIfExpBlock($lev,$statptr,$skipFirstLineLabel); 
          $skipFirstLineLabel=0; # reset
      }
      elsif ($statptr->{'block'} eq 'if' ) { ;
DEBUG(20,"block: 'if' \n");
         expandIfBlock($lev,$statptr,$skipFirstLineLabel); 
          $skipFirstLineLabel=0; # reset
      }
      elsif ($statptr->{'block'} eq 'goto' ) { ;
DEBUG(20,"block: 'goto' \n");
         expandGotoBlock($lev,$statptr,$skipFirstLineLabel); 
         $skipFirstLineLabel=0; # reset
      }
      else {
DEBUG(20,"block: unknown!!!@{$tmp} \n");
         my $elems = scalar(@{$tmp}) ;
DEBUG(20,"   elements  :$elems \n");
DEBUG(20,"1 $statptr: \n");
DEBUG(20,"2 %{$statptr}  \n");
         my @keys = (keys %{$statptr});
         foreach my $key (@keys) {
DEBUG(20," $key: $statptr->{$key} \n");
         }
      }
####
      if (exists $statptr->{'fixitup'}) {
DEBUG(25," FIXUP THIS BLOCK \n");
         print $OUTFILE "\$\(\#\n" ; 
         printParseTree($lev+1,$statptr->{'fixitup'},0);
         print $OUTFILE "\$\)\#\n" ; 
      }

   }
}


# test to see if substatement is a single line
sub  singleLineStat {
   my @statarr = @_;
   if (scalar(@statarr) == 1) {      #  1 sub record
       my $ref = $statarr[0];
       if ($ref->{'block'} eq 'stats' and
	   defined $ref->{'stats'} and 
           scalar( @{$ref->{'stats'}}) == 1 ){ # 1 stat in sub
           return 1 ;
       }
   }
   return 0;
}
   


sub  expandIfExpBlock {
   my $lev      = shift ;
   my $gotoptr  = shift ;
   my $skipFirstLineLabel = shift ;
   my $numlev   = scalar(@{$gotoptr->{'jump'}});
   my $branchrec= $gotoptr->{'master'};
   my $data =  $branches{$branchrec}[0];   # original data for this 'if' block
   my $cats =  $data->{'cats'}; # how many categories
   my $states =  $gotoptr->{'cond'} ; 
   my @keylist = keys %{$states} ;
   my $nstates = scalar(@keylist) ;

#DEBUG(25," IFEXP\n");
   if ($gotoptr->{'done'} != 1 ) {
DEBUG(25," INCOMPLETE SET OF IF BLOCKS <not 'done'>\n");
   }
   if ($nstates < $cats) {  # note can have $cats +1 if 'term' ???
DEBUG(25," SHORTFALL BETWEEN EXPECTED $cats AND ACTUAL $nstates IF CONDITION BLOKS \n");
   }
DEBUG(20,"cats $cats : keylist @keylist \n");

DEBUG(20,"active $gotoptr->{'active'} : begun $gotoptr->{'begun'} :");
DEBUG(20,"ended $gotoptr->{'ended'} : done   $gotoptr->{'done'} \n");
DEBUG(20,"ojumps @{$gotoptr->{'ojump'}} \n");

# need a sensible sort algorithm here
# need a list of duplicates for amalgamates
# need a correct sequence order 
# need  GOTO jump abbreviation
   
   my @treat = sort {$states->{$a}{'line'}<=>$states->{$b}{'line'}} keys 
                                   %{$states}  ;
DEBUG(20,"treatment order @treat \n");

#by god! there is no label printing here anyway! Fix that.
   
   my $expr =  $data->{'expr'}; 
   my $type =  $data->{'type'}; 
   my $head = 'if     ' ;
DEBUG(20," states $nstates \n");
   if ($nstates == 1) {
      my $key    = $treat[0] ;
      my $class  = $states->{$key}{'class'} ;
      if ($class eq 'goto' or  $class eq 'fgoto' ) {
         my $label = $states->{$key}{'label'} ;
         print $OUTFILE $head . "($expr) GOTO $label\n" ;
      } elsif ($class eq 'NEXT' ) {
         if ($gotoptr->{'negateAndBreak'} == 1) {;
            print $OUTFILE $head . "(!($expr)) BREAK\#\n";#if not expr;break
         } else {
            print $OUTFILE $head . "($expr) NEXT\n" ;
         }
      }
   } else { # can only be 2 states which merge
      if ($nstates >2) {
DEBUG(25," impossible number of states ($nstates) in IfExp block\n");
         exit 1;
      }
      for (my $i=0;$i<$nstates;$i++) {
         my $key = $treat[$i] ;
         my $state = $states->{$key} ;
         my $class = $state->{'class'} ;
         if ($class eq 'blok' ) {

            my $group   = $states->{$key}{'plabs'} ;
            my $val     = (keys %{$group})[0] ;
            my $sequ    = $group->{$val}[0] ;
            my $statptr = $gotoptr->{'cond'}{$key}{'cstats'} ;
            if (scalar(@{$statptr})) {
               my $cond = $data->{'cond'}[$sequ] ;
               if (singleLineStat(@{$statptr}) == 1) {
                  print $OUTFILE $head . "(\!($expr)) ";#if not expr; do this;
                  my $lin = $statptr->[0]{'stats'}[0]{'stat'} ;
# really have to check before deleting the line label ...
                  $lin =~ s/^......//;
                  print $OUTFILE $lin ;   # append 1 line statement
   #               print $OUTFILE "xxxxx";
               } else {
                  print $OUTFILE $head . "(!($expr))\#\n";#if not expr; do this;
                  print $OUTFILE "\$\(\#\n" ;
                  printParseTree($lev+1,$statptr,0); 
                  print $OUTFILE "\$\)\#\n" ;
               }
            }
         } elsif($class ne 'null') {
DEBUG(25," unexpected IfExp class : $class\n");
         }
      }
   
   } # end of else
}


sub  expandIfBlock {
   my $lev      = shift ;
   my $gotoptr  = shift ;
   my $skipFirstLineLabel = shift ;
   my $numlev   = scalar(@{$gotoptr->{'jump'}});
   my $branchrec= $gotoptr->{'master'};
   my $data =  $branches{$branchrec}[0];   # original data for this 'if' block
   my $cats =  $data->{'cats'}; # how many categories
   my $states =  $gotoptr->{'cond'} ; 
   my @keylist = keys %{$states} ;
   my $nstates = scalar(@keylist) ;

   if ($gotoptr->{'done'} != 1 ) {
DEBUG(25," INCOMPLETE SET OF IF BLOCKS <not 'done'>\n");
   }
   if ($nstates < $cats) {  # note can have $cats +1 if 'term' ???
DEBUG(25," SHORTFALL BETWEEN EXPECTED $cats AND ACTUAL $nstates IF CONDITION BLOKS \n");
   }
DEBUG(20,"cats $cats : keylist @keylist \n");

DEBUG(20,"active $gotoptr->{'active'} : begun $gotoptr->{'begun'} :");
DEBUG(20,"ended $gotoptr->{'ended'} : done   $gotoptr->{'done'} \n");
DEBUG(20,"ojumps @{$gotoptr->{'ojump'}} \n");

# need a sensible sort algorithm here
# need a list of duplicates for amalgamates
# need a correct sequence order 
# need  GOTO jump abbreviation
   
   my @treat = sort {$states->{$a}{'line'}<=>$states->{$b}{'line'}} keys 
                                   %{$states}  ;
DEBUG(20,"treatment order @treat \n");

#by god! there is no label printing here anyway! Fix that.
   
   my $ifa =  $data->{'ifa'}; 
   my $ifb =  $data->{'ifb'}; 
   my $head = 'if     ' ;
   for (my $i=0; $i<$nstates; $i++) {
      my $key = $treat[$i] ;
      if (!exists $states->{$key}{'class'}) {
        my @tmpkeys =  keys(%{$states->{$key}}) ;
DEBUG(20,"hello: $i : $key :  $states->{$key} : @tmpkeys \n");
      }
      my $class =  $states->{$key}{'class'} ;
      if ($class eq 'goto' or  $class eq 'fgoto' ) {
         my $label = $states->{$key}{'label'} ;
         my $group = $states->{$key}{'plabs'} ;
         my $sequ =  $states->{$key}{'sequ'};   # use the 'goto' fudge value
         my $cond = $data->{'cond'}[$sequ] ;
         print $OUTFILE $head . "($ifa $cond $ifb) GOTO $label\n" ;
         $head = 'elseif ' ;
      } elsif ($class eq 'NEXT') {
         my $sequ =  $states->{$key}{'sequ'};   # use the 'goto' fudge value
         my $cond = $data->{'cond'}[$sequ] ;
         print $OUTFILE $head . "($ifa $cond $ifb) NEXT\n" ;
         $head = 'elseif ' ;
      }
   }

   for (my $i=0;$i<$nstates;$i++) {
      my $key = $treat[$i] ;
      my $state = $states->{$key} ;
      my $class = $state->{'class'} ;
      if ($class eq 'blok' ) {
         my $group   = $states->{$key}{'plabs'} ;
         my $val     = (keys %{$group})[0] ;
         my $sequ    = $group->{$val}[0] ;

         my $statptr = $gotoptr->{'cond'}{$key}{'cstats'} ;
         if (scalar(@{$statptr})) {
            my $cond = $data->{'cond'}[$sequ] ;
            if (singleLineStat(@{$statptr}) == 1) {
               print $OUTFILE $head . "($ifa $cond $ifb) " ;
               my $lin = $statptr->[0]{'stats'}[0]{'stat'} ;
# really have to check before deleting the line label ...
               $lin =~ s/^......//;
               print $OUTFILE $lin ;   # append 1 line statement
#               print $OUTFILE "xxxxx";
            } else {
               print $OUTFILE $head . "($ifa $cond $ifb)\#\n" ;
               print $OUTFILE "\$\(\#\n" ;
               printParseTree($lev+1,$statptr,0); 
               print $OUTFILE "\$\)\#\n" ;
            }
            $head = 'elseif ' ;
         }
      }
      elsif ($class eq 'multi' ) { 
          # part of a multiway branch
DEBUG(25," AAAHHH POOP! encountered a multiway IF block \n\# The sensible thing to do would be to add the code to $0 to fix this.\n\# for now look though your listing for the line label $states->{$key}{'label'} and correct manually \n");
      }
      elsif ($class eq 'goto' or $class eq 'fgoto' or $class eq 'NEXT') {
          # no op skip these as already taken care of
      }
      elsif ($class eq 'term' ) {
          #  Nothing to do here:
          #  if (expr) goto a ; goto b ; c
          #  c   'term'    (continue) 
      }
      elsif ($class eq 'null' ) {
          #  Nothing to do here:
          #  if (expr) a b a
          #  a  (where a drops through to b )
          #  b  'null'
      }
      else {
         my @xxxx = (keys %{$state});
         my @yyyy = (keys %{$states});
DEBUG(25," UNRECOGNISED IF BLOCK TYPE:<$class>:<$state>:<@xxxx> 
\#     <@treat>,<$i> -> <$key>: <@yyyy> \n");
      }
   }
}




sub  expandGotoBlock {
   my $lev      = shift ;
   my $gotoptr  = shift ;
   my $skipFirstLineLabel = shift ;
   my $numlev   = scalar(@{$gotoptr->{'jump'}});
   my $branchrec= $gotoptr->{'master'};
   my $data     = $branches{$branchrec}[0];   # original data for this 'if' block
   my $cats     = $data->{'cats'};         # how many categories
   my $expr     = $data->{'expr'};         # the conditional expression
   my $states   = $gotoptr->{'cond'} ; 
   my @keylist  = keys %{$states} ;
   my $nstates = scalar(@keylist) ;

   if ($gotoptr->{'done'} != 1 ) {
DEBUG(25," INCOMPLETE SET OF GOTO BLOCKS \n");
   }

   if (scalar(@keylist) < $cats) {  # note can have $cats +1 if 'term' ???
DEBUG(25," SHORTFALL BETWEEN EXPECTED $cats AND ACTUAL $nstates GOTO CONDITION BLOKS \n");
   }
DEBUG(20,"cats $cats : keylist @keylist\n");

DEBUG(20,"active $gotoptr->{'active'} : begun $gotoptr->{'begun'} :");
DEBUG(20,"ended $gotoptr->{'ended'} : done   $gotoptr->{'done'} \n");
if (not defined $gotoptr->{'ojump'}) {
DEBUG(20,"ojumps :undefined ??????? \n");
} else {
DEBUG(20,"ojumps @{$gotoptr->{'ojump'}} \n");
}

# need a sensible sort algorithm here
# need a list of duplicates for amalgamates
# need a correct sequence order 
# need  GOTO jump abbreviation
   
   my @treat = sort {$states->{$a}{'line'}<=>$states->{$b}{'line'}} keys 
                                   %{$states}  ;
DEBUG(20,"treatment order @treat \n");
   
   my $head = 'if ' ;
   my $l = 0 ;
   for (my $i=0;$i<$nstates;$i++) {
      if ( $l == 0) { $head = 'if     ' ; }
      else          { $head = 'elseif ' ; }
      my $key = $treat[$i] ;                 # complex binary state 
### some glitch on the next line ??? - for nonexistant $keys
      my $label = $states->{$key}{'label'} ;
      my $class =  $states->{$key}{'class'} ;
      if ($class eq 'goto' or  $class eq 'fgoto' ) {
         my $group = $states->{$key}{'plabs'} ;
         my $numkeys = scalar(keys %{$group}) ;
DEBUG(20,"1number $group :of keys $numkeys \n");
         my $cond =  BuildGotoCond($expr, $group) ; 
          
         print $OUTFILE $head . "($cond) GOTO $label\n" ;
         $l++ ;
      } elsif ($class eq 'NEXT') {
         my $group = $states->{$key}{'plabs'} ;
         my $cond =  BuildGotoCond($expr, $group) ; 
         print $OUTFILE $head . "($cond) NEXT\n" ;
         $l++ ;
      }
   }

   for (my $i=0;$i<$nstates;$i++) {
      my $key = $treat[$i] ;
      my $state = $states->{$key} ;
      my $class = $state->{'class'} ;
      if ( $l == 0) { $head = 'if     ' ; }
      else          { $head = 'elseif ' ; }

      if ($class eq 'blok' ) {
         my $group = $state->{'plabs'} ;
         my $numkeys = scalar(keys %{$group}) ;
DEBUG(20,"2number of keys $numkeys \n");
DEBUG(20," group $group \n");

         my $cond =  BuildGotoCond($expr, $group) ; 
DEBUG(20," cond $cond \n");
         my $statptr = $state->{'cstats'} ;
         if (scalar(@{$statptr})) {
            print $OUTFILE $head . "($cond)\#\n" ;
            print $OUTFILE "\$\(\#\n" ;
            printParseTree($lev+1,$statptr,0); 
            print $OUTFILE "\$\)\#\n" ;
            $l++ ;
         }
      }
      elsif ($class eq 'multi' ) {
DEBUG(25," AAAHHH POOP! encountered a multiway GOTO block \n\# The sensible thing to do would be to add the code to $0 to fix this.\n\# for now look though your listing for the line label $states->{$key}{'label'} and correct manually \n");
      }
      elsif ($class eq 'term' ) {
      }
      elsif ($class eq 'null' ) {
          #  Nothing to do here:
          #  if (expr) a b a
          #  a  (where a drops through to b )
          #  b  'null'
      }
      elsif ($class eq 'goto' or $class eq 'fgoto' or $class eq 'NEXT') {
          # no op skip these as already taken care of
      }
      else {
         my @xxxx = (keys %{$state});
         my @yyyy = (keys %{$states});
         my $dumpstr = "" ;
	 foreach my $llkey (@xxxx) {
           if (ref($state->{$llkey}) eq 'ARRAY' ) {
              $dumpstr .= "\#   $llkey : @{$state->{$llkey}} \n" ;
           }
           elsif (ref($state->{$llkey}) eq 'HASH' ) {
              my @subkeys = (keys %{$state->{$llkey}}) ;
              $dumpstr .= "\#   $llkey : @subkeys \n" ;
           }
           else { $dumpstr .= "\#   $llkey : $state->{$llkey} \n" ; }
         }
DEBUG(25," UNRECOGNISED GOTO BLOCK TYPE:<$class>:<$state>:<@xxxx> 
\#     <@treat>,<$i> -> <$key>: <@yyyy> \n$dumpstr");
	
      }
   }

}


sub  BuildGotoCond {
   my $cond  = "";
   my %vals  = ( );
   my $expr  = shift;
   my $group = shift;

   # for  a goto there should only be one $sequ

   foreach my $sequ (keys %{$group}) {
       foreach my $val (@{$group->{$sequ}} ) {
           $vals{$val+1} = (); # save the ==1,5,7,2 ... for sorting
                   # ^^+1 counts from 1 to n switch elements
       }
   }

   my @ordvals  = sort {$a<=>$b} keys %vals ;

   my $h ;
   my $first = $ordvals[0] ;
   my $prev  = $ordvals[0] ;
   for($h=1;$h<=scalar(@ordvals);$h++) { #ensure one last pass
      my $val ;
      if ($h<scalar(@ordvals)){  
          $val = $ordvals[$h]
      }
      else { $val = -10 }
      if ($val == $prev+1 ){ 
         $prev = $val ;
         next ;
      }
      else {
         my $sep ;                      # conditional separator
         if ($cond eq "" ) { $sep = "" ;}   
         else              { $sep = "\\" ;}    # RATMAC "OR" ="\"
         if ($prev == $first) {      # only one sequential value 
            $cond = $cond . $sep . $expr . "==" . $first ;
         } 
         elsif ($prev == $first+1){   # two sequential values 
            $cond = $cond . $sep . $expr . "==" . $first ;
            $cond = $cond . "\\" . $expr . "==" . $prev ;
         } 
         else { 
            $cond = $cond . $sep ."(". $expr . ">=" . $first ;
            $cond = $cond . "&" . $expr . "<=" . $prev. ")" ;
         }                 # more than two sequential values 
         $first = $val ;
         $prev  = $first ;
      }

   }

   return  $cond ; 

}

