#! /usr/bin/perl

# This program will create the fortran files for stack checkpointing validation.
# We have a generator program because fortran77 doesn't allow recursion.

# Invoke it like this:

# ./fort-gen.pl REAL > job_ckpt_f-floats_std.f
# ./fort-gen.pl INTEGER > job_ckpt_f-integers_std.f

sub header
{
	my ($type) = @_;

print<<EOF;
      INTEGER DEBUGF
      CHARACTER*1 A
      $type GLOBAL0
      $type GLOBAL1
      $type GLOBAL2
      $type GLOBAL3
      $type GLOBAL4
      $type GLOBAL5
      $type GLOBAL6
      $type GLOBAL7
     
      COMMON GLOBAL0, GLOBAL1, GLOBAL2, GLOBAL3, GLOBAL4, GLOBAL5, 
     +                GLOBAL6, GLOBAL7

      GLOBAL0 = -35
      GLOBAL1 = -35
      GLOBAL2 = -35
      GLOBAL3 = -35
      GLOBAL4 = -35
      GLOBAL5 = -35
      GLOBAL6 = -35
      GLOBAL7 = -35

C     This program was autogenerated by src/condor_tests/fort-gen.pl

C     READ(*,'(A)',END=100) A
C     DEBUGF = -1
EOF

	if ($type =~ /INTEGER/) {
	print "100   CALL F0(0, 0, 0, 0, 0, 0, 0, 0)\n";
	} else {
	print "100   CALL F0(0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0, 0.0)\n";
	}

print<<EOF;
      CALL EXIT(0)
      END

      SUBROUTINE F_FIN(ARG0, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7)
      $type ARG0
      $type ARG1
      $type ARG2
      $type ARG3
      $type ARG4
      $type ARG5
      $type ARG6
      $type ARG7
      
	  RETURN
      END

EOF
}

sub frame
{
	my ($type, $name, $invokes) = @_;

print<<EOF;
      SUBROUTINE $name(ARG0, ARG1, ARG2, ARG3, ARG4, ARG5, ARG6, ARG7)
      $type ARG0
      $type ARG1
      $type ARG2
      $type ARG3
      $type ARG4
      $type ARG5
      $type ARG6
      $type ARG7
      $type GLOBAL0
      $type GLOBAL1
      $type GLOBAL2
      $type GLOBAL3
      $type GLOBAL4
      $type GLOBAL5
      $type GLOBAL6
      $type GLOBAL7
      COMMON GLOBAL0, GLOBAL1, GLOBAL2, GLOBAL3, GLOBAL4, GLOBAL5, 
     +                GLOBAL6, GLOBAL7
EOF

	if ($type =~ /INTEGER/) {
		print "900   FORMAT (A,I4,I4,I4,I4,I4,I4,I4,I4)\n";
	} else {
		print "900   FORMAT (A,F8.1,F8.1,F8.1,F8.1,F8.1,F8.1,F8.1,F8.1)\n";
	}

print<<EOF;
      IF (ARG0 .GT. 34) THEN
          WRITE(*,*)'About to checkpoint'
          CALL CKPT_AND_EXIT
          WRITE(*,*)'Returned from checkpoint'
          WRITE(*,900)'args:', ARG0, ARG1, ARG2, ARG3,
     +                       ARG4, ARG5, ARG6, ARG7
          RETURN
      ENDIF

      GLOBAL0 = -(ARG0 +1)
      GLOBAL1 = -(ARG1 +1)
      GLOBAL2 = -(ARG2 +1)
      GLOBAL3 = -(ARG3 +1)
      GLOBAL4 = -(ARG4 +1)
      GLOBAL5 = -(ARG5 +1)
      GLOBAL6 = -(ARG6 +1)
      GLOBAL7 = -(ARG7 +1)
      CALL $invokes(-GLOBAL0, -GLOBAL1, -GLOBAL2, -GLOBAL3,
     +         -GLOBAL4, -GLOBAL5, -GLOBAL6, -GLOBAL7)

      WRITE(*,900)'args:', ARG0, ARG1, ARG2, ARG3,
     +                   ARG4, ARG5, ARG6, ARG7

      WRITE(*,900)'common:', GLOBAL0, GLOBAL1, GLOBAL2, GLOBAL3,
     +                     GLOBAL4, GLOBAL5, GLOBAL6, GLOBAL7

      END

EOF
}


sub main
{
	my $arg;

	
	$arg = shift(@ARGV);

	die "$0 takes one argument: the word 'REAL' or 'INTEGER'" if (!defined($arg));

	header($arg);

	for ($i = 0; $i < 35; $i++) {
		frame($arg, "F$i", "F" . ($i + 1));
	}

	frame($arg, "F$i", "F_FIN");

	return 0;
}

exit main();

