sources/pass1/wan2.f

   1 C    Loglan82 Compiler&Interpreter
   2 C     Copyright (C) 1981-1993 Institute of Informatics, University of Warsaw
   3 C     Copyright (C)  1993, 1994 LITA, Pau
   4 C
   5 C     This program is free software; you can redistribute it and/or modify
   6 C     it under the terms of the GNU General Public License as published by
   7 C     the Free Software Foundation; either version 2 of the License, or
   8 C     (at your option) any later version.
   9 C
  10 C     This program is distributed in the hope that it will be useful,
  11 C     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 C     GNU General Public License for more details. File: LICENSE.GNU
  14 C  ===============================================================
  15
  16       subroutine e3
  17 C  E3 - RECOGNIZES OBJECTEXPRESSION
  18 C  NO LOCAL VARIABLES
  19       IMPLICIT INTEGER (A-Z)
  20       COMMON /BLANK/
  21      $   C0M(4),
  22      O   S,        ADRES,    K,        SCOMA,    SDOT,     SEMICOL,
  23      1   SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,     SRELAT,
  24      2   SEOF,     SIDENT,   SCONST,   SAND,     SARRAY,   SARROF,
  25      3   SATTACH,  SBEGIN,   SBLOCK,   SBOOL,    SCALL,    SCASE,
  26      4   SCLASS,   SCLOSE,   SCONS,    SCOPY,    SCOROUT,  SDETACH,
  27      5   SDIM,     SDO,      SDOWN,    SELSE,    SEND,     SESAC,
  28      6   SEXIT,    SEXTERN,  SFI,      SFOR,     SFUNCT,   SIF,
  29      7   SINNER,   SINPUT,   SINT,     SKILL,    SLOCK,    SNEW,
  30      8   SNONE,    SNOT,     SOD,      SOR,      SORIF,    SOTHER,
  31      9   SOUTPUT,  SPREF,    SPRCD,    SQUA,     SREAD,    SRESUME,
  32      O   SRETURN,  STEP,     STOP,     STAKEN,   STHEN,    STHIS,
  33      A   STO,      STYPE,    SUNIT,    SVAR,     SVIRTUAL, SWAIT,
  34      B   SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
  35      C   WAND,     WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
  36      D   WCALL,    WCASE,    WCASEL,   WCOMA,    WCNSTB,   WCNSTC,
  37      E   WCNSTI,   WCNSTN,   WCNSTR,   WCNST,    WCOPY,    WDETACH,
  38      F   WDOT,     WDOWNTO,  WEOF,     WESAC,    WFIN,     WFIRST,
  39      G   WFOREND,  WFORVAR,  WFROM,    WIDENT,   WIFFALS,  WIFTRUE
  40
  41       common /BLANK/
  42      H   WINNER,   WINSTREND,WJUMP,    WKILL,    WLABEL,   WLEFT,
  43      I   WLOCK,    WLOW,     WLSE,     WNEW,     WNEWARRAY,WNOT,
  44      J   WOPERAT,  WOPT,     WOR,      WOTHER,   WPREF,    WPRIM,
  45      K   WQUA,     WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
  46      L   WSTART,   WSTEP,    WSTOP,    WTHIS,    WTO,      WAIT,
  47      M   WRITE,    WRITELN,  WBOUND,   UNICAL,
  48      N   COM(132),
  49      O   LMEM,     LPMEM,    IRECN,    ISFIN,    LPMSYS,   LPML,
  50      P   LPMF,     NRINT,    NRRE,     NRBOOL,   NRCHAR,   NRCOR,
  51      Q   NRPROC,   NRTEXT,   NRUNIV,   NATTR,    NRNONE,   NBLSYS,
  52      R   NBLUS,    NEMPTY,   INSYS,    LOCAL,    OWN,      OBJECT,
  53      $   scaner(8735)
  54 cdsw $   SCANER(3735),
  55       common /BLANK/
  56      Z   TOP,      IN,       NEXT,     STACK(500),
  57      *   RESZTA(3652)
  58
  59       GOTO (10,20,30,40),IN
  60 10    IF (S.NE.SIDENT) GOTO 200
  61       CALL SLAD(0,3,2)
  62       STACK(TOP+4)=0
  63 C  PARAMETER VALUE IS ASSIGNED: THERE IS NO "NEW"
  64       NEXT=5
  65 C  E5 - FUNCTION
  66       RETURN
  67 C  RETURN TO LABEL 20, RESULTING FROM JUMP OPTIMIZATION.
  68 200   IF (S.NE.STHIS) GOTO 250
  69       CALL SCAN
  70       IF (S.EQ.SIDENT) GOTO 210
  71       CALL ERROR(109)
  72       GOTO 300
  73 210   CALL OUTPUT(WTHIS,ADRES)
  74       CALL SCAN
  75       GOTO 300
  76 250   IF (S.EQ.SNEW) GOTO 270
  77       IF (S.NE.SNONE) GOTO 255
  78       CALL OUTPUT(WCNSTN,-1)
  79       CALL SCAN
  80       GOTO 1000
  81 255   CALL ERROR(109)
  82       CALL OUTPUT(WIDENT,0)
  83       GOTO 300
  84 270   STACK(TOP+7)=ADRES
  85       CALL SCAN
  86       IF (S.NE.SIDENT) GOTO 280
  87       CALL SLAD(0,3,3)
  88       NEXT=5
  89 C  E5 - FUNCTION
  90       RETURN
  91 280   CALL ERROR(109)
  92       CALL OUTPUT(WIDENT,0)
  93 20    CONTINUE
  94 30    CONTINUE
  95 40    CONTINUE
  96 300   IF (S.EQ.SDOT) GOTO 350
  97       IF (S.NE.SQUA) GOTO 1000
  98 C  QUA
  99       CALL SCAN
 100       IF (S.NE.SIDENT) GOTO 260
 101       CALL OUTPUT(WQUA,ADRES)
 102       CALL SCAN
 103       IF (S.EQ.SDOT) GOTO 350
 104       CALL ERROR(114)
 105       GOTO 351
 106 260   CALL ERROR(109)
 107       GOTO 250
 108 C  DOT
 109 350   CALL SCAN
 110 351   STACK(TOP+7)=0
 111       IF (S.NE.SNEW) GOTO 380
 112       STACK(TOP+7)=ADRES
 113       CALL SCAN
 114 380   IF (S.EQ.SIDENT) GOTO 390
 115       CALL ERROR(109)
 116       GOTO 250
 117 390   CALL OUTPUT(WDOT,-1)
 118       CALL SLAD(0,3,4)
 119 C  RETURN INTO SOME OTHER PLACE
 120       NEXT=5
 121       RETURN
 122 C  E5 - FUNCTION
 123 1000  NEXT=0
 124       RETURN
 125       END
 126
 127       SUBROUTINE E4
 128 C  E4 - RECOGNIZES EXPRESSION
 129 C  STACK(TOP+3) - NUMBER OF ARRAYOF'S ENCOUNTERED
 130       IMPLICIT INTEGER (A-Z)
 131       COMMON /BLANK/
 132      $   C0M(4),
 133      O   S,        ADRES,    K,        SCOMA,    SDOT,     SEMICOL,
 134      1   SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,     SRELAT,
 135      2   SEOF,     SIDENT,   SCONST,   SAND,     SARRAY,   SARROF,
 136      3   SATTACH,  SBEGIN,   SBLOCK,   SBOOL,    SCALL,    SCASE,
 137      4   SCLASS,   SCLOSE,   SCONS,    SCOPY,    SCOROUT,  SDETACH,
 138      5   SDIM,     SDO,      SDOWN,    SELSE,    SEND,     SESAC,
 139      6   SEXIT,    SEXTERN,  SFI,      SFOR,     SFUNCT,   SIF,
 140      7   SINNER,   SINPUT,   SINT,     SKILL,    SLOCK,    SNEW,
 141      8   SNONE,    SNOT,     SOD,      SOR,      SORIF,    SOTHER,
 142      9   SOUTPUT,  SPREF,    SPRCD,    SQUA,     SREAD,    SRESUME,
 143      O   SRETURN,  STEP,     STOP,     STAKEN,   STHEN,    STHIS,
 144      A   STO,      STYPE,    SUNIT,    SVAR,     SVIRTUAL, SWAIT,
 145      B   SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
 146      C   WAND,     WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
 147      D   WCALL,    WCASE,    WCASEL,   WCOMA,    WCNSTB,   WCNSTC,
 148      E   WCNSTI,   WCNSTN,   WCNSTR,   WCNST,    WCOPY,    WDETACH,
 149      F   WDOT,     WDOWNTO,  WEOF,     WESAC,    WFIN,     WFIRST,
 150      G   WFOREND,  WFORVAR,  WFROM,    WIDENT,   WIFFALS,  WIFTRUE
 151
 152       common /BLANK/
 153      H   WINNER,   WINSTREND,WJUMP,    WKILL,    WLABEL,   WLEFT,
 154      I   WLOCK,    WLOW,     WLSE,     WNEW,     WNEWARRAY,WNOT,
 155      J   WOPERAT,  WOPT,     WOR,      WOTHER,   WPREF,    WPRIM,
 156      K   WQUA,     WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
 157      L   WSTART,   WSTEP,    WSTOP,    WTHIS,    WTO,      WAIT,
 158      M   WRITE,    WRITELN,  WBOUND,   UNICAL,
 159      N   COM(132),
 160      O   LMEM,     LPMEM,    IRECN,    ISFIN,    LPMSYS,   LPML,
 161      P   LPMF,     NRINT,    NRRE,     NRBOOL,   NRCHAR,   NRCOR,
 162      Q   NRPROC,   NRTEXT,   NRUNIV,   NATTR,    NRNONE,   NBLSYS,
 163      R   NBLUS,    NEMPTY,   INSYS,    LOCAL,    OWN,      OBJECT,
 164      $   scaner(8735)
 165 cdsw $   SCANER(3735),
 166        common /BLANK/
 167      Z   TOP,      IN,       NEXT,     STACK(500),
 168      *   RESZTA(3652)
 169
 170       GOTO (10,20),IN
 171 10    STACK(TOP+3)=0
 172       IF (S.NE.SARROF) GOTO 13
 173 11    STACK(TOP+3)=STACK(TOP+3)+1
 174       CALL SCAN
 175       IF (S.EQ.SARROF) GOTO 11
 176 13    IF (S.EQ.SCOROUT) GOTO 15
 177       IF (S.EQ.SINT) GOTO 16
 178       NEXT=1
 179       IF (STACK(TOP+3).GT.0) NEXT=3
 180       CALL SLAD(1,4,2)
 181       RETURN
 182 C  CALL           E1 - BOOLEXPRESSION
 183 C         OR      E3 - OBJECTEXPRESSION
 184 15    CALL OUTPUT(WIDENT,K)
 185 C  COROUTINE OR PROCESS ENCOUNTERED
 186       GOTO 19
 187 16    CALL OUTPUT(WPRIM,ADRES)
 188 19    CALL SCAN
 189 20    IF (STACK(TOP+3).NE.0) CALL OUTPUT(WARRAY,STACK(TOP+3))
 190       NEXT=0
 191       RETURN
 192       END
 193
 194       SUBROUTINE E5
 195 C  E5 - FUNCTION
 196 C  STACK(TOP+3) - COUNTS NUMBER OF EXTERNAL PARANTHESES PAIRS
 197 C  STACK(TOP+4) - PARAMETR - 0 THERE WAS NO NEW/START
 198 C                            1 NEW
 199 C                            2 START
 200       IMPLICIT INTEGER (A-Z)
 201       COMMON /BLANK/
 202      $   C0M(4),
 203      O   S,        ADRES,    K,        SCOMA,    SDOT,     SEMICOL,
 204      1   SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,     SRELAT,
 205      2   SEOF,     SIDENT,   SCONST,   SAND,     SARRAY,   SARROF,
 206      3   SATTACH,  SBEGIN,   SBLOCK,   SBOOL,    SCALL,    SCASE,
 207      4   SCLASS,   SCLOSE,   SCONS,    SCOPY,    SCOROUT,  SDETACH,
 208      5   SDIM,     SDO,      SDOWN,    SELSE,    SEND,     SESAC,
 209      6   SEXIT,    SEXTERN,  SFI,      SFOR,     SFUNCT,   SIF,
 210      7   SINNER,   SINPUT,   SINT,     SKILL,    SLOCK,    SNEW,
 211      8   SNONE,    SNOT,     SOD,      SOR,      SORIF,    SOTHER,
 212      9   SOUTPUT,  SPREF,    SPRCD,    SQUA,     SREAD,    SRESUME,
 213      O   SRETURN,  STEP,     STOP,     STAKEN,   STHEN,    STHIS,
 214      A   STO,      STYPE,    SUNIT,    SVAR,     SVIRTUAL, SWAIT,
 215      B   SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
 216      C   WAND,     WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
 217      D   WCALL,    WCASE,    WCASEL,   WCOMA,    WCNSTB,   WCNSTC,
 218      E   WCNSTI,   WCNSTN,   WCNSTR,   WCNST,    WCOPY,    WDETACH,
 219      F   WDOT,     WDOWNTO,  WEOF,     WESAC,    WFIN,     WFIRST,
 220      G   WFOREND,  WFORVAR,  WFROM,    WIDENT,   WIFFALS,  WIFTRUE
 221
 222       common /BLANK/
 223      H   WINNER,   WINSTREND,WJUMP,    WKILL,    WLABEL,   WLEFT,
 224      I   WLOCK,    WLOW,     WLSE,     WNEW,     WNEWARRAY,WNOT,
 225      J   WOPERAT,  WOPT,     WOR,      WOTHER,   WPREF,    WPRIM,
 226      K   WQUA,     WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
 227      L   WSTART,   WSTEP,    WSTOP,    WTHIS,    WTO,      WAIT,
 228      M   WRITE,    WRITELN,  WBOUND,   UNICAL,
 229      N   COM(132),
 230      O   LMEM,     LPMEM,    IRECN,    ISFIN,    LPMSYS,   LPML,
 231      P   LPMF,     NRINT,    NRRE,     NRBOOL,   NRCHAR,   NRCOR,
 232      Q   NRPROC,   NRTEXT,   NRUNIV,   NATTR,    NRNONE,   NBLSYS,
 233      R   NBLUS,    NEMPTY,   INSYS,    LOCAL,    OWN,      OBJECT,
 234      $   scaner(8735)
 235 cdsw $   SCANER(3735),
 236        common /BLANK/
 237      Z   TOP,      IN,       NEXT,     STACK(500),
 238      *   RESZTA(3652)
 239
 240       GOTO (10,20,30),IN
 241 10    STACK(TOP+3)=0
 242       CALL OUTPUT(WIDENT,ADRES)
 243       CALL SCAN
 244       IF (STACK(TOP+4)-1) 15,13,12
 245 12    CALL OUTPUT(WSTART,-1)
 246       GOTO 15
 247 13    CALL OUTPUT(WNEW,-1)
 248 15    IF (S.NE.SLEFT) GOTO 1000
 249       IF (STACK(TOP+3).GE.2) GOTO 1000
 250 C  ANALYSIS OF THE ACTUAL PARAMETER
 251       CALL OUTPUT(WLEFT,-1)
 252       CALL SCAN
 253       CALL SLAD(2,5,2)
 254       NEXT=4
 255       RETURN
 256 C  CALL E4 - EXPRESSION
 257 20    IF (S.NE.SCOMA) GOTO 28
 258 22    CALL SCAN
 259       CALL OUTPUT(WCOMA,-1)
 260       CALL SLAD(2,5,3)
 261       NEXT=4
 262       RETURN
 263 C  NEXT CALL FOR E4
 264 30    IF (S.EQ.SCOMA) GOTO 22
 265 28    IF (S.NE.SRIGHT) CALL ERROR(107)
 266       IF (S.EQ.SRIGHT) CALL SCAN
 267       CALL OUTPUT(WRIGHT,-1)
 268       STACK(TOP+3)=STACK(TOP+3)+1
 269       GOTO 15
 270 1000  NEXT=0
 271       RETURN
 272       END
 273
 274       SUBROUTINE E6
 275 C  RECOGNIZES THE SEQUENCE V1,V2,V3,. . . ,VN:= EXPR
 276 C  OR V1,V2, . . . ,VN := COPY ( OBJECT EXPR. )
 277 C  GENERATES WLSE V1 WLSE . . .  WLSE EXPR /WCOPY/  WASSIGN
 278       IMPLICIT INTEGER (A-Z)
 279       COMMON /BLANK/
 280      $   C0M(4),
 281      O   S,        ADRES,    K,        SCOMA,    SDOT,     SEMICOL,
 282      1   SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,     SRELAT,
 283      2   SEOF,     SIDENT,   SCONST,   SAND,     SARRAY,   SARROF,
 284      3   SATTACH,  SBEGIN,   SBLOCK,   SBOOL,    SCALL,    SCASE,
 285      4   SCLASS,   SCLOSE,   SCONS,    SCOPY,    SCOROUT,  SDETACH,
 286      5   SDIM,     SDO,      SDOWN,    SELSE,    SEND,     SESAC,
 287      6   SEXIT,    SEXTERN,  SFI,      SFOR,     SFUNCT,   SIF,
 288      7   SINNER,   SINPUT,   SINT,     SKILL,    SLOCK,    SNEW,
 289      8   SNONE,    SNOT,     SOD,      SOR,      SORIF,    SOTHER,
 290      9   SOUTPUT,  SPREF,    SPRCD,    SQUA,     SREAD,    SRESUME,
 291      O   SRETURN,  STEP,     STOP,     STAKEN,   STHEN,    STHIS,
 292      A   STO,      STYPE,    SUNIT,    SVAR,     SVIRTUAL, SWAIT,
 293      B   SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
 294      C   WAND,     WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
 295      D   WCALL,    WCASE,    WCASEL,   WCOMA,    WCNSTB,   WCNSTC,
 296      E   WCNSTI,   WCNSTN,   WCNSTR,   WCNST,    WCOPY,    WDETACH,
 297      F   WDOT,     WDOWNTO,  WEOF,     WESAC,    WFIN,     WFIRST,
 298      G   WFOREND,  WFORVAR,  WFROM,    WIDENT,   WIFFALS,  WIFTRUE
 299
 300       common /BLANK/
 301      H   WINNER,   WINSTREND,WJUMP,    WKILL,    WLABEL,   WLEFT,
 302      I   WLOCK,    WLOW,     WLSE,     WNEW,     WNEWARRAY,WNOT,
 303      J   WOPERAT,  WOPT,     WOR,      WOTHER,   WPREF,    WPRIM,
 304      K   WQUA,     WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
 305      L   WSTART,   WSTEP,    WSTOP,    WTHIS,    WTO,      WAIT,
 306      M   WRITE,    WRITELN,  WBOUND,   UNICAL,
 307      N   COM(132),
 308      O   LMEM,     LPMEM,    IRECN,    ISFIN,    LPMSYS,   LPML,
 309      P   LPMF,     NRINT,    NRRE,     NRBOOL,   NRCHAR,   NRCOR,
 310      Q   NRPROC,   NRTEXT,   NRUNIV,   NATTR,    NRNONE,   NBLSYS,
 311      R   NBLUS,    NEMPTY,   INSYS,    LOCAL,    OWN,      OBJECT,
 312      $   scaner(8735)
 313 cdsw $   SCANER(3735),
 314       common /BLANK/
 315      Z   TOP,      IN,       NEXT,     STACK(500),
 316      *   RESZTA(3652)
 317
 318       GOTO (10,20,30,40),IN
 319 10    CALL OUTPUT(WLSE,-1)
 320       IF (S.NE.SCOMA) GOTO 120
 321 100   CALL SCAN
 322       CALL SLAD(0,6,2)
 323       NEXT=3
 324 C  CALL OBJECTEXPRESSION
 325       RETURN
 326 20    CALL OUTPUT(WLSE,-1)
 327       IF (S.EQ.SCOMA) GOTO 100
 328 120   IF (S.NE.SBECOME) CALL ERROR(109)
 329       CALL SCAN
 330       IF (S.NE.SCOPY) GOTO 130
 331       CALL SCAN
 332       IF (S.NE.SLEFT) GOTO 110
 333       CALL SCAN
 334       GOTO 111
 335 110   CALL ERROR(106)
 336 111   CALL SLAD(0,6,3)
 337       NEXT=3
 338       RETURN
 339 C  CALL OBJECTEXPRESSION  /E3/
 340 30    IF (S.NE.SRIGHT) GOTO 112
 341       CALL SCAN
 342       GOTO 113
 343 112   CALL ERROR(107)
 344 113   CALL OUTPUT(WCOPY,WASSIGN)
 345       NEXT=0
 346       RETURN
 347 130   CALL SLAD(0,6,4)
 348       NEXT=1
 349 C  CALL BOOLEXPRESSION
 350       RETURN
 351 40    CONTINUE
 352       CALL OUTPUT(WASSIGN,-1)
 353       NEXT=0
 354       RETURN
 355       END
 356
 357       SUBROUTINE E7
 358       IMPLICIT INTEGER (A-Z)
 359 C
 360 C  RECOGNIZES AN ARITHMETIC EXPRESSION COMPOSED OF CONSTANTS
 361 C
 362 C  LOCAL VARIABLES:
 363 C     STACK(TOP+3) - MULTIPLICATIVE OPERATOR,
 364 C     STACK(TOP+4) - ADDITIVE OPERATOR,
 365 C     STACK(TOP+5) - 1 = UNARY MINUS FLAG.
 366 C
 367       COMMON /BLANK/
 368      $   C0M(4),
 369      O   S,        ADRES,    K,        SCOMA,    SDOT,     SEMICOL,
 370      1   SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,     SRELAT,
 371      2   SEOF,     SIDENT,   SCONST,   SAND,     SARRAY,   SARROF,
 372      3   SATTACH,  SBEGIN,   SBLOCK,   SBOOL,    SCALL,    SCASE,
 373      4   SCLASS,   SCLOSE,   SCONS,    SCOPY,    SCOROUT,  SDETACH,
 374      5   SDIM,     SDO,      SDOWN,    SELSE,    SEND,     SESAC,
 375      6   SEXIT,    SEXTERN,  SFI,      SFOR,     SFUNCT,   SIF,
 376      7   SINNER,   SINPUT,   SINT,     SKILL,    SLOCK,    SNEW,
 377      8   SNONE,    SNOT,     SOD,      SOR,      SORIF,    SOTHER,
 378      9   SOUTPUT,  SPREF,    SPRCD,    SQUA,     SREAD,    SRESUME,
 379      O   SRETURN,  STEP,     STOP,     STAKEN,   STHEN,    STHIS,
 380      A   STO,      STYPE,    SUNIT,    SVAR,     SVIRTUAL, SWAIT,
 381      B   SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
 382      C   WAND,     WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
 383      D   WCALL,    WCASE,    WCASEL,   WCOMA,    WCNSTB,   WCNSTC,
 384      E   WCNSTI,   WCNSTN,   WCNSTR,   WCNST,    WCOPY,    WDETACH,
 385      F   WDOT,     WDOWNTO,  WEOF,     WESAC,    WFIN,     WFIRST,
 386      G   WFOREND,  WFORVAR,  WFROM,    WIDENT,   WIFFALS,  WIFTRUE
 387
 388       common /BLANK/
 389      H   WINNER,   WINSTREND,WJUMP,    WKILL,    WLABEL,   WLEFT,
 390      I   WLOCK,    WLOW,     WLSE,     WNEW,     WNEWARRAY,WNOT,
 391      J   WOPERAT,  WOPT,     WOR,      WOTHER,   WPREF,    WPRIM,
 392      K   WQUA,     WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
 393      L   WSTART,   WSTEP,    WSTOP,    WTHIS,    WTO,      WAIT,
 394      M   WRITE,    WRITELN,  WBOUND,   UNICAL,
 395      N   COM(132),
 396      O   LMEM,     LPMEM,    IRECN,    ISFIN,    LPMSYS,   LPML,
 397      P   LPMF,     NRINT,    NRRE,     NRBOOL,   NRCHAR,   NRCOR,
 398      Q   NRPROC,   NRTEXT,   NRUNIV,   NATTR,    NRNONE,   NBLSYS,
 399      R   NBLUS,    NEMPTY,   INSYS,    LOCAL,    OWN,      OBJECT,
 400      $   scaner(8735)
 401 cdsw $   SCANER(3735),
 402       common /BLANK/
 403      Z   TOP,      IN,       NEXT,     STACK(500),
 404      *   RESZTA(3652)
 405
 406       GOTO (10,20),IN
 407 10    STACK(TOP+3)=0
 408       STACK(TOP+4)=0
 409       STACK(TOP+5)=0
 410       IF (S.NE.STAR) GOTO 100
 411       IF (ADRES.EQ.4) GOTO 82
 412       IF (ADRES.EQ.3) GOTO 85
 413 C                          MOD, DIV, * ALBO /
 414       CALL ERROR(126)
 415 C                          MINUS (-) OCCURRS BEFORE EXPRESSION
 416 82    STACK(TOP+5)=1
 417 C                          PLUS (+) BEFORE EXPRESSION - IGNORE IT
 418 85    CALL SCAN
 419 C                          MAIN LOOP
 420 100   IF (S.EQ.SLEFT) GOTO 120
 421       IF (S.EQ.SIDENT) GOTO 110
 422       IF (S.NE.SCONST) GOTO 1000
 423 C                          CONSTANT - TYPE STILL UNKNOWN
 424       GOTO (1000,1000,101,102,103,102),K
 425 C                          INTEGER (K=3)
 426 101   CALL OUTPUT(WCNSTI,ADRES)
 427       GOTO 179
 428 C                          TEXT (K=4) OR CHAR (K=6)
 429 102   CALL ERROR(115)
 430       CALL OUTPUT(WCNSTI,0)
 431       GOTO 179
 432 C                          REAL (K=5)
 433 103   CALL OUTPUT(WCNSTR,ADRES)
 434       GOTO 179
 435 C                          IDENTIFIER ENCOUNTERED
 436 110   CALL OUTPUT(WIDENT,ADRES)
 437       GOTO 179
 438 C                          LEFT PARANTHESIS ENCOUNTERED (RECURRENCE)
 439 120   CALL SCAN
 440       CALL SLAD(3,7,2)
 441       NEXT=12
 442       RETURN
 443 C                          RECURSIVE CALL OF E12 TO ANALYSE THE
 444 C                          SUBEXPRESSION
 445 20    IF (S.EQ.SRIGHT) GOTO 179
 446       CALL ERROR(107)
 447       GOTO 1000
 448 C------------- END OF THE MAIN LOOP
 449 179   CALL SCAN
 450 180   IF (STACK(TOP+5).EQ.0) GOTO 185
 451 C                          MINUS BEFORE EXCPRESSION
 452       CALL OUTPUT(WOPERAT,2)
 453       STACK(TOP+5)=0
 454 185   IF (STACK(TOP+3).NE.0) CALL OUTPUT(WOPERAT,STACK(TOP+3))
 455       STACK(TOP+3)=0
 456       IF (S.NE.STAR) GOTO 190
 457       IF (ADRES.LT.5) GOTO 190
 458 C                          MOD, DIV, * OR / - NEXT FACTOR EXPECTED
 459       STACK(TOP+3)=ADRES
 460       GOTO 85
 461 190   IF (STACK(TOP+4).NE.0) CALL OUTPUT(WOPERAT,STACK(TOP+4))
 462       STACK(TOP+4)=0
 463       IF (S.NE.STAR) GOTO 1000
 464       IF (ADRES.LT.2) GOTO 1000
 465 C                          + OR - (MINUS) - NEXT COMPONENT EXPECTED
 466       STACK(TOP+4)=ADRES
 467       GOTO 85
 468 1000  NEXT=0
 469       RETURN
 470       END
 471
 472       SUBROUTINE E8
 473 C
 474 C  RECOGNIZES THE SEQUENCE OF INSTRUCTIONS UNTIL A TERMINAL SYMBOL
 475 C  THE PARAMETER IS PASSED BY  STACK(TOP+7)
 476 C
 477 C    STACK(TOP+3)
 478 C    STACK(TOP+4)  -  NUMBERS OF THE GENERATED LABELS
 479 C      . . .       OTHERS
 480 C    STACK(TOP+7)  -  A INPUT PARAMETER WHICH DETERMINES THE SET OF THE
 481 C                     TERMINAL SYMBOLS
 482 C          MEANING:
 483 C                     1 - INSTRUCTIONS UNTIL WHEN/OTHERS/END
 484 C                     2 - .................. ELSE/FI
 485 C                     3 - .................. FI
 486 C                     4 - .................. OD
 487 C                     5 - .................. END
 488 C                     6 - .................. WHEN/OTHERWISE/ESAC
 489 C                     7 - .................. ESAC
 490 C
 491       IMPLICIT INTEGER (A-Z)
 492       logical errflg
 493       COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
 494      X                POSIT,RECNR,NEKST
 495       COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,JNK(266)
 496       COMMON /BLANK/
 497      $   C0M(4),
 498      O   S,        ADRES,    K,        SCOMA,    SDOT,     SEMICOL,
 499      1   SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,     SRELAT,
 500      2   SEOF,     SIDENT,   SCONST,   SAND,     SARRAY,   SARROF,
 501      3   SATTACH,  SBEGIN,   SBLOCK,   SBOOL,    SCALL,    SCASE,
 502      4   SCLASS,   SCLOSE,   SCONS,    SCOPY,    SCOROUT,  SDETACH,
 503      5   SDIM,     SDO,      SDOWN,    SELSE,    SEND,     SESAC,
 504      6   SEXIT,    SEXTERN,  SFI,      SFOR,     SFUNCT,   SIF,
 505      7   SINNER,   SINPUT,   SINT,     SKILL,    SLOCK,    SNEW,
 506      8   SNONE,    SNOT,     SOD,      SOR,      SORIF,    SOTHER,
 507      9   SOUTPUT,  SPREF,    SPRCD,    SQUA,     SREAD,    SRESUME,
 508      O   SRETURN,  STEP,     STOP,     STAKEN,   STHEN,    STHIS,
 509      A   STO,      STYPE,    SUNIT,    SVAR,     SVIRTUAL, SWAIT,
 510      B   SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
 511      C   WAND,     WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
 512      D   WCALL,    WCASE,    WCASEL,   WCOMA,    WCNSTB,   WCNSTC,
 513      E   WCNSTI,   WCNSTN,   WCNSTR,   WCNST,    WCOPY,    WDETACH,
 514      F   WDOT,     WDOWNTO,  WEOF,     WESAC,    WFIN,     WFIRST,
 515      G   WFOREND,  WFORVAR,  WFROM,    WIDENT,   WIFFALS,  WIFTRUE
 516
 517       common /BLANK/
 518      H   WINNER,   WINSTREND,WJUMP,    WKILL,    WLABEL,   WLEFT,
 519      I   WLOCK,    WLOW,     WLSE,     WNEW,     WNEWARRAY,WNOT,
 520      J   WOPERAT,  WOPT,     WOR,      WOTHER,   WPREF,    WPRIM,
 521      K   WQUA,     WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
 522      L   WSTART,   WSTEP,    WSTOP,    WTHIS,    WTO,      WAIT,
 523      M   WRITE,    WRITELN,  WBOUND,   UNICAL,
 524      N   COM(132),
 525      O   LMEM,     LPMEM,    IRECN,    ISFIN,    LPMSYS,   LPML,
 526      P   LPMF,     NRINT,    NRRE,     NRBOOL,   NRCHAR,   NRCOR,
 527      Q   NRPROC,   NRTEXT,   NRUNIV,   NATTR,    NRNONE,   NBLSYS,
 528      R   NBLUS,    NEMPTY,   INSYS,    LOCAL,    OWN,      OBJECT,
 529      $   scaner(8735)
 530 cdsw $   SCANER(3735),
 531       common /BLANK/
 532      Z   TOP,      IN,       NEXT,     STACK(500),
 533      *   RESZTA(3652)
 534
 535 cdsw  EQUIVALENCE (AUX,SCANER(3698))
 536       EQUIVALENCE (AUX,SCANER(8698))
 537       EQUIVALENCE (WSTART,WUNLOCK)
 538 C*******************************************************************
 539 C*** NOTE **********************************************************
 540 C*** SMAIN HAS TO BE INSERTED INTO THE BLANK COMMON ON OCCASION  ***
 541 C*** OF SOME OTHER CHANGES *********************** 10/11/1981 ******
 542 C*** WSTART SHOULD BE CHANGED TO WUNLOCK ***************************
 543 C*******************************************************************
 544       smain = 96
 545       wind = 69
 546       wwlock = 66
 547       wwunlock = 67
 548       sothrs = 57
 549       wwread = 73
 550       wreadl = 74
 551       wioend = 50
 552       wopen1 = 77
 553       wopen2 = 78
 554       wput = 75
 555       wget = 76
 556       wparin = 81
 557       wassem = 84
 558       wputrec = 89
 559       wgetrec = 90
 560 cbc added concurrent statements
 561       wenab = 91
 562       wdisab = 92
 563       waccep = 93
 564       wprend = 94
 565       senab = 35
 566 cbc
 567
 568       GOTO (10,20,30,40,50,60,70,80,90,100,110,120,130,140,150,160,
 569      X170,180,190,200,210,220,230,240,250,260,270,280,290,300,310,
 570      x320,330,340,350,360,370,380),in
 571 cdsw x320,330,340,350),in
 572 cfileX320,330,340),IN
 573 C  CHECK WHETHER SYMBOL S MAY START AN INSTRUCTION
 574 6     CALL ERROR(102)
 575 8     CALL SCAN
 576 cbc 10    if(s.gt.34) go to 1111
 577 10    if (s .gt. 36) goto 1111
 578       IF (S.GT.0) GOTO 15
 579       CALL ERROR(102)
 580       GOTO 999
 581 15    IF (AUX.NE.0) CALL SELOPT
 582       CALL OUTPUT(WINSTREND,LN)
 583       GOTO (101,201,301,401,501,601,701,801,901,1001,1101,1201,1301
 584      1,1401,1501,1601,1701,1801,1901,2001,2101,2201,2301,101,2501
 585      2,2601,2701,2801,2901,3001,3101,3201,3301,3401,3501,3601),s
 586 cbc  2,2601,2701,2801,2901,3001,3101,3201,3301,3401),s
 587 C----- S = SIDENT  -  ASSIGNMENT STATEMENT OR OBJECT GENERATOR
 588 101   CONTINUE
 589       CALL SLAD(5,8,12)
 590       NEXT=3
 591 C  CALL OBJECT EXPRESSION /E3/ TO ANALYSE THE VARIABLE
 592       GO TO 7766
 593 120   CONTINUE
 594       IF (S.EQ.SEMICOL) GOTO 125
 595       IF (S.EQ.SBECOME) GOTO 111
 596       IF (S.EQ.SCOMA) GOTO 111
 597       GOTO 1111
 598 C  INITIAL FRAGMENT OF AN ASSIGNMENT STATEMENT HAS BEEN RECOGNIZED
 599 111   CALL SLAD(5,8,2)
 600       NEXT=6
 601       GO TO 7766
 602 C  CALL ASSIGNMENT  /E6/
 603 C  RETURN TO LABEL 20 BELOW
 604 C   /JUMP OPTIMIZATION/
 605 C
 606 C   < VARIABLE  > ; IS RECOGNIZED
 607 C  CHECK FOR A PENDING NEW OR START
 608 125   IF (STACK(TOP+15).EQ.0) CALL ERROR(123)
 609       GOTO 1000
 610 C----- S = IF   INSTRUCTION: IF EXPR. THEN INSTR. ( ELSE INSTR. ) FI
 611 C  STACK(TOP+5)=0 THERT WAS NO ORIF/ANDIF
 612 C              =1 THERE WAS ANDIF
 613 C              =2 THERE WAS ORIF
 614 C  STACK(TOP+4) - LABEL BEHIND THEN OR ELSE
 615 C                 DEPENDING ON THE CONTENTS OF STACK(TOP+5)
 616 C  STACK(TOP+3) - USED TO COUN EXITS FOR THE SEQUENCES:I IF EXPR. THEN EXIT..
 617 201   STACK(TOP+5)=0
 618       STACK(TOP+4)=UNICAL
 619       UNICAL=UNICAL+1
 620 202   CALL SCAN
 621       CALL SLAD(5,8,3)
 622       NEXT=1
 623       GO TO 7766
 624 C  CAL BOOLEXPRESSION  /E1/
 625 30    IF (S.EQ.SORIF) GOTO 203
 626       IF (S.EQ.STHEN) GOTO 204
 627       CALL ERROR(103)
 628       CALL OUTPUT(WLABEL,STACK(TOP+4))
 629       GOTO 1000
 630 C  CALL ORIF
 631 203   IF (STACK(TOP+5).EQ.0) STACK(TOP+5)=ADRES
 632       IF (STACK(TOP+5).NE.ADRES) CALL ERROR(140)
 633       CALL OUTPUT(WIDENT+ADRES,STACK(TOP+4))
 634 C IF ANDIF THEN ADRES=1 & WIDENT+ADRES=WIFFALS
 635 C IF ORIF  THEN ADRES=2 & WIDENT+ADRES=WIFTRUE
 636       GOTO 202
 637 204   CALL SCAN
 638 C  THEN ENCOUNTERED, CHECK IF THERE WAS ORIF OR ANDIF
 639       IF (STACK(TOP+5).EQ.2) GOTO 215
 640       IF (STACK(TOP+5).EQ.1) GOTO 214
 641       STACK(TOP+3)=0
 642 205   IF (S.NE.SEXIT) GOTO 207
 643 C  EXIT/REPEAT ENCOUNTERED
 644       STACK(TOP+3)=STACK(TOP+3)+1
 645       IF (ADRES.EQ.2) GOTO 206
 646       CALL SCAN
 647       GOTO 205
 648 C  (EXIT)+ REPEAT ENCOUNTERED
 649 206   CALL OUTPUT(WIFTRUE,EXYT(STACK(TOP+3),0))
 650       CALL SCAN
 651       GOTO 208
 652 C  S =/= EXIT
 653 207   IF (STACK(TOP+3).EQ.0) GOTO 214
 654       CALL OUTPUT(WIFTRUE,EXYT(STACK(TOP+3),1))
 655 C  IF EXPR. THEN  (EXIT)+ REPEAT
 656 208   IF (S.EQ.SFI) GOTO 999
 657       IF (S.EQ.SELSE) GOTO 211
 658       IF (S.NE.SEMICOL) GOTO 209
 659       CALL SCAN
 660       GOTO 208
 661 C  THERE ARE INSTRUCTIONS BEHIND EXIT
 662 209   CALL ERROR(139)
 663       CALL SLAD(5,8,29)
 664       NEXT=8
 665       STACK(TOP+7)=2
 666       GO TO 7766
 667 C  CALL E8 TO ANALYSE A SEQUENCE OF STATEMENTS ENDED BY ELSE OR FI
 668 290   IF (S.NE.SELSE) GOTO 999
 669 211   CALL SCAN
 670       CALL SLAD(5,8,30)
 671       NEXT=8
 672       STACK(TOP+7)=3
 673       GO TO 7766
 674 C  CALL E8 TO ANALYSE INMSTRUCTIONS AFTER ELSE
 675 300   IF (S.EQ.SFI) GOTO 999
 676 C  A MISSING "FI" IS DIAGNOSED IN SOME OTHER PLACE. HERE WE JUMP TO 1000
 677 C  TO AVOID READING OF THE NEXT INPUT SYMBOL
 678       GOTO 1000
 679 C
 680 C  ANALYSIS FOR IF EXPR. THEN ......
 681 214   STACK(TOP+3)=STACK(TOP+4)
 682       CALL OUTPUT(WIFFALS,STACK(TOP+3))
 683       GOTO 217
 684 C  ORIF OCCURRED, A LABEL (FOR ELSE OR FI) HAS TO BE RESERVED
 685 215   STACK(TOP+3)=UNICAL
 686       UNICAL=UNICAL+1
 687       CALL OUTPUT(WIFFALS,STACK(TOP+3))
 688       CALL OUTPUT(WLABEL,STACK(TOP+4))
 689 217   CALL SLAD(5,8,4)
 690       NEXT=8
 691       STACK(TOP+7)=2
 692 C  A VALUE IS ASSIGNED TO THE PARAMETER OF E8
 693       GO TO 7766
 694 C  ANALYSIS AFTER THEN
 695 40    IF (S.EQ.SELSE) GOTO 241
 696       IF (S.NE.SFI) GOTO 271
 697 C  A "FI" UNPRECEDED BY "ELSE"
 698 221   CALL OUTPUT(WLABEL,STACK(TOP+3))
 699       GOTO 999
 700 C  ELSE ENCOUNTERED, WE SHOULD RESERVE A LABEL TO JUMP BEHIND FI
 701 241   STACK(TOP+4)=UNICAL
 702       UNICAL=UNICAL+1
 703       CALL SCAN
 704       CALL OUTPUT(WJUMP,STACK(TOP+4))
 705       CALL OUTPUT(WLABEL,STACK(TOP+3))
 706       CALL SLAD (5,8,5)
 707       NEXT=8
 708       STACK(TOP+7)=3
 709 C  PARAMETER FOR E8
 710       GO TO 7766
 711 C  ANALYSIS OF INSTRUCTIONS AFTER ELSE
 712 50    IF (S.NE.SFI) GOTO 271
 713       CALL OUTPUT(WLABEL,STACK(TOP+4))
 714       GOTO 999
 715 271   CALL ERROR(104)
 716       GOTO 1000
 717 C----- S = WHILE
 718 301   STACK(TOP+3)=UNICAL
 719       STACK(TOP+4)=UNICAL+1
 720 C  RESERVATION OF LABELS:
 721 C     STACK(TOP+3) - BEGINNING OF THE LOOP (THE BOOLEAN CONDITION)
 722 C     STACK(TOP+4) - END OF THE LOOP
 723       UNICAL=UNICAL+2
 724       CALL SCAN
 725       CALL OUTPUT(WLABEL,STACK(TOP+3))
 726       CALL OUTPUT(WINSTREND,LN)
 727       CALL SLAD(5,8,6)
 728       NEXT=1
 729       GO TO 7766
 730 C  CALL BOOLEXPRESSION  /E1/
 731 60    CALL OUTPUT(WIFFALS,STACK(TOP+4))
 732 C  CONDITIONAL JUMP BEHIND DO
 733       IF (S.EQ.SDO) GOTO 307
 734       CALL ERROR(108)
 735       GOTO 309
 736 307   CALL SCAN
 737 309   CONTINUE
 738       CALL SLAD(5,8,7)
 739       NEXT=8
 740       STACK(TOP+7)=4
 741 C  PARAMETER PASSING
 742       GO TO 7766
 743 C  ANALYSIS OF THE INTERIOR OF THE DO LOOP  /E8/
 744 70    CALL OUTPUT(WJUMP,STACK(TOP+3))
 745 C  JUMP TO THE BEGINNING OF THE LOOP
 746       CALL OUTPUT(WLABEL,STACK(TOP+4))
 747       IF (S.EQ.SOD) GOTO 999
 748       CALL ERROR(105)
 749       GOTO 1000
 750 C----- S = RETURN
 751 401   CALL OUTPUT(WRETURN,-1)
 752 cbc added enable/disable option
 753       call scan
 754 405   if (s .ne. senab) goto 415
 755       call output(wenab+adres-1, -1)
 756 410   call scan
 757       if (s .ne. sident) goto 420
 758       call output(wident, adres)
 759       call scan
 760       if (s .eq. scoma) goto 410
 761       goto 405
 762 415   call output(wprend, -1)
 763       goto 1000
 764 420   call error(109)
 765       goto 1000
 766 cbc end
 767 C----- S = DETACH
 768 501   CALL OUTPUT(WDETACH,-1)
 769       GOTO 999
 770 C----- S = INNER
 771 601   CALL OUTPUT(WINNER,-1)
 772       GOTO 999
 773 C----- S = LOCK
 774 701   STACK(TOP+3)=6
 775 C  FURTHER ANALYSIS AS FOR KILL, RESUME, ETC.
 776       GOTO 1302
 777 C----- S = READ
 778 801   CALL SCAN
 779       STACK(TOP+3)=0
 780 C     STACK(TOP+3)=   0  - READ
 781 C                     1  - READLN
 782       IF (S.EQ.SLEFT) GOTO 803
 783       CALL ERROR(106)
 784       GOTO 804
 785 803   CALL SCAN
 786 804   CALL SLAD(5,8,9)
 787       NEXT=3
 788       GO TO 7766
 789 C  CALL OBJECTEXPRESSION FOR READ( VARIABLE, . . . ,VARIABLE )
 790 90    CALL OUTPUT(WWREAD,-1)
 791 C  CHECK IF END OF THE READ LIST
 792       IF (S.EQ.SCOMA) GOTO 803
 793 808   IF (S.EQ.SRIGHT) GOTO 810
 794       CALL ERROR(107)
 795       GOTO 812
 796 810   CALL SCAN
 797 812   IF (STACK(TOP+3).GT.0) CALL OUTPUT(WREADL,-1)
 798       CALL OUTPUT(WIOEND,-1)
 799       GOTO 1000
 800 C----- S= CALL
 801 901   CALL SCAN
 802       STACK(TOP+3)=0
 803 C
 804 C  STACK(TOP+3) - 0 - CALL
 805 C                 1 - RAISE
 806 C
 807 C --- ADDED CHECK FOR STHIS AND SNEW
 808       IF (S.EQ.SIDENT.OR.S.EQ.STHIS.OR.S.EQ.SNEW) GOTO 905
 809 C ---
 810       CALL ERROR(109)
 811       GOTO 1000
 812 905   CALL SLAD(5,8,10)
 813       NEXT=3
 814       GO TO 7766
 815 C  CALL OBJECTEXPRESSION TO ANALYSE THE EXPRESSION
 816 C  WRITE WCALL OR WRAISE DEPENDING ON THE CONTENTS OF STACK(TOP+3)
 817 100   CALL OUTPUT(WCALL+STACK(TOP+3)*64,-1)
 818       GOTO 1000
 819 C----- S = KILL
 820 1001  STACK(TOP+3)=1
 821       GOTO 1302
 822 C----- S = ATTACH
 823 1101  STACK(TOP+3)=2
 824       GOTO 1302
 825 C----- S = RESUME
 826 1201  STACK(TOP+3)=3
 827       GOTO 1302
 828 C----- S = STOP
 829 1301  STACK(TOP+3)=4
 830 C  THE MEANING OF STACK(TOP+3):
 831 C    1 - KILL
 832 C    2 - ATTACH
 833 C    3 - RESUME
 834 C    4 - STOP
 835 C    5 - WAIT
 836 C    6 - LOCK
 837 C    7 - UNLOCK
 838       CALL SCAN
 839       IF (S.EQ.SLEFT) GOTO 1303
 840 C  STOP WITHOUT PARAMETER
 841       CALL OUTPUT(WSTOP,-1)
 842       GOTO 1000
 843 1302  CALL SCAN
 844       IF (S.EQ.SLEFT) GOTO 1303
 845       CALL ERROR(106)
 846       GOTO 1304
 847 1303  CALL SCAN
 848 1304  IF (S.EQ.SMAIN) GOTO 1320
 849       CALL SLAD(5,8,11)
 850       NEXT=3
 851       GO TO 7766
 852 C  CALL OBJECTEXPRESSION. /E3/ TO ANALYSE THE EXPRESSION AFTER
 853 C  KILL, ATTACH, RESUME, STOP, WAIT, LOCK
 854 110   IF (S.EQ.SRIGHT) GOTO 1305
 855       CALL ERROR(107)
 856       GOTO 1306
 857 1305  CALL SCAN
 858 C  JUMP ACCORDING TO THE PREVIOUSLY RECOGNIZED STATEMENT TYPE
 859 1306  K=STACK(TOP+3)
 860       GOTO (1307,1308,1309,1310,1311,1312,1313),K
 861 1307  CALL OUTPUT(WKILL,-1)
 862       GOTO 1000
 863 1308  CALL OUTPUT(WATTACH,-1)
 864       GOTO 1000
 865 1309  CALL OUTPUT(WRESUME,-1)
 866       GOTO 1000
 867 1310  CALL OUTPUT(WSTOP,-1)
 868       GOTO 1000
 869 1311  CALL OUTPUT(WAIT,-1)
 870       GOTO 1000
 871 1312  CALL OUTPUT(WWLOCK,-1)
 872       GOTO 1000
 873 1313  CALL OUTPUT(WWUNLOCK,-1)
 874       GOTO 1000
 875 C  MAIN ENCOUNTERED, CHECK IF THE CONTEXT IS RESUME/ATTACH
 876 1320  IF (STACK(TOP+3).EQ.2) GOTO 1330
 877       IF (STACK(TOP+3).EQ.3) GOTO 1340
 878       CALL ERROR(131)
 879       GOTO 1345
 880 C  RECOGNIZED ATTACH(MAIN)
 881 1330  CALL OUTPUT(WIDENT,K)
 882       CALL OUTPUT(WATTACH,-1)
 883       GOTO 1345
 884 1340  CALL OUTPUT(WIDENT,K)
 885       CALL OUTPUT(WRESUME,-1)
 886 1345  CALL SCAN
 887       IF (S.EQ.SRIGHT) GOTO 999
 888       CALL ERROR(107)
 889       GOTO 1000
 890 C----- S = DO
 891 C  STACK(TOP+3) - LABEL OF THE BEGINNING OF THE LOOP BODY
 892 C  STACK(TOP+4) - LABEL OF THE FIRST STATEMENT BEHIND THE LOOP BODY
 893 1401  STACK(TOP+3)=UNICAL
 894       STACK(TOP+4)=UNICAL+1
 895       UNICAL=UNICAL+2
 896       CALL SCAN
 897       CALL OUTPUT(WLABEL,STACK(TOP+3))
 898       CALL SLAD(5,8,13)
 899       STACK(TOP+7)=4
 900       NEXT = 8
 901       GO TO 7766
 902 C  CALL E8 (INSTRUCTION) WITH PARAMETER 4
 903 130   CALL OUTPUT(WINSTREND,LN)
 904       CALL OUTPUT(WJUMP,STACK(TOP+3))
 905       CALL OUTPUT(WLABEL,STACK(TOP+4))
 906       IF (S.EQ.SOD) GOTO 999
 907       CALL ERROR(105)
 908       GOTO 1000
 909 C----- S = EXIT
 910 1501  STACK(TOP+3)=0
 911 1505  STACK(TOP+3)=STACK(TOP+3)+1
 912       IF (ADRES.EQ.2) GOTO 1550
 913       CALL SCAN
 914       IF (S.EQ.SEXIT) GOTO 1505
 915       CALL OUTPUT(WJUMP,EXYT(STACK(TOP+3),1))
 916       GOTO 1000
 917 1550  CALL OUTPUT(WJUMP,EXYT(STACK(TOP+3),0))
 918       GOTO 999
 919 C----- S =   CASE
 920 1601  STACK(TOP+3)=UNICAL+1
 921       STACK(TOP+4)=UNICAL+162
 922       STACK(TOP+5)=1
 923       STACK(TOP+6)=1
 924       UNICAL=UNICAL+163
 925 C
 926 C  STACK(TOP+3) - BASIC CASE LABEL, NOT USED
 927 C  STACK(TOP+4) - END LABEL OF THE CASE STATEMENT
 928 C  STACK(TOP+5) - COUNTER OF WHEN'S (NUMBER OF WHEN'S LIMITED BY 160)
 929 C  STACK(TOP+6) - 0 = OVERFLOW FLAG (TOO MANY WHEN'S)
 930 C  NOTE:  THE BASIC LABEL IS RESERVED ESPECIALLY FOR AIL, NOT USED IN HERE.
 931 C         LABELS FOR WHEN'S ARE OF THE FORM: BASIS + I ,  WHERE  I = 1 .. 160
 932 C         TOTAL NUMBER OF RESERVED LABELS IS 163.
 933 C
 934       CALL SCAN
 935       CALL SLAD(5,8,26)
 936       NEXT=2
 937       GO TO 7766
 938 C  CALL E2 - ARITHEXPRESSION TO ANALYSE THE EXPRESSION AFTER CASE
 939 260   CALL OUTPUT(WCASE,STACK(TOP+3))
 940       IF (S.EQ.SWHEN) GOTO 1605
 941       CALL ERROR(132)
 942       GOTO 1607
 943 1605  CALL SCAN
 944 C  RECOGNITION OF THE SELECTION LABEL
 945 1607  IF (STACK(TOP+6).EQ.0) GOTO 1621
 946       IF (S.EQ.SIDENT) GOTO 1610
 947       IF (S.EQ.SCONST) GOTO 1615
 948 1608  CALL ERROR(117)
 949       CALL OUTPUT(WIDENT,0)
 950       GOTO 1620
 951 C  IDENTIFIER RECOGNIZED
 952 1610  CALL OUTPUT(WIDENT,ADRES)
 953       GOTO 1620
 954 C  CONSTANT RECOGNIZED
 955 1615  IF (K.EQ.6) GOTO 1618
 956       IF (K.NE.3) GOTO 1608
 957 C  INTEGER CONSTANT
 958       CALL OUTPUT(WCNSTI,ADRES)
 959       GOTO 1620
 960 C  CHARACTER CONSTANT
 961 1618  CALL OUTPUT(WCNSTC,ADRES)
 962 1620  CALL OUTPUT(WCASEL,STACK(TOP+3)+STACK(TOP+5))
 963 1621  CALL SCAN
 964       IF (S.EQ.SCOLON) GOTO 1625
 965       IF (S.NE.SCOMA)  GOTO 1623
 966 C  COMA ENCOUNTERED - FURTHER LABEL LIST EXPECTED
 967       CALL SCAN
 968       GOTO 1607
 969 C  NEITHER SEMICOLON NOR COMMA (ERROR AND WE CONTINUE AS FOR
 970 C  SEMICOLON - INSTRUCTIONS)
 971 1623  CALL ERROR(118)
 972       GOTO 1626
 973 C  SEMICOLON ENCOUNTERED - INSTRUCTIONS ARE TO BE ANALYSED
 974 1625  CALL SCAN
 975 1626  IF (STACK(TOP+5).NE.161) GOTO 1627
 976 C  TO MANY WHEN'S
 977       CALL ERROR(133)
 978       STACK(TOP+6)=0
 979       GOTO 1628
 980 1627  CALL OUTPUT(WLABEL,STACK(TOP+3)+STACK(TOP+5))
 981       STACK(TOP+5)=STACK(TOP+5)+1
 982 1628  CALL SLAD(5,8,27)
 983       NEXT=8
 984       STACK(TOP+7)=6
 985       GO TO 7766
 986 C  CALL E8 TO ANALYSE THE INSTRUCTION LIST ENDED BY WHEN, OTHERWISE
 987 C  OR ESAC (PARAMETER = 6)
 988 270   CALL OUTPUT(WJUMP,STACK(TOP+4))
 989       IF (S.EQ.SWHEN) GOTO 1605
 990       IF (S.NE.SOTHER) GOTO 1655
 991 C  OTHERWISE ENCOUNTERED
 992       CALL OUTPUT(WOTHER,-1)
 993       CALL SCAN
 994       CALL SLAD (5,8,28)
 995       NEXT=8
 996       STACK(TOP+7)=7
 997       GO TO 7766
 998 C  CALL E8 TO ANALYSE THE INSTRUCTION SEQUENCE ENDED BY ESAC (PARAMETER=7)
 999 C  AFTER RETURN JUMP BEHIND CASE IS NOT TO BE GENERATED
1000 280   CONTINUE
1001 C  ESAC ENCOUNTERED (A MISSING ESAC IS DIAGNOSED ON SOME OTHER LEVEL).
1002 C  HERE, TO PROVIDE CODE CONSISTENCY, WE ASSUME THAT AN ESAC HAS OCCURRED
1003 C  ANYWAY.
1004 1655  CALL OUTPUT(WESAC,-1)
1005       CALL OUTPUT(WLABEL,STACK(TOP+4))
1006       IF (S.EQ.SESAC) GOTO 999
1007       CALL ERROR(129)
1008       GOTO 1000
1009 C----- S = FOR
1010 1701  CALL SCAN
1011       CALL SLAD(5,8,21)
1012       NEXT=3
1013       GO TO 7766
1014 C  CALL E3 T OANALYSE THE VARIABLE
1015 210   CALL OUTPUT(WFORVAR,-1)
1016       IF (S.EQ.SBECOME) GOTO 1703
1017       CALL ERROR(101)
1018       GOTO 1000
1019 1703  CALL SCAN
1020       CALL SLAD(5,8,22)
1021       NEXT=2
1022       GO TO 7766
1023 C  CALL E2 - ARITHEXPRESSION TO ANALYSE BOUNDS
1024 220   CALL OUTPUT(WFROM,-1)
1025       IF (S.NE.STEP) GOTO 1705
1026       CALL SCAN
1027       CALL SLAD(5,8,23)
1028       NEXT=2
1029       GO TO 7766
1030 C  CALL E2 TO ANALYZE THE STEP
1031 230   CALL OUTPUT(WSTEP,-1)
1032 1705  IF (S.EQ.STO) GOTO 1707
1033       IF (S.EQ.SDOWN) GOTO 1709
1034       CALL ERROR(125)
1035       GOTO 1000
1036 C  STACK(TOP+3)=0 IFF "TO" ENCOUNTERED, OTHERWISE -1 STANDS FOR "DOWNTO"
1037 1707  STACK(TOP+3)=0
1038       GOTO 1711
1039 1709  STACK(TOP+3)=1
1040 1711  CALL SCAN
1041       CALL SLAD(5,8,24)
1042       NEXT=2
1043       GO TO 7766
1044 C  CALL E2 TO ANALYSE BOUNDS OF THE FOR LOOP
1045 240   IF (STACK(TOP+3).EQ.1) GOTO 1713
1046       CALL OUTPUT(WTO,-1)
1047       GOTO 1715
1048 1713  CALL OUTPUT(WDOWNTO,-1)
1049 C   STACK(TOP+3) LABEL OF THE END OF THE LOOP (BEFORE OD!)
1050 C   STACK(TOP+4) LABEL OF THE FIRST INSTRUCTION BEHIND THE LOOP
1051 C   STACK(TOP+5) LABEL OF THE BEGINNING OF THE LOOP
1052 1715  STACK(TOP+3)=UNICAL
1053       STACK(TOP+4)=UNICAL+1
1054       STACK(TOP+5)=UNICAL+2
1055       UNICAL=UNICAL+3
1056       CALL OUTPUT(STACK(TOP+5),STACK(TOP+4))
1057       IF (S.EQ.SDO) GOTO 1717
1058       CALL ERROR(108)
1059       GOTO 1000
1060 1717  CALL SCAN
1061       CALL SLAD(5,8,25)
1062       STACK(TOP+7)=4
1063       NEXT=8
1064       GO TO 7766
1065 C  CALL E8 TO ANALYSE THE INSTRUCTION SEQUENCE
1066 C  WITH PARAMETER = 4, I.E. "OD" IS THE TERMINAL SYMBOL
1067 250   CALL OUTPUT(WLABEL,STACK(TOP+3))
1068       CALL OUTPUT(WFOREND,-1)
1069       CALL OUTPUT(WJUMP,STACK(TOP+5))
1070       CALL OUTPUT(WLABEL,STACK(TOP+4))
1071       IF (S.EQ.SOD) GOTO 999
1072       CALL ERROR(105)
1073       GOTO 1000
1074 C----- S = ARRAY
1075 1801  CALL SCAN
1076       CALL SLAD(5,8,18)
1077       NEXT=3
1078       GO TO 7766
1079 C  CALL E3 TO ANALYSE THE VARIABLE
1080 180   IF (S.EQ.SDIM) GOTO 1810
1081       CALL ERROR(124)
1082       GOTO 1000
1083 1810  CALL SCAN
1084       IF (S.EQ.SLEFT) GOTO 1820
1085       CALL ERROR(106)
1086       GOTO 1000
1087 1820  CALL OUTPUT(WLSE,-1)
1088       CALL SCAN
1089       CALL SLAD(5,8,19)
1090       NEXT=2
1091       GO TO 7766
1092 C  CALL E2 - ARITHEXPRESSION TO ANALYSE BOUNDS OF THE "FOR"
1093 190   CALL OUTPUT(WLOW,-1)
1094       IF (S.EQ.SCOLON) GOTO 1830
1095       CALL ERROR(118)
1096       GOTO 1000
1097 1830  CALL SCAN
1098       CALL SLAD(5,8,20)
1099       NEXT=2
1100       GO TO 7766
1101 C  CALL E2 - ARITHEXPRESSION
1102 200   CALL OUTPUT(WNEWARRAY,-1)
1103       IF (S.EQ.SRIGHT) GOTO 999
1104       CALL ERROR(107)
1105       GOTO 1000
1106 C----- S = WRITE
1107 1901  STACK(TOP+6)=0
1108       CALL SCAN
1109       IF (S.EQ.SLEFT) GOTO 2003
1110       CALL ERROR(106)
1111       GOTO 1000
1112 C----- S = WRITELN
1113 2001  STACK(TOP+6)=1
1114 C  STACK(TOP+6) - 0 - THERE WAS WRITE, 1 - THERE WAS WRITELN
1115       CALL SCAN
1116 C  CHECK IF THERE ARE PARAMETERS OF WRITELN
1117       IF (S.EQ.SLEFT) GOTO 2003
1118       CALL OUTPUT(WRITELN,WIOEND)
1119       GOTO 1000
1120 2003  CALL SCAN
1121       CALL SLAD(5,8,16)
1122       NEXT=4
1123       GO TO 7766
1124 C  CALL E4 - EXPRESSION TO ANALYSE PARAMETERS OF WRITE(LN)N
1125 C  STACK(TOP+5) - INCLUDES NUMBER OF THE EXPRESSIONS USED TO DESCRIBE
1126 C                 THE OUTPUT FORMAT
1127 160   STACK(TOP+5)=0
1128 170   IF (S.NE.SCOLON) GOTO 2010
1129       STACK(TOP+5)=STACK(TOP+5)+1
1130       IF (STACK(TOP+5).GT.2)  GOTO 2015
1131       CALL SCAN
1132       CALL SLAD(5,8,17)
1133       NEXT=2
1134       GO TO 7766
1135 C  CALL ARITHEXPRESSION TO ANALYSE FORMATS
1136 C  RETURN TO LABEL 170 (OPTIMIZATION)
1137 2010  CALL OUTPUT(WRITE,STACK(TOP+5))
1138 C  CHECK FOR END OF WRITE / WRITELN
1139       IF (S.EQ.SCOMA) GOTO 2003
1140       IF (S.EQ.SRIGHT) GOTO 2020
1141 2015  CALL ERROR(107)
1142       GOTO 1000
1143 C  WRITE INFORMATION ABOUT THE OCCURRENCE OF WRITELN
1144 2020  IF (STACK(TOP+6).EQ.1) CALL OUTPUT(WRITELN,-1)
1145       CALL OUTPUT(WIOEND,-1)
1146       GOTO 999
1147 C----- S = WAIT
1148 2101  STACK(TOP+3)=5
1149 C  ANALYSIS OF WAIT AS FOR KIL, RESUME, AND SO ON.
1150       GOTO 1302
1151 C----- S = BLOCK
1152 2201  STACK(TOP+5)=0
1153       CALL OUTPUT(WBLOCK,ISFIN)
1154 C  STACK(TOP+5) INCLUDES PREFIX ADDRESS, HERE 0 FOR REGULAR BLOCK,
1155 C  JUMP OUT - FURTHER ANALYSIS AS FOR A PREFIXED BLOCK
1156       GOTO 2310
1157 C----- S = PREF
1158 2301  CALL SCAN
1159       IF (S.EQ.SIDENT) GOTO 2302
1160       CALL ERROR(109)
1161       GOTO 1000
1162 C  PREFIX ENCOUNTERED - STORE ITS ADDRESS INTO STACK(TOP+5)
1163 2302  STACK(TOP+5)=ADRES
1164       CALL OUTPUT(WPREF,ISFIN)
1165       CALL SCAN
1166       IF (S.EQ.SBLOCK) GOTO 2310
1167       IF (S.EQ.SLEFT) GOTO 2303
1168       CALL ERROR(122)
1169       GOTO 1000
1170 C  ANALYSIS OF THE PARAMETERS OF THE PREFIX
1171 2303  CALL OUTPUT(WLEFT,-1)
1172 2304  CALL SCAN
1173       CALL SLAD(5,8,14)
1174       NEXT=4
1175       GO TO 7766
1176 C  CALL E4 - EXPRESSION TO ANALYSE THE ACTUAL PARAMETERS
1177 C  OF THE PREFIX
1178 140   IF (S.EQ.SCOMA) GOTO 2305
1179       IF (S.EQ.SRIGHT)GOTO 2306
1180       CALL ERROR(107)
1181       GOTO 1000
1182 2305  CALL OUTPUT(WCOMA,-1)
1183       GOTO 2304
1184 2306  CALL SCAN
1185       CALL OUTPUT(WRIGHT,-1)
1186 C  COMMON ANALYSIS FOR ALL BLOCKS
1187 C  POSITIONS ARE STORED INTO THE INTERMEDIATE CODE
1188 2310  CALL MARK(STACK(TOP+3),STACK(TOP+4))
1189       STACK(TOP+6)=UNICAL
1190       NEXT=STACK(TOP+5)
1191       CALL SLAD(5,8,15)
1192       STACK(TOP+4)=NEXT
1193 C  ASSIGNMENT OF THE PARAMETER'S VALUE - BLOCK PREFIX
1194       NEXT=11
1195       GO TO 7766
1196 C  CALL E11 TO ANALYSE THE ENTIRE BLOCK
1197 C  AFTER RETURN WE RECLAIM THE PLACE FROM WHICH THE INTERMEDIATE CODE FOR
1198 C  THE GIVEN BLOCK IS TO BE CONTINUED
1199 150   CALL FIND(STACK(TOP+3),STACK(TOP+4))
1200       UNICAL=STACK(TOP+6)
1201       CALL OPTOUT
1202       GOTO 1000
1203 C----- S = UNLOCK
1204 2501  STACK(TOP+3)=7
1205 C  FURTHER ANALYSIS AS FOR KILL, RESUME, ETC.
1206       GOTO 1302
1207 C----- S = RAISE
1208 2601  STACK(TOP+3)=1
1209       CALL SCAN
1210       IF (S.EQ.SIDENT) GOTO 905
1211 C  FURTHER ANALYSIS AS FOR CALL (BUT STACK(TOP+3)=1)
1212       CALL ERROR(109)
1213       GOTO 1000
1214 C----- S = WIND, TERMINATE
1215 2701  CALL OUTPUT(WIND+ADRES-1,-1)
1216       GOTO 999
1217 C----- S = LASTWILL
1218 2801  IF (STACK(TOP+7).EQ.5) GOTO 1114
1219       CALL ERROR(143)
1220       GOTO 999
1221 C----- S = ASSEMBLER
1222 C --- ASSEMBLER INSERTIONS NOT IMPLEMENTED
1223 2901  CALL ERROR(106)
1224 2904  IF (S.EQ.SEND) GOTO 999
1225       CALL SCAN
1226       GOTO 2904
1227 330   CALL ERROR(118)
1228       GO TO 2904
1229 C----- S = OPEN
1230 3001  CALL SCAN
1231       IF (S.EQ.SLEFT) GOTO 3010
1232       CALL ERROR(106)
1233       GOTO 1000
1234 3010  CALL SCAN
1235       CALL SLAD(5,8,31)
1236       NEXT=3
1237       GO TO 7766
1238 C  CALL E3 - OBJECTEXPRESSION TO ANALYSE THE VARIABLE
1239 310   STACK(TOP+3)=WOPEN1
1240 cfile  ----------- added  ---------------------------
1241       if(s.ne.scoma) go to 3013
1242       call scan
1243       call slad(5,8,35)
1244       next = 4
1245       go to 7766
1246 c   call expression to analyse the second parameter
1247 cfile  --------------------------------------------
1248 350   IF (S.EQ.SRIGHT) GOTO 3025
1249       IF (S.EQ.SCOMA) GOTO 3015
1250 3013  CALL ERROR(107)
1251 3014  IF (S.EQ.SEND) GOTO 1000
1252       CALL SCAN
1253       GOTO 3014
1254 3015  CALL SCAN
1255       CALL SLAD(5,8,34)
1256       NEXT=4
1257       GO TO 7766
1258 C  CALL EXPRESSION TO ANALYSE THE THIRD  PARAMETER
1259 340   STACK(TOP+3)=WOPEN2
1260 3025  CALL OUTPUT(STACK(TOP+3),-1)
1261       IF (S.NE.SRIGHT) GOTO 3013
1262       GOTO 999
1263 C----- S = PUT/GET
1264 3101  STACK(TOP+3)=WPUT+ADRES-1
1265 C     STACK(TOP+3) - WPUT ALBO WGET
1266       CALL SCAN
1267       IF (S.EQ.SLEFT) GOTO 3110
1268       CALL ERROR(106)
1269       GOTO 1000
1270 3110  CALL SCAN
1271 cdsw      CALL SLAD(2,8,32)
1272       call slad(5,8,32)
1273       NEXT=3
1274       GO TO 7766
1275 C  CALL E3 (OBJECTEXPRESSION) TO ANALYSE THE PARAMETER OF PUT/GET
1276 320   CALL OUTPUT(STACK(TOP+3),-1)
1277       IF (S.EQ.SRIGHT) GOTO 3140
1278       IF (S.EQ.SCOMA) GOTO 3120
1279       CALL ERROR(107)
1280       GOTO 3180
1281 3120  CALL SCAN
1282       CALL SLAD(5,8,32)
1283       NEXT=4
1284       GO TO 7766
1285 C  CALL EXPRESSION TO ANALYSE THE PARAMETER OF PUT/GET
1286 C  NOTE: RETURN INTO NON-STANDARD PLACE
1287 3140  CALL SCAN
1288 3180  CALL OUTPUT(WIOEND,-1)
1289       GOTO 1000
1290 C----- S = READLN
1291 3201  STACK(TOP+3)=1
1292       CALL SCAN
1293       IF (S.EQ.SLEFT) GOTO 803
1294       GOTO 812
1295 cdeb  -----------  added  --------------
1296 c-------  s = break
1297 3301  call addbr(ln)
1298       go to 999
1299 cdeb  ----------------------------------
1300 cdsw -- added:
1301 c ----- s = putrec/getrec
1302 3401  addr = adres
1303       stack(top+3) = wput+addr-1
1304       call scan
1305       if (s .eq. sleft) goto 3410
1306       call error(106)
1307       goto 1000
1308 3410  call scan
1309       call slad(5, 8, 36)
1310       next = 3
1311       goto 7766
1312 360   if (s .ne. scoma) goto 3420
1313       call output(stack(top+3), -1)
1314       stack(top+3) = wputrec+addr-1
1315       call scan
1316       call slad(5, 8, 37)
1317       next = 4
1318       goto 7766
1319 370   if (s .ne. scoma) goto 3420
1320       call scan
1321       call slad(5, 8, 38)
1322       next = 4
1323       goto 7766
1324 380   if (s .ne. sright) goto 3013
1325       call output(stack(top+3), -1)
1326       call output(wioend, -1)
1327       goto 999
1328 3420  call error(147)
1329       goto 1000
1330 cdsw -- end
1331 cbc added concurrent statements
1332 c ----- s = enable/disable
1333 3501  call output(wenab+adres-1, -1)
1334 3510  call scan
1335       if (s .ne. sident) goto 3520
1336       call output(wident, adres)
1337       call scan
1338       if (s .eq. scoma) goto 3510
1339       call output(wprend, -1)
1340       goto 1000
1341 3520  call error(109)
1342       goto 1000
1343 c ----- s = accept
1344 3601  call output(waccep, -1)
1345       call scan
1346       if (s .ne. sident) goto 3620
1347       call output(wident, adres)
1348       call scan
1349       if (s .eq. scoma) goto 3510
1350 3620  call output(wprend, -1)
1351       goto 1000
1352 cbc end
1353 C ----- END OF INSTRUCTIONS ----------------------------------
1354 999   CALL SCAN
1355 20    CONTINUE
1356 C  RETURN FROM ASSIGNMENT /JUMP OPTIMIZATION/
1357 80    CONTINUE
1358 C  LABEL 80 (A GARBAGE FROM THE OLD VERSION OF THE PARSER)
1359 C  RETAINED TO PRESERVE THE CONTINUITY OF THE REMAINING LABEL NUMBERS
1360 C  (USED TO MARK RETURN POINTS FROM RECURSIVE CALLS)
1361 1000  CONTINUE
1362 C  INSTRUCTIONS RECOGNIZED
1363 C  CHECK FOR A TERMINAL SYMBOL
1364 1111  IF (S.EQ.SEMICOL) GOTO 8
1365       IF (S.EQ.SELSE) GOTO 1116
1366       IF (S.EQ.SFI) GOTO 1115
1367       IF (S.EQ.SOD) GOTO 1117
1368       IF (S.EQ.SEND) GOTO 1114
1369       IF (S.EQ.SOTHER) GOTO 1119
1370       IF (S.EQ.SOTHRS) GOTO 1120
1371       IF (S.EQ.SWHEN) GOTO 1119
1372       IF (S.EQ.SESAC) GOTO 1118
1373       IF (S.EQ.SVAR)  GOTO 1113
1374       IF (S.EQ.SUNIT) GOTO 1113
1375       IF (S.EQ.SCONS) GOTO 1113
1376       IF (S.NE.SEOF) GOTO 6
1377 1113  CALL ERROR(113)
1378 1114  NEXT=0
1379       GO TO 7766
1380 1115  IF (STACK(TOP+7).EQ.3) GOTO 1114
1381 1116  IF (STACK(TOP+7).EQ.2) GOTO 1114
1382       CALL ERROR(112)
1383       GOTO 8
1384 1117  IF (STACK(TOP+7).EQ.4) GOTO 1114
1385       CALL ERROR(130)
1386       GOTO 8
1387 1118  IF (STACK(TOP+7).EQ.7) GOTO 1114
1388       IF (STACK(TOP+7).EQ.6) GOTO 1114
1389       CALL ERROR(129)
1390       GOTO 8
1391 1119  IF (STACK(TOP+7).EQ.6) GOTO 1114
1392       IF (STACK(TOP+7).EQ.1) GOTO 1114
1393       CALL ERROR(129)
1394       GOTO 8
1395 1120  IF (STACK(TOP+7).EQ.1) GOTO 1114
1396       CALL ERROR(129)
1397       GOTO 8
1398 7766  CONTINUE
1399       RETURN
1400       END
1401
1402       SUBROUTINE E9
1403 C
1404 C  AUGMENTS THE PROTOTYPE BY THE STARTING PLACE OF THE INTERMEDIATE
1405 C  CODE FOR THE PARSED SYNTACTICAL UNIT
1406 C
1407 C  STACK(TOP+3) - ENTRY:   PROTOTYPE ADDRESS
1408 C                 CONT.:   ENDUNIT LABEL
1409 C  STACK(TOP+4) - COPY OF THE PROTOTYPE ADRESS
1410 C
1411       IMPLICIT INTEGER(A-Z)
1412       COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
1413      X                POSIT,RECNR,NEKST
1414       COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,JNK(266)
1415       COMMON /BLANK/
1416      $   C0M(4),
1417      O   S,        ADRES,    K,        SCOMA,    SDOT,     SEMICOL,
1418      1   SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,     SRELAT,
1419      2   SEOF,     SIDENT,   SCONST,   SAND,     SARRAY,   SARROF,
1420      3   SATTACH,  SBEGIN,   SBLOCK,   SBOOL,    SCALL,    SCASE,
1421      4   SCLASS,   SCLOSE,   SCONS,    SCOPY,    SCOROUT,  SDETACH,
1422      5   SDIM,     SDO,      SDOWN,    SELSE,    SEND,     SESAC,
1423      6   SEXIT,    SEXTERN,  SFI,      SFOR,     SFUNCT,   SIF,
1424      7   SINNER,   SINPUT,   SINT,     SKILL,    SLOCK,    SNEW,
1425      8   SNONE,    SNOT,     SOD,      SOR,      SORIF,    SOTHER,
1426      9   SOUTPUT,  SPREF,    SPRCD,    SQUA,     SREAD,    SRESUME,
1427      O   SRETURN,  STEP,     STOP,     STAKEN,   STHEN,    STHIS,
1428      A   STO,      STYPE,    SUNIT,    SVAR,     SVIRTUAL, SWAIT,
1429      B   SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
1430      C   WAND,     WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
1431      D   WCALL,    WCASE,    WCASEL,   WCOMA,    WCNSTB,   WCNSTC,
1432      E   WCNSTI,   WCNSTN,   WCNSTR,   WCNST,    WCOPY,    WDETACH,
1433      F   WDOT,     WDOWNTO,  WEOF,     WESAC,    WFIN,     WFIRST,
1434      G   WFOREND,  WFORVAR,  WFROM,    WIDENT,   WIFFALS,  WIFTRUE
1435       common /BLANK/
1436      H   WINNER,   WINSTREND,WJUMP,    WKILL,    WLABEL,   WLEFT,
1437      I   WLOCK,    WLOW,     WLSE,     WNEW,     WNEWARRAY,WNOT,
1438      J   WOPERAT,  WOPT,     WOR,      WOTHER,   WPREF,    WPRIM,
1439      K   WQUA,     WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
1440      L   WSTART,   WSTEP,    WSTOP,    WTHIS,    WTO,      WAIT,
1441      M   WRITE,    WRITELN,  WBOUND,   UNICAL,
1442      N   COM(132),
1443      O   LMEM,     LPMEM,    IRECN,    ISFIN,    LPMSYS,   LPML,
1444      P   LPMF,     NRINT,    NRRE,     NRBOOL,   NRCHAR,   NRCOR,
1445      Q   NRPROC,   NRTEXT,   NRUNIV,   NATTR,    NRNONE,   NBLSYS,
1446      R   NBLUS,    NEMPTY,   INSYS,    LOCAL,    OWN,      OBJECT,
1447      $   scaner(8735)
1448 cdsw $   SCANER(3735),
1449        common /BLANK/
1450      Z   TOP,      IN,       NEXT,     STACK(500),
1451      *   RESZTA(3652)
1452       DIMENSION IPMEM(7890)
1453       EQUIVALENCE (SCANER(1),IPMEM(1))
1454       DATA SLASTW/28/
1455       DATA WLASTW/72/
1456
1457       GOTO (10,20,30),IN
1458 10    STACK(TOP+4)=STACK(TOP+3)
1459       UNICAL=1
1460       NRRE=STACK(TOP+4)
1461 C  PROTOTYPE ADDRESS IS MOVED TO VARIABLE NRRE TO SPARE SOME CODE
1462 C  CHECK IF ANYTHING HAS BEEN SENT TO THE INTERMEDIATE CODE
1463       IF (IPMEM(NRRE-3).NE.0) GOTO 15
1464       IPMEM(NRRE-3)=RECNR
1465       IPMEM(NRRE-2)=POSIT
1466 15    STACK(TOP+3)=UNICAL
1467       UNICAL=UNICAL+1
1468       CALL OUTPUT(WFIRST,LN)
1469       IF (S.EQ.SBEGIN) CALL SCAN
1470       CALL OPTOUT
1471       IF (S.EQ.SEND) GOTO 22
1472       CALL SLAD(2,9,2)
1473       NEXT=8
1474       STACK(TOP+7)=5
1475       RETURN
1476 C  CALL E8 - INSTRUCTIONS
1477 C  PARAMETER = 5   /AN INSTRUCTION SEQUENCE
1478 C                   TERMINATED BY END      /
1479 20    IF (S.NE.SLASTW) GOTO 22
1480 C  LASTWILL OCCURRED - END OF CODE SHOULD BE ASSUMED AND THE PARSING SHOULD
1481 C  CONTINUE. END-LABEL IS TO BE CHANGED!
1482       CALL OUTPUT(WLASTW,STACK(TOP+3))
1483       CALL OUTPUT(LN,-1)
1484       STACK(TOP+3)=UNICAL
1485       UNICAL=UNICAL+1
1486 21    CALL SCAN
1487       IF (S.EQ.SCOLON) CALL SCAN
1488       CALL SLAD(2,9,3)
1489       NEXT=8
1490       STACK(TOP+7)=5
1491       RETURN
1492 C  CALL E8 TO ANALYSE INSTRUCTIONS AFTER LASTWILL
1493 30    IF (S.EQ.SLASTW) GOTO 32
1494 22    CALL OUTPUT(WFIN,STACK(TOP+3))
1495       CALL OUTPUT(LN,-1)
1496       NEXT = 0
1497       RETURN
1498 32    CALL ERROR(144)
1499       GOTO 21
1500       END
1501
1502       SUBROUTINE E10
1503       IMPLICIT INTEGER (A-Z)
1504 C
1505 C  RECOGNIZES SEQUENCE OF DECLARATIONS
1506 C  UPDATES THE PROTOTYPE WHOSE ADDRESS IS PASSED BY
1507 C  BY STACK(TOP+3)
1508 C  CREATES LISTS OF CONSTANTS; FOR ENUMERATION CONSTANTS CREATES DESCRIPTIONS
1509 C  INCLUDING NAMES OF THE CONSTANTS AND THE NUMBERS OF THEIR DECLARATION LINES.
1510 C     STACK(TOP+4) - STACK(TOP+5) -  DESCRIBE THE PLACE IN THE INTERMEDIATE
1511 C     CODE IN THE CASE WHEN THE SUBMODULE INSTRUCTIONS HAVE TO BE WRITTEN
1512 C     AFTER AN OCCURRENCE OF ENUMERATION CONSTANTS.
1513 C  N O T E:   THE MEANING OF THE PROTOTYPE WORD #-1 IS CHANGED. IT INCLUDES:
1514 C  0 - THERE ARE NO ENUMERATION CONSTANTS
1515 C -1 - CONSTANTS ARE WRITTEN INTO, WORKING FILE LEFT OK
1516 C  1 - THE CONSTANTS ARE FOLLOWED BY THE CODE FOR SUBMODULES
1517 C
1518 C
1519 C-------------------------------------------------------------------
1520 C  CONSTANT LIST ITEM:
1521 C
1522 C  0 ! NAME
1523 C ---+------------------------
1524 C +1 ! DECL. LINE NUMBERA
1525 C ---+------------------------
1526 C +2 ! TYPE NUMBER
1527 C ---+------------------------
1528 C +3 ! 0 (ZERO)
1529 C ---+------------------------
1530 C +4 ! ADDRESS IN DICTIONARY OR VALUE
1531 C ---+------------------------
1532 C +5 ! THE NEXT ITEM
1533 C ---+------------------------
1534 C
1535 C------------------------------------------------------------------------
1536 C  SIGNAL LIST ITEM::
1537 C
1538 C  ----+-------------------
1539 C    0 ! KIND
1540 C  ----+-------------------
1541 C   +1 ! LINE NUMBER IN THE SOURCE TEXT
1542 C  ----+-------------------
1543 C   +2 ! NAME
1544 C  ----+-------------------
1545 C   +3 ! THE NEXT ITEM IN THE LIST
1546 C  ----+-------------------
1547 C   +4 ! FORMAL PARAMETER LIST
1548 C  ----+-------------------
1549 C
1550 C  WHERE KIND =
1551 C   9 - SIGNAL CONSTRUCTED PROPERLY
1552 C  10 - SIGNAL WITH A FAULTY PARAMETER LIST
1553 C
1554       COMMON /BLANK/
1555      $   C0M(4),
1556      O   S,        ADRES,    K,        SCOMA,    SDOT,     SEMICOL,
1557      1   SCOLON,   SLEFT,    SRIGHT,   SBECOME,  STAR,     SRELAT,
1558      2   SEOF,     SIDENT,   SCONST,   SAND,     SARRAY,   SARROF,
1559      3   SATTACH,  SBEGIN,   SBLOCK,   SBOOL,    SCALL,    SCASE,
1560      4   SCLASS,   SCLOSE,   SCONS,    SCOPY,    SCOROUT,  SDETACH,
1561      5   SDIM,     SDO,      SDOWN,    SELSE,    SEND,     SESAC,
1562      6   SEXIT,    SEXTERN,  SFI,      SFOR,     SFUNCT,   SIF,
1563      7   SINNER,   SINPUT,   SINT,     SKILL,    SLOCK,    SNEW,
1564      8   SNONE,    SNOT,     SOD,      SOR,      SORIF,    SOTHER,
1565      9   SOUTPUT,  SPREF,    SPRCD,    SQUA,     SREAD,    SRESUME,
1566      O   SRETURN,  STEP,     STOP,     STAKEN,   STHEN,    STHIS,
1567      A   STO,      STYPE,    SUNIT,    SVAR,     SVIRTUAL, SWAIT,
1568      B   SWHEN,    SWHILE,   SWRIT,    SWRITLN,  STRUE,    SALL,
1569      C   WAND,     WARRAY,   WASSIGN,  WASSCON,  WATTACH,  WBLOCK,
1570      D   WCALL,    WCASE,    WCASEL,   WCOMA,    WCNSTB,   WCNSTC,
1571      E   WCNSTI,   WCNSTN,   WCNSTR,   WCNST,    WCOPY,    WDETACH,
1572      F   WDOT,     WDOWNTO,  WEOF,     WESAC,    WFIN,     WFIRST,
1573      G   WFOREND,  WFORVAR,  WFROM,    WIDENT,   WIFFALS,  WIFTRUE
1574       common /BLANK/
1575      H   WINNER,   WINSTREND,WJUMP,    WKILL,    WLABEL,   WLEFT,
1576      I   WLOCK,    WLOW,     WLSE,     WNEW,     WNEWARRAY,WNOT,
1577      J   WOPERAT,  WOPT,     WOR,      WOTHER,   WPREF,    WPRIM,
1578      K   WQUA,     WREAD,    WRELAT,   WRESUME,  WRETURN,  WRIGHT,
1579      L   WSTART,   WSTEP,    WSTOP,    WTHIS,    WTO,      WAIT,
1580      M   WRITE,    WRITELN,  WBOUND,   UNICAL,
1581      N   COM(132),
1582      O   LMEM,     LPMEM,    IRECN,    ISFIN,    LPMSYS,   LPML,
1583      P   LPMF,     NRINT,    NRRE,     NRBOOL,   NRCHAR,   NRCOR,
1584      Q   NRPROC,   NRTEXT,   NRUNIV,   NATTR,    NRNONE,   NBLSYS,
1585      R   NBLUS,    NEMPTY,   INSYS,    LOCAL,    OWN,      OBJECT,
1586      $   scaner(8735)
1587 cdsw $   SCANER(3735),
1588       common /BLANK/
1589      Z   TOP,      IN,       NEXT,     STACK(500),
1590      *   RESZTA(3652)
1591
1592 cdsw  INTEGER  IPMEM(1000)
1593       dimension  ipmem(7890)
1594       COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
1595      X                POSIT,RECNR,NEKST
1596       COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,JNK(266)
1597       EQUIVALENCE (SCANER(1),IPMEM(1))
1598       DATA SIGNAL/56/
1599       DATA SHANDL/55/
1600
1601 C  RECOGNITION OF DECLARATIONS
1602       GOTO (10,20,30),IN
1603 30    CONTINUE
1604 10    IF (S.EQ.SCONS) GOTO 200
1605       IF (S.EQ.SVAR) GOTO 110
1606       IF (S.EQ.SUNIT) GOTO 125
1607       IF (S.EQ.SIGNAL) GOTO 500
1608       IF (S.EQ.SHANDL) GOTO 1000
1609       IF (S.EQ.SBEGIN) GOTO 1000
1610       IF (S.EQ.SEND) GOTO 1000
1611       IF (S.EQ.70) GOTO 1000
1612       IF ((S.GT.1).AND.(S.LT.25)) GOTO 1000
1613       IF (S.NE.SEMICOL) CALL ERROR(127)
1614       IF (S.EQ.SBECOME) GOTO 1000
1615 15    CALL SCAN
1616       GOTO 10
1617 C  CHECK FOR FURTHER CONSTANT DECLARATIONS (COMMA)
1618 C----------  VARIABLES
1619 110   I=1
1620       J=0
1621 111   CALL SCAN
1622       IF (S.EQ.SIDENT) GOTO 112
1623       CALL ERROR(109)
1624       GOTO 10
1625 112   J=J+1
1626       K=I+J
1627       IF (K.GT.132) CALL ERROR(197)
1628 C  THE IDENTIFIER IS APPENDED TO THE LIST OF VARIABLES IN ARRAY COM.
1629 C  THE LIMIT FOR THE LENGTH OF THAT LIST IS 132. EXCEEDING THIS LIMIT
1630 C  CAUSES PARSER ERROR 137.
1631       COM(K)=ADRES
1632 C  NOTE:  K IS USED ABOVE
1633       CALL SCAN
1634       IF (S.EQ.SCOMA) GOTO 111
1635       IF (S.EQ.SCOLON) GOTO 113
1636       CALL ERROR(118)
1637       GOTO 10
1638 113   CALL SCAN
1639       CALL ADDVAR(COM(2),J)
1640
1641 C  CHECK FOR MORE DECLARATIONS OF VARIABLES (COMMA)
1642       IF (S.EQ.SCOMA) GOTO 110
1643       IF (S.EQ.SBEGIN) GOTO 1000
1644       IF (S.EQ.SEND) GOTO 1000
1645       IF (S.EQ.SEMICOL) GOTO 15
1646       CALL ERROR(102)
1647       GOTO 10
1648 C----------  SUBMODULE
1649 125   NRRE=STACK(TOP+3)-1
1650       IF (IPMEM(NRRE).GE.0) GOTO 128
1651 C  ENUMERATION CONSTANTS ARE ALREADY WRTITTEN INTO THE INTERMEDIATE CODE
1652       IPMEM(NRRE)=1
1653       CALL MARK(STACK(TOP+4),STACK(TOP+5))
1654 128   CALL SLAD(3,10,3)
1655       CALL SCAN
1656       NEXT=11
1657       RETURN
1658 C  CALL E11 - SYNTACTIC UNIT - MODULE
1659 C  RETURN TO THE BEGINNING (JUMP OPTIMIZATION)
1660 C----------  CONSTANT
1661 200   CALL SCAN
1662       IF (S.EQ.SIDENT) GOTO 202
1663       CALL ERROR(109)
1664       GOTO 10
1665 202   STACK(TOP+6)=ADRES
1666       CALL SCAN
1667       IF ((S.EQ.SRELAT).AND.(ADRES.EQ.3)) GOTO 205
1668       CALL ERROR(116)
1669       GOTO 10
1670 C  "CONST IDENT =" ENCOUNTERED
1671 205   CALL SCAN
1672 C  RESERVATION OF IPMEM SPACE FOR THE CONSTANT DESCRIPTION
1673       LPMF=LPMF-6
1674       IF (LPMF.LT.LPML) CALL ERROR(199)
1675       IPMEM(LPMF+1)=STACK(TOP+6)
1676       IPMEM(LPMF+2)=LN
1677       NRRE=STACK(TOP+3)+4
1678       IPMEM(LPMF+6)=IPMEM(NRRE)
1679       IPMEM(NRRE)=LPMF+1
1680 C  RECOGNITION OF THE TYPE
1681       IF (S.EQ.STRUE) GOTO 300
1682       IF (S.NE.SCONST) GOTO 300
1683       IF (K.EQ.4) GOTO 250
1684       IF (K.NE.6) GOTO 300
1685 C  CHARACTER CONSTANT (K=6)
1686       IPMEM(LPMF+3)=16
1687       GOTO 260
1688 C  TEXT CONSTANT (K=4)
1689 250   IPMEM(LPMF+3)=48
1690 260   IPMEM(LPMF+5)=ADRES
1691       CALL SCAN
1692       GOTO 350
1693 C  EXPRESSION ??
1694 300   NRRE=STACK(TOP+3)-1
1695       IF (IPMEM(NRRE).EQ.0) GOTO 310
1696 C  ANYTHING WRITTEN INTO INTERMEDIATE CODE ?
1697       IF (IPMEM(NRRE).EQ.-1) GOTO 325
1698 C  YES BUT A SUBMODULE HAS BEEN WRITTEN
1699       CALL FIND(STACK(TOP+4),STACK(TOP+5))
1700 C  THE PLACE IN THE INTERTMEDIATE CODE HAS BEEN FOUND
1701       IPMEM(NRRE)=-1
1702       GOTO 325
1703 C  THE INITIAL INSTRUCTIONS OF THE INTERMEDIATE CODE
1704 310   IPMEM(NRRE)=-1
1705       IPMEM(NRRE-1)=POSIT
1706       IPMEM(NRRE-2)=RECNR
1707 325   CALL OUTPUT(WINSTREND,LN)
1708       CALL OUTPUT(WIDENT,STACK(TOP+6))
1709       CALL OUTPUT(WLSE,-1)
1710       CALL SLAD(3,10,2)
1711       NEXT=12
1712       RETURN
1713 C  CALL E12 TO ANALYSE THE EXPRESSION
1714 20    CALL OUTPUT(WASSCON,-1)
1715 350   IF (S.EQ.SCOMA) GOTO 200
1716       IF (S.EQ.SBEGIN) GOTO 1000
1717       IF (S.EQ.SEND) GOTO 1000
1718       IF (S.EQ.SEMICOL) GOTO 15
1719       CALL ERROR(102)
1720       GOTO 10
1721 1000  NRRE=STACK(TOP+3)-1
1722
1723       IF (IPMEM(NRRE).LE.0) GOTO 1010
1724 C  SUBMODULES WERE PRECEDED BY ENUMERATION CONSTANTS - THE BEGINNING
1725 C  OF CODE HAS TO BE FOUND
1726       CALL FIND(STACK(TOP+4),STACK(TOP+5))
1727 1010  NEXT=0
1728       RETURN
1729 C----------  SIGNAL DECLARATION
1730 500   CALL SCAN
1731       IF (S.EQ.SIDENT) GOTO 505
1732       CALL ERROR(109)
1733       GOTO 10
1734 C  CREATION OF THE SIGNAL DESCRIPTION
1735 505   LPMF=LPMF-5
1736       IF (LPMF.LT.LPML) CALL ERROR(199)
1737       IPMEM(LPMF+1)=9
1738       IPMEM(LPMF+2)=LN
1739       IPMEM(LPMF+3)=ADRES
1740 C  THE SYNTACTIC FATHER IS APPENDED TO THE LIST OF SIGNALS (PROTOTYPE WORD #4)
1741       NRCOR=STACK(TOP+3)-4
1742       NRCHAR=IPMEM(NRCOR)
1743       IPMEM(NRCOR)=LPMF+1
1744       IPMEM(LPMF+4)=NRCHAR
1745 C  THE SIGNAL DESCRIPTION IS CREATED AND APPENDED
1746       CALL SCAN
1747       IF (S.EQ.SCOMA) GOTO 500
1748       IF (S.EQ.SEMICOL) GOTO 15
1749       IF (S.EQ.SLEFT) GOTO 508
1750       CALL ERROR(102)
1751       GOTO 10
1752 c
1753 cdsw&bc 508   STACK(TOP+5)=LPMF+1
1754 c             CALL ADDPAR(STACK(TOP+5)+4,STACK(TOP+5))
1755 508   continue
1756       call addpar(lpmf+5, lpmf+1)
1757 cdsw&bc
1758       IF (S.EQ.SRIGHT) GOTO 510
1759       CALL ERROR(107)
1760       GOTO 10
1761 510   CALL SCAN
1762       IF (S.EQ.SCOMA) GOTO 500
1763       IF (S.EQ.SEMICOL) GOTO 15
1764       CALL ERROR(102)
1765       GOTO 10
1766       END
1767