
A debugging aid for some complicated code I was writing at work was the
inspiration for this code.  By the time I was done writing at 4:30 AM, I
had no idea what it was.  I have always had an obsession with Turing machines,
and I thought it would be neet to use one to print out "The Perl Journal"
using something like one.  I'll try to explain how it works.

The first part of this code uses some basic obfuscation techniques from
some other nameless language to set up the look and feel of the remaining
code.

	#!/usr/bin/perl -P

	#define START
	#define IN	sub
	#define OUT	print
	#define OP	&exec	
	#define RET	&{$_[0]}if @_;

The next block of code was written to look like some bastardization of
an assembly language.

	START		{LOAD(r15l2)}
	IN	r15l2	{OP(r4r0r8)}
	IN	r4r0r8	{OP(r12l8l2)}
	IN	r12l8l2	{OP(r11l3)}
	IN	r11l3	{OP(r15l11)}
	IN	r15l11	{OP(r4r0l2)}
	IN	r4r0l2	{OP(r22r0l4)}
	IN	r22r0l4	{OP(r30l26r9)}
	IN	r30l26r9{OP(r6r2)}
	IN	r6r2	{OP(r8r11)}
	IN	r8r11	{OP(r12l1l1)}
	IN	r12l1l1	{OP(r12l1l6)}
	IN	r12l1l6	{OP(r23l2l3)}
	IN	r23l2l3	{OP(r4l1r0)}
	IN	r4l1r0	{OP(r16l10)}
	IN	r16l10	{OP(r12l8r9)}
	IN	r12l8r9	{OP(r4r0)}
	IN	r4r0	{OP()}

The remaining code provides the functionality.

	IN fseek{$_[0]<2?1:fseek($_[0]-1)+fseek($_[0]-2)}
	IN exec{OUT(chr(join('',unpack(op((caller(1))[3]),$/))));RET}
	IN op{$_[0]=~s~^.*::~~;$_[0]=~tr~rl~xX~;$_[0]=~s~(\d+)~$1a~g;$_[0]}
	IN LOAD{$/='';$_="JAPH reading TPJ";$/.=fseek(length($_))while(chop);RET}

The fseek subroutine is pretty obviously a Fibonacci seqeunce generator.  After
running it through the preprocessor and doing some reformatting, it should be
pretty clear.

	sub fseek
	{
		$_[0] < 2 ? 1 : fseek($_[0]-1)+fseek($_[0]-2)
	}

	Or

	sub fseek
	{
		my $value = shift(@_);

		if ($value < 2)
		{
			return 1;
		}
		else
		{
			return ( fseek($value - 1 ) + fseek($value - 2 ) );
		}
	}

Let's take the LOAD subroutine next.  This routine prepares some data for our
use.  After preprocessing and reformatting we get:

	sub LOAD
	{
		$/ = '';
		$_ = "JAPH reading TPJ";
		$/ .= fseek(length($_)) while(chop);
	
		&{$_[0]} if @_;
	}
	
	Or

	sub LOAD
	{
		$/ = '';
		$_= "JAPH reading TPJ";

		while(chop)
		{
			$/ .= fseek(length($_))
		}
	
		&{$_[0]} if @_;
	}

In order to meet my needs, I needed a string with the digits one through nine.
This sub uses the length of the meaningless string 'JAPH reading TPJ' 
as an argument to the Fibonacci number generator.  Each iteration shortens the
string by one character an appends the result to the end of $/.  Perl gives
you so many variables to play with that I decided I didn't need any in my
program.  The ultimate value of $/ is '9876103772331448955342113853211'.  This
value makes up the 'tape' of my machine.  The very last line of the
subroutine simply calls then subroutine with the name of the passed argument.

The op sub does some basic translations for me.  Cleaning it up a bit is easy.

	sub op
	{
		$_[0] =~ s/^.*:://;
		$_[0] =~ tr/rl/xX/;
		$_[0] =~ s/(\d+)/$1a/g;

		return $_[0]
	}

The last sub is the output routine.  Here it is cleaned up a litle:

	sub exec
	{
		print (chr(join('',unpack(op((caller(1))[3]),$/))));

		&{$_[0]} if @_;
	}


Let's take the 'print' line from the inside out.  The 'caller(1)[3]' returns
the name of the calling subroutine.  I was using this function to show me
the line number and subroutine name while debugging my code.  The name of
the calling subroutine is actually an instruction for the machine. 'r15l2'
actually means:

	Move right 15 and read the character
	Move left 2 and read the character

It was easiest to use unpack() to actually read the characters, so the 'op'
sub was used to convert the sub name into a usable format.  'main::r15l2' is
translated into 'r15l2', then 'x15X2', then 'x15aX2a'.  This tells unpack to
ignore the first 15 bytes, read a single character as an ASCII string, ignore
two null bytes to the left, then read in another single character.  In this
case it gives us the value '84' after joining the results from unpack().  It
just so happens that 'chr(84)' gives us the letter 'T'.

The 'exec' sub prints out one character each time it is called, then it calls
the next subroutine in the chain.

An interesting thing about this program is the fact that if you add -w to the
command line options within the program, only one warning is produced.  I
don't deserve credit for that though.  If you execute the following code,
you get the same error:

	#!/usr/bin/perl -wP

	Or

	Shell> perl -wP

I guess that's my way of putting in a bug report :)

