Here it is, reformatted and commented, with a load of character/varname
substitutions to make it more understandable ...

The way it works will be clearer if you turn debugging on by setting
$debug at the top of the script before running this.  The debug stuff
has been removed from the comp. entry.

In summary, it implements an interpreter for a Forth-like language
and then executes a short program in that language.

------------------------------------------------------------------------

for $X(                                                   
    (%core=                                               # %core is a hash of single character 'words'
	                                                      #   and their corresponding subroutines.  All
														  #   except that for 'O' (pop) have their return
														  #   values ignored
														  
	       (S,sub{&{$core{U}}(!$')-&{$core{X}}},             # swap, impl as 1X.  NB, $!' always evaluates
		                                                     #   to 1, and the subtraction is not relevant.
			R,sub{&{$core{U}}(2)*&{$core{X}}},               # rot, impl as 2X. The multiply is irrelevant.
			M,sub{&{$core{S}}+&{$core{R}}},                  # mirror, impl as SR.  Ignore the +
			L,sub{&{$core{U}}(&{$core{O}},$^R)},             # dup (duplicate), takes advantage of 'O'
			                                                 #   setting $^R as well as returning the same
															 #   value, so we do one pop and two pushes.
			
			# 'pick' takes a number, then delves down that many places in the stack and
			#    moves whatever it finds to the top of the stack.  It is implemented via
			#    a splice-like monstrosity which first gets the value, then pushes it on
			#    the top of the stack, and finally, shuffles everything from 'below' it
			#    up by one, thus overwriting the original version and everything below it.
			#    To avoid there being unwanted guests left at the bottom of the stack,
			#    the stack's $# value is changed.
			
			X,sub{                                           # pick     ignore the & and |
			  &{$core{U}}(@$stack[&{$core{O}}])    &         #  |
			  (@$stack[!$'+$^R..$|+@$stack-!$']=             #  X
			    @$stack[2*!$'+$^R..(@$stack)-!$']) |         #  |
			  ($#{@$stack}-=2) },                            # pick
		    
			P,sub{print &{$core{O}}},                        # print - obvious :-)
			U,sub{$stack=[($_[$_+$'],@$stack)]for(0..$#_);}, # push, puts a list of stuff onto the stack.
			                                                 #   it is only in the 'dup' instruction that
															 #   the list functionality is used, everything
															 #   else works on single values.
			O,sub{$^R=shift@$stack},                         # pop, removes the top value from the stack,
			                                                 #   and sets $^R.  This is the only word whose
															 #   return value is used.
		   )
    )&&
    ($stack=[]), # $stack is a reference to the array used as the stack
	
	# the result of (%core...)&&($stack...) is ignored.
	
	# Here comes the 'forth' program.  Each character goes onto the for() list individually.
	#   Each character gets interpreted and, if it _is_ a word defined above, is executed;
	#   otherwise, it ends up on the stack.  My apologies to qr and to zero and oh.  In the
	#   real comp entry, there is a \n in here as well, but it is treated specially and
	#   ignored.
	# Figuring out what's going on here is left as an exercise for the reader.  Suffice
	#   to say that the 'word' names have been character-substituted in the real version.
	#   The substituted names are 2, 6 and A-F.  The first block of characters (up to and
	#   including the space) is all the unique chars of 'the perl journal' in alphabetical
	#   order which are munged and printed by the gobble-di-gook following.
	
	split qr[[{O}]{0}],"aehjlnoprtu R9XSP9XSPLRSPLP4497XSXRXRPMXRPLPSLPRP33XSX5XPPPMSPPSPP"
   )
  
  # Now start 'executing' that for() list ...
  
  { if($debug) { print "$X\t" }                            # show current word if $debug is set

	$X=~/[\^W{\n[^\r]/||                                   # to ignore \n, \r and other nonsense, some
	                                                       #   of which is never encountered but ignored
														   #   anyway for added fun.
    (                                                      # We like nested ? ... : operators :-)
	  ($core{$X}) ? &{$core{$X}}                           # Execute if possible, otherwise ...
	    : ($|=$X && $X+9 != 9) ? &{$core{U}}($X)           # pointless wibblage which pushes numbers ...
	      : &{$core{U}}($X)                                #   otherwise, push non-numbers :-)
	);

	if($debug) { print "\t[".join(',', @$stack)."]\n" }    # show stack if($debug)
  }
