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 E11
      IMPLICIT INTEGER (A-Z)
C
C  RECOGNIZES SYNTACTICAL UNIT - CREATES THE PROTOTYPE
C   STACK(TOP+3) - ADDRESS OF THE CURRENT PROTOTYPE
C		   INITIALLY 1 FOR VIRTUAL, 0 OTHERWISE
C   STACK(TOP+4) - UNIT NAME
C		   FOR A BLOCK - ITS PREFIX SEND FROM E8
C   STACK(TOP+5) - PREFIX (IF ONE OCCURRED)
C   STACK(TOP+6) - PROTOTYPE NUMBER
C
C----------------------------------------------------------------------
C  PROTOTYPE - STRUCTURE:
C
C   -5 ! NOT USED
C  ----+------------------------
C   -4 ! SIGNAL LIST
C  ----+------------------------
C   -3 ! INTERMEDIATE CODE BLOCK NUMBER
C  ----+------------------------
C   -2 ! INTERMEDIATE CODE WORD NUMBER IN A BLOCK
C  ----+------------------------
C   -1 ! 0 = NO ENUMERATION CONSTANTS
C  ----+------------------------
C    0 ! KIND
C  ----+------------------------
C   +1 ! SL - NUMBER IN ISDICT
C  ----+------------------------
C   +2 ! PREFIX - NAME
C  ----+------------------------
C   +3 ! VARIABLE LIST
C  ----+------------------------
C   +4 ! CONSTANT LIST
C  ----+------------------------
C   +5 ! CLASS LIST
C  ----+------------------------
C   +6 ! THE LIST OF BLOCKS, FUNCTIONS AND PROCEDURES
C  ----+------------------------
C   +7 ! TAKEN LIST
C  ----+------------------------
C   +8 ! SYSTEM PREFIX
C  ----+------------------------
C   +9 ! SOURCE TEXT LINE NUMBER
C  ----+------------------------
C    REMAINDER FOR FUNCTIONS, PROCEDURES AND CLASSES
C  ----+------------------------
C  +10 ! NAME
C  ----+------------------------
C  +11 ! FORMAL PARAMETER LIST
C  ----+------------------------
C    REMAINDER FOR FUNCTIONS		       REMAINDER FOR CLASSES
C  ----+------------------------	     ----+-----------------
C  +12 ! NAME OF RESULT TYPE		     +12 ! HIDDEN LIST
C  ----+------------------------	     ----+-----------------
C  +13 ! NUMBER OF ARRAYOF'S                 +13 ! CLOSE LIST
C  ----+------------------------	     ----+-----------------
C
C  WHERE KIND =
C 1 - BLOCK
C 2 - CLASS/COROUTINE/PROCESS
C 3 - PROCEDURE
C 4 - FUNCTION
C 5 - "3" WITH ERRONEOUS PARAMETER LIST
C 6 - "4" "      "       "       "
C 7 - "2" "      "       "       "
C	 SYSTEM PREFIX =
C 2 - PROCESS
C 1 - COROUTINE
C 0 - OTHER
C	 THE SYSTEM PREFIX IS AUGMENTED BY
C 2**13 - IF INSTRUCTIONS ARE PRESENT
C 2**14 - FOR SPECIFICATION TAKEN NONE
C 2**15 - FOR SPECIFICATION VIRTUAL
C
C LIST ITEM FOR TAKEN, CLOSE, HIDDEN:
C
C   0 ! NAME
C  ---+--------------------------
C  +1 ! OCCURRENCE LINE NUMBER IN THE SOURCE TEXT
C  ---+--------------------------
C  +2 ! THE NEXT ITEM
C  ---+--------------------------
C
C  SUBMODULE LIST ITEM:
C
C   0 ! PROTOTYPE NUMBER IN THE DICTIONARY
C  ---+--------------------------
C  +1 ! THE NEXT ELEMENT
C
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)
     
      DIMENSION IPMEM(7890)
      EQUIVALENCE (IPMEM(1),SCANER(1))
      COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,JNK(266)
C  NOTE:  FOR THE MAIN BLOCK THE ENTRY IS NON-STANDARD - IN=4 JUMP TO
C	  LABEL 1
      LOGICAL BTEST
      DATA SHANDL/55/
      
C  ORIGINAL GOTO-STATEMENT	***********************************************
C     GOTO (1,200,300,400,0),IN ************************  03.01.84
C  CHANGED TO			***********************************************
      GOTO (1,200,300,400,1),IN
C  BECAUSE LABEL 0 IS UNDEFINED ***********************************************
1     STACK(TOP+3)=0
      STACK(TOP+5)=0
      STACK(TOP+6)=ISFIN
      ISFIN=ISFIN-1
C  CHECK FOR THE MAIN BLOCK (I.E. IF IN = 5)
      IF (IN.EQ.5) GOTO 1460
      IF (S.EQ.SBLOCK) GOTO 15
C				   UNIT
      IF (S.NE.SVIRTUAL) GOTO 3
      STACK(TOP+3)=1
      CALL SCAN
3     IF (S.NE.SIDENT) GOTO 3010
      STACK(TOP+4)=ADRES
      CALL SCAN
      GOTO 3030
C				   NAME MISSING
3010  CALL ERROR(109)
      STACK(TOP+4)=0
3030  IF (S.NE.SCOLON) GOTO 3050
      CALL SCAN
      GOTO 3080
C				   COLON MISSING
3050  CALL ERROR(118)
3080  IF (S.NE.SIDENT) GOTO 5
C				   PREFIX PRESENT
      STACK(TOP+5)=ADRES
      CALL SCAN
C				   RECOGNITION OF THE UNIT KIND
5     IF (S.EQ.SFUNCT) GOTO 10
      IF (S.EQ.SPRCD) GOTO 12
      IF (S.EQ.SCLASS) GOTO 14
      IF (S.EQ.SCOROUT) GOTO 16
      CALL ERROR(119)
C				   UNKNOWN KIND
C				   IF NAME WAS PRESENT ASSUME PROCEDURE
      IF (STACK(TOP+4).NE.0) GOTO 12
207   NEXT=0
      RETURN
10    LPMF=LPMF-19
      IPMEM(LPMF+6)=4
      GOTO 20
12    LPMF=LPMF-17
      IPMEM(LPMF+6)=3
      GOTO 20
14    LPMF=LPMF-19
      IPMEM(LPMF+6)=2
      IPMEM(LPMF+14)=0
      GOTO 20
1460  IF (S.NE.SEMICOL) GOTO 1480
      CALL SCAN
      GOTO 1460
1480  IF (BTEST(C0M(2),14)) GOTO 2795
15    LPMF=LPMF-15
      IF (STACK(TOP+1).EQ.10) CALL ERROR(119)
      IPMEM(LPMF+6)=1
      IF (LPMF.LT.LPML) CALL ERROR(199)
      STACK(TOP+3)=LPMF+6
      NEXT=STACK(TOP+3)
C   A LOCAL USAGE OF VARIABLE NEXT
      IPMEM(NEXT+9)=LN
      IPMEM(NEXT+2)=STACK(TOP+4)
C   PREFIX SENT FROM E8
      GOTO 262
16    LPMF=LPMF-19
      IPMEM(LPMF+6)=2
      IPMEM(LPMF+14)=ADRES
C				   THE PROTOTYPE IS ALREADY CREATED
20    CONTINUE
      IF (LPMF.LT.LPML) CALL ERROR(199)
      IF (STACK(TOP+3).EQ.1)
     *	   IPMEM(LPMF+14)=IBSET(IPMEM(LPMF+14),15)
C				   STARTING FROM THIS POINT STACK(TOP+3)
C				   INCLUDES PROTOTYPE ADDRESS
      STACK(TOP+3)=LPMF+6
      NEXT=STACK(TOP+3)
C  A LOCAL USAGE OF VARIABLE NEXT
      IPMEM(NEXT+9)=LN
      IPMEM(NEXT+10)=STACK(TOP+4)
      IPMEM(NEXT+2)=STACK(TOP+5)
      CALL SCAN
C
C  ANALYSIS OF THE FORMAL PARAMETERS
C
      IF (S.NE.SLEFT) GOTO 2050
      CALL ADDPAR(STACK(TOP+3)+11,STACK(TOP+3))
      IF (S.EQ.SRIGHT) CALL SCAN
2050  NEXT=STACK(TOP+3)
C  NEXT LOCAL USAGE OF VARIABLE NEXT
C				   JUMP OUT IF NOT A FUNCTION
      IF (IPMEM(NEXT).NE.4) GOTO 25
      IF (S.NE.SCOLON) GOTO 2080
      CALL SCAN
      GOTO 2090
C				   COLON MISSING - ERROR
2080  CALL ERROR(118)
2090  STACK(TOP+4)=0
      IF (S.NE.SARROF) GOTO 22
21    STACK(TOP+4)=STACK(TOP+4)+1
      CALL SCAN
      IF (S.EQ.SARROF) GOTO 21
C				   FUNCTION TYPE ?
22    IPMEM(NEXT+13)=STACK(TOP+4)
      IF (S.EQ.SINT)   IPMEM(NEXT+12)=ADRES*8
      IF (S.EQ.SCOROUT) IPMEM(NEXT+12)=K
      IF (S.EQ.SIDENT)	IPMEM(NEXT+12)=ADRES
      IF (IPMEM(NEXT+12).EQ.0) GOTO 2250
      CALL SCAN
      GOTO 25
C				   TYPE MISSING - ERROR
2250  CALL ERROR(109)
25    IF (S.EQ.SEMICOL) GOTO 262
      CALL ERROR(102)
C				   SEMICOLON EXPECTED
262   NRRE=STACK(TOP+6)
      IPMEM(NRRE)=NEXT
C  PROTOTYPE ADDRESS IS PUT INTO THE DICTIONARY
      IN=TOP
265   IN=STACK(IN)
C				   JUMP OUT FOR THE MAIN BLOCK
      IF (IN.EQ.0) GOTO 275
      IF (STACK(IN+1).EQ.13) GOTO 266
      IF (STACK(IN+1).NE.11) GOTO 265
C  AN E11 (SYNTACTIC UNIT) OR E13 (HANDLER) OBJECT BEING THE SYNTACTIC FATHER
C  OF THE CURRENT OBJECT HAS BEEN FOUND WITHIN THE DL-CHAIN.
C  E11 - MOVE PROTOTYPE ADDRESS TO STACK('PERTINENT' TOP + 3)
      IN = STACK(IN)
      NRRE = STACK(IN+3)+6
      GOTO 267
C  E13 - MOVE PROTOTYPE ADDRESS TO STACK('PERTINENT' TOP + 4)
266   IN=STACK(IN)
      NRRE = STACK(IN+4)+6
267   IPMEM(NEXT+1)=STACK(IN+6)
      LPMF=LPMF-2
C   UPDATE THE SUBMODULE LIST FOR THE FATHER
      IF (LPMF.LT.LPML) CALL ERROR(199)
      IF ((IPMEM(NEXT).EQ.2).OR.(IPMEM(NEXT).EQ.7)) NRRE=NRRE-1
      IPMEM(LPMF+2)=IPMEM(NRRE)
      IPMEM(NRRE)=LPMF+1
      IPMEM(LPMF+1)=STACK(TOP+6)
      GOTO 285
275   IPMEM(NEXT+1)=0
      IF (S.NE.SBLOCK) GOTO 287
285   CALL SCAN
287   IF (S.NE.STAKEN) GOTO 35
      CALL SCAN
      IF (S.EQ.SEMICOL) GOTO 29
27    IF (S.NE.SIDENT) GOTO 2805
      LPMF=LPMF-3
      IF (LPMF.LT.LPML) CALL ERROR(199)
      IPMEM(LPMF+1)=ADRES
      IPMEM(LPMF+2)=LN
      IPMEM(LPMF+3)=IPMEM(NEXT+7)
      IPMEM(NEXT+7)=LPMF+1
      CALL SCAN
      IF (S.NE.SCOMA) GOTO 28
      CALL SCAN
      GOTO 27
C				 ADD THE SYSPP SYSTEM PREFIX
2795  CONTINUE
      STACK(TOP+3)=LPMF+23
      STACK(TOP+6)=ISFIN+1
      CALL SCAN
      GOTO 36
28    IF (S.EQ.SEMICOL) GOTO 30
2805  CALL ERROR(102)
      GOTO 35
29    IPMEM(NEXT+8)=IBSET(IPMEM(NEXT+8),14)
30    CALL SCAN
35    IF (S.EQ.SCLOSE) GOTO 350
36    NEXT=STACK(TOP+3)
      CALL SLAD(4,11,2)
      STACK(TOP+3)=NEXT
      NEXT=10
      RETURN
C  CALL E10 TO ANALYSE THE DECLARATION SEQUENCE
200   IF (S.EQ.SHANDL) GOTO 380
203   NEXT=STACK(TOP+3)
      IF (S.EQ.SBEGIN) GOTO 210
      IF (S.EQ.SEND) GOTO 212
      IF (S.LT.1) GOTO 205
      IF (S.GT.24) GOTO 205
      CALL ERROR(134)
      GOTO 210
205   IF (S.EQ.SBECOME) GOTO 210
      IF (IPMEM(NEXT-1).EQ.0) GOTO 209
C				     ENUMERATION CONSTANTS OCCURRED - END CODE
      CALL OUTPUT(WFIRST,LN)
      CALL OUTPUT(WFIN,1)
      CALL OUTPUT(LN,-1)
209   CALL ERROR(113)
      GOTO 207
210   IPMEM(NEXT+8)=IBSET(IPMEM(NEXT+8),13)
212   CALL SLAD(4,11,3)
      STACK(TOP+3)=NEXT
      NEXT=9
      RETURN
C  CALL E9 TO ANALYSE THE INSTRUCTION SEQUENCE
C  E9 FILLS UP WORDS -1,-2,-3 FOR THE PROTOTYPE WHOSE
C  ADDRESS IS PASSED THROUGH STACK(TOP+3)
C
300   IF (TOP.EQ.1) GOTO 207
C
C  IF IT WAS THE MAIN BLOCK JUMP OUT TO 207
C
      CALL SCAN
      NEXT=STACK(TOP+3)
C
C  A LOCAL USAGE OF VARIABLE NEXT - IT INCLUDES THE PROTOTYPE ADDRESS.
C  CHECK IF THE PARSED UNIT WAS A BLOCK. IF SO THEN JUMP OUT AND TERMINATE
C  PARSING. OTHERWISE CHECK WHETHER "END" IS FOLLOWED BY AN IDENTIFIER
C
      IF (IPMEM(NEXT).EQ.1) GOTO 207
      IF (S.NE.SIDENT) GOTO 207
C
C  "END" IS FOLLOWED BY AN IDENTIFIER. WE HAVE TO CHECK WHETHER
C  IT MATCHES THE IDENTIFIER FROM THE PROTOTYPE.
C
      NEXT=NEXT+10
      IF (ADRES.EQ.IPMEM(NEXT)) GOTO 308
      CALL ERROR(128)
      GOTO 207
C				   NAME IS OK
308   CALL SCAN
      GOTO 207
3460  CALL ERROR(102)
      GOTO 3485
3470  CALL ERROR(109)
      GOTO 3485
3480  CALL ERROR(121)
      CALL SCAN
C				   LOOK FOR A REASONABLE SYMBOL
3485  IF (S.EQ.SBEGIN) GOTO 200
      IF (S.EQ.SEND) GOTO 212
      IF (S.EQ.SUNIT) GOTO 35
      IF (S.EQ.SVAR) GOTO 35
      IF (S.EQ.SCONS) GOTO 35
      IF (S.EQ.SCLOSE) GOTO 350
      IF (S.EQ.70) GOTO 207
      IF (S.EQ.1) GOTO 3488
      IF (S.LT.25) GOTO 200
3488  CALL SCAN
      GOTO 3485
350   NRRE=STACK(TOP+3)
      IF ((IPMEM(NRRE).NE.2).AND.(IPMEM(NRRE).NE.7)) GOTO 3480
351   STACK(TOP+4)=ADRES
      CALL SCAN
      IF (S.NE.SCLOSE) GOTO 355
      IF (ADRES.EQ.STACK(TOP+4)) CALL ERROR(120)
      GOTO 365
C  HIDDEN OR PROTECTED ENCOUNTERED
355   IF (S.NE.SIDENT) GOTO 3470
      LPMF=LPMF-3
      IF (LPMF.LT.LPML) CALL ERROR(199)
      IPMEM(LPMF+1)=ADRES
      IPMEM(LPMF+2)=LN
      NEXT=STACK(TOP+3)+STACK(TOP+4)+11
      IPMEM(LPMF+3)=IPMEM(NEXT)
      IPMEM(NEXT)=LPMF+1
      CALL SCAN
      IF (S.EQ.SEMICOL) GOTO 30
      IF (S.NE.SCOMA) GOTO 3460
      CALL SCAN
      GOTO 355
C  HIDDEN PROTECTED ENCOUNTERED
365   CALL SCAN
      IF (S.NE.SIDENT) GOTO 3470
      LPMF=LPMF-6
      IF (LPMF.LT.LPML) CALL ERROR(199)
      IPMEM(LPMF+1)=ADRES
      IPMEM(LPMF+4)=ADRES
      IPMEM(LPMF+2)=LN
      IPMEM(LPMF+5)=LN
      NEXT=STACK(TOP+3)+12
      IPMEM(LPMF+3)=IPMEM(NEXT)
      IPMEM(NEXT)=LPMF+1
      IPMEM(LPMF+6)=IPMEM(NEXT+1)
      IPMEM(NEXT+1)=LPMF+4
      CALL SCAN
      IF (S.EQ.SEMICOL) GOTO 30
      IF (S.NE.SCOMA) GOTO 3460
      GOTO 365
C					HANDLER ENCOUNTERED
380   NEXT=STACK(TOP+3)
C					PROTOTYPE ADDRESS IS SAVED
      IF (IPMEM(NEXT-1).NE.0) CALL MARK(STACK(TOP+4),STACK(TOP+5))
      CALL SLAD(4,11,4)
      NEXT=13
      RETURN
C					CALL E13 TO ANALYSE THE HANDLER
400   NEXT=STACK(TOP+3)
      IF (IPMEM(NEXT-1).NE.0) CALL FIND(STACK(TOP+4),STACK(TOP+5))
      CALL SCAN
C					SKIP THE SEQUENCE "END HANDLERS(;)"
C					END HANDLERS (;)
      IF (S.EQ.SHANDL) CALL SCAN
      IF (S.EQ.SEMICOL) CALL SCAN
      GOTO 203
      END

      SUBROUTINE E12
      IMPLICIT INTEGER (A-Z)
C
C  RECOGNIZES BOOLEAN EXPRESSIONS BUILT UP OF CONSTANTS
C
C  LOCAL VARIABLES:
C     STACK(TOP+3) - INCLUDES 1 WHEN "AND" IS TO BE WRITTEN
C     STACK(TOP+4) - ........ 1 .... "OR"  .. .. .. .......
C     STACK(TOP+5) - ........ 1 .... "NOT" .. .. .. .......
C     STACK(TOP+6) - INCLUDES RELATION CODE (SOMETIMES)
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,30),IN
10    STACK(TOP+3)=0
      STACK(TOP+4)=0
      STACK(TOP+5)=0
80    IF (S.NE.SNOT) GOTO 100
C				   NOT OCCURRED
      STACK(TOP+5)=1
85    CALL SCAN
C				   MAIN LOOP
100   IF (S.EQ.STRUE) GOTO 130
C				   THERE SHOULD BE AN IDENTIFIER
      CALL SLAD(4,12,2)
      NEXT=7
      RETURN
C				   CALL E7 - TO ANALYSE ARITHEXPRESSION
20    IF (S.NE.SRELAT) GOTO 200
C				   '=' OCCURRED (OR SOMETHING ALIKE)
C				   IT SHOULD BE STORED IN STACK (TOP+6)
115   STACK(TOP+6)=ADRES
      CALL SCAN
      CALL SLAD(4,12,3)
      NEXT=7
      RETURN
C				   ARTITHEXPRESSION CALLED AGAIN
30    CALL OUTPUT(WOPERAT,STACK(TOP+6))
      GOTO 200
C				   LOGICAL CONSTANT
130   CALL OUTPUT(WCNSTB,-1)
      CALL OUTPUT(1-ADRES,-1)
C				   END OF MAIN LOOP
195   CALL SCAN
200   IF (STACK(TOP+5).EQ.0) GOTO 205
      CALL OUTPUT(WNOT,-1)
      STACK(TOP+5)=0
205   IF (STACK(TOP+3).EQ.0) GOTO 210
      CALL OUTPUT(WAND,-1)
      STACK(TOP+3)=0
210   IF (S.NE.SAND) GOTO 220
      STACK(TOP+3)=1
      CALL SCAN
      GOTO 80
220   IF (STACK(TOP+4).EQ.0) GOTO 230
      CALL OUTPUT(WOR,-1)
      STACK(TOP+4)=0
230   IF (S.NE.SOR) GOTO 1000
      STACK(TOP+4)=1
      CALL SCAN
      GOTO 80
1000  NEXT=0
      RETURN
      END

      SUBROUTINE E13
      IMPLICIT INTEGER (A-Z)
C  RECOGNIZES HANDLER, BUILDS UP ITS PROTOTYPE
C  LOKAL VARIABLES:
C    STACK(TOP+3) - END-OF-CODE LABEL
C    STACK(TOP+4) - HANDLER PROTOTYPE ADDRESS
C    STACK(TOP+5) - INCLUDES 1 IF "OTHERS" OCCURRED
C    STACK(TOP+6) - PROTOTYPE NUMBER
C  THE FOLLOWING BLANK-COMMON VARIABLES ARE USED AS LOCAL ONES:
C    NRCHAR  - HEAD OF THE CREATED LIST OF NAMES
C    NRCOR
C    NRRE
C    NRBLUS
C
C----------------------------------------------------------------------
C  HANDLER PROTOTYPE:
C
C  ----+-------------------
C   -5 ! NOT USED
C  ----+-------------------
C   -4 ! NOT USED
C  ----+-------------------
C   -3 ! SCRATCH FILE CODE RECORD NUMBER
C  ----+-------------------
C   -2 ! NUMBER OF WORD IN THE CODE RECORD
C  ----+-------------------
C   -1 ! NOT USED
C  ----+-------------------
C    0 ! KIND = 8
C  ----+-------------------
C   +1 ! SL - NUMBER IN ISDICT
C  ----+-------------------
C   +2 ! NOT USED
C  ----+-------------------
C   +3 ! NOT USED
C  ----+-------------------
C   +4 ! NOT USED
C  ----+-------------------
C   +5 ! NOT USED
C  ----+-------------------
C   +6 ! SUBBLOCK LIST
C  ----+-------------------
C   +7 ! NOT USED
C  ----+-------------------
C   +8 ! NOT USED
C  ----+-------------------
C   +9 ! SOURCE TEXT LINE NUMBER
C  ----+-------------------
C  +10 ! LIST OF NAMES
C  ----+-------------------
C
C  NAME LIST ITEM:
C
C  ----+-------------------
C    0 ! NAME
C  ----+-------------------
C   +1 ! NEXT ITEM POINTER
C  ----+-------------------
C
C  NOTE ! EMPTY LIST OF NAMES CORRESPONDS TO THE PROTOTYPE OF A HANDLER
C	  FOR "OTHERS"
C
      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(1000)
      EQUIVALENCE (IPMEM(1),SCANER(1))
cdsw  EQUIVALENCE (AUX,SCANER(3698))
      EQUIVALENCE (AUX,SCANER(8698))
      EQUIVALENCE (WSTART,WUNLOCK)
      DATA SOTHRS/57/

      GOTO (10,20),IN
10    NRCHAR=0
      STACK(TOP+5)=0
      CALL SCAN
      IF (S.EQ.SWHEN) GOTO 100
      IF (S.EQ.SOTHRS) GOTO 200
      CALL ERROR(132)
90    NEXT=0
      RETURN
C					IS THERE AN IDENTIFIER?
100   CALL SCAN
      IF (S.EQ.SIDENT) GOTO 110
      CALL ERROR(108)
      GOTO 90
C					THERE IS
110   LPMF=LPMF-2
      IF (LPMF.LT.LPML) CALL ERROR(199)
C					CREATE AN ENTRY TO THE NAME LIST
      IPMEM(LPMF+2)=NRCHAR
      NRCHAR=LPMF+1
      IPMEM(NRCHAR)=ADRES
      CALL SCAN
C					END OF LIST?
      IF (S.EQ.SCOLON) GOTO 118
C					CONTINUATION?
      IF (S.EQ.SCOMA) GOTO 100
C					NONE OF ABOVE - ERROR
      CALL ERROR(118)
      GOTO 90
118   CALL SCAN
120   LPMF=LPMF-17
      IF (LPMF.LT.LPML) CALL ERROR(199)
C					SLOT FOR THE PROTOTYPE AND HANDLER
C					DESCRIPTION FOR THE SYNTACTIC FATHER
      NRCOR=LPMF+7
      STACK(TOP+4)=NRCOR
      STACK(TOP+6)=ISFIN
      IPMEM(ISFIN)=NRCOR
      ISFIN=ISFIN-1
      IPMEM(NRCOR+ 0)=8
      IPMEM(NRCOR+ 9)=LN
      IPMEM(NRCOR+10)=NRCHAR
C					UPDATE FATHER'S SUBMODULE LIST
      NRRE=STACK(TOP)
      IPMEM(NRCOR+ 1)=STACK(NRRE+6)
      NRBLUS=STACK(NRRE+3)
      IPMEM(LPMF+1)=STACK(TOP+6)
      IPMEM(LPMF+2)=IPMEM(NRBLUS+6)
      IPMEM(NRBLUS+6)=LPMF+1
C					PREPARE THE INTERMEDIATE CODE
      IPMEM(NRCOR- 2)= POSIT
      IPMEM(NRCOR- 3)= RECNR
      CALL OUTPUT(WFIRST,LN)
      CALL OPTOUT
      UNICAL=2
      STACK(TOP+3)=1
      CALL SLAD(4,13,2)
      NEXT=8
      STACK(TOP+7)=1
      RETURN
C					CALL E8 TO ANALYSE STATEMENT-LIST
C					PARAMETER = 1
20    CALL OUTPUT(WFIN,STACK(TOP+3))
      CALL OUTPUT(LN,-1)
      NRCHAR=0
      IF (S.EQ.SWHEN) GOTO 100
      IF (S.EQ.SOTHRS) GOTO 200
      IF (S.EQ.SEND) GOTO 90
C					WRONG END OF HANDLER
      CALL ERROR(142)
      GOTO 90
C					OTHERS OCCURRED
200   IF (STACK(TOP+5).NE.0) CALL ERROR(129)
      STACK(TOP+5)=1
      CALL SCAN
      IF (S.EQ.SCOLON) CALL SCAN
      GOTO 120
      END

      INTEGER FUNCTION EXYT(K,L)
      IMPLICIT INTEGER (A-Z)
      COMMON /BLANK/ com(9037), top, in, next, stack(500), reszta(3652) 
C
C  THIS FUNCTION RETURNS THE NUMBER OF THE PERTINENT LABEL
C  DEPENDING ON THE VALUE OF THE SECOND PARAMETER, WE CHOOSE
C  THE STARTING LOOP LABEL /FOR L = 0/ OR THE ENDING ONE /L=1/
C
      Z=TOP
      A=K
      GOTO 2
1     Z=STACK(Z)
2     IF (STACK(Z+1).EQ.8) GOTO 10
      IF (STACK(Z+1).EQ.13) GOTO 3
      IF (STACK(Z+1).NE.9) GOTO 1
C
C    EXIT IS MADE TO THE END OF THE SYNTACTIC UNIT (E9)
C    OR HANDLER (E13)
C
3     IF (A.GT.1) CALL ERROR(110)
      IF (L.EQ.0) CALL ERROR(138)
      Z=STACK(Z)
      EXYT=STACK(Z+3)
      RETURN
C
C    DO . . . OD - TYPE LOOP DETECTED
C
10    IF (STACK(Z+2).EQ.13) GOTO 15
      IF (STACK(Z+2).EQ.7)  GOTO 15
      IF (STACK(Z+2).NE.25) GOTO 1
15    CONTINUE
C
C    FOR... AND WHILE... ARE ALSO ADMITTED..
C
      A=A-1
      IF (A.GT.0) GOTO 1
C    JUMP OUT IF THE NUMBER OF LOOPS IS LESS THAN THE NUMBER OF
C    EXITS
      Z=STACK(Z)
      A=Z+L+3
      EXYT=STACK(A)
      RETURN
      END

      SUBROUTINE MARK(A,B)
      IMPLICIT INTEGER(A-Z)
      COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
     X		      POSIT,RECNR,NEXT
C
C  MARKS THE CURRENT LOCATION OF THE SCRATCH FILE
C  MEANING OF PARAMETERS (EXIT ONLY):
C     A - RECORD NUMBER
C     B - POSITION (WORD NUMBER) IN THE RECORD
C
      A=RECNR
      B=POSIT
      CALL PUT(BUF,BUFOUT)
      IF (RECNR.NE.NEXT-1) CALL SEEK(BUF,NEXT)
      RECNR=NEXT
      NEXT=NEXT+1
      POSIT=1
      RETURN
      END

      SUBROUTINE FIND (A,B)
      IMPLICIT INTEGER (A-Z)
C
C  THIS PROCEDURE RESETS THE POSITION OF THE SCRATCH FILE ACCORDING TO
C  THE PARAMETERS:		     A - RECORD NUMBER
C				     B - WORD NUMBER
C
      COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
     X		      POSIT,RECNR,NEXT
      CALL PUT(BUF,BUFOUT)
      CALL SEEK(BUF,A)
      CALL GET(BUF,BUFOUT)
      CALL SEEK(BUF,A)
      RECNR=A
      POSIT=B
      RETURN
      END

      SUBROUTINE OPTOUT
      IMPLICIT INTEGER(A-Z)
C  WRITES TO THE INTERMEDIATE CODE INFORMATION ABOUT ALL OPTIONS
C  (WORD C0M(2)) WITHOUT L-OPTION. CLEARS AUX.
      COMMON /BLANK/ c0m(4), blank0(121), wopt, blank1(8873), aux
      
      DO 100 I=2,8
      CALL OUTPUT(WOPT,I*(-1+2*IAND(1,ISHFT(C0M(2),2-I))))
100   CONTINUE
      AUX=0
      RETURN
      END

      SUBROUTINE SELOPT
      IMPLICIT INTEGER (A-Z)
C  WRITES TO THE INTERMEDIATE CODE INFORMATIONS ABOUT ALL OPTIONS FOR WHICH
C  THE CORRESPONDING BITS IN WORD AUX ARE SET.
C  CLEARS AUX.
      COMMON /BLANK/ C0M(4),BLANK0(121),WOPT,BLANK1(8873),AUX

      LOGICAL BTEST
      DO 100 I=2,8
      IF (BTEST(AUX,I-2))
     X CALL OUTPUT(WOPT,I*(-1+2*IAND(1,ISHFT(C0M(2),2-I))))
100   CONTINUE
      AUX=0
      RETURN
      END
      
      SUBROUTINE OUTPUT(A,B)
      IMPLICIT INTEGER (A-Z)
C
C   WRITES INTERMEDIATE CODE TO THE SCRATCH FILE
C
      COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
     X		      POSIT,RECNR,NEXT
      COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,POSTR(265),STATUS
      IF (B.NE.-1) GOTO 100
      BUFOUT(POSIT)=A
      IF (POSIT.EQ.255) GOTO 50
      POSIT=POSIT+1
      RETURN
50    BUFOUT(256)=NEXT
      POSIT=1
      CALL PUT(BUF,BUFOUT)
      IF (RECNR.NE.NEXT-1) CALL SEEK(BUF,NEXT)
      RECNR=NEXT
      NEXT=NEXT+1
      RETURN
100   IF (POSIT.LT.255) GOTO 150
      BUFOUT(255)=A
      BUFOUT(256)=NEXT
      POSIT=2
      CALL PUT(BUF,BUFOUT)
      IF (RECNR.NE.NEXT-1) CALL SEEK(BUF,NEXT)
      RECNR=NEXT
      NEXT=NEXT+1
      BUFOUT(1)=B
      RETURN
150   BUFOUT(POSIT)=A
      BUFOUT(POSIT+1)=B
      POSIT=POSIT+2
      IF (POSIT.EQ.256) GOTO 50
      RETURN
      END
      
      SUBROUTINE END
      IMPLICIT INTEGER (A-Z)
      COMMON /BLANK/ COM(278),
     X	      LMEM  , LPMEM , IRECN , ISFIN , LPMSYS, LPML  , LPMF  ,
     X	      NRINT , NRRE  , NRBOOL, NRCHR , NRCOR , NRPROC, NRTEXT,
     X	      NRUNIV, NATTR , NRNONE, NBLSYS, NBLUS , NEMPTY, INSYS ,
     X	      LOCAL , OWN   , OBJECT,
     X	      IPMEM(7890)
      LOGICAL  INSYS, LOCAL, OWN
C  IPMEM - MAIN MEMORY
C  LPML  - ADDRESS OF THE FIRST -
C  LPMF  - ADDRESS OF THE LAST	- FREE WORD IN IPMEM
C  ISFIN - TOP OF THE PROTOTYPE DICTIONARY STACK
C  LPMEM - DIVISION POINT FOR IPMEM
      COMMON /LISTING/ OUTSTR(265)
      COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,POSTR(265),STATUS
      COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
     X		      POSIT,RECNR,NEXT
      LOGICAL ERRFLG
CPS      character auxc(4)
CPS      equivalence (auxc(1), aux)
CPS      data aux /-1/
      character int2char

      IPMEM(ISFIN-1)=LPMF-LPML+1
      NATTR=ISFIN-1
10    NATTR=NATTR-1
      IF (IPMEM(NATTR).EQ.0) GOTO 10
cdsw  IPMEM(ISFIN)=NATTR-3738
      IPMEM(ISFIN)=NATTR-8738
      ISFIN=ISFIN+1
      LPMEM=LPMEM-1
      IRECN=LPML-1
      IF (LPMF.EQ.LMEM) CALL ERROR(191)
      NATTR=IPMEM(LPMEM)
C  CHECK IF THE PROTOTYPE DICTIONARY INCLUDES ANY ADDRESS
C  OR IF THE FIRST PROTOTYPE IS BUILT CORRECTLY
      IF (IPMEM(LPMEM).EQ.0) CALL ERROR(191)
      IF (IPMEM(NATTR).EQ.0) CALL ERROR(191)
cdsw  CALL CLOSF(OUTSTR)
cdsw  CALL CLOSF(INSTR)
      CALL PUT(BUF,BUFOUT(1))
      COM(2)=NEXT
      IF (ERRFLG) GOTO 1
cdsw  znacznik konca stringow    
cbc   WRITE(15) -1
      call ffwrite_ints( 15, -1, 1 )
cbc
1     CONTINUE
c  end of file 16
      call ffwrite_char(16, int2char(26))
C --- MPTBUF SEEMS NOT NECESSARY IN THE 'ONE-OVERLAY' VERSION
C     CALL MPTBUF
      RETURN
      END
      
      SUBROUTINE SLAD(NROFVAR,NR,MIEJSCE)
      IMPLICIT INTEGER (A-Z)
      COMMON /BLANK/ COM(9037), TOP, IN, NEXT, STACK(500), RESZTA(3652)
C  PREPARES STACK FOR CALL OF ANOTHER PROCEDURE
C  PARAMETERS:
C     NROFVAR - NUMBER OF THE LOCAL VARIABLES ALLOCATED ON THE STACK
C     NR      - NUMBER OF THE CALLING PROCEDURE
C     SLAD    - NUMBER OF THE RETURN POINT
      EQUIVALENCE(COM(282),ISFIN)
cdsw  IF (TOP+3748.GT.ISFIN) CALL ERROR(198)
      IF (TOP+8748.GT.ISFIN) CALL ERROR(198)
C  CHECK IF THE STACK ISN'T TOO LONG
      Z=TOP
      TOP=TOP+NROFVAR+3
      STACK(TOP)=Z
      STACK(TOP+1)=NR
      STACK(TOP+2)=MIEJSCE
      IN=1
      RETURN
      END
      
      SUBROUTINE ADDPAR(LHEAD,MFIELD)
      IMPLICIT INTEGER (A-Z)
C
C  APPENDS PARAMETERS TO THE CREATED PROTOTYPE
C  PARAMETERS: LHEAD - BEGINNING OF THE PARAMETER LIST
C	      MFIELD - ADDRESS OF THE PLACE TO BE CHANGED IN CASE OF
C		       ERRONEOUS LIST
C  MODIFICATION FUNCTION:
C    CONVERT:  [1..10]	------>  [1,7,5,6,5,6,7,8,10,10]
C  THE FOLLOWING BLANK-COMMON VARIABLES ARE USED:
C    OBJECT  - LAST ELEMENT ON THE PARAMETER LIST (LINK FIELD)
C    KIND    - A LOCAL VARIABLE
C    NRRE    - COUNTS NUMBER OF OCCURRENCES OF ARRAYOF'S
C    NATTR   - KEEPS THE RECOGNIZED TYPE
C    NRCHR   - A LOCAL VARIABLE (LOOP LIMIT)
C    NRCOR   - AS ABOVE
C    NRTEXT  - SAVES THE VALUE OF VARIABLE OBJECT
C    NRPROC  - ADDRESS OF THE PLACE TO BE WVERWRITTEN
C    NBLUS   - ANALYSIS LEVEL	      1 - PARAMETER LIST
C				      2 - SIMPLIFIED LIST
C---------------------------------------------------------------------
C    ITEM OF THE FORMAL PARAMETER LIST:
C
C   0 ! KIND
C  ---+------------------
C -1 ! SOURCE TEXT LINE NUMBER
C +--+------------------
C -2 ! NAME
C +--+------------------
C +3 ! NEXT ITEM INDEX
C REMAINDER FOR VARIABLES    FOR PROCEDURES AND FUNCTIONS
C ---+------------------------------------------------------------
C +4 ! TYPE NUMBER     !  +4 ! FORMAL PARAMETER LIST
C ---+-----------------------+------------------------------------
C +5 ! ARRAYOF COUNT   !  +5 ! TYPE NAME   (KIND = FUNCTION)
C			  ----+------------------------------------
C			  +6 ! NUMBER OF ARRAYOF'S (KIND = FUNCTION)
C   WHERE KIND:
C      3 - PROCEDURE
C      4 - FUNCTION
C      5 - PROCEDURE WITH ERRONEOUS PARAMETER LIST
C      6 - FUNCTION  "      "       "       "
C      7 - TYPE
C      8 - VARIABLE "INPUT"
C      9 - VARIABLE "OUTPUT"
C     10 - VARIABLE "INOUT"
C
      DIMENSION CONVERT(10)
      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 (IPMEM(1),SCANER(1))
      COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,JNK(266)
      DATA CONVERT/1,7,5,6,5,6,7,8,10,10/

      OBJECT=LHEAD
      NBLUS=1
10    CALL SCAN
11    IF (S.EQ.SINPUT) GOTO 100
      IF (S.EQ.SIDENT) GOTO 150
      IF (S.EQ.STYPE)  GOTO 300
      IF (S.EQ.SFUNCT) GOTO 400
      IF (S.EQ.SPRCD)  GOTO 500
C  NO KEYWORDS HAVE BEEN FOUND WHICH COULD PROPERLY START THE PARAMETER LIST
C  NOW WE SHOULD FIND A PERTINENT DELIMITER-SYMBOL TO CONTINUE ANALYSIS
C  THE PROTOTYPE IS ALSO TO BE CHANGED
      CALL ERROR(107)
C  LOCAL USAGE OF VARIABLES NRCHAR
C  AND NRCOR  (CODE OPTIMIZATION)
80    NRCHAR=MFIELD
      NRCOR=IPMEM(NRCHAR)
      IPMEM(NRCHAR)=CONVERT(NRCOR)
81    IF (S.LT.25) GOTO 90
      IF (S.EQ.SBECOME) GOTO 90
      IF (S.EQ.SRIGHT)	GOTO (90,550),NBLUS
      IF (S.EQ.SEND)	GOTO 90
      IF (S.EQ.SBEGIN)	GOTO 90
      IF (S.EQ.SCONS)	GOTO 90
      IF (S.EQ.SUNIT)	GOTO 90
      IF (S.EQ.STAKEN)	GOTO 90
      IF (S.EQ.SCLOSE)	GOTO 90
      IF (S.EQ.SEOF)	GOTO 90
      IF (S.EQ.SINPUT)	GOTO 100
      IF (S.EQ.STYPE)	GOTO 300
      IF (S.EQ.SFUNCT)	GOTO (400,600),NBLUS
      IF (S.EQ.SPRCD)	GOTO (500,700),NBLUS
      IF (S.EQ.SRELAT)	GOTO 90
      IF (S.EQ.SAND)	GOTO 90
      CALL SCAN
      GOTO 81
CPS 85    CALL SCAN
90    RETURN
100   KIND=7+ADRES
C			KIND INCLUDES 8 - INPUT
C				      9 - OUTPUT
C				     10 - INOUT
      GOTO 210
150   KIND=8
      J=1
      GOTO 222
210   J=1
220   CALL SCAN
222   J=J+1
      IF (J.GT.132) CALL ERROR(197)
      IF (S.EQ.SIDENT) GOTO 225
      CALL ERROR(109)
C  ERROR IN SPECIFICATION OF INPUT/OUTPUT-TYPE PARAMETERS
C  THE TYPE OF THE VARIABLES IS UNDEFINED
      COM(J)=0
      NRRE=0
      NATTR=0
      GOTO 255
225   COM(J)=ADRES
      CALL SCAN
      IF (S.EQ.SCOMA) GOTO 220
      IF (S.EQ.SCOLON) GOTO 230
      CALL ERROR(118)
      GOTO 11
230   NRRE=0
240   CALL SCAN
      IF (S.NE.SARROF) GOTO 250
      NRRE=NRRE+1
      GOTO 240
250   NATTR=0
      IF (S.EQ.SCOROUT) NATTR=K
      IF (S.EQ.SINT)	NATTR=ADRES*8
      IF (S.EQ.SIDENT)	NATTR=ADRES
      IF (NATTR.EQ.0) CALL ERROR(109)
255   NRCHAR=2
      NRCOR=J
      DO 260 J=NRCHAR,NRCOR
      LPMF=LPMF-6
      IF (LPMF.LT.LPML) CALL ERROR(199)
      IPMEM(LPMF+1)=KIND
      IPMEM(LPMF+2)=LN
      IPMEM(LPMF+3)=COM(J)
      IPMEM(OBJECT)=LPMF+1
      OBJECT=LPMF+4
      IPMEM(LPMF+5)=NATTR
      IPMEM(LPMF+6)=NRRE
260   CONTINUE
      IF (NATTR.EQ.0) GOTO 80
      CALL SCAN
      IF (S.EQ.SCOMA) GOTO 210
      IF (S.EQ.SEMICOL) GOTO (10,541),NBLUS
      IF (S.EQ.SRIGHT) GOTO (90,550),NBLUS
      CALL ERROR(102)
      GOTO (80,545),NBLUS
300   CALL SCAN
      IF (S.EQ.SIDENT) GOTO 310
      CALL ERROR(109)
      GOTO (80,545),NBLUS
310   LPMF=LPMF-4
      IF (LPMF.LT.LPML) CALL ERROR(199)
      IPMEM(LPMF+1)=7
      IPMEM(LPMF+2)=LN
      IPMEM(LPMF+3)=ADRES
      IPMEM(OBJECT)=LPMF+1
      OBJECT=LPMF+4
      CALL SCAN
      IF (S.EQ.SEMICOL) GOTO (10,541),NBLUS
      IF (S.EQ.SRIGHT) GOTO (90,550),NBLUS
      IF (S.EQ.SCOMA) GOTO 320
      CALL ERROR(107)
      GOTO (80,545),NBLUS
320   CALL SCAN
      IF (S.EQ.SIDENT) GOTO 310
      CALL ERROR(109)
      GOTO (80,545),NBLUS
400   KIND=4
      GOTO 510
500   KIND=3
510   CALL SCAN
      IF (S.EQ.SIDENT) GOTO 520
      CALL ERROR(109)
      GOTO 80
520   LPMF=LPMF+2*KIND-15
      IF (LPMF.LT.LPML) CALL ERROR(199)
      IPMEM(LPMF+1)=KIND
      IPMEM(LPMF+2)=LN
      IPMEM(LPMF+3)=ADRES
      IPMEM(OBJECT)=LPMF+1
      OBJECT=LPMF+4
      CALL SCAN
      NRPROC=LPMF
C  THE POINTER TO THE CURRENT ELEMENT OF THE PARAMETER LIST IS SAVED
      IF (S.EQ.SLEFT) GOTO 540
      IF (KIND.EQ.4) GOTO 530
      IF (S.EQ.SEMICOL) GOTO 10
      IF (S.EQ.SRIGHT) RETURN
      CALL ERROR(107)
      GOTO 80
530   NRRE=0
      IF (S.EQ.SCOLON) GOTO 531
      CALL ERROR(118)
      GOTO 535
531   CALL SCAN
      IF (S.NE.SARROF) GOTO 535
      NRRE=NRRE+1
      GOTO 531
535   NATTR=0
      IF (S.EQ.SCOROUT) NATTR=K
      IF (S.EQ.SINT)	NATTR=ADRES*8
      IF (S.EQ.SIDENT)	NATTR=ADRES
      IPMEM(NRPROC+6)=NATTR
      IPMEM(NRPROC+7)=NRRE
      IF (NATTR.EQ.0) GOTO 537
      CALL SCAN
      GOTO 538
537   CALL ERROR(109)
      GOTO 80
538   IF (S.EQ.SRIGHT) RETURN
      IF (S.EQ.SEMICOL) GOTO 10
      CALL ERROR(107)
      GOTO 80
540   NRTEXT=OBJECT
      OBJECT=OBJECT+1
      NBLUS=2
541   CALL SCAN
      IF (S.EQ.SINPUT)	GOTO 100
      IF (S.EQ.SIDENT)	GOTO 150
      IF (S.EQ.STYPE)	GOTO 300
      IF (S.EQ.SFUNCT)	GOTO 600
      IF (S.EQ.SPRCD)	GOTO 700
      IF (S.EQ.SRIGHT)	GOTO 550
      CALL ERROR(107)
545   IF (IPMEM(NRPROC+1).LT.5) IPMEM(NRPROC+1)=IPMEM(NRPROC+1)+2
C   ERRONEOUS PARAMETER LIST. WE SHOULD FIND A SYMBOL WHICH WOULD
C   ALLOW FOR A FURTHER (REASONABLE) ANALYSIS OF THE SOURCE TEXT.
C   THE SEARCHING IS COMMON FOR BOTH PARAMETER LEVELS.
      GOTO 80
550   NBLUS=1
      OBJECT=NRTEXT
      CALL SCAN
      IF (IPMEM(OBJECT-3).EQ.4) GOTO 530
      IF (S.EQ.SEMICOL) GOTO 10
      IF (S.EQ.SRIGHT) RETURN
      CALL ERROR(107)
      GOTO 80
600   KIND=4
      GOTO 710
700   KIND=3
710   CALL SCAN
      IF (S.EQ.SIDENT) GOTO 720
      CALL ERROR(109)
      GOTO 545
720   LPMF=LPMF-4
      IF (LPMF.LT.LPML) CALL ERROR(199)
      IPMEM(LPMF+1)=KIND
      IPMEM(LPMF+2)=LN
      IPMEM(LPMF+3)=ADRES
      IPMEM(OBJECT)=LPMF+1
      OBJECT=LPMF+4
      CALL SCAN
      IF (S.EQ.SRIGHT) GOTO 550
      IF (S.EQ.SEMICOL) GOTO 541
      CALL ERROR(107)
      GOTO 545
      END

      SUBROUTINE ADDVAR(SKAD,ILE)
      IMPLICIT INTEGER (A-Z)
C
C  APPENDS THE LIST OF VARIABLES TO THE LIST IN THE PROTOTYPE
C  RECOGNIZES TYPES OF VARIABLES
C  STACK(TOP+3) - PROTOTYPE ADDRESS
C
C  ILE	- LENGTH OF THE LIST OF VARIABLES
C  SKAD - BEGINNING OF THE LIST - VARIABLES ARE LOCATED IN CONSECUTIVE
C	  WORDS
C
C--------------------------------------------------------------------
C  VARIABLE LIST ITEM:
C  0 ! NAME OF THE VARIABLE
C ---+------------------------
C +1 ! DECLARATION LINE NUMBER IN THE SOURCE TEXT
C ---+------------------------
C +2 ! TYPE NAME
C ---+------------------------
C +3 ! NUMBER OF ARRAYOF'S
C ---+------------------------
C +4 ! NEXT ITEM POINTER
C
      DIMENSION SKAD(2)
      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))
      EQUIVALENCE (SOUTPUT,SEMAPH)

C  VARIABLE ARR COUNTS THE NUMBER OF ARRAYOF'S ENCOUNTERED
      ARR=0
      IF (S.NE.SARROF) GOTO 2
1     ARR=ARR+1
      CALL SCAN
      IF (S.EQ.SARROF) GOTO 1
C  TYPE OF THE VARIABLE IS RECOGNIZED
2     IF (S.EQ.SINT) GOTO 10
      IF (S.EQ.SCOROUT) GOTO 8
      IF (S.EQ.SIDENT) GOTO 6
      IF (S.EQ.SEMAPH) GOTO 4
C  ERROR IN DECLARATION - UNIVERSAL TYPE (0) IS ASSUMED
      ADRES=0
      CALL ERROR(109)
4     KIND=32
      IF (ARR.EQ.0) GOTO 90
      ARR=0
      CALL ERROR(141)
      GOTO 90
6     KIND=ADRES
      GOTO 90
8     KIND=K
C   COROUTINE / PROCESS ARE TREATED AS IDENTIFIERS
C   VARIABLE K INCLUDES HASH TABLE ADDRESS
      GOTO 90
10    KIND=ADRES*8
90    CALL SCAN
C  THE VARIABLE LIST IS COPIED INTO THE CREATED VARIABLE DESCRIPTIONS
      DO 100 I=1,ILE
      LPMF=LPMF-5
      IF (LPMF.LT.LPML) CALL ERROR(199)
C  ERROR(199) - PARSER TABLE OVERFLOW
      IPMEM(LPMF+1)=SKAD(I)
      IPMEM(LPMF+2)=LN
      IPMEM(LPMF+3)=KIND
      IPMEM(LPMF+4)=ARR
C  THE NEW ELEMENT IS APPENDED TO THE VARIABLE LIST
C  NRRE - SCRATCH - BEGINNING OF THE LIST (TAKEN FROM THE PROTOTYPE)
      NRRE=STACK(TOP+3)+3
      IPMEM(LPMF+5)=IPMEM(NRRE)
      IPMEM(NRRE)=LPMF+1
100   CONTINUE
      RETURN
      END


      SUBROUTINE OVERF(K)
      IMPLICIT INTEGER (A-Z)
      COMMON /LISTING/ OUTSTR(265)
      COMMON /BUFF/ INSTR(265),BUFOR(85),LP,LN,MAX,POSTR(265),STATUS
      COMMON /STREAM/ ERRFLG,LINE,IBUF2(265),BUF(7),ON,BUFOUT(256),
     X		      POSIT,RECNR,NEXT
1     IF (BUFOR(1).EQ.2) GOTO 2
      CALL READIN
      GOTO 1
2     CALL APARS
cdsw   CALL CLOSF(OUTSTR)
cdsw   CALL CLOSF(INSTR)
      CALL MDROP(K)
      RETURN
      END

      SUBROUTINE OPTSET
      IMPLICIT INTEGER (A-Z)
C  SETS UP THE OPTION WORD - C0M(2)
CJF  CALLED WHENEVER '(*[' IS ENCOUNTERED
C  CALLED WHENEVER '(*$' IS ENCOUNTERED
CJF  VARIABLE LP IS ASSUMED TO POINT TO THE FIRST CHARACTER FOLLOWING '['
C  VARIABLE LP IS ASSUMED TO POINT TO THE FIRST CHARACTER FOLLOWING '$'
C  IT IS ADVANCED BY OPTSET
C
C  MEANING OF THE PARTICULAR BITS IC C0M(2)
C    BIT(S)   MEANING
C     0   -   OPTION MEMBER-CONTROL   ( 1 - ON, 0 - OFF )	       M
C     1   -   OPTION OPTIMIZATION				       O
C     2   -   OPTION INDEX-CONTROL				       I
C     3   -   OPTION TYPE-CONTROL				       T
C     4   -   OPTION TRACE-CONTROL				       D
C     5   -   OPTION CASE-CONTROL     (NOT USED IN THE L-COMPILER)     C
C     6   -   OPTION FAST CASE			   "                   F
C     7-12    NOT USED
C    13   -   OPTION FOR T.SZCZEPANEK		   "                   S
C    14   -   OPTION PSEUDO-PARALLEL		   "                   P
C    15   -   OPTION LISTING					       L
C
C  NOTE:  PARTICULAR BITS IN AUX (0-12) CORRESPOND TO THE CHANGES IN
C	  C0M(2). THEY ARE SET UP WHEN THE CORRESPONDING OPTIONS ARE SELECTED
C
C  NOTE:  THE NUMBERS OF OPTIONS WRITTEN TO THE INTERMEDIATE CODE RESULT
C	  FROM ADDING 2 TO THE CORRESPONDING BIT NUMBERS.
C
C  WORDS C0M(3) AND C0M(4) ARE USED TO FORCE EXTERNAL SETTING OF OPTIONS.
C  EXTERNAL SETTING (VIA RESPONSE TO THE COMPILER PROMPT) TAKES PRECEDENCE.
C  OPTION 'P' (14) CAN BE SET ONLY EXTERNALLY.
C  INITIAL VALUES:
C    C0M(2) - X'802F'
C    C0M(3) - X'0000'
C    COM(4) - X'FFFF'
C
      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),BLANK(8995),AUX,BLANK1(4192)
      
C  RECOGNIZE THE OPTION
cdsw ------------ changed to lower-case or upper case letters -----
10    continue
      x = ord(bufor(lp))
      if(x.ne.ord(ichar('l'))) goto 100
cdsw10	  IF (BUFOR(LP).NE.ICHAR('L')) GOTO 100
cdsw -------------------------------------------
C  'L' RECOGNIZED
      IF (BUFOR(LP+1).EQ.ICHAR('-')) GOTO 50
      IF (BUFOR(LP+1).EQ.ICHAR('+')) GOTO 30
      CALL ERROR(135)
30    C0M(2)=IBSET(C0M(2),15)
      GOTO 80
50    C0M(2)=IBCLR(C0M(2),15)
C  MASK UP THE OPTIONS WHICH HAVE BEEN DECLARED EXTERNALLY
cdsw&bc  80    C0M(2)=IOR(C0M(3),IAND(C0M(4),C0M(2)))
80    continue
c
      IF (BUFOR(LP+2).NE.ICHAR(',')) GOTO 9999
      LP=LP+3
      GOTO 10
cdsw ---------------- changed -------------
100   if(x.ne.ord(ichar('m')))goto 200
cdsw100   IF (BUFOR(LP).NE.ICHAR('M')) GOTO 200
cdsw--------------------------------------------
C  'M' RECOGNIZED - MEMBER-CONTROL
      IF (BUFOR(LP+1).EQ.ICHAR('-')) GOTO 150
      IF (BUFOR(LP+1).EQ.ICHAR('+')) GOTO 130
      CALL ERROR(135)
130   C0M(2)=IBSET(C0M(2),0)
      GOTO 180
150   C0M(2)=IBCLR(C0M(2),0)
180   AUX=IBSET(AUX,0)
      IF (BUFOR(LP+2).NE.ICHAR(',')) GOTO 9999
      LP=LP+3
      GOTO 10
cdsw ---------------- changed ---------------
200   if(x.ne.ord(ichar('o'))) go to 300
cdsw200   IF (BUFOR(LP).NE.ICHAR('O')) GOTO 300
cdsw -----------------------------------------
C  'O' RECOGNIZED - OPTIMIZATION
      IF (BUFOR(LP+1).EQ.ICHAR('-')) GOTO 250
      IF (BUFOR(LP+1).EQ.ICHAR('+')) GOTO 230
      CALL ERROR(135)
230   C0M(2)=IBSET(C0M(2),1)
      GOTO 280
250   C0M(2)=IBCLR(C0M(2),1)
280   AUX=IBSET(AUX,1)
      IF (BUFOR(LP+2).NE.ICHAR(',')) GOTO 9999
      LP=LP+3
      GOTO 10
cdsw ------------------- changed ---------
300    if(x.ne.ord(ichar('i'))) go to 400
cdsw300   IF (BUFOR(LP).NE.ICHAR('I')) GOTO 400
cdsw ----------------------------------------
C  'I' RECOGNIZED - INDEX-CONTROL
      IF (BUFOR(LP+1).EQ.ICHAR('-')) GOTO 350
      IF (BUFOR(LP+1).EQ.ICHAR('+')) GOTO 330
      CALL ERROR(135)
330   C0M(2)=IBSET(C0M(2),2)
      GOTO 380
350   C0M(2)=IBCLR(C0M(2),2)
380   AUX=IBSET(AUX,2)
      IF (BUFOR(LP+2).NE.ICHAR(',')) GOTO 9999
      LP=LP+3
      GOTO 10
cdsw ------------ changed -----------------
400   if(x.ne.ord(ichar('t'))) go to 500
cdsw400   IF (BUFOR(LP).NE.ICHAR('T')) GOTO 500
cdsw -------------------------------------
C  'T' RECOGNIZED - TYPE-CONTROL
      IF (BUFOR(LP+1).EQ.ICHAR('-')) GOTO 450
      IF (BUFOR(LP+1).EQ.ICHAR('+')) GOTO 430
      CALL ERROR(135)
430   C0M(2)=IBSET(C0M(2),3)
      GOTO 480
450   C0M(2)=IBCLR(C0M(2),3)
480   AUX=IBSET(AUX,3)
      IF (BUFOR(LP+2).NE.ICHAR(',')) GOTO 9999
      LP=LP+3
      GOTO 10
cdsw ------------- changed ----------------
500   if(x.ne.ord(ichar('d'))) go to 600
cdsw500   IF (BUFOR(LP).NE.ICHAR('D')) GOTO 600
cdsw ---------------------------------------
C  'D' RECOGNIZED - TRACE-CONTROL
      C0M(2)=IBCLR(C0M(2),4)
      IF (BUFOR(LP+1).EQ.ICHAR('-')) GOTO 550
      IF (BUFOR(LP+1).NE.ICHAR('+')) CALL ERROR(135)
530   C0M(2)=IBSET(C0M(2),4)
550   AUX=IBSET(AUX,4)
      IF (BUFOR(LP+2).NE.ICHAR(',')) GOTO 9999
      LP=LP+3
      GOTO 10
cdsw --------------- changed ----------------------
600   if(x.ne.ord(ichar('c'))) go to 700
cdsw600   IF (BUFOR(LP).NE.ICHAR('C')) GOTO 700
cdsw ----------------------------------------------
C  'C' RECOGNIZED - CASE-CONTROL
      C0M(2)=IBSET(C0M(2),5)
      IF (BUFOR(LP+1).EQ.ICHAR('-')) GOTO 630
      IF (BUFOR(LP+1).NE.ICHAR('+')) CALL ERROR(135)
      GOTO 650
630   C0M(2)=IBCLR(C0M(2),5)
650   AUX=IBSET(AUX,5)
      IF (BUFOR(LP+2).NE.ICHAR(',')) GOTO 9999
      LP=LP+3
      GOTO 10
cdsw --------- changed ------------------------
700   if(x.ne.ord(ichar('f'))) go to 800
cdsw700   IF (BUFOR(LP).NE.ICHAR('F')) GOTO 800
cdsw -----------------------------------------
C  'F' RECOGNIZED - FAST CASE
      C0M(2)=IBCLR(C0M(2),6)
      IF (BUFOR(LP+1).EQ.ICHAR('+')) GOTO 730
      IF (BUFOR(LP+1).NE.ICHAR('-')) CALL ERROR(135)
      GOTO 650
730   C0M(2)=IBSET(C0M(2),6)
750   AUX=IBSET(AUX,6)
      IF (BUFOR(LP+2).NE.ICHAR(',')) GOTO 9999
      LP=LP+3
      GOTO 10
800   LP=LP-3
C  NO VALID OPTION HAS BEEN RECOGNIZED
      CALL ERROR(135)
cdsw&bc  9999  C0M(2)=IOR(C0M(3),IAND(C0M(4),C0M(2)))
9999  continue
c
      RETURN
      END