■ - fortran66のブログ

Ｒ・ペンローズ著『皇帝の新しい心』第二章より。

自然数を連続した 1 の並びで表すとして、それに１を加えるチューリング機械 UN+1。

下の例は 4+1=5 の計算。メインプログラムでは、はじめにテープに４を表す 1 の列を与えて、テープを確認の後、チューリング機械を動作させている。チューリング機械が停止した場合、停止時にテープの内容が現在指示位置の地点まで出力される。

MODULE m_turing_t
IMPLICIT NONE
TYPE :: t_instruction
 INTEGER :: iold_state, iold_mark 
 INTEGER ::  new_state,  new_mark
 INTEGER :: idirection
END TYPE 
TYPE :: t_turingmachine
 INTEGER :: ipos
 INTEGER :: istate
END TYPE
END MODULE m_turing_t 
!====================================================
MODULE m_turing
USE m_turing_t
IMPLICIT NONE
PRIVATE
PUBLIC :: t_instruction
PUBLIC :: turing, punch_tape, dump_tape 
INTEGER, PARAMETER :: max_t = 25000
INTEGER :: itape(-max_t:max_t) 
CONTAINS
!----------------------------------------
SUBROUTINE turing(table)
IMPLICIT NONE
TYPE (t_instruction), INTENT(IN) :: table(:)
TYPE (t_turingmachine) :: tm
INTEGER :: i
tm = t_turingmachine(0, 0)
LOOP: DO 
 DO i = 1, SIZE(table)
  IF (itape(tm%ipos) == table(i)%iold_mark .AND. &
            tm%istate == table(i)%iold_state ) THEN
   itape(tm%ipos) = table(i)%new_mark  
   tm%istate      = table(i)%new_state
   tm%ipos = tm%ipos + table(i)%idirection 
   IF (table(i)%idirection == 0) THEN
    EXIT LOOP
   END IF
   IF (ABS(tm%ipos) > max_t) THEN 
    WRITE(*, *) 'Out of Tape bounds!'
    STOP
   END IF
  END IF
 END DO 
END DO LOOP
WRITE(*, *) 'Normal STOP!'
CALL dump_tape(isearch(), tm%ipos)
RETURN
CONTAINS 
 INTEGER FUNCTION isearch
 INTEGER :: k
 isearch = tm%ipos
 DO k = -max_t, tm%ipos 
  IF (itape(k) == 1) THEN
   isearch = k - 3
   EXIT
  END IF
 END DO
 RETURN
 END FUNCTION isearch 
END SUBROUTINE turing
!----------------------------------------
SUBROUTINE punch_tape(text)
IMPLICIT NONE
CHARACTER (LEN = *), INTENT(IN) :: text
INTEGER :: i
CHARACTER :: ch
itape = 0
DO i = 1, LEN_TRIM(text)
 ch = text(i:i)
 IF (ch /= '0' .AND. ch /= '1') THEN
  WRITE(*, *) 'tape error'
  STOP
 END IF
 READ(ch, '(i1)') itape(i)
END DO
RETURN
END SUBROUTINE punch_tape
!----------------------------------------
SUBROUTINE dump_tape(n0, n1)
IMPLICIT NONE
INTEGER, INTENT(IN) :: n0, n1
WRITE(*, '(79I1.1:)') itape(n0:n1)
RETURN
END SUBROUTINE dump_tape
!----------------------------------------
END MODULE m_turing
!========================================================
PROGRAM UN1
USE m_turing
IMPLICIT NONE
INTEGER, PARAMETER :: ninst = 4
TYPE(t_instruction) :: instruction_table(ninst)
!
instruction_table(1) = t_instruction(B'0', 0, B'0', 0, +1)
instruction_table(2) = t_instruction(B'0', 1, B'1', 1, +1)
instruction_table(3) = t_instruction(B'1', 0, B'0', 1,  0)
instruction_table(4) = t_instruction(B'1', 1, B'1', 1, +1)
!
CALL punch_tape('0001111000')
!
CALL dump_tape(1, 10)
CALL turing(instruction_table)
STOP
END PROGRAM UN1

あまり考えないで作った。テープのダンプ位置を適当に見やすく合わせているので、入力位置とのずれが分からなくなっている。

同様に 4*2=8 を計算するチューリング機械 UN*2。

PROGRAM UN2
USE m_turing
IMPLICIT NONE
INTEGER, PARAMETER :: ninst = 12
TYPE(t_instruction) :: instruction_table(ninst)
!
instruction_table( 1) = t_instruction(B'000', 0, B'000', 0, +1)
instruction_table( 2) = t_instruction(B'000', 1, B'001', 0, +1)
instruction_table( 3) = t_instruction(B'001', 0, B'010', 1, -1)
instruction_table( 4) = t_instruction(B'001', 1, B'001', 1, +1)
instruction_table( 5) = t_instruction(B'010', 0, B'011', 0, +1)
instruction_table( 6) = t_instruction(B'010', 1, B'100', 0, +1)
instruction_table( 7) = t_instruction(B'011', 0, B'000', 1,  0)
instruction_table( 8) = t_instruction(B'011', 1, B'011', 1, +1)
instruction_table( 9) = t_instruction(B'100', 0, B'101', 1, -1)
instruction_table(10) = t_instruction(B'100', 1, B'100', 1, +1)
instruction_table(11) = t_instruction(B'101', 0, B'010', 1, -1)
instruction_table(12) = t_instruction(B'101', 1, B'101', 1, -1)
!
CALL punch_tape('0001111000')
!
CALL dump_tape(1, 10)
CALL turing(instruction_table)
STOP
END PROGRAM UN2