PROGRAM watfiv1;
{modified from U of W version supplied Nov 82}
CONST
  STACKFLAG='stack overflow';
  error2='More then 19 continuation cards for read statement';
  error4='invalid use of while(..)do,';
  error41=' or c-card following complete if(..)then do';
  gotos='GO TO ';
  CONTINUES='CONTINUE';
TYPE
  STRING1=STRING[1];
VAR
  RESULT:INTEGER;
  FILENAME:STRING;
  INFILE,OUTFILE:TEXT;
  I,PLENGTH{packed l},CARDLENGTH,WORDCOUNT:INTEGER;
  STACKSIZE,EXITCASE,LEVEL:INTEGER;
  NTOP,RTOP,REMBLK,LNO,LABLE,LINC:INTEGER;
  CODE,PRVCODE,RDEND,BCOL,BCARD:INTEGER;
  PCOL,CCOL:INTEGER;
  FOUND,HOLLERITH,EOS,EOC,ERRORSW:BOOLEAN;
  BUFFNO,RTYPE,TOP:INTEGER;
  LABLE1,LABLE2,TYPO:ARRAY[1..50]OF INTEGER;
  BLKNAM:STRING;
  BLANK:STRING1;
  BNAME:ARRAY[1..50]OF STRING[8];
  BUFFIN:ARRAY[1..2]OF STRING[20];
  LBLIST:ARRAY[1..7]OF INTEGER;
  CARD:STRING;
  PACK:STRING;
  FMT1:STRING;
  STRTNO:ARRAY[1..2,1..50]OF INTEGER;
  RETRNS:ARRAY[1..2,1..150]OF INTEGER;
  FORMAT0:STRING;
  CGOTO1,STNO,BUFLIN1:STRING;
  RTRNSW,VFMT,ENDFILE:BOOLEAN;
  AGOTO1,BLK:STRING;
  CH:STRING1;
  
EXTERNAL FUNCTION @BDOS(FUNC:INTEGER;PARM:INTEGER):INTEGER;
PROCEDURE ITOS(I:INTEGER;VAR S:STRING);FORWARD;
PROCEDURE ERROR(LN:INTEGER;S:STRING);FORWARD;
FUNCTION EQUAL(A:STRING;I:INTEGER;B:STRING;J:INTEGER;K:INTEGER):BOOLEAN;
FORWARD;  
FUNCTION OTHER(B:BOOLEAN):BOOLEAN;FORWARD;
FUNCTION NORMAL(CARD:STRING):BOOLEAN;FORWARD;
PROCEDURE FCONCAT(VAR S1:STRING;N1:INTEGER;S2:STRING;
  MODE:INTEGER;N2:INTEGER);FORWARD;
FUNCTION KOMPAR(S:STRING):BOOLEAN;FORWARD;
PROCEDURE FINDCHAR(I:INTEGER;VAR CH:STRING1);FORWARD;
FUNCTION ISDIGIT(C:STRING1):BOOLEAN;FORWARD;
FUNCTION ISBLANK(C:STRING1):BOOLEAN;FORWARD;
FUNCTION ISLETTER(C:STRING1):BOOLEAN;FORWARD;
FUNCTION KOMPCH(S1:STRING;N1:INTEGER;S2:STRING;N2:INTEGER;N:INTEGER):
  INTEGER;FORWARD;
PROCEDURE PACKIT;FORWARD;
FUNCTION FTNOPT(CARD:STRING):BOOLEAN;FORWARD;
PROCEDURE BLANKCOM(VAR S:STRING);FORWARD;
PROCEDURE UPPERC(VAR S:STRING);FORWARD;
PROCEDURE GETCODE;FORWARD;


PROCEDURE ABORT;
VAR I:INTEGER;
BEGIN
  CLOSE(INFILE,RESULT);
  CLOSE(OUTFILE,RESULT);
  I:=@BDOS(0,0)
END;


PROCEDURE ITOS;
VAR NEGFLAG:BOOLEAN;
    K:INTEGER;
BEGIN
  NEGFLAG:=(I<0);S:='     ';
  FOR K:=1 TO 5 DO BEGIN
    S[6-K]:=CHR((I MOD 10)+ORD('0'));
    I:=I DIV 10
  END;
  IF NEGFLAG THEN S:=CONCAT('-',S)
END;
PROCEDURE ERROR;
VAR STR:STRING;
BEGIN
  ITOS(LN,STR);
  WRITELN(STR,'  ',S);
  ERRORSW:=TRUE;
END;


PROCEDURE FCONCAT;
{mode 1:append the first n2 characters of s2 at position n1 of s1}
{     3:insert the first n2 characters of s2 at n1 of s1 and kill rest}
{     4:insert the first n2 characters of s2 at position n1 of s1}
VAR S:STRING;
BEGIN
  S:=COPY(S2,1,N2);
  IF(N1>LENGTH(S1))THEN S1:=CONCAT(S1,S)
  ELSE IF MODE=3 THEN BEGIN
    DELETE(S1,N1,LENGTH(S1)-N1+1);
    S1:=CONCAT(S1,S)
  END
  ELSE IF (MODE=1)THEN BEGIN
    DELETE(S1,N1,N2);
    INSERT(S,S1,N1)
  END
  ELSE IF MODE=4 THEN BEGIN
    INSERT(S,S1,N1)
  END
END;

FUNCTION ISDIGIT;
BEGIN
  IF (C[1] IN ['0'..'9'])THEN ISDIGIT:=TRUE
  ELSE ISDIGIT:=FALSE
END;

FUNCTION ISBLANK;
BEGIN
  IF C[1]=' ' THEN ISBLANK:=TRUE
  ELSE ISBLANK:=FALSE
END;

FUNCTION ISLETTER;
BEGIN
  IF (C[1]IN['A'..'Z']) THEN ISLETTER:=TRUE
  ELSE ISLETTER:=FALSE
END;

FUNCTION KOMPCH;
VAR I,K:INTEGER;
BEGIN
  IF (LENGTH(S1)<(N+N1-1))THEN BEGIN
    KOMPCH:=0; EXIT
  END;
  IF (LENGTH(S2)<(N+N2-1))THEN BEGIN
    KOMPCH:=0; EXIT
  END;
  K:=0;
  FOR I:=1 TO N DO BEGIN
    IF(K=I-1)AND(S1[N1+I-1]=S2[N2+I-1])THEN K:=I
    ELSE K:=0
    
  END;
  KOMPCH:=K
END;

PROCEDURE FINDCHAR;
BEGIN
  IF(I>LENGTH(CARD))THEN BEGIN
    CH[1]:=CHR(255); EOC:=TRUE;EXIT
  END
  ELSE CH[1]:=CARD[I]
END;

PROCEDURE PACKIT;
BEGIN
  CCOL:=7;
  PCOL:=7;
  PACK:='      ';
  EOC:=FALSE;
  FINDCHAR(CCOL,CH);
  WHILE(CH[1]  IN [' ','A'..'Z'])AND(NOT EOC)DO BEGIN
    IF (CH[1]  IN ['A'..'Z'])THEN BEGIN
      PACK:=CONCAT(PACK,CH);
      PCOL:=PCOL+1
    END;
    CCOL:=CCOL+1;
    IF(CCOL>CARDLENGTH)THEN EOC:=TRUE
    ELSE FINDCHAR(CCOL,CH)
  END;
  PRVCODE:=CODE;
  CODE:=0;
  PLENGTH:=PCOL-7
END;

  
FUNCTION KOMPAR;
BEGIN
  KOMPAR:=(KOMPCH(PACK,7,S,1,LENGTH(S))<>0)
END;

FUNCTION EQUAL;
BEGIN
  EQUAL:=KOMPCH(A,I,B,J,K)<>0
END;

FUNCTION NORMAL;
BEGIN
  NORMAL:=(EQUAL(CARD,6,BLANK,1,1))
          OR (EQUAL(CARD,6,'0',1,1))
          OR (EQUAL(CARD,1,'C',1,1))
          OR (EQUAL(CARD,1,'*',1,1))
END;

FUNCTION FTNOPT;
BEGIN
  FTNOPT:=(EQUAL(CARD,1,'*! ',1,3))
          OR (EQUAL(CARD,1,'C! ',1,3))
          OR (EQUAL(CARD,1,'c! ',1,3))
END;
  
PROCEDURE BLANKCOM;
BEGIN
  IF (LENGTH(S)>0)THEN EXIT
  ELSE S:='C'
END;
FUNCTION OTHER;
BEGIN
  IF (B=TRUE)THEN OTHER:=FALSE ELSE
    OTHER:=TRUE
END;

PROCEDURE UPPERC;
VAR STRFLAG:BOOLEAN;
    I:INTEGER;
BEGIN
  STRFLAG:=FALSE;
  FOR I:=1 TO LENGTH(S) DO BEGIN
    IF (S[I]='''') THEN STRFLAG:=OTHER(STRFLAG)
    ELSE IF ((S[I]IN ['a'..'z']) AND (NOT STRFLAG)) THEN S[I]:=CHR(ORD(S[I])
    -ORD('a')+ORD('A'))
  END
END;

PROCEDURE GETCODE;
VAR N:INTEGER;
BEGIN
  IF(PLENGTH=2)THEN 
    IF(KOMPAR('IF')AND EQUAL('(',1,CH,1,1)) THEN CODE:=13;
  IF(PLENGTH=3)THEN
    IF(KOMPAR('END')AND EOC)THEN CODE:=-1;
  IF(PLENGTH=4) THEN BEGIN 
    IF KOMPAR('READ')THEN BEGIN
      RDEND:=CCOL;
      IF EQUAL(',',1,CH,1,1)THEN CODE:=15
      ELSE IF EQUAL('(',1,CH,1,1)THEN CODE:=16
      ELSE IF ISDIGIT(CH) THEN CODE:=18
    END
    ELSE IF KOMPAR('STOP')AND EOC THEN CODE:=-2
  END;
  IF(PLENGTH=5)THEN BEGIN
    IF KOMPAR('ENDIF')AND EOC THEN CODE:=2
    ELSE IF KOMPAR('WHILE')AND EQUAL('(',1,CH,1,1) THEN CODE:=14
    ELSE IF KOMPAR('PRINT')THEN CODE:=19
  END;
  IF(PLENGTH=6)THEN
    IF (KOMPAR('ELSEDO')AND EOC)THEN CODE:=1;
  IF(PLENGTH=7)THEN
    IF EOC THEN BEGIN
      IF KOMPAR('ATENDDO')THEN CODE:=12
      ELSE IF KOMPAR('ENDCASE')THEN CODE:=8
  END;
  IF(PLENGTH=8)THEN BEGIN
    IF EOC THEN BEGIN
      IF KOMPAR('ENDWHILE') THEN CODE:=3
      ELSE BEGIN
        IF KOMPAR('ENDATEND')THEN CODE:=4
        ELSE IF KOMPAR('IFNONEDO')THEN CODE:=7
      END
    END
  END;
  IF (CODE=0) THEN BEGIN
    IF KOMPAR('DOCASE')THEN CODE:=5
    ELSE BEGIN
      IF KOMPAR('CASE')THEN CODE:=6
      ELSE BEGIN
        IF (KOMPAR('READ')AND EQUAL(',',1,CH,1,1))THEN BEGIN
          CODE:=17;
          RDEND:=CCOL;
          FMT1:=COPY(PACK,11,PCOL-11);
          
        END
        ELSE BEGIN
          IF KOMPAR('EXECUTE') THEN CODE:=9
          ELSE IF KOMPAR('REMOTEBLOCK')THEN CODE:=10
          ELSE IF KOMPAR('ENDBLOCK')THEN CODE:=11
        END
      END
    END
  END
END;
      
  
PROCEDURE LNFMT;
BEGIN
  LNO:=LNO+LINC;
  IF (NOT ((FTNOPT(CARD))OR(NORMAL(CARD))))THEN
    CARD:=CONCAT('     &',CARD)
END;
    
  
PROCEDURE GETLINE;
BEGIN
  READLN(INFILE,CARD);
  IF(EOF(INFILE))THEN BEGIN
    WRITELN('Done');ABORT
  END;
  BLANKCOM(CARD);
  LNFMT;
  UPPERC(CARD)
END;

{see WATFIV.DOC for details of use}
PROCEDURE WAT;
VAR OUTFORMAT:STRING;
BUFIN:ARRAY[1..20]OF STRING;

PROCEDURE INITIALIZE;
VAR I:INTEGER;
BEGIN
  OUTFORMAT:='READ';
  CARDLENGTH:=80;
  WORDCOUNT:=20;
  STACKSIZE:=50;
  FOR I:=1 TO 50 DO LABLE1[I]:=0;
  FOR I:=1 TO 50 DO LABLE2[I]:=0;
  FOR I:=1 TO 50 DO TYPO[I]:=0;
  CH:=' ';
  NTOP:=0;
  RTOP:=0;
  BUFFNO:=0;
  REMBLK:=0;
  BLK:='                                     ';
  BLK:=CONCAT(BLK,BLK);
  BLANK:=' ';
  LNO:=0;
  LINC:=1;
  EOC:=FALSE;
  LABLE:=30000;
  PRVCODE:=0;
  CODE:=0;
  ERRORSW:=FALSE;
  TOP:=1;
  RTRNSW:=FALSE;
  VFMT:=FALSE;
  EOS:=FALSE;
  ENDFILE:=FALSE;
END;

PROCEDURE GETLABEL;
BEGIN
  LABLE:=LABLE+1
END;
PROCEDURE GETTOP;
BEGIN
  TOP:=TOP+1;
  IF (TOP>STACKSIZE)THEN ERROR(LNO,STACKFLAG)
END;


PROCEDURE CONVERT(S:STRING;VAR T,FORMAT:STRING);
{converts the string s to t and format according to fortran rules}
{assigns 20 spaces each, takes no account of brackets}
VAR PRINTFCOMMA,PRINTCOMMA,NEWTOKEN,ASCII:BOOLEAN;
  I:INTEGER;
  S1:STRING[1];
BEGIN
  NEWTOKEN:=TRUE;
  S1:=' ';
  ASCII:=FALSE;
  I:=1;
  PRINTCOMMA:=FALSE;
  PRINTFCOMMA:=FALSE;
  WHILE (I<=LENGTH(S))DO BEGIN
    S1[1]:=S[I];
    IF (S1='''')THEN BEGIN
      IF PRINTFCOMMA THEN BEGIN
        FORMAT:=CONCAT(FORMAT,',');
        PRINTCOMMA:=FALSE
      END;
      FORMAT:=CONCAT(FORMAT,S1);
      ASCII:=NOT ASCII
    END
    ELSE BEGIN{not '}
      IF (ASCII=FALSE)THEN BEGIN
        IF (S1=',')THEN BEGIN
          NEWTOKEN:=TRUE;
          PRINTCOMMA:=TRUE;
          PRINTFCOMMA:=TRUE
        END
        ELSE BEGIN{not ',ascii,comma}
          IF PRINTFCOMMA THEN BEGIN
            FORMAT:=CONCAT(FORMAT,',');
            PRINTFCOMMA:=FALSE
          END;
          IF NEWTOKEN=TRUE THEN BEGIN
            IF(S1[1] IN ['A'..'H','a'..'h','O'..'Z','o'..'z'])THEN
              FORMAT:=CONCAT(FORMAT,'E20.8')
            ELSE FORMAT:=CONCAT(FORMAT,'I20')
          end;
          IF PRINTCOMMA THEN BEGIN
            T:=CONCAT(T,',');
            PRINTCOMMA:=FALSE
          END;
          T:=CONCAT(T,S1);
          NEWTOKEN:=FALSE
        END;
      END
      ELSE BEGIN
        FORMAT:=CONCAT(FORMAT,S1);
        PRINTFCOMMA:=FALSE
      END
    END;
    I:=I+1
  END
END;

PROCEDURE OUTCON(I:INTEGER);
BEGIN
  WRITELN(OUTFILE,I:5,' ',CONTINUES)
END;

PROCEDURE OUTGO(I:INTEGER);
BEGIN
  WRITELN(OUTFILE,'      ',GOTOS,I:5)
END;

PROCEDURE WRRD1;FORWARD;
PROCEDURE PUTLINE;FORWARD;
PROCEDURE WRRD2;FORWARD;
PROCEDURE RD2;FORWARD;
PROCEDURE NPACK;FORWARD;
PROCEDURE ENDWH;FORWARD;
PROCEDURE ENDIF;FORWARD;
PROCEDURE EXEC;FORWARD;

PROCEDURE CASES;
VAR MATCH,II,J,N:INTEGER;
BEGIN
  IF (CODE>12)AND(CODE<15)THEN BEGIN
    IF (CODE=14)THEN BEGIN
      GETLABEL;
      OUTCON(LABLE);
      N:=CCOL-1;
      FCONCAT(CARD,7,'IF',1,2);
      FCONCAT(CARD,9,BLK,1,N-8)
    END;
    CCOL:=CCOL+1;
    LEVEL:=0;
    HOLLERITH:=FALSE;
    WHILE((NOT EQUAL(CARD,CCOL,')',1,1))
           OR(LEVEL<>0)
           OR(HOLLERITH))DO BEGIN
      IF(EQUAL(CARD,CCOL,'''',1,1))THEN HOLLERITH:=OTHER(HOLLERITH)
      ELSE BEGIN
        IF (NOT HOLLERITH)THEN BEGIN
          IF EQUAL(CARD,CCOL,'(',1,1)THEN LEVEL:=LEVEL+1
          ELSE BEGIN
            IF EQUAL(CARD,CCOL,')',1,1)THEN LEVEL:=LEVEL-1
          END
        END
      END;
      CCOL:=CCOL+1;
      IF(CCOL>CARDLENGTH)THEN BEGIN
        WRRD2;
        IF(RTRNSW) THEN ABORT;
        CCOL:=7
      END
    END;
    FCONCAT(CARD,CCOL,BLANK,1,1);
    J:=CCOL;
    WHILE (EQUAL(CARD,CCOL,BLANK,1,1)
      AND(CCOL<=CARDLENGTH))DO CCOL:=CCOL+1;
    FCONCAT(CARD,J,')',1,1);
    J:=J+1;
    IF(CCOL>CARDLENGTH)THEN BEGIN
      WRRD2;
      IF(RTRNSW)THEN ABORT;
      J:=7;
      CCOL:=7
    END;
    PACK:='      ';
    PCOL:=7;
    EOC:=FALSE;
    FINDCHAR(CCOL,CH);
    NPACK;
    MATCH:=0;
    IF(KOMPAR('EXECUTE'))THEN MATCH:=2
    ELSE BEGIN
      IF(CODE=14)THEN BEGIN
        IF(KOMPAR('DO')AND(EOC))THEN MATCH:=1
        ELSE BEGIN
          ERROR(LNO,'''do'' missing from while-do');
          ABORT
        END
      END
      ELSE BEGIN
        IF (KOMPAR('THENDO')AND(EOC))THEN MATCH:=1
      END
    END;
    IF(MATCH=0)THEN WRRD1
    ELSE BEGIN
      GETLABEL;
      ITOS(LABLE,FMT1);
      CCOL:=J;
      IF (CCOL>64)THEN BEGIN
        FCONCAT(CARD,CCOL,BLK,1,CARDLENGTH+1-CCOL);
        PUTLINE;
        CARD:='     &GOTO';
        CCOL:=11
      END
      ELSE BEGIN
        FCONCAT(CARD,CCOL,'GOTO',3,4);
        CCOL:=CCOL+3
      END;
      FCONCAT(CARD,CCOL+1,FMT1,1,5);
      PUTLINE;
      GETLABEL;
      OUTGO(LABLE);
      OUTCON(LABLE-1);
      GETTOP;
      LABLE1[TOP]:=LABLE;
      TYPO[TOP]:=CODE;
      IF(CODE=14)THEN LABLE2[TOP]:=LABLE-2;
      IF(MATCH=2)THEN BEGIN
        EXEC;
        IF(CODE=14)THEN ENDWH
        ELSE ENDIF
      END;
      RD2;
      IF(NOT NORMAL(CARD))THEN BEGIN
        ERROR(LNO,CONCAT(ERROR4,ERROR41));
        ABORT
      END
    END
  END
END;



PROCEDURE PUTCLN;
VAR INDEX:INTEGER;
BEGIN
  WRITELN(OUTFILE,CARD)
END;

PROCEDURE DUMPBUF;
VAR I:INTEGER;
BEGIN
  I:=1;
  WHILE(I<=BUFFNO)DO BEGIN
    WRITELN(OUTFILE,BUFIN[I]);
    I:=I+1
  END;
  BUFFNO:=0;
END;

PROCEDURE PUTLINE;
BEGIN
  PUTCLN
END;

PROCEDURE RD1;
BEGIN
  GETLINE;
  IF EOF THEN BEGIN
    EOS:=TRUE;
    ENDFILE:=TRUE
  END;
  IF (NORMAL(CARD))THEN EOS:=TRUE
END;

PROCEDURE RD2;
BEGIN
  GETLINE;
  IF EOF THEN BEGIN
    ENDFILE:=TRUE;
    FCONCAT(CARD,6,BLK,1,1)
  END
END;

PROCEDURE WRRD1;
BEGIN
  EOS:=FALSE;
  WHILE (NOT EOS)DO BEGIN
    PUTLINE;
    RD1
  END
END;

PROCEDURE WRRD2;
BEGIN
  PUTLINE;
  RD2;
  IF(NORMAL(CARD)) THEN BEGIN
    ERROR(LNO,'Expecting continuation line.');
    RTRNSW:=TRUE
  END
END;

PROCEDURE NPACK;
BEGIN
  IF (NOT EOC) THEN BEGIN
    WHILE(ISDIGIT(CH)
    OR ISLETTER(CH) 
    OR ISBLANK(CH))AND(NOT EOC) DO BEGIN
      IF (NOT ISBLANK(CH)) THEN BEGIN
        FCONCAT(PACK,PCOL,CH,4,1);
        PCOL:=PCOL+1
      END;
      CCOL:=CCOL+1;
      IF(CCOL>CARDLENGTH)THEN EOC:=TRUE
      ELSE FINDCHAR(CCOL,CH)
    END
  END
END;
      
  PROCEDURE SKIPCOMMENT;
BEGIN
  IF FTNOPT(CARD) THEN PUTCLN;
  GETLINE
END;

PROCEDURE NMSRCH;
BEGIN
  BNAME[NTOP+1]:=BLKNAM;
  I:=1;
  WHILE (NOT EQUAL(BNAME[I],1,BLKNAM,1,8))DO I:=I+1
END;

PROCEDURE XITCAS;
BEGIN
  I:=TOP;
  FOUND:=FALSE;
  WHILE (NOT FOUND) DO BEGIN
    IF(TYPO[I]=5)THEN FOUND:=TRUE;
    I:=I-1
  END;
  OUTGO(LABLE1[I])
END;

PROCEDURE EXEC;
BEGIN
  IF(NOT EOC)THEN ERROR(LNO,'Invalid name for execute block')
  ELSE BEGIN
    PLENGTH:=PCOL-14;
    IF(PLENGTH<8)THEN FCONCAT(PACK,PCOL,BLK,1,8);
    BLKNAM:=COPY(PACK,14,8);
    NMSRCH;
    IF(I>NTOP) THEN BEGIN
      NTOP:=I;
      GETLABEL;
      STRTNO[1,I]:=LABLE;
      STRTNO[2,I]:=RTOP+1
    END;
    GETLABEL;
    RTOP:=RTOP+1;
    RETRNS[1,RTOP]:=LABLE;
    IF(STRTNO[2,I]=RTOP)THEN RETRNS[2,RTOP]:=0
    ELSE BEGIN
      RETRNS[2,RTOP]:=STRTNO[2,I];
      STRTNO[2,I]:=RTOP
    END;
    IF (NOT EQUAL(CARD,1,BLK,1,5))AND(CODE=9) THEN BEGIN
      CARD:=COPY(CARD,1,5); WRITELN(OUTFILE,CARD:5,' ',CONTINUES)
    END;
    CARD:=' ';
    WRITELN(OUTFILE,'      ','ASSIGN ',LABLE,' TO ',BLKNAM);
    IF(STRTNO[1,I]=0) THEN
      ERROR(LNO,'Execute stmt. must precede its execute block.');
    OUTGO(STRTNO[1,I]);
    OUTCON(LABLE)
  END
END;
  
PROCEDURE ENDATEND;
BEGIN
  IF(TYPO[TOP]<>12)THEN
    ERROR(LNO,'Mismatch of END AT END')
  ELSE BEGIN
    OUTCON(LABLE1[TOP]);
    TOP:=TOP-1
  END
END;

PROCEDURE DOCASEVNAME;
BEGIN
  NPACK;
  IF(NOT EOC) THEN
    ERROR(LNO,'A variable name is expected after ''DO CASE''')
  ELSE BEGIN
    PLENGTH:=PCOL-13;
    IF(PLENGTH<8)THEN FCONCAT(PACK,PCOL,BLK,1,21-PCOL);
    IF(NOT EQUAL(CARD,1,BLK,1,5))THEN BEGIN
      FCONCAT(CARD,6,' CONTINUE',3,9);
      PUTLINE
    END;
    GETTOP;
    GETLABEL;
    LABLE1[TOP]:=LABLE;
    LABLE2[TOP]:=ORD(PACK[13]);
    TYPO[TOP]:=ORD(PACK[13]);
    GETLABEL;
    GETTOP;
    LABLE1[TOP]:=LABLE;
    OUTGO(LABLE);
    GETLABEL;
    LABLE2[TOP]:=LABLE;
    TYPO[TOP]:=5;
    OUTCON(LABLE)
  END
END;

PROCEDURE ENDIF;
BEGIN
  IF (TYPO[TOP]<>13) AND (TYPO[TOP]<>1)THEN
    ERROR(LNO,'''end if'' only follows ''if(..'' or ''else do..''.')
  ELSE BEGIN
    OUTCON(LABLE1[TOP]);
    TOP:=TOP-1
  END
END;

PROCEDURE ELSEDO;
BEGIN
  IF(TYPO[TOP]<>13)THEN 
    ERROR(LNO,'''elsedo'' follows after ''if-then''.')
  ELSE BEGIN
    GETLABEL;
    IF(PRVCODE<>-2) THEN OUTGO(LABLE);
    OUTCON(LABLE1[TOP]);
    LABLE1[TOP]:=LABLE;
    TYPO[TOP]:=1
  END
END;

PROCEDURE ENDWH;
BEGIN
  IF (TYPO[TOP]<>14)THEN
    ERROR(LNO,'Mismatch of ''end while''.')
  ELSE BEGIN
    OUTGO(LABLE2[TOP]);
    OUTCON(LABLE1[TOP]);
    TOP:=TOP-1
  END
END;

PROCEDURE CASEDOT;
BEGIN
  IF ((TYPO[TOP]<>5)AND(TYPO[TOP]<>6))THEN
    ERROR(LNO,'Illegal ''case'' usage.')
  ELSE BEGIN
    IF(PRVCODE<>5)THEN BEGIN
      XITCAS;
      GETLABEL;
      OUTCON(LABLE);
      GETTOP;
      LABLE1[TOP]:=LABLE;
      TYPO[TOP]:=6
    END
  END
END;

PROCEDURE CGOTO;
VAR NOLBLS,N,J,NN,K:INTEGER;
    STR:STRING;
    S1,S2:STRING1;
PROCEDURE MAKESTRING(I:INTEGER;VAR S:STRING1);
BEGIN
  S:=' ';
  S[1]:=CHR(I)
END;
BEGIN
  CARD:=' ';
  I:=I+1;
  IF(CODE=7)THEN BEGIN
    MAKESTRING(LABLE2[I-1],S1);
    WRITELN(OUTFILE,LABLE1[I]:5,' ','IF(',S1,'.LT.1.OR.',S1,
      '.GT.',TOP-I+1,')GOTO ',LABLE)
  END
  ELSE BEGIN
    MAKESTRING(LABLE2[I-1],S1);
    WRITELN(OUTFILE,LABLE1[I]:5,' ','IF(',S1,'.LT.1.OR.',
    S1,'.GT.',TOP-I+1,')GOTO ',LABLE1[I-1])
  END;
  ITOS(LABLE2[I],CARD);
  CARD:=CONCAT('      GOTO(',CARD);
  NOLBLS:=TOP-I;
  N:=0;
  J:=I+1;
  {walk through the stack getting end case entry labels}
  WHILE (NOLBLS>0)DO BEGIN
    IF(NOLBLS<=8)THEN BEGIN
      N:=NOLBLS;
      NOLBLS:=0
    END ELSE BEGIN
      N:=8;
      NOLBLS:=NOLBLS-8
    END;
    NN:=J+N-1;
    FOR K:=J TO NN DO BEGIN
      ITOS(LABLE1[K],STR);
      CARD:=CONCAT(CARD,',',STR)
    END;
    J:=NN+1;
    IF(NOLBLS<>0)THEN BEGIN
      PUTLINE;
      CARD:='      &'
    END
  END;{while}
  CCOL:=N*6+17;
  FCONCAT(CARD,CCOL,'),',1,2);
  MAKESTRING(LABLE2[I-1],S1);
  FCONCAT(CARD,CCOL+2,S1,1,1);
  PUTLINE;
  I:=I-1
END;

    
  
PROCEDURE EXECUTE;
BEGIN
  NPACK;
  EXEC
END;

PROCEDURE IFNONEDO;
BEGIN IF(TYPO[TOP]<>5)AND(TYPO[TOP]<>6) THEN
    ERROR(LNO,'Illegal ''if none do'' usage.')
  ELSE BEGIN
    XITCAS;
    GETLABEL;
    CGOTO;
    OUTCON(LABLE);
    GETTOP;
    TYPO[TOP]:=7;
    LABLE1[TOP]:=I
  END
END;

PROCEDURE ENDCASE; BEGIN IF(TYPO[TOP]<5)OR(TYPO[TOP]>7)THEN
    ERROR(LNO,'Mismatch of ''end case''.')
  ELSE BEGIN
    XITCAS;
    IF(TYPO[TOP]=7)THEN I:=LABLE1[TOP]
    ELSE CGOTO;
    OUTCON(LABLE1[I]);
    TOP:=I-1
  END
END;

PROCEDURE REMOTEBLOCK; BEGIN NPACK;
  IF (NOT EOC) THEN ERROR(LNO,'Invalid remote block name.')
  ELSE BEGIN
    PLENGTH:=PCOL-18;
    IF(PLENGTH<8)THEN FCONCAT(PACK,PCOL,BLK,1,8);
    BLKNAM:=COPY(PACK,18,8);
    NMSRCH;
    IF(I>NTOP) OR (STRTNO[1,I]=0)THEN BEGIN
      ERROR(LNO,BLKNAM);WRITELN('not found.')
    END
    ELSE BEGIN
      REMBLK:=I;
      OUTCON(STRTNO[1,I]);
      STRTNO[1,I]:=0
    END
  END
END;

PROCEDURE ENDBLOCK;
VAR J,K:INTEGER;
    STR:STRING;

BEGIN 
  IF(REMBLK=0)THEN ERROR(LNO,'Mismatch of ''end block''.')
  ELSE BEGIN
    I:=STRTNO[2,REMBLK];
    ITOS(RETRNS[1,I],CARD);
    CARD:=CONCAT('       ',GOTOS,BNAME[REMBLK],',(',CARD);
    CCOL:=27;
    J:=0;
    WHILE(RETRNS[2,I]<>0)DO BEGIN
      J:=0;
      WHILE(J<7)AND(RETRNS[2,I]<>0)DO BEGIN
        J:=J+1;
        I:=RETRNS[2,I];
        LBLIST[J]:=RETRNS[1,I]
      END;
      FOR K:=1 TO J DO BEGIN
        ITOS(LBLIST[K],STR);
        CARD:=CONCAT(CARD,',',STR)
      END;
      CCOL:=CCOL+6*J;
      IF(RETRNS[2,I]<>0)THEN BEGIN
        PUTLINE;
        CARD:='     &';
        CCOL:=27
      END
    END;
    CARD:=CONCAT(CARD,')');
    PUTLINE;
    REMBLK:=0
  END
END;
PROCEDURE UNFORMAT;
VAR STR,T,F,LABSTR:STRING;
BEGIN
  {read,.../at end do}
  CARD:='     ';
  STR:=BUFIN[1];
  FCONCAT(CARD,1,STR,1,5);
  BCOL:=RDEND+1;
  STR:=COPY(STR,BCOL,LENGTH(STR)+1-BCOL);
  T:='';
  F:='';
  CONVERT(STR,T,F);
  GETLABEL;
  ITOS(LABLE,LABSTR);
  CARD:=CONCAT(CARD,' ',OUTFORMAT,'(1,',LABSTR,')',T);
  PUTLINE;
  CARD:=CONCAT(LABSTR,' FORMAT(',F,')');
  BUFFNO:=0
END;
PROCEDURE ATENDDO;
VAR II:INTEGER;
    STR:STRING;
PROCEDURE AR2;
BEGIN
  STR:=BUFIN[1];
  CARD:=' ';
  FCONCAT(CARD,1,STR,3,RDEND);
  LEVEL:=0;
  I:=RDEND+1;
  WHILE (I<=LENGTH(BUFIN[1]))AND(LEVEL>=0)DO BEGIN
    IF(EQUAL(BUFIN[1],I,'(',1,1))THEN LEVEL:=LEVEL+1
    ELSE IF(EQUAL(BUFIN[1],I,')',1,1))THEN LEVEL:=LEVEL-1;
    STR:=' ';
    STR[1]:=BUFIN[1,I];
    CARD:=CONCAT(CARD,STR);
    I:=I+1
  END;
  DELETE(CARD,LENGTH(CARD),1);
  GETLABEL;
  ITOS(LABLE,STR);
  BCOL:=I;
  CARD:=CONCAT(CARD,',END=',STR,')');
  I:=I+12
END;
PROCEDURE AR3;
BEGIN
  GETLABEL;
  CARD:='     ';
  STR:=BUFIN[1];
  FCONCAT(CARD,1,STR,1,5);
  ITOS(LABLE,STR);
  CARD:=CONCAT(CARD,' ',OUTFORMAT,'(',FMT1,',END=',STR,')');
  BCOL:=RDEND+1;
  I:=36
END;

BEGIN IF(PRVCODE<15)THEN 
    ERROR(LNO,'Previous  statement must be a read.')
  ELSE BEGIN
    RTYPE:=PRVCODE-14;
    IF RTYPE=1 THEN ERROR(LNO,'Does not support unformatted read')
    ELSE IF RTYPE=2 THEN AR2
    ELSE IF RTYPE=3 THEN AR3;
    STR:=BUFIN[1];
    STR:=COPY(STR,BCOL,LENGTH(STR)-BCOL+1);
    CARD:=CONCAT(CARD,STR);
    PUTLINE;
    IF(BUFFNO>1)THEN
      FOR II:=2 TO BUFFNO DO WRITELN(OUTFILE,BUFIN[II]);
    BUFFNO:=0;
    GETLABEL;
    OUTGO(LABLE);
    OUTCON(LABLE-1);
    GETTOP;
    LABLE1[TOP]:=LABLE;
    TYPO[TOP]:=12
  END
END;

PROCEDURE CASE12;
BEGIN
  IF CODE=1 THEN ELSEDO
  ELSE IF CODE=2 THEN ENDIF
  ELSE IF CODE=3 THEN ENDWH
  ELSE IF CODE=4 THEN ENDATEND
  ELSE IF CODE=5 THEN DOCASEVNAME
  ELSE IF CODE=6 THEN CASEDOT
  ELSE IF CODE=7 THEN IFNONEDO
  ELSE IF CODE=8 THEN ENDCASE
  ELSE IF CODE=9 THEN EXECUTE
  ELSE IF CODE=10 THEN REMOTEBLOCK
  ELSE IF CODE=11 THEN ENDBLOCK
  ELSE IF CODE=12 THEN ATENDDO;
  RD2;
  IF(NOT NORMAL(CARD))THEN
    ERROR(LNO,'Unexpected continuation card');
  IF ERRORSW THEN BEGIN
    ERROR(LNO,'Translator terminated. Fix error and re-try.');
    ABORT
  END
END;
    
PROCEDURE CASE16; BEGIN 
  IF(CODE=18)THEN BEGIN
    FMT1:='';
    PACK:=' ';
    PCOL:=1;
    CODE:=17;
    FINDCHAR(CCOL,CH);
    WHILE (CH<>',')DO BEGIN
      IF (NOT ISBLANK(CH))THEN BEGIN
        IF (NOT (ISDIGIT(CH))OR(ISLETTER(CH)))THEN 
          ERROR(LNO,'Unexpected non-alphabetic characters.')
        ELSE BEGIN
          FCONCAT(PACK,PCOL,CH,4,1);
          PCOL:=PCOL+1
        END
      END;
      CCOL:=CCOL+1;
      IF(CCOL>CARDLENGTH)THEN BEGIN
        WRITELN('Statement must be complete on one card.');
        ABORT
      END;
      FINDCHAR(CCOL,CH)
    END;
    IF(PCOL>6)THEN BEGIN
      ERROR(LNO,'Invalid read statement');
      ABORT
    END;
    FCONCAT(FMT1,1,PACK,1,PCOL-1);
    RDEND:=CCOL
  END{if};
  IF(LENGTH(FMT1)=0)THEN BEGIN FMT1:='1,29999';VFMT:=TRUE END
  ELSE BEGIN
    CH:=COPY(FMT1,1,1);
    IF ISDIGIT(CH)THEN FMT1:=CONCAT('1,',FMT1)
  END;
  I:=1;
  EOS:=FALSE;
  WHILE (NOT EOS) DO BEGIN
    BUFIN[I]:=CARD;
    RD1;
    I:=I+1;
    IF(I>21)THEN BEGIN
      ERROR(LNO,ERROR2);
      ABORT
    END
  END;
  BUFFNO:=I-1;
END;
      
PROCEDURE PARSE;
BEGIN
  GETLINE;
  WHILE NOT EOF DO BEGIN
    WHILE(EQUAL(CARD,1,'C',1,1))OR(EQUAL(CARD,1,'*',1,1))DO
     SKIPCOMMENT;
    PACKIT;
    GETCODE;
    IF (PRVCODE>=15)AND(CODE<>12)THEN DUMPBUF;
    IF (CODE<=0)THEN BEGIN
      IF (CODE=-1)THEN BEGIN
        IF (VFMT) THEN WRITELN(OUTFILE,'29999 FORMAT(E20.8)');
        WRITELN(OUTFILE,'C Structured Fortran, version 3.07A, Nov 82');
      END;
      WRRD1;
      IF(CODE=-1)THEN BEGIN
        IF (TOP>1) THEN ERROR(LNO,'Missing ''END..'' control.')
        ELSE BEGIN
          WHILE (NTOP>0)AND(NOT ERRORSW)DO BEGIN
            IF(STRTNO[1,NTOP]<>0)THEN ERROR(LNO,
              'Execute undefined remote block name');
            NTOP:=NTOP-1
          END;
          NTOP:=0;
          RTOP:=0;
          LABLE:=30000
        END
      END
    END
    ELSE IF (CODE<=12)THEN CASE12
    ELSE IF (CODE=19)THEN BEGIN
      OUTFORMAT:='WRITE';
      RDEND:=CCOL;
      BUFIN[1]:=CARD;
      BUFFNO:=0;
      UNFORMAT
    END
    ELSE IF (CODE=15)THEN BEGIN
      OUTFORMAT:='READ';
      RDEND:=CCOL;
      BUFIN[1]:=CARD;
      BUFFNO:=0;
      UNFORMAT
    END
    ELSE IF (CODE IN [16..18])THEN BEGIN
      OUTFORMAT:='READ';
      CASE16
    END
    ELSE CASES;
      {wrapup}
    IF ERRORSW THEN BEGIN
      ERROR(LNO,'Error ***.');ABORT 
    END
  END{while not eof};
  IF(CODE>15)THEN DUMPBUF;
  IF (TOP>1)THEN ERROR(LNO,'Missing ''END-BLOCK'' control statement')
  ELSE WRITELN(LNO,'Translation complete')
    
    
END;

BEGIN{program}
  INITIALIZE;
  WRITELN('INPUT FILE?');
  READLN(FILENAME);
  ASSIGN(INFILE,FILENAME);
  RESET(INFILE);
  WRITELN('OUTPUTFILE?');
  READLN(FILENAME);
  ASSIGN(OUTFILE,FILENAME);
  REWRITE(OUTFILE);
  PARSE;
  PUTLINE;
  ABORT
END;
BEGIN
  WAT
END.