      SUBROUTINE OPCOD(ICHK)
C
C 
C     THIS ROUTINE CHECKS THE CURRENT ASSEMBLER DIRECTIVE TO
C     SEE IF IT IS LEGAL. 
C 
C     ENTRY PARAMETERS
C       ICOL - POINTS TO COLUMN OPCODE SCAN STARTS IN 
C 
C     EXIT PARAMETERS 
C        ITYPE = OPCODE TYPE
C          -1 = COMMENT STATEMENT 
C           1 = ASSEMBLER DIRECTIVE 
C           2 = DEF OR SUB STATEMENT
C        IOPVA - OPCODE NUMBER
C        ICHK - OPCODE VALUE
C        ICOL - POINTS TO OPERAND FIELD IF VALID OPCODE FOUND 
C        JCOL - POINTS TO END OF LABEL IF LABEL FOUND 
C        IERR - ERROR STATUS
C           1 = VALID DIRECTIVE 
C           2 = SYMBOL ENDS WITH A COLON - PRESUMED LABEL 
C           3 = OPCODE ERROR
C           4 = COMMENT LINE
C           5 = NO OPCODE ON LINE
C           6 = CONTINUATION LINE
C   
      DIMENSION ITERM(4)
      DIMENSION INST(5,9),INSTE(7,5)
      INTEGER FTYPE
      REAL ITABV(249)
      COMMON ICRD,IPRT,MCFLE,IDFLE,MCREC,IDREC,IFORM,ITRUN,ILOUT,IXCOL
      COMMON MLAB,MOPC,IBIT,ICCNT,IWORD,IERRL,IERRI,IEND,IFRMC
      COMMON LSOR,LIF,LSYM,LREF,LDEF,LOCT,ITRMI,ITRMO
      COMMON ILEN,KLEN,LLEN,KWORD,IFLD(2400),IYFLD,IZFLD
      COMMON IFBIT,ZVAL,CVAL,JREAD,IN(80),INB(80),LINE,IPAGE,LISN
      COMMON IALPH(37),IAST,IDOLR,ISHRP
      COMMON ICOLN,IBLNK,ICTAB,ISEMI,ICOMM,IPLUS,IMIN,IMULT,IDIV
      COMMON IRPAR,ILPAR,IATT(9),JATT(5),LATT(9),IFPAR(16),NBASE,JBASE
      COMMON ICOL,IFCOL,MCOL,MLCOL,IOLIN,ICNT,LTITL(50),IADDR(4,12)
      COMMON ITYPE,JTYPE,FTYPE,IERR,IERRS,IOPVA,JCOL,IBUG
      COMMON ITAB(4,249),ITABS(249),ITABV,NAME(4),INDEX,INDET,ISYM,LTAB
      COMMON IXTAB(256),MXREF,IXT,IXPNT,IXCNT,IXPAG,MCORE(128)
C INCLUDE(:F1:METAD.COM)
      EQUIVALENCE (ITERM(1),IBLNK)
C 
C     THE FOLLOWING DATA TABLE DEFINES ALL LEGAL ASSEMBLER
C     DIRECTIVES.  EACH DATA STATEMENT CONSISTS OF FOUR OR SIX
C     CHARACTERS REPRESENTING THE DIRECTIVE, FOLLOWED BY
C     THE DIRECTIVE TYPE AND ITS NUMBER 
C 
C 
      DATA INST(1, 1),INST(2, 1),INST(3, 1),INST(4, 1),INST(5, 1) 
     1  /1HL,1HI,1HS,1HT,1002/
      DATA INST(1, 2),INST(2, 2),INST(3, 2),INST(4, 2),INST(5, 2) 
     1  /1HE,1HQ,1HU,1H ,1004/
      DATA INST(1, 3),INST(2, 3),INST(3, 3),INST(4, 3),INST(5, 3) 
     1  /1HS,1HE,1HT,1H ,1005/
      DATA INST(1, 4),INST(2, 4),INST(3, 4),INST(4, 4),INST(5, 4) 
     1  /1HI,1HF,1H ,1H ,1008/
      DATA INST(1, 5),INST(2, 5),INST(3, 5),INST(4, 5),INST(5, 5) 
     1  /1HE,1HL,1HS,1HE,1009/
      DATA INST(1, 6),INST(2, 6),INST(3, 6),INST(4, 6),INST(5, 6) 
     1  /1HE,1HN,1HD,1H ,1011/
      DATA INST(1, 7),INST(2, 7),INST(3, 7),INST(4, 7),INST(5, 7) 
     1  /1HD,1HE,1HF,1H ,2012/
      DATA INST(1, 8),INST(2, 8),INST(3, 8),INST(4, 8),INST(5, 8) 
     1  /1HS,1HU,1HB,1H ,2013/
      DATA INST(1, 9),INST(2, 9),INST(3, 9),INST(4, 9),INST(5, 9) 
     1  /1HW,1HO,1HR,1HD,1014/
      DATA INSTE(1,1),INSTE(2,1),INSTE(3,1),INSTE(4,1),INSTE(5,1),
     1  INSTE(6,1),INSTE(7,1) /1HN,1HO,1HL,1HI,1HS,1HT,1003/
      DATA INSTE(1,2),INSTE(2,2),INSTE(3,2),INSTE(4,2),INSTE(5,2),
     1  INSTE(6,2),INSTE(7,2) /1HE,1HN,1HD,1HI,1HF,1H ,1010/
      DATA INSTE(1,3),INSTE(2,3),INSTE(3,3),INSTE(4,3),INSTE(5,3),
     1  INSTE(6,3),INSTE(7,3) /1HS,1HP,1HA,1HC,1HE,1H ,1006/
      DATA INSTE(1,4),INSTE(2,4),INSTE(3,4),INSTE(4,4),INSTE(5,4),
     1  INSTE(6,4),INSTE(7,4) /1HE,1HJ,1HE,1HC,1HT,1H ,1007/
      DATA INSTE(1,5),INSTE(2,5),INSTE(3,5),INSTE(4,5),INSTE(5,5),
     1  INSTE(6,5),INSTE(7,5) /1HT,1HI,1HT,1HL,1HE,1H ,1001/
C 
      NUMOP = 9 
      ICHK = 0
      ITYPE = 0 
      IOPVA = 0 
      ICNT = 0
      IERR = 1
      INSTT = 0
      MLEN = 4
C     LOOK FOR START OF OPCODE
200   IF(IN(ICOL) .EQ. IBLNK) GO TO 218
      IF(IN(ICOL) .EQ. ICTAB) GO TO 218
C     CHECK FOR COMMENT LINE
210   IF(IN(ICOL)-ISEMI) 215,920,215
C     CHECK FOR A CONTINUATION LINE
215   IF(IN(ICOL)-IDIV) 220,950,220 
218   ICOL = ICOL+1 
      IF(ICOL-MCOL) 200,200,930 
C     FOUND START OF OPCODE, NOW FIND END OF OPCODE 
220   J1 = ICOL 
      J2 = 0
230   DO 232 I=1,4
      IF(IN(ICOL)-ITERM(I)) 232,260,232 
232   CONTINUE
234   IF(IN(ICOL)-ICOLN) 240,940,240
240   J2 = J2+1 
      ICOL = ICOL+1 
250   IF(ICOL-MCOL) 230,230,910 
260   IF(J2-MOPC) 265,265,910 
265   IF(J2-4) 300,300,270
270   MLEN = 6
      INSTT = 1 
      NUMOP = 5 
C     CHECK OPCODE AGAINST ALL LEGAL OPCODES
300   DO 320 L=1,NUMOP
      DO 310 K=1,J2 
      K1 = J1+K-1 
      IF(INSTT) 302,302,304 
302   IF(IN(K1)-INST(K,L)) 320,310,320
304   IF(IN(K1)-INSTE(K,L)) 320,310,320 
310   CONTINUE
      IF(J2-MLEN) 315,500,500 
315   K2 = J2+1 
      IF(INSTT) 316,316,318 
316   IF(INST(K2,L)-IBLNK) 320,500,320
318   IF(INSTE(K2,L)-IBLNK) 320,500,320 
320   CONTINUE
      GO TO 910 
C     FETCH INSTRUCTION TYPE AND VALUE
500   ICHK = INST(5,L)
      IF(INSTT) 550,550,510 
510   ICHK = INSTE(7,L) 
550   ITYPE = ICHK/1000 
      IOPVA = ICHK-ITYPE*1000 
C     SCAN TO START OF ARGUMENT FIELD 
600   IF(IN(ICOL) .EQ. IBLNK) GO TO 610
      IF(IN(ICOL) .NE. ICTAB) GO TO 990
610   ICOL = ICOL+1
      IF(ICOL-MCOL) 600,600,990 
C     OPCODE ERROR
910   IERR = 3
      GO TO 990 
C     FOUND COMMENT INDICATOR 
920   IERR = 4
      ITYPE = -1
      GO TO 990 
C     NO OPCODE ON LINE 
930   IERR = 5
      GO TO 990 
C     PRESUMED LABEL
940   IERR = 2
      JCOL = ICOL 
      ICOL = J1 
      GO TO 990 
C     CONTINUATION LINE 
950   IERR = 6
990   RETURN
      END
990   RETURN
      END
