
	PROGRAM IFTRAN
C
C	IFTRAN precompiler for the PDP-11 series of computers
C	This version created on 11-SEP-80
C	Last update on 28-JAN-81
C
C	History of Revisions
C	9-JAN-81	Removed parsing for switches (IFTRAN)
C	13-JAN-81	Greater spacing between line # and statement (GETFOR)
C	17-JAN-81	Improved command phase error messages (IFTRAN)
C	24-JAN-81	Fixed problem in phase 3 command parse (IFTRAN)
C
	IMPLICIT INTEGER (A - Z)
	LOGICAL*1 BUFFR1, BUFFR2, BUFFR3, SPACE, COMMA, EQUAL, SLASH
	LOGICAL*1 CMDLIN, CMDFIL, COMFLG, EQUFLG, EXTNS, CHAR, LABEL
	LOGICAL*1 CONLBL, LIST, IHEAD, ITAIL, IHEAD2, LHEAD
	REAL TYME, SECNDS
	COMMON /PAGING/ ISYS, PPN1, PPN2, BUFFR1(9), BUFFR2(8)
	COMMON /FORCOM/ ERRS, ITYPE, L, KIND, IP, INFILE, OUTFIL, LOUT,
     + LISTNG, PLINES, LPPAGE, LABEL(66), LHEAD(6), LIST(1320), CONLBL(6)
C	  Buffers for GETMCR, GETTSK
	DIMENSION BUFFR3 (80), BUFFR4 (16)
C	  Cmd line, cmd length, filename extensions
	DIMENSION CMDLIN (3, 19), CMDLEN(3), EXTNS (3, 4)
	DIMENSION CMDFIL(3), IHEAD(9), ITAIL(9), DAY(6), IHEAD2(9)
	DIMENSION LAST(100), WSTACK(100), LSTACK(100), DOSTK(100),
     + FORSTK(100)
	DATA ZDUMMY, ERRS /0, 0/
	DATA SPACE, COMMA, EQUAL, SLASH /' ', ',', '=', '/'/
	DATA EXTNS /'.', '.', '.', 'F', 'L', 'I', 'T', 'S', 'F', 'N',
     + 'T', 'T'/
	DATA CMDLIN(1,1), CMDLIN(1,2), CMDLIN(1,3) /'N', 'L', ':'/
	DATA CMDLIN(2,1), CMDLIN(2,2), CMDLIN(2,3) /'N', 'L', ':'/
	DATA CMDLEN /0, 0, 0/
	DATA COMFLG, EQUFLG /.FALSE., .FALSE./
	DATA CMDFIL /.FALSE., .FALSE., .FALSE./
	DATA NCHAR /0/
	DATA IHEAD / 'I', 'F', '(', '.', 'N', 'O', 'T', '.', '(' /
	DATA ITAIL / ')', ')', ' ', 'G', 'O', ' ', 'T', 'O', ' ' /
	DATA IHEAD2 /'D', 'O', ' ', ' ', ' ', ' ', ' ', ' ', ' '/
C	ERROR MESSAGES
   78	FORMAT (' IFT - Fatal flaw in command line')
   79	FORMAT (' IFT - Cannot find or open input file')
   81	FORMAT (' IFT - Cannot create listing file')
   82	FORMAT (' IFT - Cannot create output file')
   83	FORMAT (' IFT - Missing input file')
   84	FORMAT (' IFT - Missing space after call or empty command line')
   86	FORMAT (1X, ' ERRORS ENCOUNTERED: ', I3, /,
     + '  TRANSLATION TIME: ', F6.2, ' SECONDS', /, 1H1)
   87	FORMAT (1X, ' OUTPUT FILE: ', 19A1)
   88	FORMAT (1X, ' LISTING FILE:', 19A1)
   89	FORMAT (1H0, 'TRANSLATION STATISTICS', /, '0 INPUT FILE: ', 19A1)
   91	FORMAT (' ERROR:  Invalid usage.  Statement deleted.')
   92	FORMAT (' ERROR:  Extra or invalid terminator.  Statement deleted.')
   93	FORMAT (' Bad character in column ', I2, ' of command line - <',
     + A1, '>.')
   94	FORMAT (' ERROR:  Invalid EXIT.  Statement deleted.')
   95	FORMAT (' ERROR:  Program ends with an unclosed IF clause.')
   96	FORMAT (' ERROR:  Program ends with an unclosed DO clause.')
   97	FORMAT (' ERROR:  Program ends with an unclosed FOR clause.')
   98	FORMAT (' ERROR:  Program ends with an unclosed WHILE clause.')
   99	FORMAT (1H1, ' UW IFTRAN  V01.0-02  ', 4A2, '    USER [', O3, ',',
     + O3, ']    ', 8A1, 2X, 9A1, '    PAGE ', I3, // )
C
C	*******************************************************************
C
C	  Listing defaults to ON
	LISTNG = 1
C	  66 lines per page, input LUN 3, output LUN 1, listing LUN 2
	LPPAGE = 66
	INFILE = 3
	OUTFIL = 1
	LOUT = 2
C	  Synthetic line #s begin at 32000
	LBL = 32000
	ITYPE = 1
	NDSTK = 0
	NSTACK = 0
	NWSTAK = 0
	NFSTK=0
	LP = 1
	LAST(LP) = 0
C
C	  Get begin translation time
	TYME = SECNDS(0.0)
C	  Get invoking command line
	CALL GETMCR (BUFFR3, NCHAR)
C	  Get task parameters
	CALL GETTSK (BUFFR4, IFLAG)
	PPN1 = IAND(ISHFT(BUFFR4(8), -8), 255)
	PPN2 = IAND(BUFFR4(8), 255)
	ISYS = BUFFR4(15) + 1
C	  Get date
	CALL DATE (BUFFR1)
C	  Get time
	CALL TIME (BUFFR2)
C	  Parse command line
	J1 = 4
    5	IF (BUFFR3(J1) .EQ. SPACE) GO TO 10
	J1 = J1 + 1
	IF (J1 .LE. 7) GO TO 5
C	  Missing space after call to processor or void command line
	WRITE (5, 84)
	CALL EXIT
   10	J1 = J1 + 1
C	  Push down line, strip spaces, check valid character
	J3 = 0
	DO 20 J2 = J1, NCHAR
	CHAR = BUFFR3(J2)
	IF (CHAR .EQ. SPACE) GO TO 20
	IF (((CHAR .GE. 65) .AND. (CHAR .LE. 90)) .OR.
     + ((CHAR .GE. 48) .AND. (CHAR .LE. 59)) .OR.
     + (CHAR .EQ. 44) .OR. (CHAR .EQ. 46) .OR. (CHAR .EQ. 61)) GO TO 15
	WRITE (5, 93) J2, CHAR
	CALL EXIT
   15	J3 = J3 + 1
	BUFFR3(J3) = BUFFR3(J2)
   20	CONTINUE
	NCHAR = J3
C	  State transition parse of line
	J1 = 1
	J2 = 1
	DO 40 J3 = 1, NCHAR
	CHAR = BUFFR3(J3)
	IF (CHAR .NE. COMMA) GO TO 25
	IF ((.NOT. COMFLG) .AND. (.NOT. EQUFLG)) GO TO 21
	WRITE (5, 78)
	CALL EXIT
   21	COMFLG = .TRUE.
	J1 = 2
	J2 = 1
	GO TO 40
   25	IF (CHAR .NE. EQUAL) GO TO 35
	IF (.NOT. EQUFLG) GO TO 26
	WRITE (5, 78)
	CALL EXIT
   26	EQUFLG = .TRUE.
	J1 = 3
	J2 = 1
	GO TO 40
C	  Alphanumeric; tack on end of this spec
   35	CMDLIN(J1, J2) = CHAR
	IF (CHAR .EQ. 46) CMDFIL(J1) = .TRUE.
	CMDLEN(J1) = J2
	J2 = J2 + 1
   40	CONTINUE
	NCMDS = J1
C	  Check for existence of input file
	IF (CMDLEN(3) .NE. 0) GO TO 36
	WRITE (5,83)
	CALL EXIT
C	  Check for existence of listing file
   36	IF (CMDLEN(2) .EQ. 0) CMDLEN(2) = 3
C	  Check for existence of output file
	IF (CMDLEN(1) .EQ. 0) CMDLEN(1) = 3
C	  If no file extensions, append them
	DO 50 J4 = 1, 3
	IF (CMDFIL(J4)) GO TO 50
	J1 = CMDLEN(J4) + 1
	CMDLEN(J4) = CMDLEN(J4) + 4
	J2 = J1 + 3
	J3 = 1
	DO 45 J5 = J1, J2
	CMDLIN(J4, J5) = EXTNS(J4, J3)
	J3 = J3 + 1
   45	CONTINUE
   50	CONTINUE
C	  Assign logical unit numbers to units
	DO 55 J1 = 1, 3
	J2 = CMDLEN(J1)
	DO 60 J3 = 1, J2
	BUFFR3(J3) = CMDLIN(J1, J3)
   60	CONTINUE
	CALL ASSIGN (J1, BUFFR3, J2)
   55	CONTINUE
C	  Open files
	OPEN (UNIT=1, TYPE='NEW', ERR=70, CARRIAGECONTROL='LIST')
	GO TO 75
   70	WRITE (5, 82)
	CALL EXIT
   75	OPEN (UNIT=2, TYPE='NEW', ERR=80)
	GO TO 85
   80	WRITE (5, 81)
	CALL EXIT
   85	OPEN (UNIT=3, TYPE='OLD', ERR=90)
	GO TO 101
   90	WRITE (5, 79)
	CALL EXIT
C	  Print initial header
  101	CALL HEADER
C
C	  *** START OF DIETMEYER'S CODE ***
C
    1	FORMAT (10A2)
	CONLBL(5) = SPACE
	CONLBL(6) = SPACE
32098	IF (ITYPE .LT. 0) GO TO 32097
C	  Get an IFTRAN line from the input file
	CALL GETFOR
C
	IF (KIND .NE. 0) GO TO 32095
C	  KIND = 0; not an IFTRAN statement
	CALL PUTFOR (7, L, 1)
	GO TO 32098
C
32095	IF (KIND .NE. 1) GO TO 32094
C	  KIND = 1; an IF (logical) statement
	NSTACK = NSTACK + 1
	LBL = LBL - 5
	LSTACK(NSTACK) = -1 * LBL
	NSTACK = NSTACK + 1
	LBL = LBL - 5
	LSTACK(NSTACK) = LBL
	GO TO 100
C
32094	IF (KIND .NE. 2) GO TO 32093
C	  KIND = 2; an OR IF statement
	IF ((LAST(LP) .EQ. 1) .OR. (LAST(LP) .EQ. 2)) GO TO 32091
	IF ((LISTNG .EQ. 1) .AND. (PLINES .GE. LPPAGE)) CALL HEADER
	WRITE (LOUT, 91)
	PLINES = PLINES + 1
	ERRS = ERRS + 1
	GO TO 32098
C
32091	LSTACK(NSTACK-1) = IABS(LSTACK(NSTACK-1))
	CALL PUTFOR (ZDUMMY, LSTACK(NSTACK-1), 2)
	CALL PUTFOR (LSTACK(NSTACK), ZDUMMY, 3)
	LBL = LBL - 5
	LSTACK(NSTACK) = LBL
	GO TO 31
C
32093	IF (KIND .NE. 3) GO TO 32090
C	  KIND = 3; an ELSE statement
	IF ((LAST(LP) .EQ. 1) .OR. (LAST(LP) .EQ. 2)) GO TO 32088
	IF ((LISTNG .EQ. 1) .AND. (PLINES .GE. LPPAGE)) CALL HEADER
	WRITE (LOUT, 91)
	PLINES = PLINES + 1
	ERRS = ERRS + 1
	GO TO 32098
C
32088	LSTACK(NSTACK-1) = IABS(LSTACK(NSTACK-1))
	CALL PUTFOR (ZDUMMY, LSTACK(NSTACK-1), 2)
	CALL PUTFOR (LSTACK(NSTACK), ZDUMMY, 3)
	LSTACK(NSTACK) = -1 * LSTACK(NSTACK)
	LAST(LP) = KIND
	IF (LABEL(5) .NE. SPACE) CALL PUTFOR (0, ZDUMMY, 3)
	GO TO 32098
C
32090	IF (KIND .NE. 4) GO TO 32087
C	  KIND = 4; an END IF statement
	IF ((LAST(LP) .LT. 1) .OR. (LAST(LP) .GT. 3)) GO TO 110
	IF (LABEL(5) .NE. SPACE) CALL PUTFOR (0, ZDUMMY, 3)
	CALL PUTFOR (LSTACK(NSTACK), ZDUMMY, 3)
	CALL PUTFOR (LSTACK(NSTACK-1), ZDUMMY, 3)
	NSTACK = NSTACK - 2
	GO TO 120
C
32087  IF (KIND .NE. 5) GO TO 32086
C	  KIND = 5; a WHILE (logical) statement
	NWSTAK = NWSTAK + 1
	LBL = LBL - 5
	WSTACK(NWSTAK) = LBL
	CALL PUTFOR (LBL, ZDUMMY, 3)
	NWSTAK = NWSTAK + 1
	LBL = LBL - 5
	WSTACK(NWSTAK) = LBL
  100	LP = LP + 1
   31	LAST(LP) = KIND
	IP = IP - 8
	CALL COPY (8, IHEAD(1), LHEAD(IP))
	CALL COPY (8, ITAIL(2), LIST(L+1))
	CALL INTALP (LBL, LIST(L+9))
	L = L + 13
	CALL PUTFOR (IP, L, 1)
	GO TO 32098
C
32086	IF (KIND .NE. 6) GO TO 32085
C	  KIND = 6; an END WHILE statement
	IF (LAST(LP) .NE. 5) GO TO 110
	IF (LABEL(5) .NE. SPACE) CALL PUTFOR (0, ZDUMMY, 3)
	CALL PUTFOR (ZDUMMY, WSTACK(NWSTAK-1), 2)
	CALL PUTFOR (WSTACK(NWSTAK), ZDUMMY, 3)
	NWSTAK = NWSTAK - 2
	GO TO 120
C
32085	IF (KIND .NE. 7) GO TO 32084
C	  KIND = 7; an END statement
	CALL PUTFOR (7, L, 1)
C	  Check for unclosed clauses
	IF (NSTACK .EQ. 0) GO TO 30999
	WRITE (LOUT, 95)
	ERRS = ERRS + 1
30999	IF (NDSTK .EQ. 0) GO TO 30998
	WRITE (LOUT, 96)
	ERRS = ERRS + 1
30998	IF (NFSTK .EQ. 0) GO TO 30997
	WRITE (LOUT, 97)
	ERRS = ERRS + 1
30997	IF (NWSTAK .EQ. 0) GO TO 30996
	WRITE (LOUT, 98)
	ERRS = ERRS + 1
C	  Reset for possible following routines
30996	LBL = 32000
	NSTACK = 0
	NWSTAK = 0
	NDSTK = 0
	NFSTK = 0
	LP = 1
	IF ((LISTNG .EQ. 1) .AND. (ITYPE .GE. 0)) CALL HEADER
	GO TO 32098
C
32084	IF (KIND .NE. 8) GO TO 32083
C	  KIND = 8; an EXIT IF statement
	IF (NSTACK .EQ. 0) GO TO 32081
	IF (L .EQ. (IP - 6)) L = L - 1
	CALL COPY (7, ITAIL(3), LIST(L+1))
	LSTACK(NSTACK-1) = IABS(LSTACK(NSTACK-1))
	CALL INTALP (LSTACK(NSTACK-1), LIST(L+8))
	L = L + 12
	CALL PUTFOR (IP+1, L, 1)
	GO TO 32098
C
32081	IF ((LISTNG .EQ. 1) .AND. (PLINES .GE. LPPAGE)) CALL HEADER
	WRITE (LOUT, 94)
	PLINES = PLINES + 1
	ERRS = ERRS + 1
	GO TO 32098
C
32083	IF (KIND .NE. 9) GO TO 32080
C	  KIND = 9; an EXIT WHILE statement
	IF (NWSTAK .EQ. 0) GO TO 32078
	IF (L .EQ. (IP - 6)) L = L - 1
	CALL COPY (7, ITAIL(3), LIST(L+1))
	CALL INTALP (WSTACK(NWSTAK), LIST(L+8))
	L = L + 12
	CALL PUTFOR (IP+1, L, 1)
	GO TO 32098
C
32078	IF ((LISTNG .EQ. 1) .AND. (PLINES .GE. LPPAGE)) CALL HEADER
	WRITE (LOUT, 94)
	PLINES = PLINES + 1
	ERRS = ERRS + 1
	GO TO 32098
C
32080	IF (KIND .NE. 10) GO TO 32077
C	  KIND = 10; a DO statement
	NDSTK = NDSTK + 1
	LBL = LBL - 5
	DOSTK(NDSTK) = -LBL
	NDSTK = NDSTK + 1
	LBL = LBL - 5
	DOSTK(NDSTK) = LBL
	IF (LABEL(5) .NE. SPACE) CALL PUTFOR (0, ZDUMMY, 3)
	CALL PUTFOR (LBL, ZDUMMY, 3)
	LP = LP + 1
	LAST(LP) = KIND
	GO TO 32098
C
32077	IF (KIND .NE. 11) GO TO 32076
C	  KIND = 11; an UNTIL (logical) statement
	IF (LAST(LP) .EQ. 10) GO TO 32074
  110	IF ((LISTNG .EQ. 1) .AND. (PLINES .GE. LPPAGE)) CALL HEADER
	WRITE (LOUT, 92)
	PLINES = PLINES + 1
	ERRS = ERRS + 1
	GO TO 32098
C
32074	IP = IP - 8
	CALL COPY (8, IHEAD(1), LHEAD(IP))
	CALL COPY (8, ITAIL(2), LIST(L+1))
	CALL INTALP (DOSTK(NDSTK), LIST(L+9))
	L = L + 13
	CALL PUTFOR (IP, L, 1)
	NDSTK = NDSTK - 1
	CALL PUTFOR (DOSTK(NDSTK), ZDUMMY, 3)
	NDSTK = NDSTK - 1
  120	LP = LP - 1
	IF (LP .LT. 1) LP = 1
	GO TO 32098
C
32076	IF (KIND .NE. 12) GO TO 32073
C	  KIND = 12; an EXIT DO statement
	IF (NDSTK .GT. 0) GO TO 32071
	IF ((LISTNG .EQ. 1) .AND. (PLINES .GE. LPPAGE)) CALL HEADER
	WRITE (LOUT, 94)
	PLINES = PLINES + 1
	ERRS = ERRS + 1
	GO TO 32098
C
32071	IF (L .EQ. (IP - 6)) L = L - 1
	CALL COPY (7, ITAIL(3), LIST(L+1))
	DOSTK(NDSTK-1) = IABS(DOSTK(NDSTK-1))
	CALL INTALP (DOSTK(NDSTK-1), LIST(L+8))
	L = L + 12
	CALL PUTFOR (IP+1, L, 1)
	GO TO 32098
C
32073	IF (KIND .NE. 13) GO TO 32070
C	  KIND = 13; a FOR var1 = var2, var3 statement
	NFSTK = NFSTK + 1
	LBL = LBL - 5
	FORSTK(NFSTK) = -LBL
	NFSTK = NFSTK + 1
	LBL = LBL - 5
	FORSTK(NFSTK) = LBL
	LP = LP + 1
	LAST(LP) = KIND
	IP = IP - 8
	CALL COPY (9, IHEAD2, LHEAD(IP))
	CALL INTALP (LBL, LHEAD(IP+3))
	CALL PUTFOR (IP, L, 1)
	GO TO 32098
C
32070	IF (KIND .NE. 14) GO TO 32069
C	  KIND = 14; an END FOR statement
	IF (LAST(LP) .NE. 13) GO TO 110
	IF (LABEL(5) .EQ. SPACE) GO TO 32067
	CALL PUTFOR (0, ZDUMMY, 3)
	LABEL(5) = SPACE
32067	CALL PUTFOR (FORSTK(NFSTK), ZDUMMY, 3)
	CALL PUTFOR (0, ZDUMMY, 3)
	CALL PUTFOR (FORSTK(NFSTK-1), ZDUMMY, 3)
	NFSTK = NFSTK - 2
	GO TO 120
C
32069	IF (KIND .NE. 15) GO TO 32098
C	  KIND = 15; an EXIT FOR statement
	IF (NFSTK .EQ. 0) GO TO 32064
	IF (L .EQ. (IP - 6)) L = L - 1
	CALL COPY (7, ITAIL(3), LIST(L+1))
	FORSTK(NFSTK-1) = IABS(FORSTK(NFSTK-1))
	CALL INTALP (FORSTK(NFSTK-1), LIST(L+8))
	L = L + 12
	CALL PUTFOR (IP+1, L, 1)
	GO TO 32098
C
32064	IF ((LISTNG .EQ. 1) .AND. (PLINES .GE. LPPAGE)) CALL HEADER
	WRITE (LOUT, 94)
	PLINES = PLINES + 1
	ERRS = ERRS + 1
	GO TO 32098
C
32097	TYME = SECNDS(TYME)
	WRITE (LOUT, 89) (CMDLIN(3,J1), J1=1,CMDLEN(3))
	WRITE (LOUT, 88) (CMDLIN(2,J1), J1=1,CMDLEN(2))
	WRITE (LOUT, 87) (CMDLIN(1,J1), J1=1,CMDLEN(1))
	WRITE (LOUT, 86) ERRS, TYME
	CALL EXIT
	END
