      SUBROUTINE SYMTA
C 
C 
C     THIS SUBROUTINE IS USED TO OUTPUT A SYMBOL TABLE OF ALL 
C     SYMBOL USED IN THE PROGRAM AND DEFINED IN MACROS
C   
C   
      REAL IVAL
      DIMENSION IXOUT(600)
      DIMENSION MTYPE(4),LISTS(5)
      DIMENSION LLAB(4,10)
      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)
      DATA LISTS(1),LISTS(2),LISTS(3),LISTS(4),LISTS(5)
     1  /1HA,1HE,1HX,1HD,1HS/
C   
      IDIV = 256**(ICCNT-1) 
      MXLAB = 38*IDIV 
      IXCOL = 108
      IGX = 0 
      IF(LREF) 140,140,6
6     IF(IXT) 7,140,140 
7     IXT = -IXT
      WRITE(IPRT,1010) IXT
1010  FORMAT(34H CROSS REFERENCE OVERFLOW AT LINE ,I5)
      LINE = 8
      IXT = 0 
140   MM = 0
C     SET SYMBOL VALUES TO BLANKS 
      DO 142 I=1,4
      DO 142 J=1,12 
      IADDR(I,J) = IBLNK
142   CONTINUE
145   NAME(1) = MXLAB
      IGO = 0 
C     GET NEXT SYMBOL 
      LIND = 0
      IF(ISYM) 150,990,150
150   DO 260 L=1,ISYM 
      IF(ITAB(1,L)) 220,260,220 
220   DO 230 K=1,IWORD
      IF(ITAB(K,L)-NAME(K)) 240,230,260 
230   CONTINUE
240   DO 250 K=1,IWORD
       NAME(K) = ITAB(K,L)
250   CONTINUE
      LIND = L
260   CONTINUE
      IF(LIND) 300,270,300
270   IGO = 1
      IF(MM) 400,990,400
300   ITAB(1,LIND) = 0
      MM = MM+1 
      ICNT = 0
C     DECODE VALUE IN TABLE TO FORM OUTPUT CHARACTERS 
      DO 320 K=1,IWORD
      ID = IDIV
      DO 320 L=1,ICCNT
      ICNT = ICNT+1
      NN = NAME(K)/ID 
      IF(NN) 312,312,314
312   LLAB(MM,ICNT) = IBLNK 
      GO TO 3145
314   NAME(K) = NAME(K)-NN*ID 
      LLAB(MM,ICNT) = IALPH(NN) 
3145  IF(ICNT-MLAB) 316,321,321 
316   ID = ID/256 
320   CONTINUE
C     DECODE SYMBOL TYPE
321   NTYPE = ITABS(LIND) 
      IF(NTYPE) 322,323,323 
322   NTYPE = -NTYPE/16384+4
      GO TO 325
323   NTYPE = NTYPE-((NTYPE/8)*8) 
C     CHECK FOR DEF OR SUB
325   IF(NTYPE-3) 326,326,330 
C     GET SYMBOL VALUE
326   IVAL = ITABV(LIND)
      CALL AHEX(IVAL,MM)
330   MTYPE(MM) = LISTS(NTYPE)
338   IF(LSYM+LREF) 990,990,339 
339   IF(LREF) 340,340,500
340   IF(MM-3) 145,400,400
400   LINE = LINE+1 
      IF(LINE-IOLIN) 420,420,410
410   IF(IFORM.EQ.1) GO TO 415
      WRITE(IPRT,1012)
1012  FORMAT(////)
      GO TO 418 
415   WRITE(IPRT,1002) IFRMC
1002  FORMAT(A1) 
418   CONTINUE
      LINE = 3
C     OUTPUT NEXT LINE OF SYMBOL TABLE
C     IF IFBIT IS INCREASED, THE IADDR INDEX NEEDS TO BE CHANGED
C     IN THE FOLLOWING WRITE AND FORMAT STATEMENTS TO REFLECT THE
C     REQUIRED NUMBER OF OCTAL DIGITS NECESSARY FOR A SYMBOL
420   WRITE(IPRT,1003) ((LLAB(II,K),K=1,ICNT),MTYPE(II),
     1  (IADDR(II,L),L=6,12), II=1,MM)
1003  FORMAT(1X,4(8A1,1X,A1,1X,7A1,2X)) 
      IF(IGO) 990,140,990 
C     FORM CROSS REFERENCE TABLE
C     WRITE LAST RECORD TO FILE IF NECESSARY
500   IF(IGX) 530,510,530
510   IF(IXPNT) 530,530,515
515   IF(IXCNT) 530,530,520
520   CALL XREFT(1,1) 
530   IGX = 1
      LEN = 0
      IXOUT(1) = 0
      ITCNT = MXREF*IXCNT+IXPNT
      IF(ITCNT-MXREF) 580,580,540
C     READ PAGE FROM FILE
540   IXT = 1
C     IF CROSS REFERENCE FILE IS SEQUENTIAL INCLUDE REWIND
C     REWIND MCFLE
550   L = MXREF/64
      I1=0
      DO 570 I=1,L
      MCREC=IXT
C   
C     THE FOLLOWING STATEMENTS READS THE CROSS REFERENCE FILE
C   
      CALL INOUT(2)
      IXT = IXT+1
      DO 560 M1=1,64
      M2 = M1+I1
      IXTAB(M2) = MCORE(M1)
560   CONTINUE
      I1 = I1+64
570   CONTINUE
580   LL = MXREF
      IF(ITCNT-MXREF) 590,600,600 
590   LL = ITCNT
600   DO 620 I=1,LL,2 
      IF(IXTAB(I)-LIND) 620,610,620 
610   LEN = LEN+1 
      I1 = I+1
      IXOUT(LEN) = IXTAB(I1)
620   CONTINUE
      ITCNT = ITCNT-MXREF 
      IF(ITCNT) 630,630,550 
C     OUTPUT CROSS REFERENCES 
630   M1 = 1
640   M2 = M1+6 
      IF(LEN-7) 650,660,660
650   M2 = M1+LEN-1 
660   LINE = LINE+1 
      IF(LINE-IOLIN) 680,670,670
670   IF(IFORM.EQ.1) GO TO 675
      WRITE(IPRT,1012)
      GO TO 678 
675   WRITE(IPRT,1002)
678   CONTINUE
      LINE = 3
C     IF IFBIT IS INCREASED, THE IADDR INDEX NEEDS TO BE CHANGED
C     IN THE FOLLOWING WRITE AND FORMAT STATEMENTS TO REFLECT THE 
C     REQUIRED NUMBER OF OCTAL DIGITS NECESSARY FOR A SYMBOL
680   WRITE(IPRT,1005) (LLAB(1,K),K=1,ICNT),MTYPE(1), 
     1  (IADDR(1,K),K=6,12),(IXOUT(K),K=M1,M2)
1005  FORMAT(1X,8A1,2X,A1,3X,7A1,6X,8I6)
      M1 = M1+7 
      LEN = LEN-7 
      IF(LEN) 140,140,690 
690   DO 700 K=1,ICNT 
      LLAB(1,K) = IBLNK 
700   CONTINUE
      DO 710 I=1,12 
      IADDR(1,I) = IBLNK
710   CONTINUE
      MTYPE(1) = IBLNK
      GO TO 640 
990   RETURN
      END

IBLNK
      GO TO 640 
990   RETURN
      END

