Pasted

MODULE the_tape
  INTEGER, ALLOCATABLE :: tape(:), transitions(:, :)
  INTEGER :: left_edge, right_edge, tape_head_position, tape_size
END MODULE
 
MODULE states_and_transitions
  INTEGER :: accept_state, current_state, current_transition, cardinality_alphabet
END MODULE  
 
 
program turing_machine_simulator
 
  USE the_tape
  USE states_and_transitions
 
  INTEGER :: next_, write_, read_  
  CHARACTER ::  move_
 
  CHARACTER(100) :: tape_prototype, arg
 
  INTEGER :: cardinality_Q
 
  external handle_sigint ! Must declare as external
 
  call get_command_argument(1, arg)
 
  OPEN(UNIT = 12, FILE=arg)
  READ(12,*) cardinality_Q
  READ(12,*) cardinality_alphabet
  cardinality_alphabet = cardinality_alphabet + 1
 
  allocate(transitions(3, cardinality_alphabet * cardinality_Q))
  do 1 i=1, cardinality_alphabet * cardinality_Q
    READ(12,*) next_, write_, move_
    transitions(1:3, i) = (/ next_ + 1, write_, merge(1, -1, move_=='R') /)
  1 continue
  
  READ(12, *) tape_prototype
  WRITE(*,*) tape_prototype
  
  CLOSE(12) 
 
  allocate(tape(len(tape_prototype)))
  do 2 i=1, len(tape_prototype)
    tape(i) = IACHAR(tape_prototype(i:i)) - IACHAR('0')
  2 continue
 
  call SIGNAL(2, handle_sigint)
 
  current_state = 1 
  accept_state = cardinality_Q + 1
  tape_head_position = 1
  
  left_edge = 1
  right_edge = len(trim(tape_prototype))
  tape_size = right_edge
  
  call run
 
  call print_tape
  
  deallocate(tape)
  deallocate(transitions)  
end program
 
 
SUBROUTINE run
  USE the_tape
  USE states_and_transitions
 
  INTEGER :: read_ 
  read_ = 0
  current_transition = 1
  
  do while(current_state .NE. accept_state)
 
    if (tape_head_position .LT. left_edge) then 
      left_edge = left_edge - 1
    elseif (tape_head_position .GT. right_edge) then
      right_edge = right_edge + 1
    endif
 
    if (left_edge .LT. 1 .OR. right_edge .GT. tape_size) call grow_tape
    read_ = tape(tape_head_position)
    
    current_transition = ((current_state - 1) * cardinality_alphabet) + 1 + read_ 
    tape(tape_head_position) = transitions(2, current_transition)
    tape_head_position = tape_head_position + transitions(3, current_transition)
    current_state = transitions(1, current_transition)
 
  end do
end SUBROUTINE
 
 
SUBROUTINE print_tape
  USE the_tape
  do 10 i=left_edge, right_edge - 1 !Index by one, and this is inclusive
    WRITE(*,*) tape(i)
  10 continue
  print *, ''
  return
end SUBROUTINE
 
 
SUBROUTINE handle_sigint
  USE the_tape
  print *, 'Received sigint--bailing.'
  call print_tape
  deallocate(tape)
  deallocate(transitions)  
  stop
end SUBROUTINE
 
 
SUBROUTINE grow_tape
  USE the_tape
  INTEGER :: offset
  INTEGER, ALLOCATABLE :: temp(:)
  
  print *, 'Growing every time', tape_size
  offset = tape_size / 2
 
  allocate(temp(tape_size * 2))
 
  temp = 0 !sets everything to zero in the array
  left_edge = left_edge + offset
  right_edge = right_edge + offset
  tape_head_position = tape_head_position + offset
  
  temp(left_edge:right_edge) = tape(1:tape_size)
  tape = temp
  tape_size = tape_size * 2
  deallocate(temp)
  return
end SUBROUTINE