Source code in the brainfuc programming language

      MODULE BRAIN	!It will suffer.
       INTEGER MSG,KBD
       CONTAINS		!A twisted interpreter.
        SUBROUTINE RUN(PROG,STORE)	!Code and data are separate!
         CHARACTER*(*) PROG	!So, this is the code.
         CHARACTER*(1) STORE(:)	!And this a work area.
         CHARACTER*1 C		!The code of the moment.
         INTEGER I,D		!Fingers to an instruction, and to data.
          D = 1		!First element of the store.
          I = 1		!First element of the prog.

          DO WHILE(I.LE.LEN(PROG))	!Off the end yet?
            C = PROG(I:I)			!Load the opcode fingered by I.
            I = I + 1				!Advance one. The classic.
            SELECT CASE(C)			!Now decode the instruction.
             CASE(">"); D = D + 1				!Move the data finger one place right.
             CASE("<"); D = D - 1				!Move the data finger one place left.
             CASE("+"); STORE(D) = CHAR(ICHAR(STORE(D)) + 1)	!Add one to the fingered datum.
             CASE("-"); STORE(D) = CHAR(ICHAR(STORE(D)) - 1)	!Subtract one.
             CASE("."); WRITE (MSG,1) STORE(D)			!Write a character.
             CASE(","); READ (KBD,1) STORE(D)			!Read a character.
             CASE("["); IF (ICHAR(STORE(D)).EQ.0) CALL SEEK(+1)	!Conditionally, surge forward.
             CASE("]"); IF (ICHAR(STORE(D)).NE.0) CALL SEEK(-1)	!Conditionally, retreat.
             CASE DEFAULT				!For all others,
		  						!Do nothing.
            END SELECT				!That was simple.
          END DO			!See what comes next.

    1     FORMAT (A1,$)	!One character, no advance to the next line.
         CONTAINS	!Now for an assistant.
          SUBROUTINE SEEK(WAY)	!Look for the BA that matches the AB.
           INTEGER WAY		!Which direction: ±1.
           CHARACTER*1 AB,BA	!The dancers.
           INTEGER INDEEP	!Nested brackets are allowed.
            INDEEP = 0		!None have been counted.
            I = I - 1		!Back to where C came from PROG.
            AB = PROG(I:I)	!The starter.
            BA = "[ ]"(WAY + 2:WAY + 2)	!The stopper.
    1       IF (I.GT.LEN(PROG)) STOP "Out of code!"	!Perhaps not!
            IF (PROG(I:I).EQ.AB) THEN		!A starter? (Even if backwards)
              INDEEP = INDEEP + 1			!Yep.
            ELSE IF (PROG(I:I).EQ.BA) THEN	!A stopper?
              INDEEP = INDEEP - 1			!Yep.
            END IF				!A case statement requires constants.
            IF (INDEEP.GT.0) THEN	!Are we out of it yet?
              I = I + WAY			!No. Move.
              IF (I.GT.0) GO TO 1		!And try again.
              STOP "Back to 0!"			!Perhaps not.
            END IF			!But if we are out of the nest,
            I = I + 1			!Advance to the following instruction, either WAY.
          END SUBROUTINE SEEK	!Seek, and one shall surely find.
        END SUBROUTINE RUN	!So much for that.
      END MODULE BRAIN	!Simple in itself.

      PROGRAM POKE	!A tester.
      USE BRAIN		!In a rather bad way.
      CHARACTER*1 STORE(30000)	!Probably rather more than is needed.
      CHARACTER*(*) HELLOWORLD	!Believe it or not...
      PARAMETER (HELLOWORLD = "++++++++[>++++[>++>+++>+++>+<<<<-]"
     1 //" >+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------"
     2 //".--------.>>+.>++.")
      KBD = 5		!Standard input.
      MSG = 6		!Standard output.
      STORE = CHAR(0)	!Scrub.

      CALL RUN(HELLOWORLD,STORE)	!Have a go.

      END	!Enough.


        SUBROUTINE BRAINFORT(PROG,N,INF,OUF,F)	!Stand strong!
Converts the Brain*uck in PROG into the equivalent furrytran source...
         CHARACTER*(*) PROG	!The Brain*uck source.
         INTEGER N		!A size for the STORE.
         INTEGER INF,OUF,F	!I/O unit numbers.
         INTEGER L		!A stepper.
         INTEGER LABEL,NLABEL,INDEEP,STACK(66)	!Labels cause difficulty.
         CHARACTER*1 C		!The operation of the moment.
         CHARACTER*36 SOURCE	!A scratchpad.
          WRITE (F,1) PROG,N	!The programme heading.
    1     FORMAT (6X,"PROGRAM BRAINFORT",/,	!Name it.
     1     "Code: ",A,/				!Show the provenance.
     2     6X,"CHARACTER*1 STORE(",I0,")",/	!Declare the working memory.
     3     6X,"INTEGER D",/			!The finger to the cell of the moment.
     4     6X,"STORE = CHAR(0)",/		!Clear to nulls, not spaces.
     5     6X,"D = 1",/)			!Start the data finger at the first cell.
          NLABEL = 0		!No labels seen.
          INDEEP = 0		!So, the stack is empty.
          LABEL = 0		!And the current label is absent.
          L = 1			!Start at the start.
Chug through the PROG.
          DO WHILE(L.LE.LEN(PROG))	!And step through to the end.
            C = PROG(L:L)		!The code of the moment.
            SELECT CASE(C)		!What to do?
             CASE(">")			!Move the data finger forwards one.
              WRITE (SOURCE,2) "D = D + ",RATTLE(">")	!But, catch multiple steps.
             CASE("<")			!Move the data finger back one.
              WRITE (SOURCE,2) "D = D - ",RATTLE("<")	!Rather than a sequence of one steps.
             CASE("+")			!Increment the fingered datum by one.
              WRITE (SOURCE,2) "STORE(D) = CHAR(ICHAR(STORE(D)) + ",	!Catching multiple increments.
     1         RATTLE("+"),")"						!And being careful over the placement of brackets.
             CASE("-")			!Decrement the fingered datum by one.
              WRITE (SOURCE,2) "STORE(D) = CHAR(ICHAR(STORE(D)) - ",	!Catching multiple decrements.
     1         RATTLE("-"),")"						!And closing brackets.
             CASE(".")			!Write a character.
              WRITE (SOURCE,2) "WRITE (",OUF,",'(A1,$)') STORE(D)"	!Using the given output unit.
             CASE(",")			!Read a charactger.
              WRITE (SOURCE,2) "READ (",INF,",'(A1)') STORE(D)"		!And the input unit.
             CASE("[")			!A label!
              NLABEL = NLABEL + 1		!Labels come in pairs due to [...]
              LABEL = 2*NLABEL - 1		!So this belongs to the [.
              INDEEP = INDEEP + 1		!I need to remember when later the ] is encountered.
              STACK(INDEEP) = LABEL + 1		!This will be the other label.
              WRITE (SOURCE,2) "IF (ICHAR(STORE(D)).EQ.0) GO TO ",	!So, go thee, therefore.
     1         STACK(INDEEP)			!Its placement will come, all going well.
             CASE("]")			!The end of a [...] pair.
              LABEL = STACK(INDEEP)		!This was the value of the label to be, now to be placed.
              WRITE (SOURCE,2) "IF (ICHAR(STORE(D)).NE.0) GO TO ",	!The conditional part
     1         LABEL - 1			!The branch back destination is known by construction.
              INDEEP = INDEEP - 1		!And we're out of the [...] sequence's consequences.
             CASE DEFAULT		!All others are ignored.
              SOURCE = "CONTINUE"		!So, just carry on.
            END SELECT			!Enough of all that.
    2       FORMAT (A,I0,A)	!Text, an integer, text.
Cast forth the statement.
            IF (LABEL.LE.0) THEN	!Is a label waiting?
              WRITE (F,3) SOURCE		!No. Just roll the source.
    3         FORMAT (<6 + 2*MIN(12,INDEEP)>X,A)!With indentation.
             ELSE			!But if there is a label,
              WRITE (F,4) LABEL,SOURCE		!Slightly more complicated.
    4         FORMAT (I5,<1 + 2*MIN(12,INDEEP)>X,A)	!I align my labels rightwards...
              LABEL = 0				!It is used.
            END IF			!So much for that statement.
            L = L + 1		!Advance to the next command.
          END DO		!And perhaps we're finished.

Closedown.
          WRITE (F,100)		!No more source.
  100     FORMAT (6X,"END")	!So, this is the end.
         CONTAINS	!A function with odd effects.
          INTEGER FUNCTION RATTLE(C)	!Advances thrugh multiple C, counting them.
           CHARACTER*1 C	!The symbol.
            RATTLE = 1		!We have one to start with.
    1       IF (L.LT.LEN(PROG)) THEN	!Further text to look at?
              IF (PROG(L + 1:L + 1).EQ.C) THEN	!Yes. The same again?
              	L = L + 1		!Yes. Advance the finger to it.
                RATTLE = RATTLE + 1	!Count another.
                GO TO 1			!And try again.
              END IF			!Rather than just one at a time.
            END IF			!Curse the double evaluation of WHILE(L < LEN(PROG) & ...)
          END FUNCTION RATTLE	!Computers excel at counting.
        END SUBROUTINE BRAINFORT!Their only need be direction as to what to count...
      END MODULE BRAIN	!Simple in itself.

      PROGRAM POKE	!A tester.
      USE BRAIN		!In a rather bad way.
      CHARACTER*1 STORE(30000)	!Probably rather more than is needed.
      CHARACTER*(*) HELLOWORLD	!Believe it or not...
      PARAMETER (HELLOWORLD = "++++++++[>++++[>++>+++>+++>+<<<<-]"
     1 //" >+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------"
     2 //".--------.>>+.>++.")
      INTEGER F
      KBD = 5		!Standard input.
      MSG = 6		!Standard output.
      F = 10

      STORE = CHAR(0)	!Scrub.

c      CALL RUN(HELLOWORLD,STORE)	!Have a go.

      OPEN (F,FILE="BrainFort.for",STATUS="REPLACE",ACTION="WRITE")
      CALL BRAINFORT(HELLOWORLD,30000,KBD,MSG,F)
      END	!Enough.


      PROGRAM BRAINFORT
Code: ++++++++[>++++[>++>+++>+++>+<<<<-] >+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
      CHARACTER*1 STORE(30000)
      INTEGER D
      STORE = CHAR(0)
      D = 1

      STORE(D) = CHAR(ICHAR(STORE(D)) + 8)
    1   IF (ICHAR(STORE(D)).EQ.0) GO TO 2   
        D = D + 1                           
        STORE(D) = CHAR(ICHAR(STORE(D)) + 4)
    3     IF (ICHAR(STORE(D)).EQ.0) GO TO 4   
          D = D + 1                           
          STORE(D) = CHAR(ICHAR(STORE(D)) + 2)
          D = D + 1                           
          STORE(D) = CHAR(ICHAR(STORE(D)) + 3)
          D = D + 1                           
          STORE(D) = CHAR(ICHAR(STORE(D)) + 3)
          D = D + 1                           
          STORE(D) = CHAR(ICHAR(STORE(D)) + 1)
          D = D - 4                           
          STORE(D) = CHAR(ICHAR(STORE(D)) - 1)
    4   IF (ICHAR(STORE(D)).NE.0) GO TO 3   
        CONTINUE                            
        D = D + 1                           
        STORE(D) = CHAR(ICHAR(STORE(D)) + 1)
        D = D + 1                           
        STORE(D) = CHAR(ICHAR(STORE(D)) + 1)
        D = D + 1                           
        STORE(D) = CHAR(ICHAR(STORE(D)) - 1)
        D = D + 2                           
        STORE(D) = CHAR(ICHAR(STORE(D)) + 1)
    5     IF (ICHAR(STORE(D)).EQ.0) GO TO 6   
          D = D - 1                           
    6   IF (ICHAR(STORE(D)).NE.0) GO TO 5   
        D = D - 1                           
        STORE(D) = CHAR(ICHAR(STORE(D)) - 1)
    2 IF (ICHAR(STORE(D)).NE.0) GO TO 1   
      D = D + 2                           
      WRITE (6,'(A1,$)') STORE(D)         
      D = D + 1                           
      STORE(D) = CHAR(ICHAR(STORE(D)) - 3)
      WRITE (6,'(A1,$)') STORE(D)         
      STORE(D) = CHAR(ICHAR(STORE(D)) + 7)
      WRITE (6,'(A1,$)') STORE(D)         
      WRITE (6,'(A1,$)') STORE(D)         
      STORE(D) = CHAR(ICHAR(STORE(D)) + 3)
      WRITE (6,'(A1,$)') STORE(D)         
      D = D + 2                           
      WRITE (6,'(A1,$)') STORE(D)         
      D = D - 1                           
      STORE(D) = CHAR(ICHAR(STORE(D)) - 1)
      WRITE (6,'(A1,$)') STORE(D)         
      D = D - 1                           
      WRITE (6,'(A1,$)') STORE(D)         
      STORE(D) = CHAR(ICHAR(STORE(D)) + 3)
      WRITE (6,'(A1,$)') STORE(D)         
      STORE(D) = CHAR(ICHAR(STORE(D)) - 6)
      WRITE (6,'(A1,$)') STORE(D)         
      STORE(D) = CHAR(ICHAR(STORE(D)) - 8)
      WRITE (6,'(A1,$)') STORE(D)         
      D = D + 2                           
      STORE(D) = CHAR(ICHAR(STORE(D)) + 1)
      WRITE (6,'(A1,$)') STORE(D)         
      D = D + 1                           
      STORE(D) = CHAR(ICHAR(STORE(D)) + 2)
      WRITE (6,'(A1,$)') STORE(D)         
      END


  4   IF (ICHAR(STORE(D)).NE.0) GO TO 3  
      IF (ICHAR(STORE(D)).NE.0) GO TO 3