      SUBROUTINE XPASS
C   
C   
C     THIS SUBROUTINE READS THE ASSEMBLY LANGUAGE DEFINITION AND
C     SAVES THE DEFINITION ON A DISK FILE.  THE ROUTINE
C     EXECUTES ALL ASSEMBLER DIRECTIVES AND PRODUCES A LISTING ON
C     THE LIST DEVICE
C   
C   
      REAL IVAL,IVAL1
      INTEGER FTYP1
      DIMENSION ITERM(4),NUMS(10)
      DIMENSION IBIN(36),JCTYP(4)
      DIMENSION LISTS(10),LCTL(10)
      INTEGER FTYPE,FLEN
      REAL ITABV(384),LC,LODLC,LCMAX
      COMMON ICRD,IPRT,IPCH,MCFLE,IMFLE,IDFLE,MCREC,IMREC,IDREC,IOREC
      COMMON MLAB,MOPC,IBIT,ICCNT,IWORD,IERRL,IERRI,IEND,LEND,IFRMC
      COMMON LSOR,LIF,LSYM,LREF,LDEF,LOCT,LOBJ,LOBJ1,LOBJ2,LINV
      COMMON ILEN,KLEN,LLEN,FLEN,KWORD,IYFLD,IZFLD
      COMMON IDUP,NDUP,NFLAG,IOFLG,LWORD,LINEL,KFILE
      COMMON IFBIT,ZVAL,CVAL,JREAD,IN(80),INB(80),LINE,IPAGE,LISN
      COMMON IALPH(37),IAST,IDOLR,ISHRP,IAMP,ICOLN
      COMMON 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,IOVER
      COMMON IPASS,LC,IOBIN(128),IPDEF,LODLC,LCMAX,LCMIN,LEN
      COMMON ITAB(4,384),ITABS(384),ITABV,NAME(4),INDEX,INDET
      COMMON ISYM,LTAB,IFORM,ITRUN,ILOUT,IXCOL,NUMER,ITRMI,ITRMO
      COMMON IXTAB(768),MXREF,IXT,IXPNT,IXCNT,IXPAG,MCORE(128)
C
C
C	THE NAMED COMMON VARIABLE IFLD(400) IS A DUMMY ENTRY POINT FOR
C	A MUCH LARGER ARRAY -- DEFINED IN INIT.FOR. 
C
      COMMON /OVRLAY/IFLD(400)
C
      EQUIVALENCE(ICHRX,IALPH(34))
      EQUIVALENCE (IBIN(1),IADDR(1,1))
      EQUIVALENCE (NUMS(1),IALPH(1))
      EQUIVALENCE (ICHR0,IALPH(1))
      EQUIVALENCE (LCTL(1),LSOR)
      EQUIVALENCE (JCTYP(1),IATT(6))
      EQUIVALENCE(ITERM(1),IBLNK) 
      DATA LISTS(1),LISTS(2),LISTS(3),LISTS(4) /1HS,1HI,1HT,1HX/
      DATA LISTS(5),LISTS(6),LISTS(7),LISTS(8) /1HD,1HQ,1HO,1HL/
      DATA LISTS(9),LISTS(10)                  /1HB,1HV/
C 
      I = 5
      J = 5
      N = 5
C     INITIALIZE IF STATEMENT NESTING LEVEL NUMBER
      IFSET = 0 
      IFON = 0
C     INITIALIZE IF STATEMENT CONTROL FLAG
      IFCTL = 2 
C     INITIALIZE CURRENT COLUMN NUMBER
100   ICOL = IFCOL
      JCOL = 1
C     SET LABEL INDICATOR (INDEX) TO ZERO 
Š      INDET = 0 
      INDEX = 0 
C     SET LABEL DEFINITION FLAG 
      IPDEF = 0 
C     INITIALIZE ERROR INDICATOR
      IERRL = 0 
      IERRI = 0 
      IERR = 0
C     RESET INSTRUCTION LENGTH
      LEN = 0 
      LENBS = 0 
C     RESET LINE END FLAG 
      LEND = 0
C     SET DEFAULT NUMBER BASE TO DECIMAL
      JBASE = 4
C     SET MODE FOR OUTPUT LISTING 
      LMODE = 1 
C     SET EXPLICIT LENGTH TO INDICATE NONE
      ILEN = -1 
C     CHECK FOR DUPLICATE DIRECTIVE 
      IF(IDUP .EQ. 0) GO TO 112
      NDUP = NDUP-1
      GO TO 119
112   IF(JREAD .NE. 0) GO TO 116
C     READ NEXT SOURCE LINE
      CALL INOUT(1)
C     INCREMENT LINE NUMBER
116   LISN = LISN+1
C     MOVE NEW LINE TO INPUT BUFFER
117   DO 118 I=1,80
      IN(I) = INB(I)
118   CONTINUE
      IXCOL = IFCOL
      ICOL = IXCOL
      JCOL = ICOL
      JREAD = 0
119   IDUP = NDUP
C     DETERMINE ASSEMBLER DIRECTIVE
120   CALL OPCOD(ICHK)
C     CHECK TO SEE IF THIS IS AN IF EXPANSION AND THIS LINE
C     IS TO BE SKIPPED
      IF(IFCTL .EQ. 2) GO TO 185
      IF(IERR .NE. 2) GO TO 250
C     SET ICOL TO POINT PAST LABEL
      ICOL = JCOL+1
      GO TO 120 
185   GO TO (350,200,920,240,187,986),IERR
C     NO OPCODE ON LINE, CHECK IF LABEL PRESENT 
187   IF(INDET) 800,920,800 
C     CHECK TO MAKE SURE THAT TWO LABELS ARE NOT ON LINE
200   IF(INDET .GT. 0) GO TO 930
C     PROCESS A LABEL 
      CALL LABEL(0) 
      LABST = 1 
C     CHECK FOR A COLON 
Š      IF(IN(ICOL) .NE. ICOLN) GO TO 900
      ICOL = ICOL+1
C     CHECK FOR DOUBLE COLON
      IF(IN(ICOL) .NE. ICOLN) GO TO 212
      ICOL = ICOL+1
      LABST = 2
212   IF(IN(ICOL) .EQ. IBLNK) GO TO 213
      IF(IN(ICOL) .NE. ICTAB) GO TO 214
213   ICOL=ICOL+1
      IF(ICOL-MCOL) 212,212,214
214   IF(IFCTL-2) 120,215,120
215   GO TO (216,220,900,916),IERR
C     LABEL IS IN SYMBOL TABLE, IF PASS 1 THEN LABEL IS A DUPLICATE
216   IF(IPASS .EQ. 1) GO TO 915
C     ON PASS 2 LABEL IS DUPLICATE IF ALREADY DEFINED 
C     CHECK DEFINED BIT 
      I = ITABS(INDEX)/8
      I = I-(I/2)*2 
      IF(I .NE. 0) GO TO 915
C     SYMBOL NOT PREVIOUSLY DEFINED, MARK SYMBOL DEFINED
      ITABS(INDEX) = ITABS(INDEX) + 8 
      GO TO 230 
C     ON PASS 1 PLACE LABEL IN SYMBOL TABLE, ON PASS 2 TABLE FULL 
220   IF(IPASS .NE. 1) GO TO 916
C     PLACE LABEL IN SYMBOL TABLE 
      DO 225 I=1,IWORD
      ITAB(I,INDEX) = NAME(I) 
225   CONTINUE
      ITABS(INDEX) = LABST
      ITABV(INDEX) = LC 
230   INDET = INDEX 
C     HAVE PROCESSED LABEL, NOW FETCH OPCODE
      GO TO 120 
C     PROCESS A COMMENT 
240   IF(IFCTL-2) 588,805,588 
C     CHECK FOR AN IF CONTROL DIRECTIVE
250   IF(ICHK .EQ. 1010) GO TO 580
      IF(ICHK .EQ. 1009) GO TO 560
      IF(ICHK .EQ. 1008) GO TO 255
      IF(ICHK-1011) 588,600,588
255   IF(IFSET .GE. 16) GO TO 985
      IFSET = IFSET+1 
      IFPAR(IFSET) = 0
      GO TO 588 
350   LEN = ITYPE-1 
      IF(IPASS .NE. 1) GO TO 370
      GO TO(805,420,440,460,480,805,805,540,560,580,
     1  600,620,640,660,805,700,805,805),IOPVA
C     INITIALIZE OUTPUT BUFFER TO DON"T CARES 
C     IF NOT PROCESSING OVERLAYED INSTRUCTION 
370   IF(IOVER .NE. 0) GO TO 380
      DO 375 I=1,KWORD
      IOBIN(I) = ICHRX
375   CONTINUE
380   IOVER = 0 
Š      GO TO (400,420,440,460,480,500,520,540,560,580, 
     1  600,620,640,660,4610,700,720,740),IOPVA 
C 
C     PROCESS TITLE DIRECTyVE                                -- TITLE 
C 
400   N = 1 
      ICOL1 = ICOL+49 
      DO 405 J=ICOL,ICOL1 
      IF(J .GT. MCOL) GO TO 406
      LTITL(N) = IN(J)
      N = N+1 
405   CONTINUE
406   IF(N-50) 407,407,800
407   DO 408 J=N,50 
      LTITL(J) = IBLNK
408   CONTINUE
      GO TO 800 
C 
C     PROCESS LIST DIRECTIVE                                 -- LIST
C 
420   LSET = 1
421   IF(ICOL-MCOL) 422,422,428 
422   DO 423 I=1,10 
      IF(IN(ICOL)-LISTS(I)) 423,424,423 
423   CONTINUE
C     ILLEGAL LIST OPERAND
      GO TO 925 
C     SET CORRESPONDING LIST CONTROL FLAG 
424   LCTL(I) = LSET
      ICOL1 = ICOL+1
      ICOL = ICOL1+1
C     CHECK FOR END OF ARGUMENT LIST
      DO 425 I=1,3
      IF(IN(ICOL1)-ITERM(I)) 425,800,425
425   CONTINUE
      IF(IN(ICOL1)-ICOMM) 925,421,925 
428   LSOR = LSET 
      GO TO 800 
C 
C     PROCESS NOLIST DIRECTIVE                               -- NOLIST
C 
440   LSET = 0
      GO TO 421 
C 
C     PROCESS EQU DIRECTIVE                                  -- EQU 
C 
C     READ VALUE THAT LABEL IS TO BE SET TO 
460   IPDEF = 1 
C     CHECK FOR EXPLICIT EXPRESSION LENGTH
4610  DO 4611 I=1,10
      IF(IN(ICOL)-NUMS(I)) 4611,4612,4611 
4611  CONTINUE
      GO TO 4619
4612  ILEN = 0
      LCOL = ICOL 
Š4613  DO 4614 I=1,10
      IF(IN(ICOL)-NUMS(I)) 4614,4618,4614
4614  CONTINUE
      IF(IN(ICOL) .EQ. ILPAR) GO TO 4619
      ICOL = LCOL 
      ILEN = -1 
      GO TO 4619
4618  ILEN = ILEN*10+I-1
      ICOL = ICOL+1 
      GO TO 4613
4619  CALL ESCAN(IVAL)
      IF(IOPVA .EQ. 15) GO TO 680
      IF(IERR .EQ. 1) GO TO 465
C     CHECK FOR DUPLICATE LABEL 
      IF(IERRL-53) 4625,681,4625
C     SET SYMBOL VALUE TO ZERO IF THERE WAS AN ERROR
4625  IF(INDET .EQ. 0) GO TO 464
      ITABV(INDET) = 0
      ITABS(INDET) = LABST
464   GO TO 681 
C     CHECK FOR MISSING LABEL 
465   IF(INDET) 466,910,466 
C     CHECK FOR DUPLICATE LABEL 
466   IF(IERRL .EQ. 53) GO TO 800
C     PLACE SYMBOL"S VALUE IN TABLE 
      ITABV(INDET) = IVAL 
      ITABS(INDET) = KLEN*16+LABST
      IF(IPASS .EQ. 1) GO TO 800
      ITABS(INDET) = ITABS(INDET)+8 
      GO TO 800 
C 
C     PROCESS SET DIRECTIVE                                  -- SET 
C 
C     CHECK FOR DUPLICATE LABEL 
480   IF(IERRL .NE. 53) GO TO 484
      JTYPE = ITABS(INDET)
      JTYPE = JTYPE-(JTYPE/8)*8 
      IF(JTYPE .NE. 3) GO TO 800
      IERRL = 0 
484   LABST = 3 
      GO TO 460 
C 
C     PROCESS SPACE DIRECTIVE                                -- SPACE 
C 
500   CALL ESCAN(IVAL)
      IF(IERR-1) 681,505,681
505   ICNT = IVAL 
      IF(ICNT-IOLIN) 515,515,510
510   ICNT = IOLIN
515   LMODE = 2 
      GO TO 800 
C 
C     PROCESS EJECT DIRECTIVE                                -- EJECT 
C 
520   LMODE = 3 
Š      IF(LSOR) 525,800,525
525   LINE = IOLIN
      GO TO 800 
C 
C     PROCESS IF DIRECTIVE                                   -- IF
C 
540   IPDEF = 1 
      CALL ESCAN(IVAL)
      IF(IERR .NE. 1) GO TO 681
      IFON = 2
      IF(IVAL .NE. 0.) GO TO 546
      IFON = 1
546   IFCTL = IFON
      IF(IFSET .GE. 16) GO TO 985
      IFSET = IFSET+1 
      IFPAR(IFSET) = IFON+IFON
      GO TO 800 
C 
C     PROCESS ELSE DIRECTIVE                                 -- ELSE
C 
560   IF(IFSET) 920,920,562 
562   IFON = IFPAR(IFSET)/2 
      IELSE = IFPAR(IFSET)-(IFON+IFON)
      IF(IFON .LE. 0) GO TO 588
      IF(IELSE .GT. 0) GO TO 920
      IFCTL = 3-IFON
      IFPAR(IFSET) = IFCTL+IFCTL+1
      GO TO 800 
C 
C     PROCESS THE ENDIF DIRECTIVE                            -- ENDIF 
C 
580   IF(IFSET-1) 920,582,584 
582   IFCTL = 2 
      IFSET = 0 
      GO TO 800 
584   IFSET = IFSET-1 
      IFCTL = IFPAR(IFSET)/2
C     CHECK FOR CONDITIONAL ASSEMBLY EXPANSION THAT SHOULD NOT BE LISTED
      IF(IFCTL-1) 588,588,800 
588   IF(LIF) 589,100,589 
589   ITYPE = -1
      GO TO 800 
C 
C 
C     PROCESS THE END DIRECTIVE                              -- END 
C 
600   IEND = 1
      GO TO 800 
C 
C 
C     PROCESS ORG DIRECTIVE                                  -- ORG 
C 
620   IPDEF = 1 
      CALL ESCAN(IVAL)
      IF(IERR .NE. 1) GO TO 681
Š      IF(IVAL-LC) 988,624,624 
624   IF(IVAL-65536.) 625,980,980 
625   LC = IVAL 
C     CHECK FOR DUPLICATE LABEL 
626   IF(IERRL .NE. 0) GO TO 800
C     IF LABEL PRESENT, CHANGE ITS VALUE
      IF(INDET) 628,800,628 
628   ITABV(INDET) = LC 
      GO TO 800 
C 
C     PROCESS ALIGN DIRECTIVE                                -- ALIGN 
C 
640   IPDEF = 1 
      CALL ESCAN(IVAL)
      IF(IERR .NE. 1) GO TO 681
      IF(IVAL-32768.) 644,980,980 
644   FLG = 0.
      J = IVAL
      IF(LC .LT. 32768.) GO TO 646
      LC = LC-32768.
      FLG = 1.
646   I = LC
      LC = ((I-1)/J+1)*J
      LC = LC+FLG*32768.
      GO TO 626 
C 
C     PROCESS RES DIRECTIVE                                  -- RES 
C 
660   IPDEF = 1 
      CALL ESCAN(IVAL)
      IF(IERR .NE. 1) GO TO 681
      IF(IVAL .GE. 32768.) GO TO 988
      LENBS = IVAL
      GO TO 800 
C 
C     PROCESS DATA DIRECTIVE                                 -- DATA
C 
680   CONTINUE
681   GO TO (682,925,940,930,980,960,988,955,965),IERR
682   IF(KLEN-KWORD) 684,684,980
C     CONVERT NUMBER TO BINARY
684   CALL AHEX(IVAL,0) 
C     MOVE BITS TO OBJECT CODE BUFFER 
      DO 688 I=1,KWORD
      IOBIN(I) = ICHR0
688   CONTINUE
      I = 1 
      J = KWORD-35
      K = 36
      IF(J .GT. 0) GO TO 692
      I = 37-KWORD
      J = 1 
      K = KWORD 
692   DO 695 L=1,K
      IOBIN(J) = IBIN(I)
Š      I = I+1 
      J = J+1 
695   CONTINUE
      GO TO 800 
C 
C     PROCESS DUP DIRECTIVE                                  -- DUP 
C 
700   IPDEF = 1 
      CALL ESCAN(IVAL)
      IF(IERR .NE. 1) GO TO 681
      IF(IVAL .GE. 32768.) GO TO 988
      IF(IVAL .LE. 0) GO TO 988
      NDUP = IVAL-1.
      GO TO 800 
C 
C     PROCESS FF DIRECTIVE                                   -- FF
C 
C     INITIALIZE INSTRUCTION LENGTH 
720   JLEN = 0
      KBIT = 1
C     SET FIELD ATTRIBUTES SO NO ACTION IS TAKEN
      DO 721 I=1,9
      LATT(I) = 0 
721   CONTINUE
C     SCAN NEXT FIELD 
722   CALL SCAN(IVAL) 
      IF(IERR-1) 7715,725,7715
C     UPDATE WORD LENGTH AND CHECK
725   JLEN = JLEN+ILEN
      IF(JLEN-KWORD) 726,726,945
726   GO TO (728,730,735,987,935),FTYPE 
C     PLACE DON"T CARE FIELD IN WORD
728   KBIT = KBIT+ILEN
      GO TO 735 
C     PLACE CONSTANT FIELD IN WORD
730   CALL AHEX(IVAL,0) 
      J = 37-ILEN 
      DO 732 I=1,ILEN 
      IOBIN(KBIT) = IBIN(J) 
      KBIT = KBIT+1 
      J = J+1 
732   CONTINUE
C     FINISHED WITH CURRENT FIELD, PROCESS NEXT FIELD 
735   IF(IN(ICOL) .NE. ICOMM) GO TO 737
      ICOL = ICOL+1 
      GO TO 722 
737   DO 738 I=1,4
      IF(IN(ICOL)-ITERM(I)) 738,739,738 
738   CONTINUE
      GO TO 987 
739   IF(JLEN-KWORD) 945,800,945
C 
C     PROCESS INSTRUCTION                                    -- DEF 
C 
740   JTYPE = -ITABS(INDEX)/256 
ŠC     SET NUMBER OF FIELDS AND POINTER TO FIELD TABLE 
      KFLD = JTYPE-(JTYPE/64)*64
      INDEF = ITABV(INDEX)
      KBIT = 1
      IGO = 0 
C     INITIALIZE OVERLAY FLAG 
      IOVER = 0 
C 
C     PROCESS NEXT FIELD
C 
C     SET FIELD TYPE, LENGTH, AND ATTRIBUTES
741   JTYPE = IFLD(INDEF) 
      INDEF = INDEF+1 
      FTYPE = JTYPE-(JTYPE/4)*4+1 
      FTYP1 = FTYPE 
C     FTYPE - FIELD TYPE
C        1 = DON"T CARE 
C        2 = CONSTANT 
C        3 = VARIABLE 
C        4 = VARIABLE WITH DEFAULT
      JTYPE = JTYPE/4 
      FLEN = JTYPE
      IF(FTYPE .EQ. 1) GO TO 750
      FLEN = FLEN-(FLEN/64)*64
      JTYPE = JTYPE/64
C     INITIALIZE FIELD ATTRIBUTE ARRAY
      DO 7425 J=1,9 
      LATT(J) = 0 
7425  CONTINUE
      IJ = JTYPE-(JTYPE/4)*4+1
      J1 = IJ+5 
      LATT(J1) = 1
      JTYPE = JTYPE/4 
      J1 = 16 
      DO 743 I=1,5
      LATT(I) = JTYPE/J1
      JTYPE = JTYPE-LATT(I)*J1
      J1 = J1/2 
743   CONTINUE
C 
C     BRANCH TO PROCESS FIELD TYPE
C 
      GO TO (750,760,770,770),FTYPE 
C     PROCESS DON"T CARE FIELD
750   KBIT = KBIT+FLEN
      GO TO 790 
C     PROCESS CONSTANT FIELD
760   IVAL = IFLD(INDEF)
      INDEF = INDEF+1 
      IVAL1 = IFLD(INDEF) 
      INDEF = INDEF+1 
      IVAL = IVAL*32768.+IVAL1
      IF(FTYPE .EQ. 1) GO TO 787
      KLEN = FLEN 
      CALL MODFY(IVAL,FLEN,0) 
Š      GO TO 787 
C     PROCESS VARIABLE FIELD
C     CHECK TO SEE IF NO MORE FIELDS
770   IF(IGO .NE. 0) GO TO 780
C     SET FIELD DEFAULT NUMBER BASE 
      JBASE = IJ
      CALL SCAN(IVAL) 
7715  GO TO (772,946,987,940,950,960,980,955,925,930,988,955,965),IERR
C     SKIP OVER COMMA OR AMPERSAND
772   ICOL = ICOL+1 
C     FTYPE NOW REPRESENTS THE FIELD TYPE FOUND ON SCAN 
      GO TO (773,773,780,776,776),FTYPE 
C     SKIP OVER POSSIBLE FIELD DEFAULT VALUE
773   IF(FTYP1 .NE. 4) GO TO 7738
      IF(IFLD(INDEF)) 7736,7734,7734
7734  INDEF = INDEF+1 
7736  INDEF = INDEF+1 
7738  IF(FTYPE .NE. 1) GO TO 785
C     SUBSTITUTE DON"T CARES FOR V FIELD
      IF(ILEN-FLEN) 960,750,960 
C     SET IGO CONTROL SO ALL REMAINING VARIABLE FIELDS
C     WILL BE FILLED WITH THEIR DEFAULTS
776   IGO = 1 
      ICOL = ICOL-1 
C     NULL FIELD, CHECK FOR DEFAULT 
C     RESTORE FIELD TYPE FROM INSTRUCTION DEFINTION 
780   FTYPE = FTYP1 
      IF(FTYPE .NE. 4) GO TO 975
      IF(IFLD(INDEF) .GE. 0) GO TO 760
      INDEF = INDEF+1 
      GO TO 750 
C     SUBSTITUE CONSTANT FOR V FIELD
785   IF(ILEN-FLEN) 960,787,960 
787   CALL AHEX(IVAL,0) 
      J = 37-FLEN 
      DO 788 I=1,FLEN 
      IF(IOBIN(KBIT)-ICHRX) 970,7875,970
7875  IOBIN(KBIT) = IBIN(J) 
      J = J+1 
      KBIT = KBIT+1 
788   CONTINUE
C     FINISHED SCANNING CURRENT FIELD 
790   KFLD = KFLD-1 
      IF(KFLD) 741,792,741
C     CHECK FOR OVERLAYED INSTRUCTION 
792   IF(IOVER) 120,793,120 
793   IF(LEND) 800,794,800
C 
C     FINISHED PROCESSING CURRENT INSTRUCTION 
C     CALL SCAN TO CHECK FOR ADDITIONAL INSTRUCTION OVERLAYING
C 
794   CALL SCAN(IVAL) 
      IF(IERR-1) 7715,795,7715
795   GO TO (925,925,935,120,800),FTYPE 
C 
ŠC     CHECK FOR FORMAT ERROR IF NO OTHER ERRORS 
C 
800   IF(IERRI .NE. 0) GO TO 805
      IF(ICOL .GT. MCOL) GO TO 805
      IF(IN(ICOL)-ICOMM) 805,935,805
805   IF(IPASS-1) 810,820,810 
810   CALL LOUT(LMODE)
      CALL OUT
820   IVAL = LEN+LENBS
      LC = LC+IVAL
      IF(IEND) 840,100,840
840   IF(IPASS-1) 850,995,850 
850   WRITE(IPRT,1002) IERRS
      WRITE(ITRMO,1002) IERRS 
1002  FORMAT(/,/,26H   TOTAL ASSEMBLY ERRORS =,I5)
      GO TO 995 
C 
C     SET ERROR INDICATOR 
C 
C     LABEL ERROR 
900   IERRL = 51
      GO TO 921 
C     MISSING LABEL 
910   IERRL = 52
      GO TO 990 
C     DUPLICATE LABEL 
915   IERRL = 53
      GO TO 230 
C     SYMBOL TABLE FULL 
916   IERRL = 54
      GO TO 990 
C     ILLEGAL DIRECTIVE 
920   IERRI = 1 
921   LEN = 1 
      DO 922 I=1,128
      IOBIN(I) = ICHRX
922   CONTINUE
      GO TO 990 
C     ARGUMENT ERROR
925   IERRI = 2 
      GO TO 990 
C     SYNTAX ERROR - ILLEGAL EXPRESSION 
930   IERRI = 3 
      GO TO 990 
C     FORMAT ERROR
935   IERRI = 4 
      GO TO 805 
C     UNDEFINED SYMBOL
940   IERRI = 5 
      GO TO 990 
C     ILLEGAL MICROWORD LENGTH
945   IERRI = 6 
      GO TO 990 
C     ILLEGAL FIELD TYPE
946   IERRI = 15
Š      GO TO 990 
C     ILLEGAL FIELD LENGTH
950   IERRI = 7 
      GO TO 990 
C     ILLEGAL CONSTANT MODIFIER 
955   IERRI = 8 
      GO TO 990 
C     FIELD LENGTH CONFLICT 
960   IERRI = 9 
      GO TO 989 
C     ADDRESS NOT ON CURRENT PAGE 
965   IERRI = 16
      GO TO 990 
C     OVERLAY ERROR
970   IERRI = 17
      GO TO 990 
C     NO DEFAULT VALUE
975   IERRI = 18
      GO TO 990
C     VALUE ERROR, VALUE TOO LARGE FOR A HOST MACHINE REAL NUMBER 
980   IERRI = 10
      GO TO 990 
C     TABLE OVERFLOW ERROR
985   IERRI = 13
      GO TO 990 
C     UNEXPECTED CONTINUATION LINE
986   IERRI = 14
      GO TO 992 
C     ILLEGAL CHARACTER 
987   IERRI = 12
      GO TO 990 
C     ILLEGAL VALUE 
988   IERRI = 11
      GO TO 990 
989   ICOL = ICOL-1 
C     HAVE SET ERROR CODE, NOW OUTPUT LINE
990   ICOL = ICOL-1 
992   GO TO 800 
995   RETURN
      END
DE, NOW OUTPUT LINE
990   ICOL = ICOL-1 
992   GO TO 800 
995   RETURN
      END
