🚀 go-pugleaf

I'm posting this for a friend, who can't post to Alt.* groups.
If you reply to this article by email, please don't send any mail to
me but to mag...@thep.lu.se

Jan Gustavsson <d8...@efd.lth.se>

=============================================================================

A few months ago, there was a thread about the "most perverse Fortran
statement" here in Alt.folklore.computers. I posted a program called
HUBBA, which was the most perverted abuse of Fortran 77 I could think of.
Unfortunately, it was a bit too perverted - it did some pretty weird things
with ASSIGN (the command that stores a label in an integer variable, which you
can then use as the target of a GOTO), which worked on the computers I tried
it on but turned out not to work on other systems (like IBM mainframes).
It also turned out not to be legal Fortran 77.

To remedy this, I've rewritten the program to use a computed GOTO instead of
assigns. Now, it's legal Fortran 77 and should work on all computers. If it
doesn't, you probably have a bug in your compiler... :-)


Magnus Olsson		     	| \e+ 	   /_	      
Dept. of Theoretical Physics 	|  \  Z	  / q	      
University of Lund, Sweden	|   >----<	      
Internet: mag...@thep.lu.se	|  /	  \===== g    
Bitnet: THEPMO@SELDC52 		| /e-	   \q	      


       PROGRAM HUBBA2
C      Written by Magnus Olsson (mag...@thep.lu.se) in 1990
C      This program can actually be quite useful (but of course there 
C      are simpler ways of implementing the same function). It gives 
C      the wrong output for negative input.
C      In contrast to the first version, this program is written in
C      legal, portable Fortran 77, and should run on all machines.
C
C      Can you find out what this program does, and how it does
C      it, without actually running it?
       COMMON /X/L(4),J
       CHARACTER GRONK*18
       CALL FOO (*70,*60,*50)       
   20  CALL BAR (N-(N/M)*M,*20,*30,*40)
   50  M=M+2
       CALL BAR (5-M,*60,*50,*40)
       CALL BAR (5-M,*30,*40,*50)
   60  M=3
       CALL BAR (5-M,*20,*30,*40)
   70  WRITE (*,*) 'ENTER A NON-NEGATIVE INTEGER'
       READ (*,*) N
       M=2
       GRONK='C O MPPROISMIET E'
   30  CALL BAR (M*M-N,*30,*20,*40)
   40  WRITE (*,*) (GRONK (I:I),I=J+1,17,2)
       END
       SUBROUTINE FOO (*,*,*)
       COMMON /X/L(4),J
       EQUIVALENCE (L(1),M)
       K=1
   50  M=K
       J=1
   80  CALL FNARR (J,*80,*90)
   10  RETURN 1
   20  RETURN 2
   90  K=K+1
       IF (K-4) 50,50,10
   30  RETURN 3
       ENTRY BAR (I,*,*,*)
       J=1
   60  CALL FNARR (J,*60,*70)
   40  RETURN
   70  J=(1-SIGN (1,-I))/2
       K=J*L(2)+(1-J)*L(1)
       GOTO (10,20,30,40) K
       END
       SUBROUTINE FNARR (I,*,*)
       COMMON /X/L(4),J
       L(I)  =L(I)+L(I+1)
       L(I+1)=L(I)-L(I+1)
       L(I)  =L(I)-L(I+1)
       I=I+1
       IF (I*I-3*I-4) 10,20,10
   10  RETURN 1
   20  RETURN 2
       END
       BLOCK DATA XYZZY
       COMMON /X/L(4),J
       DATA L/4*4/
       END