Member Avatar for Reverend Jim

While going through some old CDs I came across one containing all of the source code for our old ADG/SCADA system (retired 1998). I remembered one horrifyingly bad piece of code that I later rewrote and I thought it might be interesting to post it as an object lesson in how not to write code. I am sure there are worse pieces of code out there in production systems but most are thankfully hidden because the source code is not available (it reminds me about the adage regarding the law and sausages).

The code was written in SFORX (extended FORTRAN which, when run through a preprocessor resulted in standard FORTRAN). All $ keywords are SFORX extensions.

Added 2012-06-29 17:36 - The original code was not written by me

         SUBROUTINE READALL(UNIT,BUFF,*,*,IFIRST)
C*TTL READALL READ FROM ANYTHING
C
C
C
C     THIS SUBROUTINE IS USED FOR READING COMPRESSED OR UNCOMPRESSED
C     DATA INPUT FILES FROM LFC 'UNIT' INTO 80 BYTE ARRAYY BUFF.
C     END RETURNS TO FIRST RETURN, ERROR RTETURNS TO SECOND
C     IFIRST IS LOGICAL WHICH CALLER PROVIDES TRUE ON
C     FIRST READ OFF OF THIS ALLOCATION OF THIS LFC, ELSE FALSE
C*PGMXX READALL  SAVD TOOLS    FS$READA ON 07/23/80 17:43:51 01819B00R01
      LOGICAL IFIRST
         INTEGER*1 BUFF(80)
         INTEGER*4 UNIT
         INTEGER*1 BYTE(120,2)
C
C
         INTEGER*1 IN(2)/2*0/,ISP(2)/2*0/,ITX(2)/2*0/,NB(2)/2*0/
         INTEGER*1 NBT(2)/2*1/
         INTEGER*1 KCR/ZBF/,KLR/Z9F/
         INTEGER*1 EOR/ZFF/
         INTEGER*2 NSEQ(2)/2*0/,ITY(6),ISEQ(60,2),ICKS(60,2)
         INTEGER*4 LFC(2)/2*0/
      INTEGER*4 K,N,IERR,IN0,ISP0,ITX0,NB0,IS,I,ISUM,J
C
C
         EQUIVALENCE (BYTE(3,1),ICKS(1,1)),(BYTE(5,1),ISEQ(1,1))
C
C
      IF(.NOT.IFIRST) GO TO 21
      DO 19 K=1,2
      IN(K) = 0
      ISP(K) = 0
      ITX(K) = 0
      NB(K) = 0
      NBT(K) = 1
      NSEQ(K) = 0
      LFC(K) = 0
19    CONTINUE
21    CONTINUE
         DO 101 N=1,2
         IF (UNIT.EQ.LFC(N)) GO TO 103
         IF (LFC(N).EQ.0) GO TO 102
101      CONTINUE
         GO TO 94
102      LFC(N) = UNIT
         CALL W:PDEV(UNIT,ITY)
         NBT(N) = 1
         IF (ITY(3).GE.4.AND.ITY(3).LE.6) NBT(N)=2
103      IERR = 0
         IN0 = IN(N)
         ISP0 = ISP(N)
         ITX0 = ITX(N)
         NB0 = NB(N)
1        IF (IN0.NE.0) GO TO 8
2        CALL BUFFERIN(UNIT,0,BYTE(1,N),30)
         CALL M:WAIT(UNIT)
         CALL STATUS(UNIT,IS,NB0)
         IF (IS-3) 3,80,90
3        IF (BYTE(1,N).EQ.KCR.OR.BYTE(1,N).EQ.KLR) GO TO 6
         NB0 = NB0*NBT(N)
         DO 4 I=1,NB0
         IF (BYTE(I,N).EQ.10.OR.BYTE(I,N).EQ.13) BYTE(I,N) = 1R
4        BUFF(I) = BYTE(I,N)
         IF (NB0.GE.80) GO TO 20
         I = I+1
         DO 5 I=I,80
5        BUFF(I) = 1R
         GO TO 20
6        NB0 = BYTE(2,N)
         IF (NB0.GT.114) GO TO 91
         ISUM = 0
         DO 7 I=1,NB0
7        ISUM = ISUM+BYTE(I+6,N)
         IF (ISUM.NE.ICKS(1,N)) GO TO 92
         IF (ISEQ(1,N).NE.NSEQ(N)) GO TO 93
         NSEQ(N) = NSEQ(N)+1
         IN0 = 7
8        DO 16 I=1,80
         IF (ISP0.NE.0) GO TO 9
         IF (ITX0.NE.0) GO TO 12
         IF (BYTE(IN0,N).EQ.EOR) GO TO 9
         ISP0 = BYTE(IN0,N)
         IF (ISP0.GT.81-I) GO TO 91
         IN0 = IN0+1
         GO TO 10
9        ISP0 = ISP0-1
10       IF (ISP0.EQ.0) GO TO 11
         BUFF(I) = 1R
         GO TO 16
11       IF (BYTE(IN0,N).EQ.EOR) GO TO 9
         ITX0 = BYTE(IN0,N)
         IF (ITX0.GT.81-I) GO TO 91
         IN0 = IN0+1
12       BUFF(I) = BYTE(IN0,N)
         IF (BUFF(I).EQ.10.OR.BUFF(I).EQ.13) BUFF(I) = 1R
         ITX0 = ITX0-1
13       IN0 = IN0+1
         IF (IN0.LE.NB0+6) GO TO 16
         CALL BUFFERIN(UNIT,0,BYTE(1,N),30)
         CALL M:WAIT(UNIT)
         CALL STATUS(UNIT,IS,NB0)
         IF (IS-3) 14,80,90
14       IF (BYTE(1,N).NE.KCR.AND.BYTE(1,N).NE.KLR) GO TO 91
         NB0 = BYTE(2,N)
         IF (NB0.GT.114) GO TO 91
         ISUM = 0
         DO 15 J=1,NB0
15       ISUM = ISUM+BYTE(J+6,N)
         IF (ISUM.NE.ICKS(1,N)) GO TO 92
         IF (ISEQ(1,N).NE.NSEQ(N)) GO TO 93
         NSEQ(N) = NSEQ(N)+1
         IN0 = 7
16       CONTINUE
         IF (BYTE(IN0,N).NE.EOR) GO TO 91
         ISP0 = 0
         IF (ITX0.NE.0) GO TO 91
         IN0 = IN0+1
         IF (IN0.GT.NB0+6) IN0 = 0
         IF (BYTE(1,N).EQ.KLR.AND.IN0.EQ.0) NSEQ(N) = 0
20       IN(N) = IN0
         ISP(N) = ISP0
         ITX(N) = ITX0
         NB(N) = NB0
         RETURN
80       NSEQ(N) = 0
         IN(N) = ISP(N) = ITX(N) = 0
         RETURN 1
90       IERR = 1
91       IERR = IERR+1
92       IERR = IERR+1
93       IERR = IERR+1
94       IERR = IERR+1
         IN(N) = ISP(N) = ITX(N) = 0
         BUFF(1) = IERR
         RETURN 2
         END

The "unraveled" code is as follows:

C*TTL READ    - READ A COMPRESSES OR UNCOMPRESSED RECORD FROM FILE
      SUBROUTINE READ ( FILE , REC , LREC , * , * , STAT )

C*PGMJD READ     SAVD MHTOOLS  READ     ON 10/03/91 13:59:58 JIM

C =====================================================================
C =
C =  NAME:
C =
C =    (MHTOOLS)READ         READ       (FTN)
C =
C =  SYNOPSIS:
C =
C =    READ A RECORD FROM A COMPRESSED OR UNCOMPRESSED FILE.
C =
C =  CALLING SEQUENCE:
C =
C =    CALL READ ( FILE , REC , LREC , $EOF , $ERR , STAT )
C =
C =  PARAMETERS:
C =
C =    FILE:     ID   I-   INPUT FILE NAME IN CURRENT USERNAME
C =    $EOF:          I-   RETURN FOR END OF FILE
C =    $ERR:          I-   RETURN FOR READ ERROR
C =    REC:      IB*  -O   BUFFER TO CONTAIN INPUT RECORD
C =    LREC:     IW   -O   NUMBER OF CHARACTERS IN CURRENT RECORD
C =    STAT:     IW   -O   RETURN STATUS
C =
C =               0    -   OK
C =              -1    -   END OF FILE
C =            1-99    -   SEE RETURN CODES FOR M:ALOC1
C =             101    -   READ ERROR
C =             102    -   BAD BYTE COUNT IN RECORD (COMPRESSED)
C =             103    -   SEQUENCE NUMBER OUT OF ORDER (COMPRESSED)
C =
C =  NOTE:
C =
C =    ONLY ONE FILE CAN BE READ AT A TIME, HOWEVER, MANY FILES CAN
C =    BE READ SEQUENTIALLY.
C =
C =  MAKE:
C =
C =    SUBMIT SFORB MHTOOLS READ
C =
C =  AUDIT:
C =
C =    911003  JD  UPDATED HEADER
C =    900829  JD  RECOVED SOURCE AFTER HEAD CRASH ON PACK 007
C =    890926  JD  UNRAVELED DECOMPRESSION LOGIC
C =    880322  JD  EXPANDED BUFFER TO HANDLE 132 CHARS MAX
C =    880314  JD  IMPLEMENTED
C =
C =====================================================================
C*EJE
      INTEGER *8  FILE            ! FILE TO READ
      INTEGER *8  OLDFILE  /-1/   ! LAST FILE READ
      INTEGER *1  REC      (1)    ! RETURNED RECORD
      INTEGER *4  LREC            ! LENGTH OF RETURNED RECORD
      INTEGER *4  STAT            ! I/O STATUS RETURN
      INTEGER *4  LFC      /0/    ! FILE INPUT LOGICAL FILE CODE
      INTEGER *2  OLDSEQ   /-1/   ! SEQ # OF PREVIOUS BLOCK
      INTEGER *2  NEWSEQ          ! SEQ # OF CURRENT BLOCK
      INTEGER *4  NBYTES   /0/    ! # BYTES OF DATA IN BLOCK

      INTEGER *4  LBUFW    /34/   ! # WORDS ALLOCATED TO BUFFER
      INTEGER *4  BUFW     (34)   ! BLOCK INPUT BUFFER
      INTEGER *2  BUFH     (68)   ; EQUIVALENCE (BUFW,BUFH)
      INTEGER *1  BUF      (136)  ; EQUIVALENCE (BUFW,BUFB)

      INTEGER *2  EOR      /ZFF/  ! END OF RECORD INDICATOR
      INTEGER *4  I               ! LOOP INDEX
      INTEGER *4  NI       /1/    ! NEXT BYTE IN
      INTEGER *4  NO       /1/    ! NEXT BYTE OUT
      INTEGER *4  NB              ! NUMBER OF BYTES OR BLANKS

C     --- CHECK IF INITIAL CALL FOR A FILE OR NEW FILE REQUESTED

      $IF (LFC .EQ. 0 .OR. OLDFILE .NE. FILE)
         OLDSEQ  = -1
         NI = NO =  1
         NBYTES  =  0
         STAT    =  0
         BUF(W)  = '    '
         LFC     = 'RD1 '
         OLDFILE = FILE
         CALL M:DALOC (LFC)
         CALL M:ALOC1 (LFC,FILE,,,.TRUE.,,STAT)
         $IF (STAT .NE. 0)
            LFC = 0
            RETURN 2
         $ENDI
      $ENDI

C     --- KEEP GOING UNTIL A COMPLETE RECORD IS TRANSFERRED

      $WHILE (.TRUE.)

C        --- IF NO MORE DATA BYTES, READ ANOTHER BLOCK

         $WHILE (NBYTES .LE. 0)
            $CALL READNEXT
         $ENDW

C        --- GET NUMBER OF BLANKS TO EXPAND

         NB = BUF(NI); NI = NI + 1 ; NBYTES = NBYTES - 1

         $IF (NB .EQ. EOR)
            $BREAK
         $ENDI

         $WHILE (NB .GT. 0)
            REC(NO) = ' '
            NO = NO + 1; NB = NB - 1
         $ENDW

C        --- GET NUMBER OF CHARACTERS TO COPY

         NB = BUF(NI); NI = NI + 1 ; NBYTES = NBYTES - 1

         $IF (NB .EQ. EOR)
            $BREAK
         $ENDI

         $WHILE (NB .GT. 0)
            REC(NO) = BUF(NI)
            NO = NO + 1; NI = NI + 1
            NB = NB - 1; NBYTES = NBYTES - 1
         $ENDW

      $ENDW

C     --- UPDATE BUFFER POINTERS, FIND RECORD LENGTH AND RETURN

      LREC = NO - 1; NO = 1

      RETURN
C*TTL READ NEXT RECORD
C     ================
      $SUB READNEXT
C     =============

C     --- GET THE NEXT DATA BLOCK

      CALL BUFFERIN (LFC,0,BUFW,LBUFW)      ! READ NEXT BLOCK
      CALL M:WAIT   (LFC)                   ! WAIT FOR I/O COMPLETION
      CALL STATUS   (LFC,STAT,NBYTES)       ! GET STATUS AND # OF BYTES

C     --- CHECK FOR END OF FILE OR ERROR

      $IF (STAT .EQ. 3)
         LFC  = 0
         STAT = -1
         RETURN 1       ! END OF FILE
      $ENDI

      $IF (STAT .GT. 3)
         LFC  = 0
         STAT = 101
         RETURN 2       ! ERROR
      $ENDI

      STAT = 0

      $IF (BUF(1) .EQ. 2ZBF .OR. BUF(1) .EQ. 2Z9F)

C        --- THIS IS A COMPRESSED FILE, RESET BUFFER VARIABLES

         NBYTES = BUF(2)
         NEWSEQ = BUFH(3)
         NI     = 7

C        --- CHECK FOR SEQUENCE ERROR

         $IF (NEWSEQ .NE. OLDSEQ + 1)
            STAT = 103
            RETURN 2         ! SEQUENCE ERROR
         $ENDI

         OLDSEQ = NEWSEQ

      $ELSE

C        --- FILE IS UNCOMPRESSED - COPY DATA VERBATIM

         $FOR I = 1 , NBYTES
            REC(I) = BUF(I)
         $ENDF

C        --- SET RECORD LENGTH - CLEAR NBYTES TO FORCE READ ON NEXT CALL

         LREC = NBYTES; NBYTES = 0

         RETURN

      $ENDI

      $ENDS

      END
Edited by Reverend Jim because: Had to claify that I did NOT write the original code
  • 5 Contributors
  • 12 Replies
  • 355 Views
  • 8 Hours Discussion Span
  • Latest Post Latest Post by MosaicFuneral

Recommended Answers

All 12 Replies

Member Avatar for Ancient Dragon

I'm shocked! You should have been horsewhipped for writing that horrible stuff :)

Member Avatar for Reverend Jim

Let me be clear on one thing. I did not write that abomination. It was written by a company in Pittsburgh. My job was to rewrite it while preserving the logic. The company (which shall remain nameless) that wrote the original code had implemented their own compressison algorithm. I had to rewrite the code while maintaining the interfaces.

Member Avatar for mike_2000_17

Isn't any code written in FORTRAN horrible?

But this one is particularly horrible, probably the highest density of GO TO ever seen in one piece of code (excluding assembly code, of course).

Member Avatar for Reverend Jim

FORTRAN code is not pretty. Adding extensions like the above sforx is just lipstick on a pig. Some (engineers mostly) argue that FORTRAN compilers product code that is more highly optimized then C. I haven't seen the benchmarks but I imagine that any difference is insignificant compared to the difficulty in working with the language.

Member Avatar for mike_2000_17

The benchmarks I have seen put fortran at about two or three times slower than C or C++, but that was on GCC compilers. So, unless you are using one of Intel's super-optimized fortran compilers, it's really not worth the trouble (and even then, I'm sure Intel's super-optimized C / C++ compilers are just as good if not better). I do interact with fortran code from time to time (in the field of numerical analysis, it's unavoidable), but I see it just as an annoying legacy language which is disgusting to look at and decypher.

Member Avatar for TrustyTony

Here is sample not written by me in language to test the recently revived software of Dani, Brainfuck, code is claimed to do ROT13:

+[,+[-[>+>+<<-]>[<+>-]+>>++++++++[<-------->-]<-[<[-]>>>+[<+<+>>-]<[>+<-]<[<++>
>>+[<+<->>-]<[>+<-]]>[<]<]>>[-]<<<[[-]<[>>+>+<<<-]>>[<<+>>-]>>++++++++[<-------
->-]<->>++++[<++++++++>-]<-<[>>>+<<[>+>[-]<<-]>[<+>-]>[<<<<<+>>>>++++[<++++++++
>-]>-]<<-<-]>[<<<<[-]>>>>[<<<<->>>>-]]<<++++[<<++++++++>>-]<<-[>>+>+<<<-]>>[<<+
>>-]+>>+++++[<----->-]<-[<[-]>>>+[<+<->>-]<[>+<-]<[<++>>>+[<+<+>>-]<[>+<-]]>[<]
<]>>[-]<<<[[-]<<[>>+>+<<<-]>>[<<+>>-]+>------------[<[-]>>>+[<+<->>-]<[>+<-]<[<
++>>>+[<+<+>>-]<[>+<-]]>[<]<]>>[-]<<<<<------------->>[[-]+++++[<<+++++>>-]<<+>
>]<[>++++[<<++++++++>>-]<-]>]<[-]++++++++[<++++++++>-]<+>]<.[-]+>>+<]>[[-]<]<]
!optimus
Edited by TrustyTony
Member Avatar for mike_2000_17

I wouldn't be surprised if Linus Torvalds (who used to program directly in machine code! (not assembly)) came out to say that Brain#### is a pretty good language for system programming!

BTW, I think there's a bug on line 4. ;)

Member Avatar for TrustyTony

I used to make black the pages of op codes from Programming in Z80 by Zaks to poke the code to memory from Philips P2000 QBASIC (16 KB memory version, not the 48 KB CP/M ready one) to combine the half graphical Teletext characters for primitive pixel graphics.

Edited by TrustyTony
Member Avatar for MosaicFuneral

I was refering to the topic post.

Be a part of the DaniWeb community

We're a friendly, industry-focused community of developers, IT pros, digital marketers, and technology enthusiasts meeting, networking, learning, and sharing knowledge.