C    Loglan82 Compiler&Interpreter
C     Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw
C     Copyright (C)  1993, 1994 LITA, Pau
C     
C     This program is free software; you can redistribute it and/or modify
C     it under the terms of the GNU General Public License as published by
C     the Free Software Foundation; either version 2 of the License, or
C     (at your option) any later version.
C     
C     This program is distributed in the hope that it will be useful,
C     but WITHOUT ANY WARRANTY; without even the implied warranty of
C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
C     GNU General Public License for more details. File: LICENSE.GNU
C  ===============================================================     

      subroutine e3
C  E3 - RECOGNIZES OBJECTEXPRESSION
C  NO LOCAL VARIABLES
      IMPLICIT INTEGER (A-Z)
      COMMON /BLANK/
     $	 C0M(4),
     O	 S,	   ADRES,    K,        SCOMA,	 SDOT,	   SEMICOL,
     1	 SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,	   SRELAT,
     2	 SEOF,	   SIDENT,   SCONST,   SAND,	 SARRAY,   SARROF,
     3	 SATTACH,  SBEGIN,   SBLOCK,   SBOOL,	 SCALL,    SCASE,
     4	 SCLASS,   SCLOSE,   SCONS,    SCOPY,	 SCOROUT,  SDETACH,
     5	 SDIM,	   SDO,      SDOWN,    SELSE,	 SEND,	   SESAC,
     6	 SEXIT,    SEXTERN,  SFI,      SFOR,	 SFUNCT,   SIF,
     7	 SINNER,   SINPUT,   SINT,     SKILL,	 SLOCK,    SNEW,
     8	 SNONE,    SNOT,     SOD,      SOR,	 SORIF,    SOTHER,
     9	 SOUTPUT,  SPREF,    SPRCD,    SQUA,	 SREAD,    SRESUME,
     O	 SRETURN,  STEP,     STOP,     STAKEN,	 STHEN,    STHIS,
     A	 STO,	   STYPE,    SUNIT,    SVAR,	 SVIRTUAL, SWAIT,
     B	 SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
     C	 WAND,	   WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
     D	 WCALL,    WCASE,    WCASEL,   WCOMA,	 WCNSTB,   WCNSTC,
     E	 WCNSTI,   WCNSTN,   WCNSTR,   WCNST,	 WCOPY,    WDETACH,
     F	 WDOT,	   WDOWNTO,  WEOF,     WESAC,	 WFIN,	   WFIRST,
     G	 WFOREND,  WFORVAR,  WFROM,    WIDENT,	 WIFFALS,  WIFTRUE

      common /BLANK/
     H	 WINNER,   WINSTREND,WJUMP,    WKILL,	 WLABEL,   WLEFT,
     I	 WLOCK,    WLOW,     WLSE,     WNEW,	 WNEWARRAY,WNOT,
     J	 WOPERAT,  WOPT,     WOR,      WOTHER,	 WPREF,    WPRIM,
     K	 WQUA,	   WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
     L	 WSTART,   WSTEP,    WSTOP,    WTHIS,	 WTO,	   WAIT,
     M	 WRITE,    WRITELN,  WBOUND,   UNICAL,
     N	 COM(132),
     O	 LMEM,	   LPMEM,    IRECN,    ISFIN,	 LPMSYS,   LPML,
     P	 LPMF,	   NRINT,    NRRE,     NRBOOL,	 NRCHAR,   NRCOR,
     Q	 NRPROC,   NRTEXT,   NRUNIV,   NATTR,	 NRNONE,   NBLSYS,
     R	 NBLUS,    NEMPTY,   INSYS,    LOCAL,	 OWN,	   OBJECT,
     $   scaner(8735)
cdsw $	 SCANER(3735),
      common /BLANK/
     Z	 TOP,	   IN,	     NEXT,     STACK(500),
     *	 RESZTA(3652)
     
      GOTO (10,20,30,40),IN
10    IF (S.NE.SIDENT) GOTO 200
      CALL SLAD(0,3,2)
      STACK(TOP+4)=0
C  PARAMETER VALUE IS ASSIGNED: THERE IS NO "NEW"
      NEXT=5
C  E5 - FUNCTION
      RETURN
C  RETURN TO LABEL 20, RESULTING FROM JUMP OPTIMIZATION.
200   IF (S.NE.STHIS) GOTO 250
      CALL SCAN
      IF (S.EQ.SIDENT) GOTO 210
      CALL ERROR(109)
      GOTO 300
210   CALL OUTPUT(WTHIS,ADRES)
      CALL SCAN
      GOTO 300
250   IF (S.EQ.SNEW) GOTO 270
      IF (S.NE.SNONE) GOTO 255
      CALL OUTPUT(WCNSTN,-1)
      CALL SCAN
      GOTO 1000
255   CALL ERROR(109)
      CALL OUTPUT(WIDENT,0)
      GOTO 300
270   STACK(TOP+7)=ADRES
      CALL SCAN
      IF (S.NE.SIDENT) GOTO 280
      CALL SLAD(0,3,3)
      NEXT=5
C  E5 - FUNCTION
      RETURN
280   CALL ERROR(109)
      CALL OUTPUT(WIDENT,0)
20    CONTINUE
30    CONTINUE
40    CONTINUE
300   IF (S.EQ.SDOT) GOTO 350
      IF (S.NE.SQUA) GOTO 1000
C  QUA
      CALL SCAN
      IF (S.NE.SIDENT) GOTO 260
      CALL OUTPUT(WQUA,ADRES)
      CALL SCAN
      IF (S.EQ.SDOT) GOTO 350
      CALL ERROR(114)
      GOTO 351
260   CALL ERROR(109)
      GOTO 250
C  DOT
350   CALL SCAN
351   STACK(TOP+7)=0
      IF (S.NE.SNEW) GOTO 380
      STACK(TOP+7)=ADRES
      CALL SCAN
380   IF (S.EQ.SIDENT) GOTO 390
      CALL ERROR(109)
      GOTO 250
390   CALL OUTPUT(WDOT,-1)
      CALL SLAD(0,3,4)
C  RETURN INTO SOME OTHER PLACE
      NEXT=5
      RETURN
C  E5 - FUNCTION
1000  NEXT=0
      RETURN
      END
      
      SUBROUTINE E4
C  E4 - RECOGNIZES EXPRESSION
C  STACK(TOP+3) - NUMBER OF ARRAYOF'S ENCOUNTERED
      IMPLICIT INTEGER (A-Z)
      COMMON /BLANK/
     $	 C0M(4),
     O	 S,	   ADRES,    K,        SCOMA,	 SDOT,	   SEMICOL,
     1	 SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,	   SRELAT,
     2	 SEOF,	   SIDENT,   SCONST,   SAND,	 SARRAY,   SARROF,
     3	 SATTACH,  SBEGIN,   SBLOCK,   SBOOL,	 SCALL,    SCASE,
     4	 SCLASS,   SCLOSE,   SCONS,    SCOPY,	 SCOROUT,  SDETACH,
     5	 SDIM,	   SDO,      SDOWN,    SELSE,	 SEND,	   SESAC,
     6	 SEXIT,    SEXTERN,  SFI,      SFOR,	 SFUNCT,   SIF,
     7	 SINNER,   SINPUT,   SINT,     SKILL,	 SLOCK,    SNEW,
     8	 SNONE,    SNOT,     SOD,      SOR,	 SORIF,    SOTHER,
     9	 SOUTPUT,  SPREF,    SPRCD,    SQUA,	 SREAD,    SRESUME,
     O	 SRETURN,  STEP,     STOP,     STAKEN,	 STHEN,    STHIS,
     A	 STO,	   STYPE,    SUNIT,    SVAR,	 SVIRTUAL, SWAIT,
     B	 SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
     C	 WAND,	   WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
     D	 WCALL,    WCASE,    WCASEL,   WCOMA,	 WCNSTB,   WCNSTC,
     E	 WCNSTI,   WCNSTN,   WCNSTR,   WCNST,	 WCOPY,    WDETACH,
     F	 WDOT,	   WDOWNTO,  WEOF,     WESAC,	 WFIN,	   WFIRST,
     G	 WFOREND,  WFORVAR,  WFROM,    WIDENT,	 WIFFALS,  WIFTRUE

      common /BLANK/
     H	 WINNER,   WINSTREND,WJUMP,    WKILL,	 WLABEL,   WLEFT,
     I	 WLOCK,    WLOW,     WLSE,     WNEW,	 WNEWARRAY,WNOT,
     J	 WOPERAT,  WOPT,     WOR,      WOTHER,	 WPREF,    WPRIM,
     K	 WQUA,	   WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
     L	 WSTART,   WSTEP,    WSTOP,    WTHIS,	 WTO,	   WAIT,
     M	 WRITE,    WRITELN,  WBOUND,   UNICAL,
     N	 COM(132),
     O	 LMEM,	   LPMEM,    IRECN,    ISFIN,	 LPMSYS,   LPML,
     P	 LPMF,	   NRINT,    NRRE,     NRBOOL,	 NRCHAR,   NRCOR,
     Q	 NRPROC,   NRTEXT,   NRUNIV,   NATTR,	 NRNONE,   NBLSYS,
     R	 NBLUS,    NEMPTY,   INSYS,    LOCAL,	 OWN,	   OBJECT,
     $   scaner(8735)
cdsw $	 SCANER(3735),
       common /BLANK/
     Z	 TOP,	   IN,	     NEXT,     STACK(500),
     *	 RESZTA(3652)
     
      GOTO (10,20),IN
10    STACK(TOP+3)=0
      IF (S.NE.SARROF) GOTO 13
11    STACK(TOP+3)=STACK(TOP+3)+1
      CALL SCAN
      IF (S.EQ.SARROF) GOTO 11
13    IF (S.EQ.SCOROUT) GOTO 15
      IF (S.EQ.SINT) GOTO 16
      NEXT=1
      IF (STACK(TOP+3).GT.0) NEXT=3
      CALL SLAD(1,4,2)
      RETURN
C  CALL 	  E1 - BOOLEXPRESSION
C	  OR	  E3 - OBJECTEXPRESSION
15    CALL OUTPUT(WIDENT,K)
C  COROUTINE OR PROCESS ENCOUNTERED
      GOTO 19
16    CALL OUTPUT(WPRIM,ADRES)
19    CALL SCAN
20    IF (STACK(TOP+3).NE.0) CALL OUTPUT(WARRAY,STACK(TOP+3))
      NEXT=0
      RETURN
      END
      
      SUBROUTINE E5
C  E5 - FUNCTION
C  STACK(TOP+3) - COUNTS NUMBER OF EXTERNAL PARANTHESES PAIRS
C  STACK(TOP+4) - PARAMETR - 0 THERE WAS NO NEW/START
C			     1 NEW
C			     2 START
      IMPLICIT INTEGER (A-Z)
      COMMON /BLANK/
     $	 C0M(4),
     O	 S,	   ADRES,    K,        SCOMA,	 SDOT,	   SEMICOL,
     1	 SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,	   SRELAT,
     2	 SEOF,	   SIDENT,   SCONST,   SAND,	 SARRAY,   SARROF,
     3	 SATTACH,  SBEGIN,   SBLOCK,   SBOOL,	 SCALL,    SCASE,
     4	 SCLASS,   SCLOSE,   SCONS,    SCOPY,	 SCOROUT,  SDETACH,
     5	 SDIM,	   SDO,      SDOWN,    SELSE,	 SEND,	   SESAC,
     6	 SEXIT,    SEXTERN,  SFI,      SFOR,	 SFUNCT,   SIF,
     7	 SINNER,   SINPUT,   SINT,     SKILL,	 SLOCK,    SNEW,
     8	 SNONE,    SNOT,     SOD,      SOR,	 SORIF,    SOTHER,
     9	 SOUTPUT,  SPREF,    SPRCD,    SQUA,	 SREAD,    SRESUME,
     O	 SRETURN,  STEP,     STOP,     STAKEN,	 STHEN,    STHIS,
     A	 STO,	   STYPE,    SUNIT,    SVAR,	 SVIRTUAL, SWAIT,
     B	 SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
     C	 WAND,	   WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
     D	 WCALL,    WCASE,    WCASEL,   WCOMA,	 WCNSTB,   WCNSTC,
     E	 WCNSTI,   WCNSTN,   WCNSTR,   WCNST,	 WCOPY,    WDETACH,
     F	 WDOT,	   WDOWNTO,  WEOF,     WESAC,	 WFIN,	   WFIRST,
     G	 WFOREND,  WFORVAR,  WFROM,    WIDENT,	 WIFFALS,  WIFTRUE

      common /BLANK/
     H	 WINNER,   WINSTREND,WJUMP,    WKILL,	 WLABEL,   WLEFT,
     I	 WLOCK,    WLOW,     WLSE,     WNEW,	 WNEWARRAY,WNOT,
     J	 WOPERAT,  WOPT,     WOR,      WOTHER,	 WPREF,    WPRIM,
     K	 WQUA,	   WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
     L	 WSTART,   WSTEP,    WSTOP,    WTHIS,	 WTO,	   WAIT,
     M	 WRITE,    WRITELN,  WBOUND,   UNICAL,
     N	 COM(132),
     O	 LMEM,	   LPMEM,    IRECN,    ISFIN,	 LPMSYS,   LPML,
     P	 LPMF,	   NRINT,    NRRE,     NRBOOL,	 NRCHAR,   NRCOR,
     Q	 NRPROC,   NRTEXT,   NRUNIV,   NATTR,	 NRNONE,   NBLSYS,
     R	 NBLUS,    NEMPTY,   INSYS,    LOCAL,	 OWN,	   OBJECT,
     $   scaner(8735)
cdsw $	 SCANER(3735),
       common /BLANK/
     Z	 TOP,	   IN,	     NEXT,     STACK(500),
     *	 RESZTA(3652)
     
      GOTO (10,20,30),IN
10    STACK(TOP+3)=0
      CALL OUTPUT(WIDENT,ADRES)
      CALL SCAN
      IF (STACK(TOP+4)-1) 15,13,12
12    CALL OUTPUT(WSTART,-1)
      GOTO 15
13    CALL OUTPUT(WNEW,-1)
15    IF (S.NE.SLEFT) GOTO 1000
      IF (STACK(TOP+3).GE.2) GOTO 1000
C  ANALYSIS OF THE ACTUAL PARAMETER
      CALL OUTPUT(WLEFT,-1)
      CALL SCAN
      CALL SLAD(2,5,2)
      NEXT=4
      RETURN
C  CALL E4 - EXPRESSION
20    IF (S.NE.SCOMA) GOTO 28
22    CALL SCAN
      CALL OUTPUT(WCOMA,-1)
      CALL SLAD(2,5,3)
      NEXT=4
      RETURN
C  NEXT CALL FOR E4
30    IF (S.EQ.SCOMA) GOTO 22
28    IF (S.NE.SRIGHT) CALL ERROR(107)
      IF (S.EQ.SRIGHT) CALL SCAN
      CALL OUTPUT(WRIGHT,-1)
      STACK(TOP+3)=STACK(TOP+3)+1
      GOTO 15
1000  NEXT=0
      RETURN
      END
      
      SUBROUTINE E6
C  RECOGNIZES THE SEQUENCE V1,V2,V3,. . . ,VN:= EXPR
C  OR V1,V2, . . . ,VN := COPY ( OBJECT EXPR. )
C  GENERATES WLSE V1 WLSE . . .  WLSE EXPR /WCOPY/  WASSIGN
      IMPLICIT INTEGER (A-Z)
      COMMON /BLANK/
     $	 C0M(4),
     O	 S,	   ADRES,    K,        SCOMA,	 SDOT,	   SEMICOL,
     1	 SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,	   SRELAT,
     2	 SEOF,	   SIDENT,   SCONST,   SAND,	 SARRAY,   SARROF,
     3	 SATTACH,  SBEGIN,   SBLOCK,   SBOOL,	 SCALL,    SCASE,
     4	 SCLASS,   SCLOSE,   SCONS,    SCOPY,	 SCOROUT,  SDETACH,
     5	 SDIM,	   SDO,      SDOWN,    SELSE,	 SEND,	   SESAC,
     6	 SEXIT,    SEXTERN,  SFI,      SFOR,	 SFUNCT,   SIF,
     7	 SINNER,   SINPUT,   SINT,     SKILL,	 SLOCK,    SNEW,
     8	 SNONE,    SNOT,     SOD,      SOR,	 SORIF,    SOTHER,
     9	 SOUTPUT,  SPREF,    SPRCD,    SQUA,	 SREAD,    SRESUME,
     O	 SRETURN,  STEP,     STOP,     STAKEN,	 STHEN,    STHIS,
     A	 STO,	   STYPE,    SUNIT,    SVAR,	 SVIRTUAL, SWAIT,
     B	 SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
     C	 WAND,	   WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
     D	 WCALL,    WCASE,    WCASEL,   WCOMA,	 WCNSTB,   WCNSTC,
     E	 WCNSTI,   WCNSTN,   WCNSTR,   WCNST,	 WCOPY,    WDETACH,
     F	 WDOT,	   WDOWNTO,  WEOF,     WESAC,	 WFIN,	   WFIRST,
     G	 WFOREND,  WFORVAR,  WFROM,    WIDENT,	 WIFFALS,  WIFTRUE

      common /BLANK/
     H	 WINNER,   WINSTREND,WJUMP,    WKILL,	 WLABEL,   WLEFT,
     I	 WLOCK,    WLOW,     WLSE,     WNEW,	 WNEWARRAY,WNOT,
     J	 WOPERAT,  WOPT,     WOR,      WOTHER,	 WPREF,    WPRIM,
     K	 WQUA,	   WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
     L	 WSTART,   WSTEP,    WSTOP,    WTHIS,	 WTO,	   WAIT,
     M	 WRITE,    WRITELN,  WBOUND,   UNICAL,
     N	 COM(132),
     O	 LMEM,	   LPMEM,    IRECN,    ISFIN,	 LPMSYS,   LPML,
     P	 LPMF,	   NRINT,    NRRE,     NRBOOL,	 NRCHAR,   NRCOR,
     Q	 NRPROC,   NRTEXT,   NRUNIV,   NATTR,	 NRNONE,   NBLSYS,
     R	 NBLUS,    NEMPTY,   INSYS,    LOCAL,	 OWN,	   OBJECT,
     $   scaner(8735)
cdsw $	 SCANER(3735),
      common /BLANK/
     Z	 TOP,	   IN,	     NEXT,     STACK(500),
     *	 RESZTA(3652)

      GOTO (10,20,30,40),IN
10    CALL OUTPUT(WLSE,-1)
      IF (S.NE.SCOMA) GOTO 120
100   CALL SCAN
      CALL SLAD(0,6,2)
      NEXT=3
C  CALL OBJECTEXPRESSION
      RETURN
20    CALL OUTPUT(WLSE,-1)
      IF (S.EQ.SCOMA) GOTO 100
120   IF (S.NE.SBECOME) CALL ERROR(109)
      CALL SCAN
      IF (S.NE.SCOPY) GOTO 130
      CALL SCAN
      IF (S.NE.SLEFT) GOTO 110
      CALL SCAN
      GOTO 111
110   CALL ERROR(106)
111   CALL SLAD(0,6,3)
      NEXT=3
      RETURN
C  CALL OBJECTEXPRESSION  /E3/
30    IF (S.NE.SRIGHT) GOTO 112
      CALL SCAN
      GOTO 113
112   CALL ERROR(107)
113   CALL OUTPUT(WCOPY,WASSIGN)
      NEXT=0
      RETURN
130   CALL SLAD(0,6,4)
      NEXT=1
C  CALL BOOLEXPRESSION
      RETURN
40    CONTINUE
      CALL OUTPUT(WASSIGN,-1)
      NEXT=0
      RETURN
      END
      
      SUBROUTINE E7
      IMPLICIT INTEGER (A-Z)
C
C  RECOGNIZES AN ARITHMETIC EXPRESSION COMPOSED OF CONSTANTS
C
C  LOCAL VARIABLES:
C     STACK(TOP+3) - MULTIPLICATIVE OPERATOR,
C     STACK(TOP+4) - ADDITIVE OPERATOR,
C     STACK(TOP+5) - 1 = UNARY MINUS FLAG.
C
      COMMON /BLANK/
     $	 C0M(4),
     O	 S,	   ADRES,    K,        SCOMA,	 SDOT,	   SEMICOL,
     1	 SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,	   SRELAT,
     2	 SEOF,	   SIDENT,   SCONST,   SAND,	 SARRAY,   SARROF,
     3	 SATTACH,  SBEGIN,   SBLOCK,   SBOOL,	 SCALL,    SCASE,
     4	 SCLASS,   SCLOSE,   SCONS,    SCOPY,	 SCOROUT,  SDETACH,
     5	 SDIM,	   SDO,      SDOWN,    SELSE,	 SEND,	   SESAC,
     6	 SEXIT,    SEXTERN,  SFI,      SFOR,	 SFUNCT,   SIF,
     7	 SINNER,   SINPUT,   SINT,     SKILL,	 SLOCK,    SNEW,
     8	 SNONE,    SNOT,     SOD,      SOR,	 SORIF,    SOTHER,
     9	 SOUTPUT,  SPREF,    SPRCD,    SQUA,	 SREAD,    SRESUME,
     O	 SRETURN,  STEP,     STOP,     STAKEN,	 STHEN,    STHIS,
     A	 STO,	   STYPE,    SUNIT,    SVAR,	 SVIRTUAL, SWAIT,
     B	 SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
     C	 WAND,	   WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
     D	 WCALL,    WCASE,    WCASEL,   WCOMA,	 WCNSTB,   WCNSTC,
     E	 WCNSTI,   WCNSTN,   WCNSTR,   WCNST,	 WCOPY,    WDETACH,
     F	 WDOT,	   WDOWNTO,  WEOF,     WESAC,	 WFIN,	   WFIRST,
     G	 WFOREND,  WFORVAR,  WFROM,    WIDENT,	 WIFFALS,  WIFTRUE

      common /BLANK/
     H	 WINNER,   WINSTREND,WJUMP,    WKILL,	 WLABEL,   WLEFT,
     I	 WLOCK,    WLOW,     WLSE,     WNEW,	 WNEWARRAY,WNOT,
     J	 WOPERAT,  WOPT,     WOR,      WOTHER,	 WPREF,    WPRIM,
     K	 WQUA,	   WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
     L	 WSTART,   WSTEP,    WSTOP,    WTHIS,	 WTO,	   WAIT,
     M	 WRITE,    WRITELN,  WBOUND,   UNICAL,
     N	 COM(132),
     O	 LMEM,	   LPMEM,    IRECN,    ISFIN,	 LPMSYS,   LPML,
     P	 LPMF,	   NRINT,    NRRE,     NRBOOL,	 NRCHAR,   NRCOR,
     Q	 NRPROC,   NRTEXT,   NRUNIV,   NATTR,	 NRNONE,   NBLSYS,
     R	 NBLUS,    NEMPTY,   INSYS,    LOCAL,	 OWN,	   OBJECT,
     $   scaner(8735)
cdsw $	 SCANER(3735),
      common /BLANK/
     Z	 TOP,	   IN,	     NEXT,     STACK(500),
     *	 RESZTA(3652)
     
      GOTO (10,20),IN
10    STACK(TOP+3)=0
      STACK(TOP+4)=0
      STACK(TOP+5)=0
      IF (S.NE.STAR) GOTO 100
      IF (ADRES.EQ.4) GOTO 82
      IF (ADRES.EQ.3) GOTO 85
C			   MOD, DIV, * ALBO /
      CALL ERROR(126)
C			   MINUS (-) OCCURRS BEFORE EXPRESSION
82    STACK(TOP+5)=1
C			   PLUS (+) BEFORE EXPRESSION - IGNORE IT
85    CALL SCAN
C			   MAIN LOOP
100   IF (S.EQ.SLEFT) GOTO 120
      IF (S.EQ.SIDENT) GOTO 110
      IF (S.NE.SCONST) GOTO 1000
C			   CONSTANT - TYPE STILL UNKNOWN
      GOTO (1000,1000,101,102,103,102),K
C			   INTEGER (K=3)
101   CALL OUTPUT(WCNSTI,ADRES)
      GOTO 179
C			   TEXT (K=4) OR CHAR (K=6)
102   CALL ERROR(115)
      CALL OUTPUT(WCNSTI,0)
      GOTO 179
C			   REAL (K=5)
103   CALL OUTPUT(WCNSTR,ADRES)
      GOTO 179
C			   IDENTIFIER ENCOUNTERED
110   CALL OUTPUT(WIDENT,ADRES)
      GOTO 179
C			   LEFT PARANTHESIS ENCOUNTERED (RECURRENCE)
120   CALL SCAN
      CALL SLAD(3,7,2)
      NEXT=12
      RETURN
C			   RECURSIVE CALL OF E12 TO ANALYSE THE
C			   SUBEXPRESSION
20    IF (S.EQ.SRIGHT) GOTO 179
      CALL ERROR(107)
      GOTO 1000
C------------- END OF THE MAIN LOOP
179   CALL SCAN
180   IF (STACK(TOP+5).EQ.0) GOTO 185
C			   MINUS BEFORE EXCPRESSION
      CALL OUTPUT(WOPERAT,2)
      STACK(TOP+5)=0
185   IF (STACK(TOP+3).NE.0) CALL OUTPUT(WOPERAT,STACK(TOP+3))
      STACK(TOP+3)=0
      IF (S.NE.STAR) GOTO 190
      IF (ADRES.LT.5) GOTO 190
C			   MOD, DIV, * OR / - NEXT FACTOR EXPECTED
      STACK(TOP+3)=ADRES
      GOTO 85
190   IF (STACK(TOP+4).NE.0) CALL OUTPUT(WOPERAT,STACK(TOP+4))
      STACK(TOP+4)=0
      IF (S.NE.STAR) GOTO 1000
      IF (ADRES.LT.2) GOTO 1000
C			   + OR - (MINUS) - NEXT COMPONENT EXPECTED
      STACK(TOP+4)=ADRES
      GOTO 85
1000  NEXT=0
      RETURN
      END
      
      SUBROUTINE E8
C
C  RECOGNIZES THE SEQUENCE OF INSTRUCTIONS UNTIL A TERMINAL SYMBOL
C  THE PARAMETER IS PASSED BY  STACK(TOP+7)
C
C    STACK(TOP+3)
C    STACK(TOP+4)  -  NUMBERS OF THE GENERATED LABELS
C      . . .	   OTHERS
C    STACK(TOP+7)  -  A INPUT PARAMETER WHICH DETERMINES THE SET OF THE
C		      TERMINAL SYMBOLS
C	   MEANING:
C		      1 - INSTRUCTIONS UNTIL WHEN/OTHERS/END
C		      2 - .................. ELSE/FI
C		      3 - .................. FI
C		      4 - .................. OD
C		      5 - .................. END
C		      6 - .................. WHEN/OTHERWISE/ESAC
C		      7 - .................. ESAC
C
      IMPLICIT INTEGER (A-Z)
      logical errflg
      COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
     X		      POSIT,RECNR,NEKST
      COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,JNK(266)
      COMMON /BLANK/
     $	 C0M(4),
     O	 S,	   ADRES,    K,        SCOMA,	 SDOT,	   SEMICOL,
     1	 SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,	   SRELAT,
     2	 SEOF,	   SIDENT,   SCONST,   SAND,	 SARRAY,   SARROF,
     3	 SATTACH,  SBEGIN,   SBLOCK,   SBOOL,	 SCALL,    SCASE,
     4	 SCLASS,   SCLOSE,   SCONS,    SCOPY,	 SCOROUT,  SDETACH,
     5	 SDIM,	   SDO,      SDOWN,    SELSE,	 SEND,	   SESAC,
     6	 SEXIT,    SEXTERN,  SFI,      SFOR,	 SFUNCT,   SIF,
     7	 SINNER,   SINPUT,   SINT,     SKILL,	 SLOCK,    SNEW,
     8	 SNONE,    SNOT,     SOD,      SOR,	 SORIF,    SOTHER,
     9	 SOUTPUT,  SPREF,    SPRCD,    SQUA,	 SREAD,    SRESUME,
     O	 SRETURN,  STEP,     STOP,     STAKEN,	 STHEN,    STHIS,
     A	 STO,	   STYPE,    SUNIT,    SVAR,	 SVIRTUAL, SWAIT,
     B	 SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
     C	 WAND,	   WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
     D	 WCALL,    WCASE,    WCASEL,   WCOMA,	 WCNSTB,   WCNSTC,
     E	 WCNSTI,   WCNSTN,   WCNSTR,   WCNST,	 WCOPY,    WDETACH,
     F	 WDOT,	   WDOWNTO,  WEOF,     WESAC,	 WFIN,	   WFIRST,
     G	 WFOREND,  WFORVAR,  WFROM,    WIDENT,	 WIFFALS,  WIFTRUE

      common /BLANK/
     H	 WINNER,   WINSTREND,WJUMP,    WKILL,	 WLABEL,   WLEFT,
     I	 WLOCK,    WLOW,     WLSE,     WNEW,	 WNEWARRAY,WNOT,
     J	 WOPERAT,  WOPT,     WOR,      WOTHER,	 WPREF,    WPRIM,
     K	 WQUA,	   WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
     L	 WSTART,   WSTEP,    WSTOP,    WTHIS,	 WTO,	   WAIT,
     M	 WRITE,    WRITELN,  WBOUND,   UNICAL,
     N	 COM(132),
     O	 LMEM,	   LPMEM,    IRECN,    ISFIN,	 LPMSYS,   LPML,
     P	 LPMF,	   NRINT,    NRRE,     NRBOOL,	 NRCHAR,   NRCOR,
     Q	 NRPROC,   NRTEXT,   NRUNIV,   NATTR,	 NRNONE,   NBLSYS,
     R	 NBLUS,    NEMPTY,   INSYS,    LOCAL,	 OWN,	   OBJECT,
     $   scaner(8735)
cdsw $	 SCANER(3735),
      common /BLANK/
     Z	 TOP,	   IN,	     NEXT,     STACK(500),
     *	 RESZTA(3652)
     
cdsw  EQUIVALENCE (AUX,SCANER(3698))
      EQUIVALENCE (AUX,SCANER(8698))
      EQUIVALENCE (WSTART,WUNLOCK)
C*******************************************************************
C*** NOTE **********************************************************
C*** SMAIN HAS TO BE INSERTED INTO THE BLANK COMMON ON OCCASION  ***
C*** OF SOME OTHER CHANGES *********************** 10/11/1981 ******
C*** WSTART SHOULD BE CHANGED TO WUNLOCK ***************************
C*******************************************************************
      smain = 96
      wind = 69
      wwlock = 66
      wwunlock = 67
      sothrs = 57
      wwread = 73
      wreadl = 74
      wioend = 50
      wopen1 = 77
      wopen2 = 78
      wput = 75
      wget = 76
      wparin = 81
      wassem = 84
      wputrec = 89
      wgetrec = 90
cbc added concurrent statements
      wenab = 91
      wdisab = 92
      waccep = 93
      wprend = 94
      senab = 35
cbc

      GOTO (10,20,30,40,50,60,70,80,90,100,110,120,130,140,150,160,
     X170,180,190,200,210,220,230,240,250,260,270,280,290,300,310,
     x320,330,340,350,360,370,380),in
cdsw x320,330,340,350),in
cfileX320,330,340),IN
C  CHECK WHETHER SYMBOL S MAY START AN INSTRUCTION
6     CALL ERROR(102)
8     CALL SCAN
cbc 10    if(s.gt.34) go to 1111
10    if (s .gt. 36) goto 1111
      IF (S.GT.0) GOTO 15
      CALL ERROR(102)
      GOTO 999
15    IF (AUX.NE.0) CALL SELOPT
      CALL OUTPUT(WINSTREND,LN)
      GOTO (101,201,301,401,501,601,701,801,901,1001,1101,1201,1301
     1,1401,1501,1601,1701,1801,1901,2001,2101,2201,2301,101,2501
     2,2601,2701,2801,2901,3001,3101,3201,3301,3401,3501,3601),s
cbc  2,2601,2701,2801,2901,3001,3101,3201,3301,3401),s
C----- S = SIDENT  -  ASSIGNMENT STATEMENT OR OBJECT GENERATOR
101   CONTINUE
      CALL SLAD(5,8,12)
      NEXT=3
C  CALL OBJECT EXPRESSION /E3/ TO ANALYSE THE VARIABLE
      GO TO 7766
120   CONTINUE
      IF (S.EQ.SEMICOL) GOTO 125
      IF (S.EQ.SBECOME) GOTO 111
      IF (S.EQ.SCOMA) GOTO 111
      GOTO 1111
C  INITIAL FRAGMENT OF AN ASSIGNMENT STATEMENT HAS BEEN RECOGNIZED
111   CALL SLAD(5,8,2)
      NEXT=6
      GO TO 7766
C  CALL ASSIGNMENT  /E6/
C  RETURN TO LABEL 20 BELOW
C   /JUMP OPTIMIZATION/
C
C   < VARIABLE	> ; IS RECOGNIZED
C  CHECK FOR A PENDING NEW OR START
125   IF (STACK(TOP+15).EQ.0) CALL ERROR(123)
      GOTO 1000
C----- S = IF	INSTRUCTION: IF EXPR. THEN INSTR. ( ELSE INSTR. ) FI
C  STACK(TOP+5)=0 THERT WAS NO ORIF/ANDIF
C	       =1 THERE WAS ANDIF
C	       =2 THERE WAS ORIF
C  STACK(TOP+4) - LABEL BEHIND THEN OR ELSE
C		  DEPENDING ON THE CONTENTS OF STACK(TOP+5)
C  STACK(TOP+3) - USED TO COUN EXITS FOR THE SEQUENCES:I IF EXPR. THEN EXIT..
201   STACK(TOP+5)=0
      STACK(TOP+4)=UNICAL
      UNICAL=UNICAL+1
202   CALL SCAN
      CALL SLAD(5,8,3)
      NEXT=1
      GO TO 7766
C  CAL BOOLEXPRESSION  /E1/
30    IF (S.EQ.SORIF) GOTO 203
      IF (S.EQ.STHEN) GOTO 204
      CALL ERROR(103)
      CALL OUTPUT(WLABEL,STACK(TOP+4))
      GOTO 1000
C  CALL ORIF
203   IF (STACK(TOP+5).EQ.0) STACK(TOP+5)=ADRES
      IF (STACK(TOP+5).NE.ADRES) CALL ERROR(140)
      CALL OUTPUT(WIDENT+ADRES,STACK(TOP+4))
C IF ANDIF THEN ADRES=1 & WIDENT+ADRES=WIFFALS
C IF ORIF  THEN ADRES=2 & WIDENT+ADRES=WIFTRUE
      GOTO 202
204   CALL SCAN
C  THEN ENCOUNTERED, CHECK IF THERE WAS ORIF OR ANDIF
      IF (STACK(TOP+5).EQ.2) GOTO 215
      IF (STACK(TOP+5).EQ.1) GOTO 214
      STACK(TOP+3)=0
205   IF (S.NE.SEXIT) GOTO 207
C  EXIT/REPEAT ENCOUNTERED
      STACK(TOP+3)=STACK(TOP+3)+1
      IF (ADRES.EQ.2) GOTO 206
      CALL SCAN
      GOTO 205
C  (EXIT)+ REPEAT ENCOUNTERED
206   CALL OUTPUT(WIFTRUE,EXYT(STACK(TOP+3),0))
      CALL SCAN
      GOTO 208
C  S =/= EXIT
207   IF (STACK(TOP+3).EQ.0) GOTO 214
      CALL OUTPUT(WIFTRUE,EXYT(STACK(TOP+3),1))
C  IF EXPR. THEN  (EXIT)+ REPEAT
208   IF (S.EQ.SFI) GOTO 999
      IF (S.EQ.SELSE) GOTO 211
      IF (S.NE.SEMICOL) GOTO 209
      CALL SCAN
      GOTO 208
C  THERE ARE INSTRUCTIONS BEHIND EXIT
209   CALL ERROR(139)
      CALL SLAD(5,8,29)
      NEXT=8
      STACK(TOP+7)=2
      GO TO 7766
C  CALL E8 TO ANALYSE A SEQUENCE OF STATEMENTS ENDED BY ELSE OR FI
290   IF (S.NE.SELSE) GOTO 999
211   CALL SCAN
      CALL SLAD(5,8,30)
      NEXT=8
      STACK(TOP+7)=3
      GO TO 7766
C  CALL E8 TO ANALYSE INMSTRUCTIONS AFTER ELSE
300   IF (S.EQ.SFI) GOTO 999
C  A MISSING "FI" IS DIAGNOSED IN SOME OTHER PLACE. HERE WE JUMP TO 1000
C  TO AVOID READING OF THE NEXT INPUT SYMBOL
      GOTO 1000
C
C  ANALYSIS FOR IF EXPR. THEN ......
214   STACK(TOP+3)=STACK(TOP+4)
      CALL OUTPUT(WIFFALS,STACK(TOP+3))
      GOTO 217
C  ORIF OCCURRED, A LABEL (FOR ELSE OR FI) HAS TO BE RESERVED
215   STACK(TOP+3)=UNICAL
      UNICAL=UNICAL+1
      CALL OUTPUT(WIFFALS,STACK(TOP+3))
      CALL OUTPUT(WLABEL,STACK(TOP+4))
217   CALL SLAD(5,8,4)
      NEXT=8
      STACK(TOP+7)=2
C  A VALUE IS ASSIGNED TO THE PARAMETER OF E8
      GO TO 7766
C  ANALYSIS AFTER THEN
40    IF (S.EQ.SELSE) GOTO 241
      IF (S.NE.SFI) GOTO 271
C  A "FI" UNPRECEDED BY "ELSE"
221   CALL OUTPUT(WLABEL,STACK(TOP+3))
      GOTO 999
C  ELSE ENCOUNTERED, WE SHOULD RESERVE A LABEL TO JUMP BEHIND FI
241   STACK(TOP+4)=UNICAL
      UNICAL=UNICAL+1
      CALL SCAN
      CALL OUTPUT(WJUMP,STACK(TOP+4))
      CALL OUTPUT(WLABEL,STACK(TOP+3))
      CALL SLAD (5,8,5)
      NEXT=8
      STACK(TOP+7)=3
C  PARAMETER FOR E8
      GO TO 7766
C  ANALYSIS OF INSTRUCTIONS AFTER ELSE
50    IF (S.NE.SFI) GOTO 271
      CALL OUTPUT(WLABEL,STACK(TOP+4))
      GOTO 999
271   CALL ERROR(104)
      GOTO 1000
C----- S = WHILE
301   STACK(TOP+3)=UNICAL
      STACK(TOP+4)=UNICAL+1
C  RESERVATION OF LABELS:
C     STACK(TOP+3) - BEGINNING OF THE LOOP (THE BOOLEAN CONDITION)
C     STACK(TOP+4) - END OF THE LOOP
      UNICAL=UNICAL+2
      CALL SCAN
      CALL OUTPUT(WLABEL,STACK(TOP+3))
      CALL OUTPUT(WINSTREND,LN)
      CALL SLAD(5,8,6)
      NEXT=1
      GO TO 7766
C  CALL BOOLEXPRESSION	/E1/
60    CALL OUTPUT(WIFFALS,STACK(TOP+4))
C  CONDITIONAL JUMP BEHIND DO
      IF (S.EQ.SDO) GOTO 307
      CALL ERROR(108)
      GOTO 309
307   CALL SCAN
309   CONTINUE
      CALL SLAD(5,8,7)
      NEXT=8
      STACK(TOP+7)=4
C  PARAMETER PASSING
      GO TO 7766
C  ANALYSIS OF THE INTERIOR OF THE DO LOOP  /E8/
70    CALL OUTPUT(WJUMP,STACK(TOP+3))
C  JUMP TO THE BEGINNING OF THE LOOP
      CALL OUTPUT(WLABEL,STACK(TOP+4))
      IF (S.EQ.SOD) GOTO 999
      CALL ERROR(105)
      GOTO 1000
C----- S = RETURN
401   CALL OUTPUT(WRETURN,-1)
cbc added enable/disable option
      call scan
405   if (s .ne. senab) goto 415
      call output(wenab+adres-1, -1)
410   call scan
      if (s .ne. sident) goto 420
      call output(wident, adres)
      call scan
      if (s .eq. scoma) goto 410
      goto 405
415   call output(wprend, -1)
      goto 1000
420   call error(109)
      goto 1000
cbc end
C----- S = DETACH
501   CALL OUTPUT(WDETACH,-1)
      GOTO 999
C----- S = INNER
601   CALL OUTPUT(WINNER,-1)
      GOTO 999
C----- S = LOCK
701   STACK(TOP+3)=6
C  FURTHER ANALYSIS AS FOR KILL, RESUME, ETC.
      GOTO 1302
C----- S = READ
801   CALL SCAN
      STACK(TOP+3)=0
C     STACK(TOP+3)=   0  - READ
C		      1  - READLN
      IF (S.EQ.SLEFT) GOTO 803
      CALL ERROR(106)
      GOTO 804
803   CALL SCAN
804   CALL SLAD(5,8,9)
      NEXT=3
      GO TO 7766
C  CALL OBJECTEXPRESSION FOR READ( VARIABLE, . . . ,VARIABLE )
90    CALL OUTPUT(WWREAD,-1)
C  CHECK IF END OF THE READ LIST
      IF (S.EQ.SCOMA) GOTO 803
808   IF (S.EQ.SRIGHT) GOTO 810
      CALL ERROR(107)
      GOTO 812
810   CALL SCAN
812   IF (STACK(TOP+3).GT.0) CALL OUTPUT(WREADL,-1)
      CALL OUTPUT(WIOEND,-1)
      GOTO 1000
C----- S= CALL
901   CALL SCAN
      STACK(TOP+3)=0
C
C  STACK(TOP+3) - 0 - CALL
C		  1 - RAISE
C
C --- ADDED CHECK FOR STHIS AND SNEW
      IF (S.EQ.SIDENT.OR.S.EQ.STHIS.OR.S.EQ.SNEW) GOTO 905
C ---
      CALL ERROR(109)
      GOTO 1000
905   CALL SLAD(5,8,10)
      NEXT=3
      GO TO 7766
C  CALL OBJECTEXPRESSION TO ANALYSE THE EXPRESSION
C  WRITE WCALL OR WRAISE DEPENDING ON THE CONTENTS OF STACK(TOP+3)
100   CALL OUTPUT(WCALL+STACK(TOP+3)*64,-1)
      GOTO 1000
C----- S = KILL
1001  STACK(TOP+3)=1
      GOTO 1302
C----- S = ATTACH
1101  STACK(TOP+3)=2
      GOTO 1302
C----- S = RESUME
1201  STACK(TOP+3)=3
      GOTO 1302
C----- S = STOP
1301  STACK(TOP+3)=4
C  THE MEANING OF STACK(TOP+3):
C    1 - KILL
C    2 - ATTACH
C    3 - RESUME
C    4 - STOP
C    5 - WAIT
C    6 - LOCK
C    7 - UNLOCK
      CALL SCAN
      IF (S.EQ.SLEFT) GOTO 1303
C  STOP WITHOUT PARAMETER
      CALL OUTPUT(WSTOP,-1)
      GOTO 1000
1302  CALL SCAN
      IF (S.EQ.SLEFT) GOTO 1303
      CALL ERROR(106)
      GOTO 1304
1303  CALL SCAN
1304  IF (S.EQ.SMAIN) GOTO 1320
      CALL SLAD(5,8,11)
      NEXT=3
      GO TO 7766
C  CALL OBJECTEXPRESSION. /E3/ TO ANALYSE THE EXPRESSION AFTER
C  KILL, ATTACH, RESUME, STOP, WAIT, LOCK
110   IF (S.EQ.SRIGHT) GOTO 1305
      CALL ERROR(107)
      GOTO 1306
1305  CALL SCAN
C  JUMP ACCORDING TO THE PREVIOUSLY RECOGNIZED STATEMENT TYPE
1306  K=STACK(TOP+3)
      GOTO (1307,1308,1309,1310,1311,1312,1313),K
1307  CALL OUTPUT(WKILL,-1)
      GOTO 1000
1308  CALL OUTPUT(WATTACH,-1)
      GOTO 1000
1309  CALL OUTPUT(WRESUME,-1)
      GOTO 1000
1310  CALL OUTPUT(WSTOP,-1)
      GOTO 1000
1311  CALL OUTPUT(WAIT,-1)
      GOTO 1000
1312  CALL OUTPUT(WWLOCK,-1)
      GOTO 1000
1313  CALL OUTPUT(WWUNLOCK,-1)
      GOTO 1000
C  MAIN ENCOUNTERED, CHECK IF THE CONTEXT IS RESUME/ATTACH
1320  IF (STACK(TOP+3).EQ.2) GOTO 1330
      IF (STACK(TOP+3).EQ.3) GOTO 1340
      CALL ERROR(131)
      GOTO 1345
C  RECOGNIZED ATTACH(MAIN)
1330  CALL OUTPUT(WIDENT,K)
      CALL OUTPUT(WATTACH,-1)
      GOTO 1345
1340  CALL OUTPUT(WIDENT,K)
      CALL OUTPUT(WRESUME,-1)
1345  CALL SCAN
      IF (S.EQ.SRIGHT) GOTO 999
      CALL ERROR(107)
      GOTO 1000
C----- S = DO
C  STACK(TOP+3) - LABEL OF THE BEGINNING OF THE LOOP BODY
C  STACK(TOP+4) - LABEL OF THE FIRST STATEMENT BEHIND THE LOOP BODY
1401  STACK(TOP+3)=UNICAL
      STACK(TOP+4)=UNICAL+1
      UNICAL=UNICAL+2
      CALL SCAN
      CALL OUTPUT(WLABEL,STACK(TOP+3))
      CALL SLAD(5,8,13)
      STACK(TOP+7)=4
      NEXT = 8
      GO TO 7766
C  CALL E8 (INSTRUCTION) WITH PARAMETER 4
130   CALL OUTPUT(WINSTREND,LN)
      CALL OUTPUT(WJUMP,STACK(TOP+3))
      CALL OUTPUT(WLABEL,STACK(TOP+4))
      IF (S.EQ.SOD) GOTO 999
      CALL ERROR(105)
      GOTO 1000
C----- S = EXIT
1501  STACK(TOP+3)=0
1505  STACK(TOP+3)=STACK(TOP+3)+1
      IF (ADRES.EQ.2) GOTO 1550
      CALL SCAN
      IF (S.EQ.SEXIT) GOTO 1505
      CALL OUTPUT(WJUMP,EXYT(STACK(TOP+3),1))
      GOTO 1000
1550  CALL OUTPUT(WJUMP,EXYT(STACK(TOP+3),0))
      GOTO 999
C----- S =   CASE
1601  STACK(TOP+3)=UNICAL+1
      STACK(TOP+4)=UNICAL+162
      STACK(TOP+5)=1
      STACK(TOP+6)=1
      UNICAL=UNICAL+163
C
C  STACK(TOP+3) - BASIC CASE LABEL, NOT USED
C  STACK(TOP+4) - END LABEL OF THE CASE STATEMENT
C  STACK(TOP+5) - COUNTER OF WHEN'S (NUMBER OF WHEN'S LIMITED BY 160)
C  STACK(TOP+6) - 0 = OVERFLOW FLAG (TOO MANY WHEN'S)
C  NOTE:  THE BASIC LABEL IS RESERVED ESPECIALLY FOR AIL, NOT USED IN HERE.
C	  LABELS FOR WHEN'S ARE OF THE FORM: BASIS + I ,  WHERE  I = 1 .. 160
C	  TOTAL NUMBER OF RESERVED LABELS IS 163.
C
      CALL SCAN
      CALL SLAD(5,8,26)
      NEXT=2
      GO TO 7766
C  CALL E2 - ARITHEXPRESSION TO ANALYSE THE EXPRESSION AFTER CASE
260   CALL OUTPUT(WCASE,STACK(TOP+3))
      IF (S.EQ.SWHEN) GOTO 1605
      CALL ERROR(132)
      GOTO 1607
1605  CALL SCAN
C  RECOGNITION OF THE SELECTION LABEL
1607  IF (STACK(TOP+6).EQ.0) GOTO 1621
      IF (S.EQ.SIDENT) GOTO 1610
      IF (S.EQ.SCONST) GOTO 1615
1608  CALL ERROR(117)
      CALL OUTPUT(WIDENT,0)
      GOTO 1620
C  IDENTIFIER RECOGNIZED
1610  CALL OUTPUT(WIDENT,ADRES)
      GOTO 1620
C  CONSTANT RECOGNIZED
1615  IF (K.EQ.6) GOTO 1618
      IF (K.NE.3) GOTO 1608
C  INTEGER CONSTANT
      CALL OUTPUT(WCNSTI,ADRES)
      GOTO 1620
C  CHARACTER CONSTANT
1618  CALL OUTPUT(WCNSTC,ADRES)
1620  CALL OUTPUT(WCASEL,STACK(TOP+3)+STACK(TOP+5))
1621  CALL SCAN
      IF (S.EQ.SCOLON) GOTO 1625
      IF (S.NE.SCOMA)  GOTO 1623
C  COMA ENCOUNTERED - FURTHER LABEL LIST EXPECTED
      CALL SCAN
      GOTO 1607
C  NEITHER SEMICOLON NOR COMMA (ERROR AND WE CONTINUE AS FOR
C  SEMICOLON - INSTRUCTIONS)
1623  CALL ERROR(118)
      GOTO 1626
C  SEMICOLON ENCOUNTERED - INSTRUCTIONS ARE TO BE ANALYSED
1625  CALL SCAN
1626  IF (STACK(TOP+5).NE.161) GOTO 1627
C  TO MANY WHEN'S
      CALL ERROR(133)
      STACK(TOP+6)=0
      GOTO 1628
1627  CALL OUTPUT(WLABEL,STACK(TOP+3)+STACK(TOP+5))
      STACK(TOP+5)=STACK(TOP+5)+1
1628  CALL SLAD(5,8,27)
      NEXT=8
      STACK(TOP+7)=6
      GO TO 7766
C  CALL E8 TO ANALYSE THE INSTRUCTION LIST ENDED BY WHEN, OTHERWISE
C  OR ESAC (PARAMETER = 6)
270   CALL OUTPUT(WJUMP,STACK(TOP+4))
      IF (S.EQ.SWHEN) GOTO 1605
      IF (S.NE.SOTHER) GOTO 1655
C  OTHERWISE ENCOUNTERED
      CALL OUTPUT(WOTHER,-1)
      CALL SCAN
      CALL SLAD (5,8,28)
      NEXT=8
      STACK(TOP+7)=7
      GO TO 7766
C  CALL E8 TO ANALYSE THE INSTRUCTION SEQUENCE ENDED BY ESAC (PARAMETER=7)
C  AFTER RETURN JUMP BEHIND CASE IS NOT TO BE GENERATED
280   CONTINUE
C  ESAC ENCOUNTERED (A MISSING ESAC IS DIAGNOSED ON SOME OTHER LEVEL).
C  HERE, TO PROVIDE CODE CONSISTENCY, WE ASSUME THAT AN ESAC HAS OCCURRED
C  ANYWAY.
1655  CALL OUTPUT(WESAC,-1)
      CALL OUTPUT(WLABEL,STACK(TOP+4))
      IF (S.EQ.SESAC) GOTO 999
      CALL ERROR(129)
      GOTO 1000
C----- S = FOR
1701  CALL SCAN
      CALL SLAD(5,8,21)
      NEXT=3
      GO TO 7766
C  CALL E3 T OANALYSE THE VARIABLE
210   CALL OUTPUT(WFORVAR,-1)
      IF (S.EQ.SBECOME) GOTO 1703
      CALL ERROR(101)
      GOTO 1000
1703  CALL SCAN
      CALL SLAD(5,8,22)
      NEXT=2
      GO TO 7766
C  CALL E2 - ARITHEXPRESSION TO ANALYSE BOUNDS
220   CALL OUTPUT(WFROM,-1)
      IF (S.NE.STEP) GOTO 1705
      CALL SCAN
      CALL SLAD(5,8,23)
      NEXT=2
      GO TO 7766
C  CALL E2 TO ANALYZE THE STEP
230   CALL OUTPUT(WSTEP,-1)
1705  IF (S.EQ.STO) GOTO 1707
      IF (S.EQ.SDOWN) GOTO 1709
      CALL ERROR(125)
      GOTO 1000
C  STACK(TOP+3)=0 IFF "TO" ENCOUNTERED, OTHERWISE -1 STANDS FOR "DOWNTO"
1707  STACK(TOP+3)=0
      GOTO 1711
1709  STACK(TOP+3)=1
1711  CALL SCAN
      CALL SLAD(5,8,24)
      NEXT=2
      GO TO 7766
C  CALL E2 TO ANALYSE BOUNDS OF THE FOR LOOP
240   IF (STACK(TOP+3).EQ.1) GOTO 1713
      CALL OUTPUT(WTO,-1)
      GOTO 1715
1713  CALL OUTPUT(WDOWNTO,-1)
C   STACK(TOP+3) LABEL OF THE END OF THE LOOP (BEFORE OD!)
C   STACK(TOP+4) LABEL OF THE FIRST INSTRUCTION BEHIND THE LOOP
C   STACK(TOP+5) LABEL OF THE BEGINNING OF THE LOOP
1715  STACK(TOP+3)=UNICAL
      STACK(TOP+4)=UNICAL+1
      STACK(TOP+5)=UNICAL+2
      UNICAL=UNICAL+3
      CALL OUTPUT(STACK(TOP+5),STACK(TOP+4))
      IF (S.EQ.SDO) GOTO 1717
      CALL ERROR(108)
      GOTO 1000
1717  CALL SCAN
      CALL SLAD(5,8,25)
      STACK(TOP+7)=4
      NEXT=8
      GO TO 7766
C  CALL E8 TO ANALYSE THE INSTRUCTION SEQUENCE
C  WITH PARAMETER = 4, I.E. "OD" IS THE TERMINAL SYMBOL
250   CALL OUTPUT(WLABEL,STACK(TOP+3))
      CALL OUTPUT(WFOREND,-1)
      CALL OUTPUT(WJUMP,STACK(TOP+5))
      CALL OUTPUT(WLABEL,STACK(TOP+4))
      IF (S.EQ.SOD) GOTO 999
      CALL ERROR(105)
      GOTO 1000
C----- S = ARRAY
1801  CALL SCAN
      CALL SLAD(5,8,18)
      NEXT=3
      GO TO 7766
C  CALL E3 TO ANALYSE THE VARIABLE
180   IF (S.EQ.SDIM) GOTO 1810
      CALL ERROR(124)
      GOTO 1000
1810  CALL SCAN
      IF (S.EQ.SLEFT) GOTO 1820
      CALL ERROR(106)
      GOTO 1000
1820  CALL OUTPUT(WLSE,-1)
      CALL SCAN
      CALL SLAD(5,8,19)
      NEXT=2
      GO TO 7766
C  CALL E2 - ARITHEXPRESSION TO ANALYSE BOUNDS OF THE "FOR"
190   CALL OUTPUT(WLOW,-1)
      IF (S.EQ.SCOLON) GOTO 1830
      CALL ERROR(118)
      GOTO 1000
1830  CALL SCAN
      CALL SLAD(5,8,20)
      NEXT=2
      GO TO 7766
C  CALL E2 - ARITHEXPRESSION
200   CALL OUTPUT(WNEWARRAY,-1)
      IF (S.EQ.SRIGHT) GOTO 999
      CALL ERROR(107)
      GOTO 1000
C----- S = WRITE
1901  STACK(TOP+6)=0
      CALL SCAN
      IF (S.EQ.SLEFT) GOTO 2003
      CALL ERROR(106)
      GOTO 1000
C----- S = WRITELN
2001  STACK(TOP+6)=1
C  STACK(TOP+6) - 0 - THERE WAS WRITE, 1 - THERE WAS WRITELN
      CALL SCAN
C  CHECK IF THERE ARE PARAMETERS OF WRITELN
      IF (S.EQ.SLEFT) GOTO 2003
      CALL OUTPUT(WRITELN,WIOEND)
      GOTO 1000
2003  CALL SCAN
      CALL SLAD(5,8,16)
      NEXT=4
      GO TO 7766
C  CALL E4 - EXPRESSION TO ANALYSE PARAMETERS OF WRITE(LN)N
C  STACK(TOP+5) - INCLUDES NUMBER OF THE EXPRESSIONS USED TO DESCRIBE
C		  THE OUTPUT FORMAT
160   STACK(TOP+5)=0
170   IF (S.NE.SCOLON) GOTO 2010
      STACK(TOP+5)=STACK(TOP+5)+1
      IF (STACK(TOP+5).GT.2)  GOTO 2015
      CALL SCAN
      CALL SLAD(5,8,17)
      NEXT=2
      GO TO 7766
C  CALL ARITHEXPRESSION TO ANALYSE FORMATS
C  RETURN TO LABEL 170 (OPTIMIZATION)
2010  CALL OUTPUT(WRITE,STACK(TOP+5))
C  CHECK FOR END OF WRITE / WRITELN
      IF (S.EQ.SCOMA) GOTO 2003
      IF (S.EQ.SRIGHT) GOTO 2020
2015  CALL ERROR(107)
      GOTO 1000
C  WRITE INFORMATION ABOUT THE OCCURRENCE OF WRITELN
2020  IF (STACK(TOP+6).EQ.1) CALL OUTPUT(WRITELN,-1)
      CALL OUTPUT(WIOEND,-1)
      GOTO 999
C----- S = WAIT
2101  STACK(TOP+3)=5
C  ANALYSIS OF WAIT AS FOR KIL, RESUME, AND SO ON.
      GOTO 1302
C----- S = BLOCK
2201  STACK(TOP+5)=0
      CALL OUTPUT(WBLOCK,ISFIN)
C  STACK(TOP+5) INCLUDES PREFIX ADDRESS, HERE 0 FOR REGULAR BLOCK,
C  JUMP OUT - FURTHER ANALYSIS AS FOR A PREFIXED BLOCK
      GOTO 2310
C----- S = PREF
2301  CALL SCAN
      IF (S.EQ.SIDENT) GOTO 2302
      CALL ERROR(109)
      GOTO 1000
C  PREFIX ENCOUNTERED - STORE ITS ADDRESS INTO STACK(TOP+5)
2302  STACK(TOP+5)=ADRES
      CALL OUTPUT(WPREF,ISFIN)
      CALL SCAN
      IF (S.EQ.SBLOCK) GOTO 2310
      IF (S.EQ.SLEFT) GOTO 2303
      CALL ERROR(122)
      GOTO 1000
C  ANALYSIS OF THE PARAMETERS OF THE PREFIX
2303  CALL OUTPUT(WLEFT,-1)
2304  CALL SCAN
      CALL SLAD(5,8,14)
      NEXT=4
      GO TO 7766
C  CALL E4 - EXPRESSION TO ANALYSE THE ACTUAL PARAMETERS
C  OF THE PREFIX
140   IF (S.EQ.SCOMA) GOTO 2305
      IF (S.EQ.SRIGHT)GOTO 2306
      CALL ERROR(107)
      GOTO 1000
2305  CALL OUTPUT(WCOMA,-1)
      GOTO 2304
2306  CALL SCAN
      CALL OUTPUT(WRIGHT,-1)
C  COMMON ANALYSIS FOR ALL BLOCKS
C  POSITIONS ARE STORED INTO THE INTERMEDIATE CODE
2310  CALL MARK(STACK(TOP+3),STACK(TOP+4))
      STACK(TOP+6)=UNICAL
      NEXT=STACK(TOP+5)
      CALL SLAD(5,8,15)
      STACK(TOP+4)=NEXT
C  ASSIGNMENT OF THE PARAMETER'S VALUE - BLOCK PREFIX
      NEXT=11
      GO TO 7766
C  CALL E11 TO ANALYSE THE ENTIRE BLOCK
C  AFTER RETURN WE RECLAIM THE PLACE FROM WHICH THE INTERMEDIATE CODE FOR
C  THE GIVEN BLOCK IS TO BE CONTINUED
150   CALL FIND(STACK(TOP+3),STACK(TOP+4))
      UNICAL=STACK(TOP+6)
      CALL OPTOUT
      GOTO 1000
C----- S = UNLOCK
2501  STACK(TOP+3)=7
C  FURTHER ANALYSIS AS FOR KILL, RESUME, ETC.
      GOTO 1302
C----- S = RAISE
2601  STACK(TOP+3)=1
      CALL SCAN
      IF (S.EQ.SIDENT) GOTO 905
C  FURTHER ANALYSIS AS FOR CALL (BUT STACK(TOP+3)=1)
      CALL ERROR(109)
      GOTO 1000
C----- S = WIND, TERMINATE
2701  CALL OUTPUT(WIND+ADRES-1,-1)
      GOTO 999
C----- S = LASTWILL
2801  IF (STACK(TOP+7).EQ.5) GOTO 1114
      CALL ERROR(143)
      GOTO 999
C----- S = ASSEMBLER
C --- ASSEMBLER INSERTIONS NOT IMPLEMENTED
2901  CALL ERROR(106)
2904  IF (S.EQ.SEND) GOTO 999
      CALL SCAN
      GOTO 2904
330   CALL ERROR(118)
      GO TO 2904
C----- S = OPEN
3001  CALL SCAN
      IF (S.EQ.SLEFT) GOTO 3010
      CALL ERROR(106)
      GOTO 1000
3010  CALL SCAN
      CALL SLAD(5,8,31)
      NEXT=3
      GO TO 7766
C  CALL E3 - OBJECTEXPRESSION TO ANALYSE THE VARIABLE
310   STACK(TOP+3)=WOPEN1
cfile  ----------- added  ---------------------------
      if(s.ne.scoma) go to 3013
      call scan
      call slad(5,8,35)
      next = 4
      go to 7766
c   call expression to analyse the second parameter
cfile  --------------------------------------------
350   IF (S.EQ.SRIGHT) GOTO 3025
      IF (S.EQ.SCOMA) GOTO 3015
3013  CALL ERROR(107)
3014  IF (S.EQ.SEND) GOTO 1000
      CALL SCAN
      GOTO 3014
3015  CALL SCAN
      CALL SLAD(5,8,34)
      NEXT=4
      GO TO 7766
C  CALL EXPRESSION TO ANALYSE THE THIRD  PARAMETER
340   STACK(TOP+3)=WOPEN2
3025  CALL OUTPUT(STACK(TOP+3),-1)
      IF (S.NE.SRIGHT) GOTO 3013
      GOTO 999
C----- S = PUT/GET
3101  STACK(TOP+3)=WPUT+ADRES-1
C     STACK(TOP+3) - WPUT ALBO WGET
      CALL SCAN
      IF (S.EQ.SLEFT) GOTO 3110
      CALL ERROR(106)
      GOTO 1000
3110  CALL SCAN
cdsw      CALL SLAD(2,8,32)
      call slad(5,8,32)
      NEXT=3
      GO TO 7766
C  CALL E3 (OBJECTEXPRESSION) TO ANALYSE THE PARAMETER OF PUT/GET
320   CALL OUTPUT(STACK(TOP+3),-1)
      IF (S.EQ.SRIGHT) GOTO 3140
      IF (S.EQ.SCOMA) GOTO 3120
      CALL ERROR(107)
      GOTO 3180
3120  CALL SCAN
      CALL SLAD(5,8,32)
      NEXT=4
      GO TO 7766
C  CALL EXPRESSION TO ANALYSE THE PARAMETER OF PUT/GET
C  NOTE: RETURN INTO NON-STANDARD PLACE
3140  CALL SCAN
3180  CALL OUTPUT(WIOEND,-1)
      GOTO 1000
C----- S = READLN
3201  STACK(TOP+3)=1
      CALL SCAN
      IF (S.EQ.SLEFT) GOTO 803
      GOTO 812
cdeb  -----------  added  --------------
c-------  s = break
3301  call addbr(ln)
      go to 999
cdeb  ----------------------------------
cdsw -- added:
c ----- s = putrec/getrec
3401  addr = adres
      stack(top+3) = wput+addr-1
      call scan
      if (s .eq. sleft) goto 3410
      call error(106)
      goto 1000
3410  call scan
      call slad(5, 8, 36)
      next = 3
      goto 7766
360   if (s .ne. scoma) goto 3420
      call output(stack(top+3), -1)
      stack(top+3) = wputrec+addr-1
      call scan
      call slad(5, 8, 37)
      next = 4
      goto 7766
370   if (s .ne. scoma) goto 3420
      call scan
      call slad(5, 8, 38)
      next = 4
      goto 7766
380   if (s .ne. sright) goto 3013
      call output(stack(top+3), -1)
      call output(wioend, -1)
      goto 999
3420  call error(147)
      goto 1000
cdsw -- end
cbc added concurrent statements
c ----- s = enable/disable
3501  call output(wenab+adres-1, -1)
3510  call scan
      if (s .ne. sident) goto 3520
      call output(wident, adres)
      call scan
      if (s .eq. scoma) goto 3510
      call output(wprend, -1)
      goto 1000
3520  call error(109)
      goto 1000
c ----- s = accept
3601  call output(waccep, -1)
      call scan
      if (s .ne. sident) goto 3620
      call output(wident, adres)
      call scan
      if (s .eq. scoma) goto 3510
3620  call output(wprend, -1)
      goto 1000
cbc end
C ----- END OF INSTRUCTIONS ----------------------------------
999   CALL SCAN
20    CONTINUE
C  RETURN FROM ASSIGNMENT /JUMP OPTIMIZATION/
80    CONTINUE
C  LABEL 80 (A GARBAGE FROM THE OLD VERSION OF THE PARSER)
C  RETAINED TO PRESERVE THE CONTINUITY OF THE REMAINING LABEL NUMBERS
C  (USED TO MARK RETURN POINTS FROM RECURSIVE CALLS)
1000  CONTINUE
C  INSTRUCTIONS RECOGNIZED
C  CHECK FOR A TERMINAL SYMBOL
1111  IF (S.EQ.SEMICOL) GOTO 8
      IF (S.EQ.SELSE) GOTO 1116
      IF (S.EQ.SFI) GOTO 1115
      IF (S.EQ.SOD) GOTO 1117
      IF (S.EQ.SEND) GOTO 1114
      IF (S.EQ.SOTHER) GOTO 1119
      IF (S.EQ.SOTHRS) GOTO 1120
      IF (S.EQ.SWHEN) GOTO 1119
      IF (S.EQ.SESAC) GOTO 1118
      IF (S.EQ.SVAR)  GOTO 1113
      IF (S.EQ.SUNIT) GOTO 1113
      IF (S.EQ.SCONS) GOTO 1113
      IF (S.NE.SEOF) GOTO 6
1113  CALL ERROR(113)
1114  NEXT=0
      GO TO 7766
1115  IF (STACK(TOP+7).EQ.3) GOTO 1114
1116  IF (STACK(TOP+7).EQ.2) GOTO 1114
      CALL ERROR(112)
      GOTO 8
1117  IF (STACK(TOP+7).EQ.4) GOTO 1114
      CALL ERROR(130)
      GOTO 8
1118  IF (STACK(TOP+7).EQ.7) GOTO 1114
      IF (STACK(TOP+7).EQ.6) GOTO 1114
      CALL ERROR(129)
      GOTO 8
1119  IF (STACK(TOP+7).EQ.6) GOTO 1114
      IF (STACK(TOP+7).EQ.1) GOTO 1114
      CALL ERROR(129)
      GOTO 8
1120  IF (STACK(TOP+7).EQ.1) GOTO 1114
      CALL ERROR(129)
      GOTO 8
7766  CONTINUE
      RETURN
      END
      
      SUBROUTINE E9
C
C  AUGMENTS THE PROTOTYPE BY THE STARTING PLACE OF THE INTERMEDIATE
C  CODE FOR THE PARSED SYNTACTICAL UNIT
C
C  STACK(TOP+3) - ENTRY:   PROTOTYPE ADDRESS
C		  CONT.:   ENDUNIT LABEL
C  STACK(TOP+4) - COPY OF THE PROTOTYPE ADRESS
C
      IMPLICIT INTEGER(A-Z)
      COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
     X		      POSIT,RECNR,NEKST
      COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,JNK(266)
      COMMON /BLANK/
     $	 C0M(4),
     O	 S,	   ADRES,    K,        SCOMA,	 SDOT,	   SEMICOL,
     1	 SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,	   SRELAT,
     2	 SEOF,	   SIDENT,   SCONST,   SAND,	 SARRAY,   SARROF,
     3	 SATTACH,  SBEGIN,   SBLOCK,   SBOOL,	 SCALL,    SCASE,
     4	 SCLASS,   SCLOSE,   SCONS,    SCOPY,	 SCOROUT,  SDETACH,
     5	 SDIM,	   SDO,      SDOWN,    SELSE,	 SEND,	   SESAC,
     6	 SEXIT,    SEXTERN,  SFI,      SFOR,	 SFUNCT,   SIF,
     7	 SINNER,   SINPUT,   SINT,     SKILL,	 SLOCK,    SNEW,
     8	 SNONE,    SNOT,     SOD,      SOR,	 SORIF,    SOTHER,
     9	 SOUTPUT,  SPREF,    SPRCD,    SQUA,	 SREAD,    SRESUME,
     O	 SRETURN,  STEP,     STOP,     STAKEN,	 STHEN,    STHIS,
     A	 STO,	   STYPE,    SUNIT,    SVAR,	 SVIRTUAL, SWAIT,
     B	 SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
     C	 WAND,	   WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
     D	 WCALL,    WCASE,    WCASEL,   WCOMA,	 WCNSTB,   WCNSTC,
     E	 WCNSTI,   WCNSTN,   WCNSTR,   WCNST,	 WCOPY,    WDETACH,
     F	 WDOT,	   WDOWNTO,  WEOF,     WESAC,	 WFIN,	   WFIRST,
     G	 WFOREND,  WFORVAR,  WFROM,    WIDENT,	 WIFFALS,  WIFTRUE
      common /BLANK/
     H	 WINNER,   WINSTREND,WJUMP,    WKILL,	 WLABEL,   WLEFT,
     I	 WLOCK,    WLOW,     WLSE,     WNEW,	 WNEWARRAY,WNOT,
     J	 WOPERAT,  WOPT,     WOR,      WOTHER,	 WPREF,    WPRIM,
     K	 WQUA,	   WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
     L	 WSTART,   WSTEP,    WSTOP,    WTHIS,	 WTO,	   WAIT,
     M	 WRITE,    WRITELN,  WBOUND,   UNICAL,
     N	 COM(132),
     O	 LMEM,	   LPMEM,    IRECN,    ISFIN,	 LPMSYS,   LPML,
     P	 LPMF,	   NRINT,    NRRE,     NRBOOL,	 NRCHAR,   NRCOR,
     Q	 NRPROC,   NRTEXT,   NRUNIV,   NATTR,	 NRNONE,   NBLSYS,
     R	 NBLUS,    NEMPTY,   INSYS,    LOCAL,	 OWN,	   OBJECT,
     $   scaner(8735)
cdsw $	 SCANER(3735),
       common /BLANK/
     Z	 TOP,	   IN,	     NEXT,     STACK(500),
     *	 RESZTA(3652)
      DIMENSION IPMEM(7890)
      EQUIVALENCE (SCANER(1),IPMEM(1))
      DATA SLASTW/28/
      DATA WLASTW/72/
      
      GOTO (10,20,30),IN
10    STACK(TOP+4)=STACK(TOP+3)
      UNICAL=1
      NRRE=STACK(TOP+4)
C  PROTOTYPE ADDRESS IS MOVED TO VARIABLE NRRE TO SPARE SOME CODE
C  CHECK IF ANYTHING HAS BEEN SENT TO THE INTERMEDIATE CODE
      IF (IPMEM(NRRE-3).NE.0) GOTO 15
      IPMEM(NRRE-3)=RECNR
      IPMEM(NRRE-2)=POSIT
15    STACK(TOP+3)=UNICAL
      UNICAL=UNICAL+1
      CALL OUTPUT(WFIRST,LN)
      IF (S.EQ.SBEGIN) CALL SCAN
      CALL OPTOUT
      IF (S.EQ.SEND) GOTO 22
      CALL SLAD(2,9,2)
      NEXT=8
      STACK(TOP+7)=5
      RETURN
C  CALL E8 - INSTRUCTIONS
C  PARAMETER = 5   /AN INSTRUCTION SEQUENCE
C		    TERMINATED BY END	   /
20    IF (S.NE.SLASTW) GOTO 22
C  LASTWILL OCCURRED - END OF CODE SHOULD BE ASSUMED AND THE PARSING SHOULD
C  CONTINUE. END-LABEL IS TO BE CHANGED!
      CALL OUTPUT(WLASTW,STACK(TOP+3))
      CALL OUTPUT(LN,-1)
      STACK(TOP+3)=UNICAL
      UNICAL=UNICAL+1
21    CALL SCAN
      IF (S.EQ.SCOLON) CALL SCAN
      CALL SLAD(2,9,3)
      NEXT=8
      STACK(TOP+7)=5
      RETURN
C  CALL E8 TO ANALYSE INSTRUCTIONS AFTER LASTWILL
30    IF (S.EQ.SLASTW) GOTO 32
22    CALL OUTPUT(WFIN,STACK(TOP+3))
      CALL OUTPUT(LN,-1)
      NEXT = 0
      RETURN
32    CALL ERROR(144)
      GOTO 21
      END
      
      SUBROUTINE E10
      IMPLICIT INTEGER (A-Z)
C
C  RECOGNIZES SEQUENCE OF DECLARATIONS
C  UPDATES THE PROTOTYPE WHOSE ADDRESS IS PASSED BY
C  BY STACK(TOP+3)
C  CREATES LISTS OF CONSTANTS; FOR ENUMERATION CONSTANTS CREATES DESCRIPTIONS
C  INCLUDING NAMES OF THE CONSTANTS AND THE NUMBERS OF THEIR DECLARATION LINES.
C     STACK(TOP+4) - STACK(TOP+5) -  DESCRIBE THE PLACE IN THE INTERMEDIATE
C     CODE IN THE CASE WHEN THE SUBMODULE INSTRUCTIONS HAVE TO BE WRITTEN
C     AFTER AN OCCURRENCE OF ENUMERATION CONSTANTS.
C  N O T E:   THE MEANING OF THE PROTOTYPE WORD #-1 IS CHANGED. IT INCLUDES:
C  0 - THERE ARE NO ENUMERATION CONSTANTS
C -1 - CONSTANTS ARE WRITTEN INTO, WORKING FILE LEFT OK
C  1 - THE CONSTANTS ARE FOLLOWED BY THE CODE FOR SUBMODULES
C
C
C-------------------------------------------------------------------
C  CONSTANT LIST ITEM:
C
C  0 ! NAME
C ---+------------------------
C +1 ! DECL. LINE NUMBERA
C ---+------------------------
C +2 ! TYPE NUMBER
C ---+------------------------
C +3 ! 0 (ZERO)
C ---+------------------------
C +4 ! ADDRESS IN DICTIONARY OR VALUE
C ---+------------------------
C +5 ! THE NEXT ITEM
C ---+------------------------
C
C------------------------------------------------------------------------
C  SIGNAL LIST ITEM::
C
C  ----+-------------------
C    0 ! KIND
C  ----+-------------------
C   +1 ! LINE NUMBER IN THE SOURCE TEXT
C  ----+-------------------
C   +2 ! NAME
C  ----+-------------------
C   +3 ! THE NEXT ITEM IN THE LIST
C  ----+-------------------
C   +4 ! FORMAL PARAMETER LIST
C  ----+-------------------
C
C  WHERE KIND =
C   9 - SIGNAL CONSTRUCTED PROPERLY
C  10 - SIGNAL WITH A FAULTY PARAMETER LIST
C
      COMMON /BLANK/
     $	 C0M(4),
     O	 S,	   ADRES,    K,        SCOMA,	 SDOT,	   SEMICOL,
     1	 SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,	   SRELAT,
     2	 SEOF,	   SIDENT,   SCONST,   SAND,	 SARRAY,   SARROF,
     3	 SATTACH,  SBEGIN,   SBLOCK,   SBOOL,	 SCALL,    SCASE,
     4	 SCLASS,   SCLOSE,   SCONS,    SCOPY,	 SCOROUT,  SDETACH,
     5	 SDIM,	   SDO,      SDOWN,    SELSE,	 SEND,	   SESAC,
     6	 SEXIT,    SEXTERN,  SFI,      SFOR,	 SFUNCT,   SIF,
     7	 SINNER,   SINPUT,   SINT,     SKILL,	 SLOCK,    SNEW,
     8	 SNONE,    SNOT,     SOD,      SOR,	 SORIF,    SOTHER,
     9	 SOUTPUT,  SPREF,    SPRCD,    SQUA,	 SREAD,    SRESUME,
     O	 SRETURN,  STEP,     STOP,     STAKEN,	 STHEN,    STHIS,
     A	 STO,	   STYPE,    SUNIT,    SVAR,	 SVIRTUAL, SWAIT,
     B	 SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
     C	 WAND,	   WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
     D	 WCALL,    WCASE,    WCASEL,   WCOMA,	 WCNSTB,   WCNSTC,
     E	 WCNSTI,   WCNSTN,   WCNSTR,   WCNST,	 WCOPY,    WDETACH,
     F	 WDOT,	   WDOWNTO,  WEOF,     WESAC,	 WFIN,	   WFIRST,
     G	 WFOREND,  WFORVAR,  WFROM,    WIDENT,	 WIFFALS,  WIFTRUE
      common /BLANK/
     H	 WINNER,   WINSTREND,WJUMP,    WKILL,	 WLABEL,   WLEFT,
     I	 WLOCK,    WLOW,     WLSE,     WNEW,	 WNEWARRAY,WNOT,
     J	 WOPERAT,  WOPT,     WOR,      WOTHER,	 WPREF,    WPRIM,
     K	 WQUA,	   WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
     L	 WSTART,   WSTEP,    WSTOP,    WTHIS,	 WTO,	   WAIT,
     M	 WRITE,    WRITELN,  WBOUND,   UNICAL,
     N	 COM(132),
     O	 LMEM,	   LPMEM,    IRECN,    ISFIN,	 LPMSYS,   LPML,
     P	 LPMF,	   NRINT,    NRRE,     NRBOOL,	 NRCHAR,   NRCOR,
     Q	 NRPROC,   NRTEXT,   NRUNIV,   NATTR,	 NRNONE,   NBLSYS,
     R	 NBLUS,    NEMPTY,   INSYS,    LOCAL,	 OWN,	   OBJECT,
     $   scaner(8735)
cdsw $	 SCANER(3735),
      common /BLANK/ 
     Z	 TOP,	   IN,	     NEXT,     STACK(500),
     *	 RESZTA(3652)
     
cdsw  INTEGER  IPMEM(1000)
      dimension  ipmem(7890)
      COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
     X		      POSIT,RECNR,NEKST
      COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,JNK(266)
      EQUIVALENCE (SCANER(1),IPMEM(1))
      DATA SIGNAL/56/
      DATA SHANDL/55/
      
C  RECOGNITION OF DECLARATIONS
      GOTO (10,20,30),IN
30    CONTINUE
10    IF (S.EQ.SCONS) GOTO 200
      IF (S.EQ.SVAR) GOTO 110
      IF (S.EQ.SUNIT) GOTO 125
      IF (S.EQ.SIGNAL) GOTO 500
      IF (S.EQ.SHANDL) GOTO 1000
      IF (S.EQ.SBEGIN) GOTO 1000
      IF (S.EQ.SEND) GOTO 1000
      IF (S.EQ.70) GOTO 1000
      IF ((S.GT.1).AND.(S.LT.25)) GOTO 1000
      IF (S.NE.SEMICOL) CALL ERROR(127)
      IF (S.EQ.SBECOME) GOTO 1000
15    CALL SCAN
      GOTO 10
C  CHECK FOR FURTHER CONSTANT DECLARATIONS (COMMA)
C----------  VARIABLES
110   I=1
      J=0
111   CALL SCAN
      IF (S.EQ.SIDENT) GOTO 112
      CALL ERROR(109)
      GOTO 10
112   J=J+1
      K=I+J
      IF (K.GT.132) CALL ERROR(197)
C  THE IDENTIFIER IS APPENDED TO THE LIST OF VARIABLES IN ARRAY COM.
C  THE LIMIT FOR THE LENGTH OF THAT LIST IS 132. EXCEEDING THIS LIMIT
C  CAUSES PARSER ERROR 137.
      COM(K)=ADRES
C  NOTE:  K IS USED ABOVE
      CALL SCAN
      IF (S.EQ.SCOMA) GOTO 111
      IF (S.EQ.SCOLON) GOTO 113
      CALL ERROR(118)
      GOTO 10
113   CALL SCAN
      CALL ADDVAR(COM(2),J)

C  CHECK FOR MORE DECLARATIONS OF VARIABLES (COMMA)
      IF (S.EQ.SCOMA) GOTO 110
      IF (S.EQ.SBEGIN) GOTO 1000
      IF (S.EQ.SEND) GOTO 1000
      IF (S.EQ.SEMICOL) GOTO 15
      CALL ERROR(102)
      GOTO 10
C----------  SUBMODULE
125   NRRE=STACK(TOP+3)-1
      IF (IPMEM(NRRE).GE.0) GOTO 128
C  ENUMERATION CONSTANTS ARE ALREADY WRTITTEN INTO THE INTERMEDIATE CODE
      IPMEM(NRRE)=1
      CALL MARK(STACK(TOP+4),STACK(TOP+5))
128   CALL SLAD(3,10,3)
      CALL SCAN
      NEXT=11
      RETURN
C  CALL E11 - SYNTACTIC UNIT - MODULE
C  RETURN TO THE BEGINNING (JUMP OPTIMIZATION)
C----------  CONSTANT
200   CALL SCAN
      IF (S.EQ.SIDENT) GOTO 202
      CALL ERROR(109)
      GOTO 10
202   STACK(TOP+6)=ADRES
      CALL SCAN
      IF ((S.EQ.SRELAT).AND.(ADRES.EQ.3)) GOTO 205
      CALL ERROR(116)
      GOTO 10
C  "CONST IDENT =" ENCOUNTERED
205   CALL SCAN
C  RESERVATION OF IPMEM SPACE FOR THE CONSTANT DESCRIPTION
      LPMF=LPMF-6
      IF (LPMF.LT.LPML) CALL ERROR(199)
      IPMEM(LPMF+1)=STACK(TOP+6)
      IPMEM(LPMF+2)=LN
      NRRE=STACK(TOP+3)+4
      IPMEM(LPMF+6)=IPMEM(NRRE)
      IPMEM(NRRE)=LPMF+1
C  RECOGNITION OF THE TYPE
      IF (S.EQ.STRUE) GOTO 300
      IF (S.NE.SCONST) GOTO 300
      IF (K.EQ.4) GOTO 250
      IF (K.NE.6) GOTO 300
C  CHARACTER CONSTANT (K=6)
      IPMEM(LPMF+3)=16
      GOTO 260
C  TEXT CONSTANT (K=4)
250   IPMEM(LPMF+3)=48
260   IPMEM(LPMF+5)=ADRES
      CALL SCAN
      GOTO 350
C  EXPRESSION ??
300   NRRE=STACK(TOP+3)-1
      IF (IPMEM(NRRE).EQ.0) GOTO 310
C  ANYTHING WRITTEN INTO INTERMEDIATE CODE ?
      IF (IPMEM(NRRE).EQ.-1) GOTO 325
C  YES BUT A SUBMODULE HAS BEEN WRITTEN
      CALL FIND(STACK(TOP+4),STACK(TOP+5))
C  THE PLACE IN THE INTERTMEDIATE CODE HAS BEEN FOUND
      IPMEM(NRRE)=-1
      GOTO 325
C  THE INITIAL INSTRUCTIONS OF THE INTERMEDIATE CODE
310   IPMEM(NRRE)=-1
      IPMEM(NRRE-1)=POSIT
      IPMEM(NRRE-2)=RECNR
325   CALL OUTPUT(WINSTREND,LN)
      CALL OUTPUT(WIDENT,STACK(TOP+6))
      CALL OUTPUT(WLSE,-1)
      CALL SLAD(3,10,2)
      NEXT=12
      RETURN
C  CALL E12 TO ANALYSE THE EXPRESSION
20    CALL OUTPUT(WASSCON,-1)
350   IF (S.EQ.SCOMA) GOTO 200
      IF (S.EQ.SBEGIN) GOTO 1000
      IF (S.EQ.SEND) GOTO 1000
      IF (S.EQ.SEMICOL) GOTO 15
      CALL ERROR(102)
      GOTO 10
1000  NRRE=STACK(TOP+3)-1

      IF (IPMEM(NRRE).LE.0) GOTO 1010
C  SUBMODULES WERE PRECEDED BY ENUMERATION CONSTANTS - THE BEGINNING
C  OF CODE HAS TO BE FOUND
      CALL FIND(STACK(TOP+4),STACK(TOP+5))
1010  NEXT=0
      RETURN
C----------  SIGNAL DECLARATION
500   CALL SCAN
      IF (S.EQ.SIDENT) GOTO 505
      CALL ERROR(109)
      GOTO 10
C  CREATION OF THE SIGNAL DESCRIPTION
505   LPMF=LPMF-5
      IF (LPMF.LT.LPML) CALL ERROR(199)
      IPMEM(LPMF+1)=9
      IPMEM(LPMF+2)=LN
      IPMEM(LPMF+3)=ADRES
C  THE SYNTACTIC FATHER IS APPENDED TO THE LIST OF SIGNALS (PROTOTYPE WORD #4)
      NRCOR=STACK(TOP+3)-4
      NRCHAR=IPMEM(NRCOR)
      IPMEM(NRCOR)=LPMF+1
      IPMEM(LPMF+4)=NRCHAR
C  THE SIGNAL DESCRIPTION IS CREATED AND APPENDED
      CALL SCAN
      IF (S.EQ.SCOMA) GOTO 500
      IF (S.EQ.SEMICOL) GOTO 15
      IF (S.EQ.SLEFT) GOTO 508
      CALL ERROR(102)
      GOTO 10
c
cdsw&bc 508   STACK(TOP+5)=LPMF+1
c             CALL ADDPAR(STACK(TOP+5)+4,STACK(TOP+5))
508   continue
      call addpar(lpmf+5, lpmf+1)
cdsw&bc
      IF (S.EQ.SRIGHT) GOTO 510
      CALL ERROR(107)
      GOTO 10
510   CALL SCAN
      IF (S.EQ.SCOMA) GOTO 500
      IF (S.EQ.SEMICOL) GOTO 15
      CALL ERROR(102)
      GOTO 10
      END