{ > PasStmt }

{ Tutu 14/2/86 - FOR loop checking improved for D1.07 }
{ Tutu - hacked array stuff for ARM 11 feb 86 }
{ Tutu D1.02 fix 04 sep 85 for correct WITH clause action on exit - Bug 13 }

PROCEDURE STMT (THISSEQ : UW; OKGOTO : BOOLEAN);
VAR EXPR,
    EXPR2 : SYMREC;

    CVAR     : SYMP;
    P1,
    P2       : LABP;
    USER,
    DEL      : ADRSP;

    SAVENC   : BOOLEAN; { Used to save 'NOCODE' flag }
    STKP,
    SA1,
    SA2      : UW;
    PROCNO   : UB;


PROCEDURE CHKLEV;
BEGIN
   IF X.ACTIVLEV <> X.LEVEL THEN SETLEV (X.LEVEL)
END; { chklev }


PROCEDURE CASESTMT;
LABEL 1313,131;
TYPE CASEP = ^CASELST;
     CASELST = RECORD
                  K : SI;
                  SADR : UW;
                  NEXT : CASEP
               END;
VAR FIRST,
    AFTER,
    BEFOR     : CASEP;
    EXPR      : SYMREC;
    JUMPTAB   : BOOLEAN;
    SA1,
    OADR      : UW;
    JTABSZ,
    STABSZ,
    I         : SI;
    BASE,
    CASE_TYPE : UB;


PROCEDURE INSERTAS (VAR POSITION : CASEP);
VAR ELEMENT : CASEP;

BEGIN
   NEW (ELEMENT);
   ELEMENT^.K := I;
   ELEMENT^.SADR := X.CADR;
   ELEMENT^.NEXT := AFTER;
   POSITION := ELEMENT
END; { insertas }


PROCEDURE CASES;
BEGIN
   X.ACTIVLEV := BASE;
   OADR := X.CADR;
   X.STKINC := STKP;
   STMT (THISSEQ,FALSE);
   GENJMP (JMPNOW,0);
   SA2 := X.LASTADR
END; { cases }


BEGIN { casestmt }
   NXTSYMOK;
   EXPRESS (EXPR);
   IF EXPR.IDTYP <> SUBR THEN ERROR (107);

   GENJMP (JMPNOW,0);
   SA1 := X.LASTADR; { adr of JMP to case_??? BL-code }
   FIRST := NIL;
   STABSZ := 0;
   CHKNEXT (OFSY);
   BASE := X.ACTIVLEV;  {Save active level}

   REPEAT { Get case_list_element }
    1313: { Get case constants for this case_list_element }
         STABSZ := STABSZ + 3;
         ORDCON;
         IF NOT EQTYPS (EXPR,THISSYMP^,FALSE) THEN ERROR (113);

         AFTER := FIRST;
         I := THISSYMP^.VAL;
         IF FIRST = NIL THEN INSERTAS (FIRST)
         ELSE
         BEGIN
            BEFOR := FIRST;
       131: IF I = BEFOR^.K THEN ERROR (116)
            ELSE
               IF I < BEFOR^.K THEN INSERTAS (FIRST)
               ELSE
                 IF (AFTER = NIL) OR (I < AFTER^.K) THEN INSERTAS (BEFOR^.NEXT)
                  ELSE
                  BEGIN
                     BEFOR := AFTER;
                     AFTER := AFTER^.NEXT;
                     GOTO 131
                  END
         END;

         NEXTSYM;
         IF ISCOMA THEN
         BEGIN
            NXTSYMOK;
            GOTO 1313 {Ben wanted repeat..until but a sturdy goto wins}
         END;

      CHKNEXT (COLON);
      CASES;

      IF ISSEMI THEN NXTSYMOK;

      FUCKUP := FALSE
   UNTIL (SYM = ENDSY);

   NXTSYMOK;

   OADR := 0;
   IF SYM = OTHER THEN
   BEGIN
      ISOERR;
      NXTSYMOK;
      CASES
   END;

   X.ACTIVLEV := X.LEVEL;

   STORPATCH (SA1,X.CADR);

   AFTER := FIRST;
   WHILE AFTER^.NEXT <> NIL DO AFTER := AFTER^.NEXT;
   JTABSZ := SUCC(AFTER^.K - FIRST^.K);
   JUMPTAB := (STABSZ >= (JTABSZ * SUCC(ORD(NOT ISINT (EXPR)))));

   CASE_TYPE := (214 - ORD(JUMPTAB)) + (ORD(ISINT (EXPR)) * 2);

   GENOPWTB (CASE_TYPE,OADR);

   IF JUMPTAB THEN STABSZ := FIRST^.K;

   CASE CHR(CASE_TYPE-148) OF
     'A' : {case_jmp_bce} BEGIN
                             GENUB (STABSZ);
                             GENUB (JTABSZ)
                          END;
     'B' : {case_tst_bce}    GENUB (STABSZ DIV 3);
     'C' : {case_jmp_int} BEGIN
                             GENSI (STABSZ);
                             GENUW (JTABSZ)
                          END;
     'D' : {case_tst_int}    GENUW (STABSZ DIV 3)
   END;

   AFTER := FIRST;
   WHILE AFTER <> NIL DO
   BEGIN
      IF JUMPTAB THEN
         WHILE STABSZ < AFTER^.K DO
         BEGIN
            GENUW (0);
            STABSZ := SUCC(STABSZ)
         END
      ELSE { Search table }
         IF CASE_TYPE = 216 THEN GENSI (AFTER^.K) ELSE GENUB (AFTER^.K);
      GENUW (AFTER^.SADR);
      AFTER := AFTER^.NEXT;
      STABSZ := SUCC(STABSZ)
   END;

   IF OADR <> 0 THEN STORPATCH (PRED(PRED(OADR)),X.CADR);
  { Patch jump to end of case table, for last stmt }
   STORPATCH (SA2,X.CADR);

   WHILE FIRST <> NIL DO
   BEGIN
      AFTER := FIRST;
      I := PRED(PRED(AFTER^.SADR));
      IF I > SA1 THEN STORPATCH (I,X.CADR);
      FIRST := FIRST^.NEXT;
      DISPOSE (AFTER)
   END
END; { casestmt }


PROCEDURE SPROCSTMT;
LABEL 13;
VAR ELREF,
    ZADESCREF : STP;
    CLIST     : CONSTSP;
    EXPR,FWIDTH,IOFILE,LHSVAR : SYMREC;
    VARIENTS  : VARIANTP;
    IOTYPES   : SET OF TYPES;
    IOVAR     : TYPES;
    ISWRITE,ISTXT,MORE,HEXALLOW : BOOLEAN;
    OP,BASE,PROCNO,CRAP : UB;
    SA1       : UW;


PROCEDURE GETA;
VAR COPY : SYMREC;

BEGIN
   VARACCESS (LHSVAR);
   IF (LHSVAR.REF^.ALEV>127)
   OR (LHSVAR.IDTYP > ARAY) OR (LHSVAR.IDTYP < CARAY) THEN ERROR (42);
   LOCADESC (LHSVAR,ADESCREF);
   CHKNEXT (COMMA);
   EXPRESS (EXPR);
   COPY       := LHSVAR;
   COPY.IDTYP := SUBR;
   COPY.REF   := COPY.REF^.IREF;
   IF NOT EQTYPS (COPY,EXPR,TRUE) THEN ERROR (41);
   FLUSHNGEN (AACESOP);
{ Tutu - was GENUB (5 + ORD(ISINT (EXPR)) * 3);}
   genuw (twiceptrsize + 4); { Tutu - ptr, ptr, index (always 4 bytes) }
   GENUB (1); { One index }
END; { GETA }


PROCEDURE POPFCB;
BEGIN
   FLUSH;
   CHKLEV;
{ Tutu - was GENUW (&712) {popS_ptr 7}
   genlors (&12, fcbref)  { Tutu }
END; { popfcb }


PROCEDURE IOFCB;
BEGIN
  { Get FCB address onto TOS and then stash it }
   GENMOV (LOCATE,IOFILE);
   POPFCB;
   EXPR := LHSVAR;
   LHSVAR := IOFILE
END; { iofcb }


PROCEDURE WPARAM;
BEGIN
   IF SYM = TWIDLE THEN
   BEGIN
      ISOERR;
      HEXALLOW := TRUE;
      NXTSYMOK
   END;
   EXPRESS (EXPR)
END; { wparam }


PROCEDURE GETPARAM (PARAM1 : BOOLEAN);
BEGIN
   IF ISCOMA THEN
   BEGIN
      NXTSYMOK;
      IF ISWRITE THEN WPARAM ELSE VARACCESS (EXPR)
   END
   ELSE
   BEGIN
      MORE := FALSE;
      IF (NOT ISTXT) AND PARAM1 THEN ERROR (17)
   END
END; { getparam }


PROCEDURE FORMAT (OP:UB);
BEGIN
   IF SYM = COLON THEN
   BEGIN
      NXTSYMOK;
      EXPRESS (FWIDTH);
      IF NOT ISINT (FWIDTH) THEN ERROR (OP);
      FLUSHNGEN (OP);
      IF OP = WPLAOP THEN
      BEGIN
         IF EXPR.IDTYP <> REEL THEN ERROR (88)
      END
      ELSE FORMAT (WPLAOP);
      IF LHSVAR.IDTYP = FYLE THEN ERROR (98)
   END
END; { format }


BEGIN { sprocstmt }
   HEXALLOW := FALSE; {No hex integers}
   PROCNO := THISSYMP^.PROCNO;

   CASE PROCNO OF

   WRIT,WRITLN,REED,REEDLN :
      BEGIN
         ISWRITE := PROCNO > REED;
         IOFILE:= INPTSYMP^;
         IF ISWRITE THEN IOFILE := OTPTSYMP^;
         NXTSYMOK;
         ISTXT := ODD(PROCNO) <> ISWRITE;
         IF SYM = LPAREN THEN
         BEGIN
            NXTSYMOK;
          { Get file variable or expression }
            IF ISWRITE THEN { Write(ln) }
            BEGIN
               BASE := WRIT;
               IOTYPES := [BOOL,CHARR,INT,REEL,STRNG];
               WPARAM;
               LHSVAR := EXPR
            END
            ELSE
            BEGIN { Read(ln) }
              { Reads are done by putting the value read in onto the
                stack and then popping into the variable. So LHS is
                set to true so as to avoid locating the variable
                first and then popping indirect if possible and doing
                read value - pop value instead }
               LHS := TRUE;
               BASE := REED;
               IOTYPES := [CHARR,INT,REEL];
               VARACCESS (LHSVAR)
            END;

            MORE := TRUE;

            IF (LHSVAR.IDTYP >= FYLE) AND (NOT HEXALLOW) THEN
            BEGIN { File variable present }
              { Get FCB address onto TOS }
               IF NOCODE THEN GENMOV (LOCATE,LHSVAR);
               POPFCB;
               GETPARAM (TRUE)
            END
            ELSE IOFCB;

            IF LHSVAR.IDTYP = FYLE THEN
               IF ISWRITE THEN BASE := WNONTXT
               ELSE BASE := RNONTXT;

            WHILE MORE DO
            BEGIN
              { Get total width and dec places if present}
               IF ISWRITE THEN FORMAT (WWIDOP)
               ELSE IF EXPR.PERM THEN ERROR (55);

              { Make a copy of LHSVAR in FWIDTH }
               FWIDTH := LHSVAR;
               FWIDTH.IDTYP := FWIDTH.REF^.TYP;
               FWIDTH.REF := FWIDTH.REF^.FILEREF;

               IOVAR := EXPR.IDTYP;
               IF LHSVAR.IDTYP = TXT THEN
               BEGIN
                  IF IOVAR = SUBR THEN IOVAR := EXPR.REF^.TYP;
                  IF NOT (IOVAR IN IOTYPES) THEN ERROR (87);
                  OP := CODE0 (TABSEARCH,ORD(IOVAR),
                              MLO,MHI{MOVTYPVAL}) MOD 128
               END
               ELSE { File is not of type text }
               BEGIN
                  TYPSZ (FWIDTH,OP,CRAP,FALSE);
                  IF ISWRITE THEN
                  BEGIN
                    IF NOT EQTYPS (FWIDTH,EXPR,TRUE) THEN ERROR (86);
                    IF IOVAR >= FYLE THEN ERROR (85)
                  END;
                  IF OP < 5 THEN OP := 0
               END;
               OP := OP + BASE;
               IF HEXALLOW THEN
                  IF OP = 151 THEN OP := 153
                  ELSE ERROR (59);

               FLUSHNGEN (OP);
               IF OP = WSTR THEN GENUW (LIMITS (EXPR));

               IF NOT ISWRITE THEN
               BEGIN
                  IF LHSVAR.IDTYP = TXT THEN FWIDTH := EXPR;
                  IF NOT EQTYPS (EXPR,FWIDTH,TRUE) THEN ERROR (86);
                  IF OP <> 147 {pr_ird_blk} THEN
                  BEGIN
                     GENMOV (IPOP-ORD(NOCODE)*16,EXPR);
                     IF EXPR.IDTYP = SETT THEN STKUP (MAXSET)
                  END
               END;
               HEXALLOW := FALSE;

               X.STKINC := STKP;
               GETPARAM (FALSE)
            END;
            CHKNEXT (RPAREN)
         END

         ELSE { Just a writeln; or readln;. No (.....) }
         BEGIN
           { Get FCB address onto TOS and then stash it }
            IOFCB;
            IF NOT ISTXT THEN ERROR (17) {Param list expected}
         END;

         IF ISTXT THEN
         BEGIN
            IF LHSVAR.IDTYP <> TXT THEN ERROR (89);
            FLUSHNGEN (PROCNO)
         END;
         LHS := FALSE;
         IF LHSVAR.ADR < 0 THEN ERROR (16)
      END; { Of writes and reads }

   GETT,PUTT,RSET,RWRIT : { Get, Put, Resets and rewrites }
      BEGIN
         NXTSYMOK;
         CHKNEXT (LPAREN);
         VARACCESS (LHSVAR);
         IF LHSVAR.IDTYP < FYLE THEN ERROR (92)
         ELSE
         BEGIN
            OP := ORD(LHSVAR.IDTYP <> TXT);
            IF PROCNO < RSET THEN FLUSHNGEN (PROCNO + OP)
            ELSE
            BEGIN
               IF ISCOMA THEN
               BEGIN
                  PROCNO := SUCC(PROCNO);
                  NXTSYMOK;
                  EXPRESS (EXPR);
                  ISOERR;
                  IF EXPR.IDTYP <> STRNG THEN ERROR (83);
                  IF NOT LHSVAR.PERM THEN ERROR (84)
               END;

               FLUSHNGEN (PROCNO);
               GENOPWTB (OP,LHSVAR.REF^.FILESIZ);
               IF ODD(PROCNO) THEN GENUB (LIMITS (EXPR))
            END
         END;
         CHKNEXT (RPAREN)
      END;  { Of get, put, resets and rewrites }

   PAIG :  { Procedure page }
      BEGIN
         NXTSYMOK;
         IF SYM = LPAREN THEN
         BEGIN
            NXTSYMOK;
            VARACCESS (LHSVAR);
            IF LHSVAR.IDTYP <> TXT THEN ERROR (82);
            CHKNEXT (RPAREN)
         END
         ELSE GENMOV (LOCATE,OTPTSYMP^);
         FLUSHNGEN (PROCNO);
      END;  { Of page }

   217,218 : { Pack and Unpack }
      BEGIN
         NXTSYMOK;
         CHKNEXT (LPAREN);
         IF PROCNO = 217 { Pack } THEN
         BEGIN
            GETA; {A,I}
            CHKNEXT (COMMA);
            OP := 0
         END;

        { Get Z (Packed array)}
         VARACCESS (IOFILE); { Z }
         IF (IOFILE.REF^.ALEV < 128) OR (IOFILE.IDTYP < STRNG)
         OR (IOFILE.IDTYP > ARAY) OR (IOFILE.OBJ = KONST) THEN ERROR (45);

         ZADESCREF := ADESCREF;
         IF PROCNO = 218 { Unpack } THEN
         BEGIN
            PROCNO := 217;
            OP := 128;
            CHKNEXT (COMMA);
            GETA {A,I}
         END;

         LOCADESC (IOFILE,ZADESCREF); {Z Descriptor}

         ELREF := IOFILE.REF^.ELREF;
         IF LHSVAR.REF^.ELREF <> ELREF THEN ERROR (43);
         FLUSHNGEN (PROCNO);
         IF ELREF^.TYP = INT THEN
            OP := OP + BYTES (ELREF^.LOW,ELREF^.HIGH)
         ELSE OP := OP + 4;
         GENUB (OP);
         CHKNEXT (RPAREN)
      END; { Pack and unpack }

   NU,DISPOZ : { New and Dispose }
      BEGIN
         NXTSYMOK;
         CHKNEXT (LPAREN);
         IF PROCNO = NU THEN VARACCESS (LHSVAR)
         ELSE EXPRESS (LHSVAR);
         IF LHSVAR.IDTYP <> PNTR THEN ERROR (142); {Pntr type expected}
         SA1 := LHSVAR.REF^.PSZ;
         IF ISCOMA THEN
         BEGIN { Creating record dynamically with variants }
            IF LHSVAR.REF^.TYP = REKORD THEN
            BEGIN
               VARIENTS := LHSVAR.REF^.PNTRREF^.VARIANTS;
               REPEAT
                  NXTSYMOK;
                  IF VARIENTS = NIL THEN ERROR (74)
                  ELSE
                  BEGIN
                     ORDCON;
                     ELREF := VARIENTS^.CONSTLIST^.CONS^.REF;
                     IF (ELREF^.TYP = THISSYMP^.REF^.TYP) AND
                        (ELREF^.SUBRREF = THISSYMP^.REF^.SUBRREF) THEN
                     BEGIN
                        REPEAT
                           CLIST := VARIENTS^.CONSTLIST;

                           REPEAT
                              IF CLIST^.CONS^.VAL =THISSYMP^.VAL THEN
                                 GOTO 13; { Sly GOTO, I don't know! }
                              CLIST := CLIST^.NEXTC
                           UNTIL CLIST = NIL;

                           VARIENTS := VARIENTS^.LASTV
                        UNTIL VARIENTS = NIL;

                        ERROR (72);

                        13 : SA1 := VARIENTS^.MAXSIZE;
                        NEXTSYM;
                        IF ISCOMA THEN VARIENTS := VARIENTS^.NESTEDV
                     END
                     ELSE ERROR (73)
                  END
               UNTIL NOT ISCOMA
            END
            ELSE ERROR (75)
         END;

         CHKNEXT (RPAREN);
         GENLORS (PROCNO,SA1)
      END;  { Of New and Dispose }

   END  { Of PROCNO case }
   OTHERWISE
END; { sprocstmt }


PROCEDURE GETLAB (VAR P1 : LABP);
LABEL 13;

VAR CRAP : SI;

BEGIN
   FOR CRAP := X.LEVEL DOWNTO 1 DO
   BEGIN
      P1 := LABS[CRAP];
      WHILE P1 <> NIL DO
         IF P1^.VAL = THISSYMP^.VAL THEN
         BEGIN
            PROCNO := CRAP;
            GOTO 13
         END
         ELSE P1 := P1^.NEXT
   END;
13:
END; { getlab }


BEGIN { stmt }
   X.STMTLEV := SUCC(X.STMTLEV);
   LHS := FALSE;
   STKP := X.STKINC;
   P1 := NIL;

{ Check for label }
   IF ISLAB THEN
   BEGIN
      GETLAB (P1);

      IF (P1 <> NIL) AND (PROCNO = X.LEVEL) THEN
      BEGIN
         P1^.CA := X.CADR;
         P1^.SPO := X.STKINC;
         IF P1^.USED THEN ERROR (38); { Label already defined }
         P1^.USED := TRUE;
         P1^.LEV := X.STMTLEV;
         P1^.PREFIX := TRUE;
         P1^.SEQNO := THISSEQ;
         P1^.OKGOTO := OKGOTO;

         USER := P1^.USER;

         WHILE USER <> NIL DO
         BEGIN  { Patch any GOTO to this label }
            STORPATCH (USER^.CA,X.CADR);
            STORPATCH (USER^.CA+3,P1^.SPO);

            IF USER^.LEV <> X.LEVEL THEN
            BEGIN { Check that this label prefixes a statement at the outermost
                    level of nesting of a block. }
               IF X.STMTLEV <> 1 THEN ERROR (36)
            END
            ELSE { Label must prefix a statement which is in the same statement
                   sequence as the GOTO }
               IF NOT (OKGOTO AND (THISSEQ IN USER^.ACCSET)) THEN ERROR (34);

            DEL := USER;
            USER := USER^.NEXT;
            DISPOSE (DEL)
         END;
         P1^.USER := NIL
      END
      ELSE ERROR (37);

      NXTSYMOK;
      CHKNEXT (COLON);
      CHKLEV
   END;


   FUCKUP := TRUE;
   WHILE NOT (SYM IN [BEGINSY,EPROC,SPROC,PROC,VARID,FIELD,TAG,UNDEFID,NEWID,
              GOTOSY,IFSY,ELSESY,CASEY,REPEATSY,WHILESY,FORSY,WITHSY,BOUNDID,
              SEMICOLON,ENDSY,UNTILSY,PROCSY,FUNC,FUNCSY,EOFILE]) DO
   BEGIN
      IF FUCKUP THEN ERROR (13); { Bad statement start }
      FUCKUP := FALSE;
      NEXTSYM
   END;

   FUCKUP := FALSE;
   ACCEPT := [ENDSY,SEMICOLON,UNTILSY,PROCSY,FUNCSY];
   RETKONST := FALSE;

   DEBLINE;
   SA2 := 0;

   CASE SYM OF { Actions for various symbols ! }

      BEGINSY : BLKSTMT (ENDSY);

      EPROC :
         BEGIN
            ISOERR;
            PROCNO := THISSYMP^.FUNCNO;

            NXTSYMOK;

            SA1 := THISSYMP^.NPARAMS;
            IF SA1 > 0 THEN { No. params > 0 }
            BEGIN
               CHK (LPAREN);

               REPEAT
                  NXTSYMOK;
                  SA2 := SUCC(SA2);

{ Tutu - I've taken over code0 -> call (addr, regs^). Below nicked from efunc }
                  if (procno = 238) and (SA2 = 2)
                  then varaccess (expr)
                  else
                  begin
                     EXPRESS (EXPR);
                     IF PROCNO = 231 {oscli} THEN
                     BEGIN
                        IF EXPR.IDTYP <> STRNG THEN ERROR (61)
                     END
                     ELSE
                        IF NOT ISINT (EXPR) THEN ERROR (81)
                  end
               UNTIL NOT ISCOMA;

               CHKNEXT (RPAREN);

               IF SA2 <> SA1 THEN
               BEGIN
                  IF SA2 > SA1 THEN ERROR (60);
                  IF SA1 <> 63 THEN ERROR (17) {fudge for vdu}
               END
            END;

            FLUSHNGEN (PROCNO);
            IF PROCNO = 227 { vdu } THEN GENUB (SA2);
            IF PROCNO = 231 {oscli} THEN GENUB (LIMITS (EXPR))
         END;

      SPROC : SPROCSTMT;

      PROC  : PFCALL (THISSYMP);

      VARID,TAG,FIELD,UNDEFID,NEWID,BOUNDID,FUNC :
         BEGIN
            IF SYM = BOUNDID THEN ERROR (156); {CANNOT ASSIGN VALUE TO BOUNDID}
            LHS := TRUE;
            VARACCESS (EXPR2);
            IF CONTAINSFILE (EXPR2.IDTYP,EXPR2.REF^,TRUE) THEN ERROR (97);
            IF EXPR2.PERM THEN ERROR (55);
            LHS := FALSE;
            SAVENC := NOCODE;
            CHKNEXT (ASSIGN);
            EXPRESS (EXPR);
            IF NOT EQTYPS (EXPR2,EXPR,TRUE) THEN ERROR (12);
            GENMOV (IPOP-ORD(SAVENC)*16,EXPR2)
         END;

      GOTOSY :
         BEGIN
            NXTSYMOK;
            IF ISLAB THEN
            BEGIN
               GETLAB (P2);
               IF PROCNO <> X.LEVEL THEN
                  VAL_CONF_DISPOSE (DISPLAY[X.LEVEL]^.LASTPARAM);

               FLUSHNGEN (72{GOTO});

               IF P2 <> NIL THEN
               BEGIN
                  IF P2^.CA = 0 THEN
                  BEGIN { Label not yet defined }
                     NEW (USER);
                     USER^.CA := X.CADR;
                     USER^.LEV := X.LEVEL;
                     USER^.ACCSET := OKGOTOS;
                     USER^.NEXT := P2^.USER;
                     P2^.USER := USER
                  END
                  ELSE
                     IF NOT (P2^.PREFIX OR
                            (P2^.OKGOTO AND (P2^.SEQNO IN OKGOTOS)))
                     THEN ERROR (34);
{ Label must prefix a statement which is in the same
                                              statement sequence as the GOTO }
                  GENUW (P2^.CA);
                  GENUB (PRED(PROCNO));
                  GENUW (P2^.SPO)
               END
               ELSE ERROR (33);

               NEXTSYM
            END
            ELSE ERROR (40)
         END;

      IFSY :
         BEGIN
            NXTSYMOK;
            BOOLEXP (EXPR);
            CHKNEXT (THENSY);
           { GENERATE A BRANCH FALSE TO AFTER 'THEN STMT'}
            GENJMP (JMPFALS,0);
            SA1 := X.LASTADR;
            SA2 := SA1;
            STMT (THISSEQ,FALSE);
            IF SYM = ELSESY THEN
            BEGIN
              { GENERATE BRANCH-NOW TO END OF 'ELSE STMT'}
               GENJMP (JMPNOW,0);
               SA1 := X.LASTADR;
              { Patch branch false to after then stmt }
               STORPATCH (SA2,X.CADR);
               NXTSYMOK;
               STMT (THISSEQ,FALSE)
            END;
            CHKLEV;
            STORPATCH (SA1,X.CADR)
         END;

      CASEY    : CASESTMT;

      REPEATSY :
         BEGIN
            CHKLEV;
            SA1 := X.CADR;
            BLKSTMT (UNTILSY);
            DEBLINE;
            BOOLEXP (EXPR);
           { GENERATE BRANCH-FALSE TO START OF REPEAT LOOP}
            GENJMP (JMPFALS,SA1)
         END;

      WHILESY :
         BEGIN
            NXTSYMOK;
            CHKLEV;
            SA1 := X.CADR;
           { Start of loop control evaluation }
            BOOLEXP (EXPR);
           { GENERATE BRANCH-FALSE TO END OF WHILE LOOP}
            GENJMP (JMPFALS,0);
            SA2 := X.LASTADR;
            CHKNEXT (DOSY);
            STMT (THISSEQ,FALSE);
           { GENERATE BRANCH-NOW TO START OF LOOP EVALUATION}
            GENJMP (JMPNOW,SA1);
           { Patch 'branch false to end of while loop' }
            STORPATCH (SA2,X.CADR)
         END;

      FORSY :
         BEGIN
            NXTSYMOK;
            VARACCESS (EXPR2);
            IF EXPR2.IDTYP <> SUBR THEN ERROR (64);
            IF NOT SIMPLE THEN ERROR (56); {variable must be a simple var}
            IF EXPR2.PERM THEN ERROR (55);
            IF EXPR2.THREAT THEN ERROR (94);
            CVAR := DISPLAY[X.LEVEL]^.LASTPARAM;
            IF CVAR = NIL THEN CVAR := DISPLAY[PRED(X.LEVEL)]^.LASTSYM;
            IF (EXPR2.NAMLINK <= CVAR^.NAMLINK) AND (X.LEVEL > 1) THEN
              ERROR (20);
            THISSYMP^.PERM := TRUE;
            CVAR := THISSYMP;
            CHKNEXT (ASSIGN);
            EXPRESS (EXPR);
            IF NOT EQTYPS (EXPR2,EXPR,FALSE) THEN ERROR (63);
            IF SYM = DOWNTOSY THEN
            BEGIN
               SA1 := 186;
               NXTSYMOK
            END
            ELSE
            BEGIN
               SA1 := 182;
               CHKNEXT (TOSY)
            END;

            EXPRESS (EXPR);
            IF NOT EQTYPS (EXPR2,EXPR,FALSE) THEN ERROR (63);
            X.STKINC := STKP + ptrsize + 2;
                                               { Tutu - was 4 : ptr, bce, bce }
            CHKNEXT (DOSY);
            IF ISINT (EXPR2) THEN
            BEGIN
               SA1 :=  SUCC(SUCC(SA1));  { Tutu - opcode := for_xx_int type }
               X.STKINC :=  X.STKINC + 6 { Tutu - make it ptr, int, int }
            END;

            GENOPWTB (SA1,0);
            X.ACTIVLEV := X.LEVEL;
            SA2 := X.CADR;

          { Do range checking on control variable here so as to avoid bug 9 }
            IF (RNGCHK AND (Expr2.ref^.typ <> Int)) THEN
                           { Int check added for D1.07 - Tutu code!}
            BEGIN
               GENMOV (PUSH,EXPR2);
               SAVENC := EQTYPS (EXPR2,EXPR,TRUE);
               GENMOV (POP,EXPR2)
            END;

            STMT (THISSEQ,FALSE);

            SA1 := SUCC(SA1); { Tutu - generate closing opcode }
            GENOPWTB (SA1,SA2);
            STORPATCH (PRED(PRED(SA2)),X.CADR);
            CVAR^.PERM := EXPR2.PERM;
            X.ACTIVLEV := X.LEVEL
         END;

      WITHSY :
         BEGIN
            VARP := TRUE;
            SA1 := X.STKINC;
            REPEAT
               NXTSYMOK;
               VARACCESS (EXPR);

               ACTIVREC (EXPR);

               NEWACTIVE^.WITHADR := X.STKINC;
               STKUP (ptrsize) { Tutu - was 2 }
            UNTIL NOT ISCOMA;

            VARP := FALSE;
            SA2 := X.STKINC;

            CHKNEXT (DOSY);
            STMT (THISSEQ,FALSE);
            CHKLEV;
            REPEAT
               SA2 := SA2 - ptrsize; { Tutu - was pred(pred(sa2)) ! }
               GENLORS (18 {pop_ptr}, SA2); {Tutu 4sep85 V1.02}
  { Tutu - was FLUSHNGEN(POP_S_PTR (18)); - Wot a load of crap ! Li is a wally.
               GENUB(SA2); }
               ACTIVELIST := ACTIVELIST^.NEXT
            UNTIL SA2 <= SA1
         END
   END
   OTHERWISE ;

   IF P1 <> NIL THEN P1^.PREFIX := FALSE;
   X.STKINC := STKP;
   X.STMTLEV := PRED(X.STMTLEV)

END; { stmt }


BEGIN { blkstmt }
   X.SEQNO := SUCC(X.SEQNO);
   IF X.SEQNO > 255 THEN ERROR (103) ELSE OKGOTOS := OKGOTOS + [X.SEQNO];
   THISSEQ := X.SEQNO;

   REPEAT
      NXTSYMOK;
      STMT (THISSEQ,TRUE);
      IF NOT ISSEMI THEN CHK (TERMSY)
   UNTIL (NOT ISSEMI) OR (SYM IN [TERMSY,PROCSY,FUNCSY,EOFILE]);

   CHKNEXT (TERMSY);
   OKGOTOS := OKGOTOS - [THISSEQ]
END; { blkstmt }

{$S'PasMain'}