PROGRAM MAIN
C
C	M68000 CROSS-ASSEMBLER MAIN PROGRAM
C
C
C REVISION:
C	X1.0	(EXPERIMENTAL PRE-RELEASE)
C
C AUTHOR:
C	Allen Kossow
C	Department of Physiology
C	Medical College of Wisconsin
C	8701 Watertown Plank Road
C	Milwaukee, WI 53226
C
C	SYMBOLS ARE A MAXIMUM OF EIGHT CHRS IN LENGTH
C	THERE CAN BE UP TO 512 SYMBOLS
C
C
C....	LOGICAL UNIT DEFINITION
C	1 = SOURCE FILE
C	2 = OBJECT FILE
C	3 = LIST   FILE
C	5 = KEYBD
C
C
	IMPLICIT INTEGER (A-Z)
	BYTE NAME(8),SYMFLG(513)
C
	COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
C
	COMMON /SYMT/STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
C
	COMMON /PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
     +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
C
	COMMON /SRC/ LNELEN,ISERR,NOCARD,SRCLNE
C
	COMMON /OBJOUT/ OBJBUF,OBJWC,LFLG,RFLG,DBFLG
C
	COMMON /OPCPTS/ OPTYP,OPSKEL,OPSK2,OPIDX
C
	COMMON /CNVT  / WORD,PL
C
	COMMON /HEXFLG/ ENDFLG,HEXWC,HEXPC,OLDPC
C
	DIMENSION OBJBUF(40)
C
	INTEGER*4 PC,NEWPC,SYMADR(512),HEXPC,OLDPC
C
	BYTE ERR,SRCLNE(81),LABEL(8),PL(132)
C
C....	TELL FORTRAN TO IGNORE INTEGER OVERFLOWS ON MULTIPLY AND DIVIDE.
C
	ERR=128
C
C....	THE FOLLOWING CALL IS NO OP'ED OUT FOR F4P
C
C	CALL SETERR(1,ERR)
C
C....	INITIALIZE VARIABLES
C
5	NOPAGE=0
	RFLG=1
	LFLG=1
C
C....	OPEN FILES
C
	CALL SOURCE(1)
	CALL LIST(1)
	CALL OBJECT(1)
C
C....	DO PASS 1
C
1	NOSYM=0
	PASS=1
	CALL I4CLR(PC)
	DO 10 I=1,8
	NAME(I)=32
10	CONTINUE
C
C....	READ ONE LINE OF SOURCE FILE
C
15	CALL I4CLR(NEWPC)
	CALL SOURCE(2)
C
C....	IF EOF DETECTED DO PASS 2
C
	IF(ISERR.EQ.1) GOTO 20
C
C....	RESET MULTIPLE ERROR FLG
C
	MEFLG = 0
C
C....	PARSE SOURCE LINE
C
	CALL PARSE
C
C....	IF NULL LINE GET NEXT LINE
C
	IF(PRFLG.EQ.0) GOTO 15
C
C....	PROCESS SOURCE LINE
C
	CALL PRCESS
C
C....	IF END DETECTED DO PASS 2 ELSE GET NEXT LINE
C
	IF(ISERR.EQ.1) GOTO 20
	I=JADD(PC,NEWPC,PC)
	GOTO 15
C
C....	DO PASS 2
C
C
C....	REW SOURCE SET TO PASS 2 AND RESET PC
C
20	CALL SOURCE(3)
	PASS=2
	IERCNT = 0
	CALL I4CLR(PC)
	CALL I4CLR(HEXPC)
	CALL I4CLR(OLDPC)
C
C....	FLUSH PRINT BUFFER IN CASE ANYTHING LEFT
C....	FROM LAST ASSEMBLY
C
	DO 25 I=1,132
25	PL(I) = "40
C
C....	INITIALIZE OBJECT BUFFER
C
	ENDFLG = 0
	HEXWC  = 0
C
C....	PRINT FIRST PAGE HEADING
C
	CALL NEWPAG
30	CALL I4CLR(NEWPC)
	OBJWC = 0
	CALL SOURCE(2)
C
C....	EOF DETECTED
C
	IF(ISERR.EQ.1) GOTO 50
C
C....	RESET MULTIPLE ERROR FLG
C
	MEFLG = 0
C
C....	PARSE LINE
C
	CALL PARSE
C
C....	PRINT A LINE OF ONLY COMMENTS NORMALLY
C
	IF(CMTPTR.EQ.1) GOTO 40
C
C....	CHECK FOR PARSING ERRORS
C
	IF(PRFLG.EQ.0) GOTO 30
C
C....	PROCESS IT
C
38	CALL PRCESS
C
C....	GENERATE LISTING
C
40	CALL LSTLNE
C
C....	CHECK IF THERE IS OBJ CODE TO GENERATE
C
	IF(OBJWC.EQ.0) GOTO 45
	CALL BLDOBJ
C
C....	DO NEXT LINE IF NOT END
C
45	IF(ISERR.EQ.1) GOTO 50
	I=JADD(PC,NEWPC,PC)
	GOTO 30
C
C....	END OF ASSEMBLY, OUTPUT BALANCE OF OBJ BUFFER
C
50	ENDFLG = 1
	CALL BLDOBJ
C
C....	PRINT SYMBOL TABLE
C
	CALL PST
C
C....	CLOSE FILES AND DO IT AGAIN
C
	CALL SOURCE(4)
	CALL LIST(2)
	CALL OBJECT(2)
	GOTO 5
	END
	SUBROUTINE SOURCE(ICODE)
C
C PERFORMS ALL OPERATIONS OF SOURCE INPUT FILE
C
C INPUT:
C ICODE = 1 => OPEN SOURCE FILE (NAME READ FROM KEYBOARD)
C         2 => READ ONE LINE FROM SOURCE FILE INTO
C             'SRCLNE' (80R1 FORMAT). TRAILING BLANKS
C              ARE DELETED. ZERO CHAR IS INSERTED AT
C              THE END OF THE LINE.
C         3 => REWIND SOURCE FILE.
C         4 => CLOSE SOURCE FILE.
C
C OUTPUT:
C	SRCLNE = SOURCE LINE FOR CODE 2
C	LNELEN = LENGTH OF LINE FOR CODE 2
C	ISERR  = 1 IF END OF FILE ON READ (ZERO OTHERWISE)
C	NOCARD = CARD NUMBER READ FROM SOURCE (1-?)
C
	BYTE FILNAM(12)
	BYTE SRCLNE(81)
	COMMON/SRC/LNELEN,ISERR,NOCARD,SRCLNE
	COMMON /FNAM/ FILNAM,OBJFLG
C
C SELECT FUNCTION
C
	GO TO (100,200,300,400),ICODE
C
C OPEN SOURCE FILE
C
100	TYPE 110
110	FORMAT('$Src file name: ')
	READ (5,120) ICNT,FILNAM
120	FORMAT(Q,12A1)
	IF(ICNT.EQ.0) STOP
	CALL ASSIGN(1,FILNAM,ICNT)
	NOCARD=0
	GOTO 500
C
C READ SOURCE LINE
C
200	ISERR=0
	READ(1,210,END=250) (SRCLNE(I),I=1,80)
210	FORMAT(80A1)
	NOCARD=NOCARD+1
C
C CONVERT ALL CHARACTERS
C
	DO 225 I=1,80
	IF(SRCLNE(I).GE.32) GO TO 220
215	SRCLNE(I)=32
	GO TO 225
220	IF(SRCLNE(I).LT.96) GO TO 225
	SRCLNE(I)=SRCLNE(I)-32
	IF(SRCLNE(I).GE.96) GO TO 215
225	CONTINUE
C
C REMOVE TRAILING BLANKS
C
	LNELEN=80
230	IF(SRCLNE(LNELEN).NE.32) GO TO 240
	LNELEN=LNELEN-1
	IF(LNELEN.GT.0) GO TO 230
240	LNELEN=LNELEN+1
	SRCLNE(LNELEN)=0
	GO TO 500
C
C END OF FILE
C
250	ISERR=1
	GO TO 500
C
C REWIND SOURCE FILE
C
300	REWIND 1
	NOCARD=0
	GO TO 500
C
C CLOSE SOURCE FILE
C
400	CLOSE(UNIT=1)
500	RETURN
	END
	SUBROUTINE LIST(LCODE)
C
C PERFORMS OPEN AND CLOSE ON LIST FILE
C
C INPUT:LCODE = 1 => OPEN FILE (NAME READ FROM KEYBOARD)
C               2 => CLOSE FILE
C
	BYTE FILNAM(12)
	INTEGER PASS
	BYTE NAME(8)
C
	COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
C
	COMMON /FNAM/ FILNAM,OBJFLG
C
C SELECT FUNCTION
C
	GO TO (100,200),LCODE
C
C....	ASSIGN DEFAULT LISTING TO CONSOLE
C
100	LUNIT=5
	TYPE 110
110	FORMAT('$Lst file name: ')
	READ (5,115) ICNT,FILNAM
115	FORMAT(Q,12A1)
	IF(ICNT.EQ.0) GOTO 116
C
C....	IF THERE IS A FILENAME ASSIGN LISTING TO LUN 3
C
	LUNIT = 3
	CALL ASSIGN(LUNIT,FILNAM,ICNT)
116	NOPAGE=0
	GO TO 300
C
C CLOSE FILE
C
200	IF(LUNIT.EQ.5) RETURN
	CALL CLOSE(LUNIT)
300	RETURN
	END
	SUBROUTINE OBJECT(ICODE)
C
C PERFORMS OPEN AND CLOSE ON OBJECT FILE
C
	BYTE FILNAM(12)
	INTEGER PASS
	BYTE NAME(8)
	COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
	COMMON /FNAM/ FILNAM,OBJFLG
	GOTO (100,200),ICODE
100	TYPE 110
110	FORMAT ('$Obj file name: ')
	READ (5,115) ICNT,FILNAM
115	FORMAT(Q,12A1)
	IF(ICNT .EQ.0) GOTO 116
	CALL ASSIGN(2,FILNAM,ICNT)
	OBJFLG = 1
	RETURN
116	OBJFLG = 0
	RETURN
200	IF(OBJFLG.EQ.0) RETURN
	CALL CLOSE(2)
	RETURN
	END
	SUBROUTINE SYMTBL(ICODE,IADDR,SYMSTR)
C
C SYMBOL TABLE PROCESSOR
C
C INPUT:
C       ICODE = 1 => FIND OPERAND IN SYMBOL TABLE.  IF NOT FOUND,
C                    IT IS ENTERED INTO THE TABLE AS REFERENCED
C                    BUT NOT DEFINED.  THE INDEX OF THE SYMBOL
C                    IN THE SYMBOL IS RETURNED IN 'STIND'.
C
C               2 => FIND LABEL IN SYMBOL TABLE.  IF FOUND AND ALREADY
C                    DEFINED AND THIS IS THE FIRST PASS OF THE
C                    ASSEMBLER, THE MULTIPLE DEFINED BIT IS SET IN
C                    SYMFLG.  IF FOUND BUT ONLY PREVIOUSLY REFERENCED,
C                    THE DEFINED BUT PREVIOUSLY REFERENCED BIT IS SET
C                    AND THE REFERENCED BIT IS CLEARED.  IF NOT FOUND,
C                    IT IS ENTERED AND THE DEFINED BIT IS SET.
C
C       IADDR =      ADDRESS OF SYMBOL FOR ENTERING INTO SYMBOL TABLE.
C       SYMBOL=      SYMBOL TO LOOK UP OR ENTER IN SYMBOL TABLE.
C
C OUTPUT:
C       STIND = INDEX INTO SYMBOL TABLE FOR SYMBOL.
C
C FORMAT OF 'SYMFLG':
C
C BIT   MEANING IF SET
C  0    SYMBOL HAS BEEN REFERENCED BUT NOT DEFINED.
C  1    SYMBOL HAS BEEN DEFINED AND WAS REFERENCED BEFORE DEFINITION.
C  2    SYMBOL HAS BEEN DEFINED AND THERE WERE NO REFERENCES BEFORE.
C  3    SYMBOL HAS BEEN MULTIPLE DEFINED.
C  4    SYMBOL IS AN EQUATED VALUE
C
	IMPLICIT INTEGER (A-Z)
	BYTE SYMFLG(513),SYMSTR(8),SRCLNE(81)
	DIMENSION SYMSYM(4,512),SYMBOL(4),SYMLIN(512)
	INTEGER*4 SYMADR(512),IADDR
	INTEGER*4 PC,NEWPC
	COMMON/SYMT/STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
	BYTE NAME(8)
	COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
	COMMON /SRC/ LNELEN,ISERR,NOCARD,SRCLNE
	COMMON/SYMN/SYMSYM,SYMLIN
C
C	PACK SYMBOL TWO BYTES TO A WORD
C
	DO 100 J=1,4
	I = J*2
100	SYMBOL(J) = ((SYMSTR(I-1)*256).OR.SYMSTR(I))
C
C	SEARCH FOR SYMBOL IN SYMBOL TABLE
C
	STIND  = 1
	MOVFLG = 0
	IF(NOSYM.EQ.0) GO TO 200
	DO 120 STIND=1,NOSYM
	DO 110 J=1,4
	IF(SYMSYM(J,STIND).NE.SYMBOL(J)) GO TO 115
110	CONTINUE
	GO TO 300
115	DO 118 J=1,4
	IF (SYMSYM(J,STIND).LT.SYMBOL(J)) GOTO 120
	IF (SYMSYM(J,STIND).EQ.SYMBOL(J)) GOTO 118
	MOVFLG = 1
	GOTO 200
118	CONTINUE
120	CONTINUE
C
C SYMBOL WAS NOT FOUND
C
200	IF(NOSYM.LT.513) GO TO 210
	CALL ERROR(221)
	STIND=513
	GOTO 400
210	IF (MOVFLG.EQ.0) GOTO 218
	ITEMP = NOSYM
211	DO 212 J=1,4
212	SYMSYM(J,ITEMP+1) = SYMSYM(J,ITEMP)
	CALL JMOV (SYMADR(ITEMP),SYMADR(ITEMP+1))
	SYMFLG(ITEMP+1) = SYMFLG(ITEMP)
	SYMLIN(ITEMP+1) = SYMLIN(ITEMP)
	ITEMP = ITEMP - 1
	IF (ITEMP.GE.STIND) GOTO 211
218	NOSYM = NOSYM + 1
	DO 220 J = 1,4
220	SYMSYM (J,STIND) = SYMBOL(J)
	IF(ICODE.EQ.1) GO TO 250
	SYMFLG(STIND)=4
	CALL I4CLR(SYMADR(STIND))
	I=JADD(SYMADR(STIND),IADDR,SYMADR(STIND))
	SYMLIN(STIND) = NOCARD
	GOTO 400
250	CALL I4CLR(SYMADR(STIND))
	SYMFLG(STIND)=1
	SYMLIN(STIND) = 0
	GOTO 400
C
C SYMBOL FOUND
C
300	IF(PASS.EQ.2.OR.ICODE.EQ.1) GOTO 400
	IF(SYMFLG(STIND).NE.1) GO TO 310
	SYMFLG(STIND)=2
	CALL I4CLR(SYMADR(STIND))
	I=JADD(SYMADR(STIND),IADDR,SYMADR(STIND))
	SYMLIN(STIND) = NOCARD
	GOTO 400
310	SYMFLG(STIND)=SYMFLG(STIND).OR.8
400	RETURN
	END
	SUBROUTINE CNVHEX(INDEX)
C
C CONVERTS 4 BITS TO HEX ASCII AND INSERTS INTO 'PL' AT 'INDEX'
C
C INPUT: WORD = VALUE
C        INDEX= WHERE TO INSERT IN PL
C
C OUTPUT:
C        WORD = WORD/16
C
	BYTE PL(132),DIG
	INTEGER WORD
	COMMON /CNVT/ WORD,PL
	CALL GETBIT(WORD,DIG)
	PL(INDEX)=DIG
	RETURN
	END
	SUBROUTINE INSDAT(IPL,IDIG)
C
C CONVERTS BINARY DATA TO HEX ASCII AND INSERTS INTO 'PL'
C
C INPUT:IPL = INDEX TO INSERT INTO PL
C       IDIG= NUMBER OF DIGITS TO CONVERT AND INSERT
C       WORD= VALUE TO CONVERT (IN COMMON - NOT REFERENCED HERE)
C
	I=IDIG
5	J=IPL+I-1
	CALL CNVHEX(J)
	I=I-1
	IF(I.LE.0) RETURN
	GO TO 5
	END

	SUBROUTINE IHX(ISZ,IDTA,IPPOS)
C
C PRINT A 4 OR 8 DIGIT HEX VALUE
C NUMBER OBTAINED STARTING AT 'WORD'
C AND PUT INTO PRINT BUFFER 'PL' STARTING IN COL 1
C
	IMPLICIT INTEGER (A-Z)
	COMMON /CNVT/ WORD,PL
	COMMON /LST/LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
	BYTE PL(132),NAME(8)
	DIMENSION IDTA(3)
	PL(1)=32
	IF(ISZ.EQ.2) GOTO 15
	WORD=IDTA(1)
	CALL INSDAT(IPPOS,4)
	RETURN
15	WORD=IDTA(2)
	CALL INSDAT(IPPOS,4)
	WORD=IDTA(1)
	CALL INSDAT(IPPOS+4,4)
	RETURN
	END

	SUBROUTINE PST
C
C SORT AND PRINT SYMBOL TABLE
C
	INTEGER PASS,STIND,SYMLIN(512)
	INTEGER*4 PC,NEWPC,SYMADR(512)
	BYTE NAME(8),SYMSYM(8,512),SYMFLG(513),PL(132)
	COMMON/LST/LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
	COMMON/SYMN/SYMSYM,SYMLIN
	COMMON/SYMT/STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
	COMMON /CNVT/ WORD,PL
	IF(NOSYM.EQ.0) RETURN
C
C	START OUT WITH CLEAN BUFFER
C
	DO 50 I = 1,132
50	PL(I) = "40
C
C GOTO TOP OF PAGE
C
	CALL NEWPAG
C
C	GENERATE THE SYMBOL LIST A LINE AT A TIME
C
	DO 300 I = 1,NOSYM,5
	DO 210 IDX=0,4
	IF (I+IDX.GT.NOSYM) GOTO 290
	DO 170 IPT=1,7,2
	PL(IPT+(IDX*24)+1) = SYMSYM(IPT,(I+IDX))
170	PL(IPT+(IDX*24)) = SYMSYM(IPT+1,(I+IDX))
	CALL IHX(2,SYMADR(I+IDX),(IDX*24)+12)
	IFTMP = SYMFLG(I+IDX)
	IF ((IFTMP.AND.16).NE.16 ) GOTO 180
	PL((IDX*24)+19) = 'E'
	PL((IDX*24)+20) = 'Q'
180	IF ((IFTMP.AND.8).NE.8  ) GOTO 190
	PL((IDX*24)+19) = 'M'
	PL((IDX*24)+20) = 'U'
190	IF ((IFTMP.AND.1).NE.1) GOTO 200
	PL((IDX*24)+19) = 'U'
	PL((IDX*24)+20) = 'N'
200	IF ((IFTMP.AND."31).NE.0) GOTO 210
	PL((IDX*24)+19) = ' '
	PL((IDX*24)+20) = ' '
210	CONTINUE
290	WRITE (LUNIT,400) (PL(N),N=1,IDX*24)
	NOLINE = NOLINE -1
	CALL PAGCHK
300	CONTINUE
400	FORMAT (' ',132A1)
	WRITE (LUNIT,410) NOSYM,IERCNT
410	FORMAT (/,' ',I3,' SYMBOLS , ',I3,' ERRORS DETECTED')
	IF (LUNIT.EQ.5) RETURN
	WRITE (5,410)     NOSYM,IERCNT
	RETURN
	END
	SUBROUTINE NEWPAG
	IMPLICIT INTEGER (A-Z)
C
C PUTS OUT HEADERS AT TOP OF EACH PAGE
C
	INTEGER PASS
	BYTE NAME(8),FF
	COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
	FF="14
	NOPAGE=NOPAGE+1
	NOLINE = 57
	IF(NOPAGE.EQ.1) FF = 0
	WRITE(LUNIT,10)FF,NAME,NOPAGE
10	FORMAT(' ',1A1,8A1,T28,'M68000 CROSS-ASSEMBLER X1.0
     +',T83,'PAGE ',I3,/)
	RETURN
	END
	SUBROUTINE PAGCHK
	IMPLICIT INTEGER (A-Z)
C
C CHECKS TO SEE IF A PAGE HAS BEEN FILLED
C
	BYTE NAME(8)
	COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
	IF(NOLINE.EQ.0) CALL NEWPAG
	RETURN
	END
	SUBROUTINE ERROR(IERR)
	IMPLICIT INTEGER(A-Z)
C
C	AND PRINTS ERROR MESSAGE DURING PASS 2
C
	COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
	COMMON /SRC/ LNELEN,ISERR,NOCARD,SRCLNE
	COMMON /PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
     +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
	COMMON /OBJOUT/ OBJBUF,OBJWC,LFLG,RFLG,DBFLG
	DIMENSION OBJBUF(40)
	COMMON /SYMT/STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
	INTEGER*4 PC,NEWPC,SYMADR(512)
	LOGICAL*1 SYMFLG(513),ERRPTR(80),NAME(8),SRCLNE(81)
	LOGICAL*1 LABEL(8)
C
C....	ERRORS ARE IGNORED DURING THE FIRST PASS
C
	IF(PASS.EQ.1) RETURN
C
	PRFLG  = 3
C
C....	WE NEED AT LEAST THREE LINES TO PRINT AN BAD LINE
C
	IF(NOLINE.LE.2) NOLINE = 0
	CALL PAGCHK
C
C....	IF THIS IS NOT THE FIRST ERROR THEN DON'T PRINT THE LINE
C
	IF (MEFLG.EQ.1) GOTO 15
	WRITE(LUNIT,10) NOCARD,(SRCLNE(I),I=1,LNELEN-1)
10	FORMAT(' ',/,' ',I4,35X,80A1:)
	NOLINE = NOLINE - 2
15	DO 20,I=1,SCANPT
20	ERRPTR(I)="40
	ERRPTR(I)="136
	WRITE(LUNIT,30) IERR,(ERRPTR(I),I=1,SCANPT+1)
30	FORMAT(' ++++  ERROR    ',I3,20X,80A1:)
	NOLINE = NOLINE - 1
	IERCNT = IERCNT + 1
	MEFLG = 1
	RETURN
	END
	SUBROUTINE LSTLNE
	IMPLICIT INTEGER (A-Z)
C
C	BUILD LINE (OR LINES IF DC.B DC.W DC.L)
C	FOR DISPLAY
C
	COMMON /SRC/ LNELEN,ISERR,NOCARD,SRCLNE
C
	COMMON /CNVT/ WORD,PL
C
	COMMON /LST/ LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
C
	COMMON /OBJOUT/ OBJBUF,OBJWC,LFLG,RFLG,DBFLG
C
	COMMON /SYMT/ STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
C
	COMMON /PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
     +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
C
	INTEGER*4 PC,NEWPC,SYMADR(512)
	DIMENSION OBJBUF(40)
	BYTE SYMFLG(513),NAME(8),LABEL(8),SRCLNE(81),PL(132)
	DATA PL/132*"40/
C
C       PRFLG = 0    ERRORS DETECTED (PRINT LINE AS READ)
C               1    NO ERRORS DETECTED (PRINT NORMALLY)
C               2    DC.W  / DC.L DIRECTIVES
C               3    SUPRESS PRINTOUT OF LINE
C               4    DC.B DIRECTIVE
C               5    NAM / END / MON DIRECTIVES
C               6    EQU / SET DIRECTIVES
C               7    ORG / RORG DIRECTIVES
C               8    DS   DIRECTIVE
C               9    PAGE DIRECTIVE
C
C
C
C	IF THIS IS THE FIRST PASS, THEN DONT PRINT ANYTHING
C
	IF (PASS.EQ.1) RETURN
C
C	IF CODE IS LONGER THAN FIVE WORDS THEN
C	ONLY PRINT 5 WORDS OF AN INSTRUCTION
C
	LSWRDS = OBJWC
	IF(OBJWC.GT.5) LSWRDS=5
C
C	CHECK IF WE HAVE TO GO TO NEXT PAGE
C
	CALL PAGCHK
C
C
	IF(CMTPTR.NE.1)GOTO 80
	OPPTR=1
	GOTO 220
80	GOTO (200,200,200,410,500,600,200,200,200,400),PRFLG+1
200	CALL IHX(2,PC,7)
C
C
	IF(LSWRDS.EQ.0) GOTO 212
205	DO 210,I=1,LSWRDS
210	CALL IHX(1,OBJBUF(I),11+(5*I))
C
C
212	IF(LABEL(1).EQ.0) GOTO 220
	DO 215,I=1,8
215	PL(I+40)=LABEL(I)
220	J=0
	DO 230 I=OPPTR,LNELEN
	PL(J+50)=SRCLNE(I)
	IF(SRCLNE(I).EQ."40) GOTO 240
230	J=J+1
	GOTO 1000
240	III=0
	DO 250 II=I+1,LNELEN
	IF (II.EQ.CMTPTR) III = 25
	PL(57+III)=SRCLNE(II)
	III = III + 1
250	IF ((III + 57).GT.132) GOTO 255
	GOTO 1000
255	PL(132) = 0
	GOTO 1000
C
C	PRFLG = 3  (NEW PAGE)
C
400	CALL NEWPAG
410	RETURN
C
C
500	GOTO 205
C
C
600	GOTO 220
C
C
700	CALL IHX(2,OBJBUF(2),16)
	GOTO 212
C
C
1000	DO 1001 I=48,132
1001	IF(PL(I).EQ.0)GOTO 1002
1002	WRITE(LUNIT,1110) NOCARD,(PL(II),II=6,I-1)
1110	FORMAT(' ',I4,132A1)
	DO 1120 II = 1,I
1120	PL(II) = "40
	NOLINE = NOLINE - 1
	RETURN
	END

	SUBROUTINE BLDOBJ
	IMPLICIT INTEGER (A-Z)
C
C	BUILD OBJ FILE
C
	COMMON /FNAM  / FILNAM,OBJFLG
C
	COMMON /OBJOUT/ OBJBUF,OBJWC,LFLG,RFLG,DBFLG
C
	COMMON /CNVT  / WORD,PL
C
	COMMON /SYMT  / STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
C
	COMMON /HEXFLG/ ENDFLG,HEXWC,HEXPC,OLDPC
C
	DIMENSION OBJBUF(40),HEXBUF(8)
	INTEGER*4 PC,NEWPC,SYMADR(512),OLDPC,NEWVAL,HEXPC
	LOGICAL*1 SYMFLG(513),PL(132),FILNAM(12)
C
C	CHECK IF OBJ FILE IS TO BE GENERATED
C
	IF (OBJFLG.EQ.0) RETURN
C
C	CHECK FOR THE END OF ASSEMBLY FLAG
C	IF IT IS SET, WRITE OUT THE BALANCE OF THE OBJ BUFFER
C
	IF (ENDFLG.EQ.0) GOTO 10
	IF (HEXWC.NE.0)  CALL WRTOBJ(HEXPC,HEXWC,HEXBUF)
	RETURN
C
C	CHECK THE CURRENT VALUE OF THE PC WITH THAT OF THE ONE SAVED
C	IF THE TWO ARE NOT EQUAL, THEN WRITE OUT THE BALANCE OF THE
C	OBJ BUFFER AND START AT THE NEW PC VAL
C
10	CALL DBLSGL(PC,PC1,PC2)
	CALL DBLSGL(OLDPC,OLDPC1,OLDPC2)
	IF (PC1.NE.OLDPC1) GOTO 50
	IF (PC2.EQ.OLDPC2) GOTO 75
50	IF (HEXWC.NE.0) CALL WRTOBJ(HEXPC,HEXWC,HEXBUF)
	CALL JMOV(PC,HEXPC)
	CALL JMOV(PC,OLDPC)
C
C	EXTRACT OBJECT WORDS FROM OBJECT BUFFER AND
C	PUT THEM INTO AN INTERNAL BUFFER. IF THE
C	INTERNAL BUFFER IS FULL, THEN OUTPUT THE BUFFER.
C
75	I = 1
76	HEXWC = HEXWC + 1
	HEXBUF(HEXWC) = OBJBUF(I)
	IF (HEXWC.NE.8) GOTO 99
C
C....	OBJECT BUFFER IS FULL, OUTPUT IT TO OBJ FILE
C
	CALL WRTOBJ(HEXPC,HEXWC,HEXBUF)
C
C	CALCULATE NEW STARTING PC FOR HEX BUFFER
C
	N = JICVT(I*2,NEWVAL)
	N = JADD(PC,NEWVAL,HEXPC)
99	I = I + 1
	IF (I.LE.OBJWC) GOTO 76
C
C	CALCULATE WHAT THE NEW PC SHOULD BE BY ADDING
C	THE OBJECT WORD COUNT TO THE CURRENT PC
C
	I = JADD(OLDPC,NEWPC,OLDPC)
	RETURN
	END
	SUBROUTINE WRTOBJ(HEXPC,HEXWC,HEXBUF)
	IMPLICIT INTEGER(A-Z)
C
C	OUTPUT THE CONTENTS OF THE OBJECT BUFFER
C
C	HEXPC = STARTING PC FOR BUFFER
C	HEXWC = NUMBER OF WORDS USED IN BUFFER
C	HEXBUF= 8 WORD OBJECT BUFFER
C
	COMMON /CNVT/ WORD,PL
	LOGICAL*1 PL(132)
	INTEGER*4 HEXPC
	DIMENSION HEXBUF(8)
	DO 10, I = 1,80
10	PL(I) = "40
	CALL IHX(2,HEXPC,1)
	PLIDX = 10
	DO 20,I=1,HEXWC
20	CALL IHX(1,HEXBUF(I),PLIDX+(5*(I-1)))
	WRITE (2,100)(PL(I),I=3,10+(5*HEXWC))
100	FORMAT(' ',80A1)
	HEXWC = 0
	DO 900, I = 1,80
900	PL(I) = "40
	RETURN
	END
 	SUBROUTINE PRCESS
C
C	PROCESSES SOURCE LINE AFTER IT HAS BEEN PARSED BY PARSE
C
C INPUT:PARSE OUTPUTS
C
C OUTPUT:
C
C  OBJWC    NUMBER OF WORDS REQUIRED FOR INSTRUCTION
C
C  OBJBUF   TABLE OF WORDS GENERATED
C
C  PRFLG 0  ERRORS DETECTED (PRINT LINE AS READ
C        1  NO ERRORS DETECTED (PRINT NORMALLY)
C        2  DC.W/DC.L DIRECTIVES
C        3  DONT PRINT LINE
C        4  DC.B DIRECTIVE
C        5  NAM/END/MON DIRECTIVES
C        6  EQU/SET DIRECTIVE
C        7  ORG/RORG DIRECTIVE
C        8  DS DIRECTIVE
C        9  PAGE DIRECTIVE
C
C  NEWPC    NEW VALUE FOR PC
C
C
C  OP1EA 0  NOT REG OR IMMEDIATE DATA
C        1  D REG
C        2  A REG
C        3  (AN)
C        4  (AN)+
C        5  -(AN)
C        6  # DATA
C        7  SR
C        8  CCR
C        9  USP
C        10 ERROR DETECTED
C
C  IMODE 0  NO SIZE SPECIFIED (DEFAULT IS WORD)
C        1  .B
C        2  .W
C        3  .L
C        4  .S  (SHORT BRANCH)
C
C       ERRORS DEFINED.....
C
C	400	UNDEFINED OPCODE
C	401	OPERAND MISSING FOR OPCODE
C	402	NO ORG SPECIFIED FOR ORG INSTRUCTION
C	403	ERROR IN DC OPN VALUE
C	406	GENERAL ERROR IN DECODING
C	407	UNDEFINED SYMBOL
C	408	ERROR IN SIZE OF Y(Ax,Rx) INDEX
C	409	MULT DEFN SYMBOL
C
	IMPLICIT INTEGER (A-Z)
C
	COMMON /OPWD  / OPNFLG,OPNWC,OPNWRD
C
	COMMON /LST   / LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
C
	COMMON /OBJOUT/ OBJBUF,OBJWC,LFLG,RFLG,BRFLG
C
	COMMON /SRC   / LNELEN,ISERR,NOCARD,SRCLNE
C
	COMMON /SYMT  / STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
C
	COMMON /PRSE  / OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
     +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
C
	COMMON /OPCPTS/ OPTYP,OPSKEL,OPSK2,OPIDX
C
	INTEGER*4 PC,NEWPC,SYMADR(512),SYMVAL,TMPVAL,J2
	LOGICAL*1 SRCLNE(81),LABEL(8),NAME(8),SYMFLG(513)
	DIMENSION OBJBUF(40),OPNWRD(3)
C
C....	SET UP FLAGS THAT CHANGE EACH TIME THRU
C
	CALL I4CLR(NEWPC)
	J2     = 2
	OP1EA  = 0
	OP2EA  = 0
	OP1DA  = 0
	OP2DA  = 0
	OPNWC = 0
C
C....	DECODE OPCODE
C
	CALL DECOPC
	IF(OPTYP.NE.0) GOTO 10
	CALL ERROR(400)
	RETURN
C
C....	SKIP IF NO OPERANDS
C
10	IF(OPNPTR.EQ.0)GOTO 20
C
C....	DECODE FIRST OPERAND
C
	OP1EA=OPNPTR
	CALL EATYP(OP1EA,OP1DA)
	IF(OPNPT2.EQ.0)GOTO 20
C
C....	DECODE SECOND OPERAND
C
	OP2EA=OPNPT2
	CALL EATYP(OP2EA,OP2DA)
C
C....	CHECK FOR OPERANDS
C
20	IF(OP1EA.EQ.10.OR.OP2EA.EQ.10) GOTO 8500
	IF(OPTYP.EQ.1.OR.OPTYP.EQ.2) GOTO 90
	IF(OPNPTR.NE.0) GOTO 90
	CALL ERROR(401)
	RETURN
C
C....	DEFAULT SIZE IS ONE WORD FOR INSTRUCTIONS
C
90	OBJWC=1
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C GOTO OPCODE EVALUATION ROUTINES VIA OPTYPE
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++ 
	GOTO(100,200,300,500,400,600,700,800,900,1000
     +,1100,1200,1300,1400,1500,1600,1700,1800,1900,2000,2100),OPTYP
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS PSEUDO OPS
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C....	PSEUDO OPS NORMALLY DON'T GENERATE CODE
C....	THE EXECEPTION BEING 'DC'
C
100	OBJWC=0
	GOTO(110,120,130,140,150,195,150,160,170,180,190),OPIDX
C
C	DC
C
110	PRFLG=2
	IFLG = RFLG
	RFLG = 1
111	CALL PROCOP(OPNPTR)
	IF(OPNWC.EQ.0) GOTO 115
	IF(IMODE.EQ.3) OBJWC = OBJWC+2
	IF(IMODE.NE.3) OBJWC = OBJWC+1
	IF(IMODE.EQ.3) OBJBUF(OBJWC-1) = OPNWRD(3)
	IF(IMODE.EQ.3) OBJBUF(OBJWC  ) = OPNWRD(2)
	IF(IMODE.NE.3) OBJBUF(OBJWC  ) = OPNWRD(2)
	IF(SRCLNE(OPNPTR).NE."54) GOTO 119
	OPNPTR = OPNPTR+1
	GOTO 111
115	CALL ERROR(403)
118	RFLG = IFLG
	GOTO 7000
119	IF(IMODE.NE.1.OR.OPNWRD(2).GE.256) GOTO 118
	OBJBUF(OBJWC)=(OBJBUF(OBJWC)*"400)
	GOTO 118
C
C	DS
C
120	PRFLG=7
	IF(OPNPTR.EQ.0) GOTO 8500
	CALL PROCOP(OPNPTR)
	IF(OPNWC.EQ.7) GOTO 134
	IF(IMODE.EQ.1) GOTO 122
	IF(IMODE.NE.3) GOTO 125
	I=JICVT(4,NEWPC)
	I=JMUL(NEWPC,OPNWRD(2),NEWPC)
	GOTO 128
122	I=JMOV(OPNWRD(2),NEWPC)
	GOTO 128
125	I=JICVT(2,NEWPC)
	I=JMUL(NEWPC,OPNWRD(2),NEWPC)
128	I=JMOV(PC,OBJBUF(2))
	I=JMOV(PC,SYMVAL)
	GOTO 7005
C
C	ORG
C
130	IF(LABEL(1).EQ.0) GOTO 132
131	CALL ERROR(402)
	RETURN
C
132	RFLG=1
133	PRFLG=7
	IF(OPNPTR.NE.0) GOTO 134
	CALL I4CLR(NEWPC)
	CALL I4CLR(PC)
	RETURN
134	CALL PROCOP(OPNPTR)
	IF(OPNWC.EQ.7) GOTO 135
	CALL I4CLR(PC)
	I=JADD(NEWPC,OPNWRD(2),NEWPC)
	RETURN
135	CALL ERROR(403)
	RETURN
C
C	END <STARTING ADR>
C
140	ISERR=1
	IF(LABEL(1).NE.0) GOTO 131
	PRFLG=5
	RETURN
C
C	EQU
C
150	IF(LABEL(1).EQ.0) GOTO 131
	PRFLG=6
	IF(OPNPTR.EQ.0) GOTO 8500
	CALL PROCOP(OPNPTR)
	IF(OPNWC.EQ.7) RETURN
	CALL SYMTBL(2,OPNWRD(2),LABEL)
	IF((SYMFLG(STIND).AND."10).EQ."10)CALL ERROR(409)
	I=JMOV(OPNWRD(2),SYMADR(STIND))
	SYMFLG(STIND)=SYMFLG(STIND).OR.16
	I=JMOV(SYMADR(STIND),OBJBUF(2))
	RETURN
C
C	RORG
C
160	IF(LABEL(1).NE.0) GOTO 131
	RFLG=0
	GOTO 133
C
C	PAGE
C
170	IF(LABEL(1).NE.0)GOTO 131
	LFLG=0
	PRFLG=9
	RETURN
C
C	LIST
C
180	IF(LABEL(1).NE.0)GOTO 131
	LFLG=1
	PRFLG=3
	RETURN
C
C	NLIST
C
190	IF(LABEL(1).NE.0) GOTO 131
	LFLG=0
	PRFLG=3
	RETURN
C
C	NAM
C
195	IF(LABEL(1).NE.0) GOTO 131
	DO 197 I=1,8
197	NAME(I)="40
	N=1
	DO 196 I=OPNPTR,OPNPTR+7
	NAME(N)=SRCLNE(I)
	N=N+1
196	IF(I.EQ.LNELEN-1) RETURN
	RETURN
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS INHERENT INSTRUCTIONS..IE NOP
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
200	OBJBUF(1)=OPSKEL
	GOTO 7000
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS MOVE INSTRUCTION
C	<EA>,<EA>  SR,<EA>  <EA>,CCR  <EA>,SR  USP,An  An,USP
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C....	LOOK FOR OBVIOUS MISTAKES
C
300	IF(OP2EA .EQ.6.OR.OP1EA .EQ.8) GOTO 8500
	IF(OP1EA.EQ.9 .AND.OP2EA.NE.2) GOTO 8500
	IF(OP1EA.NE.2 .AND.OP2EA.EQ.9) GOTO 8500
	IF(OPNPTR.EQ.0.OR.OPNPT2.EQ.0) GOTO 8500
C
C....	SR,<EA> - USP,<EA>
C
	IF(OP1EA.EQ.7.OR. OP1EA.EQ.9) GOTO 350
C
C....	OP1EA = 1 THRU 5
C
	IF((OP1EA.GE.1).AND.(OP1EA.LE.5)) GOTO 305
C
C....	PROCESS FIRST OPN HERE IF COMPLEX
C
	CALL PROCOP(OPNPTR)
C
C....	CHECK FOR EA TYPES 7-9
C
303	IF(OP2EA.GT.6) GOTO 340
C
C....	CHECK FOR FIRST OPERAND IMMEDIATE MODE ADDRESSING
C
	IF (OP1EA.NE.6) GOTO 304
C
C....	SKIP MOVQ IF FWD REF SYMBOL
C
	IF(OPNFLG.EQ.1) GOTO 304		! CANNOT BE FWD REF SYM
	IF(IMODE .NE.3) GOTO 304		! MUST BE .L MODE
	IF(OPNWRD(3).EQ. 0) GOTO 301		! HI WORD MUST BE ZERO
	IF(OPNWRD(3).EQ.-1) GOTO 301		! OR MINUS ONE
	GOTO 304
C
C....	CHECK IF VAL WITHIN RANGE FOR MOVEQ (+/- 128)
C....	ALSO CHECK IF DESTINATION IS A DATA REGISTER
C
301	I=ICKVAL(OPNWRD(2))
	IF ((I.EQ.0).AND.(OP2EA.EQ.1)) GOTO 330
C
C....	ADD IN OPCODE SIZE BITS
C
304	OBJBUF(1)=OBJBUF(1).OR."30000
	IF(IMODE.EQ.1) OBJBUF(1)=(OBJBUF(1)).AND."17777
	IF(IMODE.EQ.3) OBJBUF(1)=(OBJBUF(1)).AND."27777
C
C....	MOVE IN NUMBERS FOR 1ST AND 2ND EXT WORDS
C
	OBJWC     = OBJWC+OPNWC
	OBJBUF(2) = OPNWRD(2)
	OBJBUF(1) = OPNWRD(1)
	IF(OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
	IF(OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
	GOTO 310
C
C....	PROCESS EA TYPES 0-5 FOR FIRST OPN
C
305	OBJBUF(1)=(((OP1EA-1)*"10).OR.OP1DA)
C
C....	CHK FOR SIMPLE SECOND OPERANDS
C
310	IF(OP2EA.EQ.0) GOTO 315
C
C....	CHK FOR SR,CCR,USP
C
	IF(OP2EA.GT.6) GOTO 340
	GOTO 320
C
C....	CALCULATE COMPLEX SECOND OPN
C
315	CALL PROCOP(OPNPT2)
	OBJBUF(OBJWC+1)=OPNWRD(2)
	IF(OPNWC.EQ.2) OBJBUF(OBJWC+2)=OPNWRD(2)
	IF(OPNWC.EQ.2) OBJBUF(OBJWC+1)=OPNWRD(3)
	OBJWC=OBJWC+OPNWC
	I=(OPNWRD(1).AND.7)*"10
	J=(OPNWRD(1).AND."70)/8
	OBJBUF(1)=OBJBUF(1).OR.((I+J)*"100).OR."30000
	GOTO 325
C
C....	PROCESS EA TYPES 0-5 FOR SECOND OPN
C
320	OBJBUF(1)=OBJBUF(1)+(((OP2EA-1).OR.(OP2DA*"10))*"100).OR."30000
C
C....	ADD IN SIZE BITS
C
325	IF(IMODE.EQ.1)OBJBUF(1)=OBJBUF(1).AND."17777
	IF(IMODE.EQ.3)OBJBUF(1)=OBJBUF(1).AND."27777
	GOTO 7000
C
C....	GEN MOVEQ ALSO CLR SIZE BITS IF SET
C
330	OBJBUF(1) = 0
	OBJBUF(1) = (OPNWRD(2).AND."377).OR."70000.OR.(OP2DA*"1000)
	GOTO 7000
C
C....	GENERATE MOVE <EA>,SR - <EA>,CCR - AN,USP
C
340	IF(OP2EA.EQ.7) OBJBUF(1)="43300
	IF(OP2EA.EQ.8) OBJBUF(1)="42300
	IF(OP2EA.NE.9) GOTO 342
	OBJBUF(1) = "47140.OR.OP1DA
	GOTO 7000
C
C....	GET NON-REG EA'S IF 0 OR 6
C
342	IF(OP1EA.EQ.0.OR.OP1EA.EQ.6) GOTO 349
C
C....	ELSE JUST ADD OR IN THE EA AND REG
C
	OBJBUF(1)=OBJBUF(1).OR.OP1DA.OR.((OP1EA-1)*"10)
	GOTO 7000

C
C....	HANDLE STUFF FOR EA'S 0 AND 6
C
349	OBJBUF(1)=OBJBUF(1).OR.OPNWRD(1)
	OBJBUF(2)=OPNWRD(2)
	IF(OPNWC.EQ.2)OBJBUF(2)=OPNWRD(3)
	IF(OPNWC.EQ.2)OBJBUF(3)=OPNWRD(2)
	OBJWC=OBJWC+OPNWC
	GOTO 7000
C
C....	GENERATE MOVE SR,<EA> - USP,AN
C
350	IF (OP1EA.EQ.9) GOTO 355		! SR,<EA>
	IF (OP2EA.EQ.2) GOTO 8500		! USP,AN
	IF (OP2EA.EQ.0) GOTO 353
	OBJBUF(1) = "40300.OR.OP2DA.OR.((OP2EA-1)*"10)
	GOTO 7000
C
353	CALL PROCOP(OPNPT2)
	OBJBUF(2)=OPNWRD(2)
	IF(OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
	IF(OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
	OBJWC = OBJWC + OPNWC
	OBJBUF(1) = "43000.OR.OPNWRD(1)
	GOTO 7000
C
355	OBJBUF(1) = "47150.OR.OP2DA
	GOTO 7000
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS CMP INSTRUCTION
C	<EA>,DN <EA>,AN #DATA,<EA> (AY)+,(AX)+
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
400	IF((OP1EA.EQ.6).AND.(OP2EA.NE.2)) GOTO 460	! CMPI INSTR
	IF((OP1EA.EQ.5).AND.(OP2EA.EQ.5)) GOTO 480	! CMPM INSTR
	IF((OP2EA.EQ.1).OR. (OP2EA.EQ.2)) GOTO 410	! CMP <EA>,DN OR AN
	GOTO 8500					! ALL ELSE ILLEGAL
C
C....	PROCESS <EA>,DN <EA>,AN
C
410	IF(OP2EA.EQ.2.AND.IMODE.EQ.1) GOTO 8500		! CMPA CANT HAVE .B
	IF(OP2EA.NE.2) GOTO 411
	IF(IMODE.EQ.3) OPSKEL = OPSKEL.OR."500		! CMPA.L
	IF(IMODE.NE.3) OPSKEL = OPSKEL.OR."200		! CMPA.W
411	IF((OP1EA.EQ.0).OR.(OP1EA.EQ.6)) GOTO 415	! COMPLEX OPN
C
C....	PROCESS FOR REG OPNS
C
412	OBJBUF(1)=OPSKEL.OR.(OP2DA*"1000).OR.((OP1EA-1)*"10).OR.OP1DA
	GOTO 6000
C
C....	PROCESS FOR COMPLEX 1ST OPNS
C
415	CALL PROCOP(OPNPTR)
	OBJBUF(1) = OPSKEL.OR.(OP2DA*"1000).OR.(OPNWRD(1).AND."77)
	OBJBUF(2)=OPNWRD(2)
	IF(OPNWC.EQ.2) OBJBUF(2)=OPNWRD(3)
	IF(OPNWC.EQ.2) OBJBUF(3)=OPNWRD(2)
	OBJWC=OBJWC+OPNWC
	GOTO 6000
C
C....	CMPI INSTRUCTION
C....	EVALUATE THE IMMEDIATE PART
C
460	CALL PROCOP(OPNPTR)
	OBJWC = OBJWC + OPNWC
	OBJBUF(2)=OPNWRD(2)
	IF(OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)		! PLAY GAMES IF 2 WDS
	IF(OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
C
C....	CHECK FOR SIMPLE DESTINATION EA
C
	IF((OP2EA.GT.0).AND.(OP2EA.LT.6)) GOTO 470
	IF(OP2EA.GT.6) GOTO 8500
	CALL PROCOP(OPNPT2)
	OBJBUF(1) = OPSK2.OR.(OPNWRD(1).AND."77)
	OBJBUF(OBJWC+1) = OPNWRD(2)
	IF (OPNWC.EQ.2) OBJBUF(OBJWC+1) = OPNWRD(3)
	IF (OPNWC.EQ.2) OBJBUF(OBJWC+2) = OPNWRD(2)
	OBJWC = OBJWC+OPNWC
	GOTO 6000
C
C....	SECOND EA IS NOT COMPLEX
C
470	OBJBUF(1) = OPSK2.OR.OP2DA.OR.((OP2EA-1)*"10)
	GOTO 6000
C
C....	CMPM (AY)+,(AX)+
C
480	OBJBUF(1)=OPSKEL+((OP2DA*"1000)+OP1DA)
	GOTO 6000
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS ADD,SUB INSTRUCTIONS
C	<EA>,DN <EA>,AN  DN,<EA> #DATA,<EA>
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
500	IF(OP2EA.EQ.2) GOTO 525		! ADDA,SUBA
	IF(OP1EA.EQ.6) GOTO 530		! ADDI,SUBI
	IF(OP1EA.EQ.1.OR.OP2EA.EQ.1)  GOTO 510
	GOTO 8500			! ALL OTHERS ILLEGAL
C
C....
C
510	IF(OP2EA.EQ.1) GOTO 520
	OPSKEL = OPSKEL .OR. "400
C
C....	GENERATE DN,<EA>
C
	OPSKEL = OPSKEL.OR.(OP1DA*"1000)
	IF(OP2EA.EQ.0) GOTO 511
	OBJBUF(1) = OPSKEL.OR.((OP2EA-1)*"10).OR.OP2DA
	GOTO 6000
C
511	CALL PROCOP(OPNPT2)
514	OBJBUF(2) = OPNWRD(2)
	IF(OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
	IF(OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
	OBJWC = OBJWC+OPNWC
	OBJBUF(1) = OPSKEL.OR.OPNWRD(1)
	GOTO 6000
C
C....	GENERATE <EA>,DN
C
520	OPSKEL = OPSKEL.OR.(OP2DA*"1000)
	IF(OP1EA.EQ.0) GOTO 522
521	OBJBUF(1) = OPSKEL.OR.((OP1EA-1)*"10).OR.OP1DA
	GOTO 6000
C
522	CALL PROCOP(OPNPTR)
	GOTO 514
C
C....	GENERATE <EA>,AN
C
525	IF (IMODE.EQ.1) GOTO 8500
	IF (IMODE.EQ.3) OPSKEL = OPSKEL .OR. "500
	IF ((IMODE.EQ.2).OR.(IMODE.EQ.0)) OPSKEL = OPSKEL.OR."200
	OPSKEL = OPSKEL .OR.(OP2DA*"1000)
	IF((OP1EA.EQ.0).OR.(OP1EA.EQ.6)) GOTO 522
	OBJBUF(1) = OPSKEL.OR.((OP1EA-1)*"10).OR.OP1DA
	GOTO 6000
C
C....	GENERATE xxxI
C
530	IF(OP2EA.GT.6) GOTO 8500
C
C....	EVALUATE IMMEDIATE EXPRESSION
C
	CALL PROCOP(OPNPTR)
C
C....	TRY GENERATING SHORT FORM OF INSTRUCTION
C....	AFTER CHECKING TO SEE IF OPERAND WAS FWD REF
C
	IF(OPNFLG.EQ.1) GOTO 536
	IF(OPNWRD(2).GE.1.AND.OPNWRD(2).LE.8) GOTO 550
C
C....	GENERATE EXTENSION WORDS
C....	LENGTH OF OPERAND DEPENDS ON THE IMODE OF INSTRUCTION
C
536	OBJBUF(2) = OPNWRD(2)
	IF(OPNWC.EQ.2)OBJBUF(2) = OPNWRD(3)
	IF(OPNWC.EQ.2)OBJBUF(3) = OPNWRD(2)
537	OBJWC = OBJWC + OPNWC
C
C....	IF DEST THRU REG EVAL IT HERE
C
538	IF(OP2EA.EQ.0) GOTO 540
	OBJBUF(1)=OPSK2.OR.((OP2EA-1)*"10).OR.OP2DA
	GOTO 6000
C
C....	EVAL NON-REG DEST
C
540	CALL PROCOP(OPNPT2)
	OBJWC = OBJWC + OPNWC
	OBJBUF(1) = OPSK2.OR.OPNWRD(1)
	IF(OPNWC.EQ.1) OBJBUF(OBJWC  ) = OPNWRD(2)
	IF(OPNWC.EQ.2) OBJBUF(OBJWC+1) = OPNWRD(3)
	IF(OPNWC.EQ.2) OBJBUF(OBJWC  ) = OPNWRD(2)
	GOTO 6000
C
C....	GENERATE xxxQ
C
550	IF(OPNWRD(2).EQ.8) OPNWRD(2) = 0
	IF(OPSK2.EQ."2000) OPSK2 = "50400
	IF(OPSK2.EQ."3000) OPSK2 = "50000
	OPSK2 = OPSK2.OR.(OPNWRD(2)*"1000)
	GOTO 538
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS AND,OR INSTRUCTIONS
C	<EA>,DN  DN,<EA>  #DATA,<EA>
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
600	IF(OP1EA.EQ.6) GOTO 610
	IF(OP2EA.NE.1) GOTO 620
C
C....	PROCESS <EA>,DN
C
	OPSKEL=OPSKEL+(OP2DA*"1000)
	IF(OP1EA.EQ.0) GOTO 605
	OBJBUF(1)=OPSKEL.OR.OP1DA.OR.((OP1EA-1)*"10)
	GOTO 6000
C
605	CALL PROCOP(OPNPTR)
	OBJBUF(1)=OPSKEL.OR.OPNWRD(1)
	OBJBUF(2)=OPNWRD(2)
	IF(OPNWC.EQ.2) OBJBUF(2)=OPNWRD(3)
	IF(OPNWC.EQ.2) OBJBUF(3)=OPNWRD(2)
	OBJWC=OBJWC+OPNWC
	GOTO 6000
C
C....	PROCESS #DATA,<EA>
C
610	OPSKEL = OPSK2
	IF(OP2EA.EQ.6) GOTO 8500
	CALL PROCOP(OPNPTR)
	OBJBUF(2)=OPNWRD(2)
	IF(OPNWC.EQ.2) OBJBUF(2)=OPNWRD(3)
	IF(OPNWC.EQ.2) OBJBUF(3)=OPNWRD(2)
	OBJWC=OBJWC+OPNWC
C
C....	NOW THAT WE HAVE IMMEDIATE DATA GET ,<EA>
C
	IF(OP2EA.EQ.0.AND.OP1EA.EQ.1) GOTO 6000
	IF(OP2EA.EQ.0) GOTO 615
C
C....	CHECK FOR #DATA,SR OR #DATA,CCR
C
	IF(OP2EA.LT.7) GOTO 612
	IF(OP2EA.GT.8) GOTO 8500
	IF((IMODE.EQ.1).AND.(OP2EA.EQ.8)) GOTO 611
	IF((IMODE.EQ.1).OR.(IMODE.EQ.3))  GOTO 8500
611	OBJBUF(1) = OPSKEL.OR."74
	GOTO 6000
612	OBJBUF(1) = OPSKEL.OR.((OP2EA-1)*"10).OR.OP2DA
	GOTO 6000
C
C....	EVALUATE ,<EA> FOR COMPLEX ADR
C
615	CALL PROCOP(OPNPT2)
630	OBJBUF(OBJWC+1)=OPNWRD(2)
	IF(OPNWC.EQ.2) OBJBUF(OBJWC+1)=OPNWRD(3)
	IF(OPNWC.EQ.2) OBJBUF(OBJWC+2)=OPNWRD(2)
	OBJWC=OBJWC+OPNWC
	OBJBUF(1)=OBJBUF(1).OR.OPSKEL
	GOTO 6000
C
C....	EVALUATE DN,<EA>
C
620	OPSKEL=OPSKEL+(OP1DA*"1000).OR."400
	IF(OP2EA.EQ.0) GOTO 615
	OBJBUF(1) = OPSKEL.OR.OP2DA.OR.((OP2EA-1)*"10)
	GOTO 6000
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS EOR INSTRUCTION
C	DN,<EA>  #DATA,<EA>
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
700	IF(OP1EA.EQ.6) GOTO 610
	IF(OP1EA.NE.1) GOTO 8500
	IF(OP2EA.EQ.0) GOTO 620
	OBJBUF(1)=OPSKEL+((OP1EA-1)*"1000)+OP2DA+((OP1EA-1)*"10)
	GOTO 6000
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS ROTATES AND SHIFTS
C	DX,DY  DATA,DY  <EA>
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
800	IF(OP1EA.EQ.1.AND.OP2EA.EQ.1) GOTO 810
	IF(OP1EA.EQ.6.AND.OP2EA.EQ.1) GOTO 820
	IF(OP1EA.EQ.0.AND.OP2EA.EQ.1) GOTO 820
C
C....	PROCESS  <EA>
C
	IF(OP1EA.EQ.0) GOTO 801
	IF(OP1EA.LT.3.OR.OP1EA.GT.5) GOTO 8500
	OBJBUF(1)=OPSKEL+((OP1EA-1)*"10)+OP1DA
	GOTO 7000
C
801	CALL PROCOP(OPNPTR)
	OBJBUF(1)=OPSKEL+OPNWRD(1)
	OBJBUF(2) = OPNWRD(2)
	IF (OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
	IF (OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
	OBJWC = OBJWC + OPNWC
	GOTO 7000
C
810	OBJBUF(1) = OPSKEL.OR."40.OR.(OP1DA*"1000).OR.OP2DA
	GOTO 6000
C
820	CALL PROCOP(OPNPTR)
	IF(OPNWRD(2).LT.1.OR.OPNWRD(2).GT.8) GOTO 8500
	IF(OPNWRD(2).EQ.8) OPNWRD(2)=0
	OBJBUF(1)=OPSKEL+(OPNWRD(2)*"1000)+OP2DA
	GOTO 6000
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS BRANCH INSTRUCTIONS
C	<LABEL>
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
900	IF(OPNPTR.EQ.0) GOTO 8500
	IF(OP1EA .NE.0) GOTO 8500
	BRFLG = 1
C
C....	GENERATE BRANCH ADDRESS
C
	CALL PROCOP(OPNPTR)
C
C....	CHK FOR FORCED SHORT ADR MODE
C
	IF(IMODE.EQ.4) GOTO 910
C
C....	CHECK FOR FWD REF SYMBOL OR REF BEFORE DEFINITION
C
	IF(OPNFLG.EQ.1) GOTO 905
C
C....	CHECK FOR SHORT BRANCH
C
	I = ICKVAL(OPNWRD(2))
	IF((I.EQ.0).AND.(OPNWRD(2).NE."177600)) GOTO 910
	IF(IMODE.EQ.4) CALL ERROR(404)
C
C....	ELSE GENERATE TWO WORD BRANCH
C
905	OBJBUF(1) = OPSKEL
	OBJBUF(2) = OPNWRD(2)
	OBJWC = 2
	GOTO 920
C
C....	GENERATE SHORT BRANCH
C
910	OBJWC =1
	OPSKEL=OPSKEL+(OPNWRD(2).AND."377)
	OBJBUF(1) = OPSKEL
920	BRFLG = 0
	GOTO 7000
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS BIT MODIFICATION INSTRUCTIONS
C	DN,<EA>  #DATA,<EA>
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
1000	IF(OP1EA.EQ.1.OR.OP1EA.EQ.6) GOTO 1010
	GOTO 8500
1010	IF(OP1EA.EQ.6) GOTO 1020
	IF(OP2EA.EQ.0) GOTO 1015
C
C....	SIMPLE EA'S
C
	OBJBUF(1) = OPSKEL.OR.(OP1DA*"1000).OR.OP2DA
	OBJBUF(1) = OBJBUF(1) .OR. ((OP2EA-1)*"10)
	GOTO 7000
C
1015	CALL PROCOP(OPNPT2)
	OBJBUF(2) = OPNWRD(2)
	IF (OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
	IF (OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
	OBJWC = OBJWC + OPNWC
	OBJBUF(1) = OPSKEL.OR.OPNWRD(1).OR.(OP1DA*"1000)
	GOTO 7000
C
1020	CALL PROCOP(OPNPT2)
	IF(OPNWRD(3).NE.0) GOTO 8500
	OBJBUF(2)=OPNWRD(2)
	OBJWC=OBJWC+1
	OBJBUF(1)=OPSK2+(OPNWRD(1).AND."77)
	GOTO 7000
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS MULT DIV AND CHK INSTRUCTIONS
C	<EA>,DN
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
1100	IF(OP2EA.NE.1) GOTO 8500
	IF(OP1EA.EQ.2) GOTO 8500
	IF(OP1EA.EQ.0.OR.OP1EA.EQ.6) GOTO 1110
	IF(OP1EA.GT.6) GOTO 8500
	OPSKEL=OPSKEL+((OP1EA-1)*"10)+OP1DA
	GOTO 1120
1110	CALL PROCOP(OPNPTR)
	OPSKEL=OPSKEL+OPNWRD(1)
	OBJBUF(2)=OPNWRD(2)
	IF(OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
	IF(OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
	OBJWC = OBJWC + OPNWC
1120	OBJBUF(1)=OPSKEL+(OP2DA*"1000)
	GOTO 7000
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS INSTRUCTIONS OF FORM OPCODE <EA>
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C	CHK FOR CLR,NEG
1200	IF(OPIDX.EQ.18.OR.OPIDX.EQ.25) GOTO 1202
C	CHK FOR NOT,TST
	IF(OPIDX.EQ.27.OR.OPIDX.EQ.48) GOTO 1202
	IF(IMODE.NE.0) GOTO 8500		! SIZE BITS ILLEGAL
	GOTO 1210
1202	IF(IMODE.EQ.1) GOTO 1205
	IF(IMODE.EQ.3) OPSKEL=OPSKEL+"200
	IF(IMODE.EQ.2.OR.IMODE.EQ.0)OPSKEL=OPSKEL+"100
1205	IF(OP1EA.EQ.0.OR.OP1EA.GE.6) GOTO 1210
	IF(OP1EA.GT.6) GOTO 8500
C
C....	PROCESS REG OPERAND
C
	OBJBUF(1)=OPSKEL+OP1DA+((OP1EA-1)*"10)
	GOTO 7000
C
C....	PROCESS COMPLEX OPERAND
C
1210	IF(OP1EA.NE.0.AND.OP1EA.NE.3) GOTO 8500
	IF(OP1EA.NE.3) GOTO 1215
	OBJBUF(1) = OPSKEL.OR.OP1DA.OR."20
	GOTO 7000
C
C....	GENERATE EXTENSION WORDS AS NECESSARY
C
1215	CALL PROCOP(OPNPTR)
	OBJBUF(1) = OPSKEL.OR.OPNWRD(1)
	OBJBUF(2) = OPNWRD(2)
	IF(OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
	IF(OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
	OBJWC = OBJWC + OPNWC
	GOTO 7000
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS DECR AND BRANCH INSTRUCTIONS
C	DN,<LABEL>
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
1300	IF(OP1EA.NE.1) GOTO 8500
	OBJBUF(1)=OPSKEL+OP1DA
	I=RFLG
	RFLG=0
	SCANPT = OPNPT2
	CALL PROCOP(OPNPT2)
	OBJBUF(2)=OPNWRD(2)
	IF(I.EQ.1) RFLG=1
	OBJWC=2
	GOTO 7000
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS EXG INSTRUCTION
C	RX,RY
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
1400	IF(OP1EA.EQ.0.OR.OP1EA.GT.2) GOTO 8500
	IF(OP2EA.EQ.0.OR.OP2EA.GT.2) GOTO 8500
	OPSKEL=OPSKEL+OP2DA
	OPSKEL=OPSKEL+(OP1DA *"1000)
	IF(OP1EA.EQ.1.AND.OP2EA.EQ.1) OBJBUF(1)=OPSKEL+"500
	IF(OP1EA.EQ.2.AND.OP2EA.EQ.2) OBJBUF(1)=OPSKEL+"510
	IF(OP1EA.EQ.OP2EA) GOTO 7000
	OBJBUF(1)=OPSKEL+"610
	GOTO 7000
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS EXT AND SWAP INSTRUCTIONS
C	DN
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
1500	IF(OPIDX.EQ.28) GOTO 1510
	IF(IMODE.EQ.3 ) OPSKEL = OPSKEL.OR."100
1510	IF(OP1EA.NE.1) GOTO 8500
	OBJBUF(1)=OPSKEL+OP1DA
	GOTO 7000
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS LEA INSTRUCTION
C	<EA>,AN
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
1600	IF(OP1EA.EQ.0) GOTO 1610
	IF(OP1EA.EQ.3) GOTO 1620
	GOTO 8500
C
1610	CALL PROCOP(OPNPTR)
	OBJBUF(1) = OPSKEL.OR.OPNWRD(1).OR.OP2DA
	OBJBUF(2) = OPNWRD(2)
	IF (OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
	IF (OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
	OBJWC = OBJWC + OPNWC
	GOTO 7000
C
1620	OBJBUF(1) = OPSKEL.OR.OP2DA.OR.OP1DA
	OBJBUF(1) = OBJBUF(1).OR.((OP1EA-1)*"10)
	GOTO 7000
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS LINK INSTRUCTION
C	AN,#<DISPLACEMENT>
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
1700	IF(OP1EA.NE.2.AND.OP2EA.NE.6) GOTO 8500
	CALL PROCOP(OPNPT2)
	IF (OPNWRD(3).EQ.0) GOTO 1710
	IF (OPNWRD(3).EQ.-1)GOTO 1710
	GOTO 8500
C
1710	OBJWC=2
	OBJBUF(1)=OPSKEL+OP1DA
	OBJBUF(2)=OPNWRD(2)
	GOTO 7000
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS TRAP INSTRUCTION
C	#<VECTOR>
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
1800	IF(OP1EA.NE.6) GOTO 8500
	CALL PROCOP(OPNPTR)
	IF(OPNWC.NE.1) GOTO 8500
	IF(OPNWRD(2).GT.16) GOTO 8500
	OBJBUF(1)=OPSKEL+OPNWRD(2)
	GOTO 7000
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS ABCD,SBCD,ADDX,SUBX INSTRUCTIONS
C	DY,DX  -(AY),-(AX)
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
1900	IF(OP1EA.EQ.1.AND.OP2EA.EQ.1) GOTO 1910
	IF(OP1EA.NE.5.OR.OP2EA.NE.5) GOTO 8500
1910	IF(OP1EA.EQ.5) OPSKEL=OPSKEL+8
	OPSKEL=OPSKEL+OP2DA
	OBJBUF(1)=OPSKEL+(OP1DA*"1000)
	GOTO 7000
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS UNLK INSTRUCTION
C	AN
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
2000	IF(OP1EA.NE.2) GOTO 8500
	OBJBUF(1)=OPSKEL+OP1DA
	GOTO 7000
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS MOVEM,STM,LDM INSTRUCTIONS
C
D	STM <RLIST>,<ADR>  LDM <ADR>,<RLIST>
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
2100	IF(IMODE.EQ.1) GOTO 8500
	IF(IMODE.EQ.3) OPSKEL = OPSKEL.OR."100
C
C....	TRY PICKING UP A REGISTER OPERAND
C
	OP = OPNPTR
2110	CALL RLSTDC(OP,DLIST,ALIST)
	IF ((DLIST.EQ.0).AND.(ALIST.EQ.0)) GOTO 2150
C
C....	CHECK IF DESTINATION EA IS LEGAL FOR A STM INSTRUCTION
C....	-(AN) AND CTL ALTERABLE ADR MODES ARE LEGAL
C
	IF ((OP2EA.EQ.3).OR.(OP2EA.EQ.5)) GOTO 2112
	IF (OP2EA.EQ.0) GOTO 2112
	GOTO 8500
C
C....	REFORMAT DATA AND ADR BITMAPS FOR STM INSTRUCTION
C
2112	IF (OP2EA.NE.5) GOTO 2116
C
C....	-(AN) REQUIRES REGISTERS TO BE BACKWARDS IN THE BITMAP
C
	DLSTI = 0
	ALSTI = 0
	DO 2113,I=0,7
2113	IF((DLIST.AND.(2**I)).NE.0) DLSTI = (DLSTI.OR.(2**(7-I)))
C
	DO 2114,I=0,7
2114	IF((ALIST.AND.(2**I)).NE.0) ALSTI = (ALSTI.OR.(2**(7-I)))
C
	ALIST = DLSTI
	DLIST = ALSTI
C
C....	BUILD BITMAP
C
2116	CALL BLDMAP(DLIST,ALIST,OBJBUF(2))
C
C....	PROCESS DESTINATION OPERAND
C
	IF (OP2EA.EQ.0) GOTO 2118
C
C....	SIMPLE DESTINATION OPERAND
C
	OBJWC = 2
	OBJBUF(1) = OPSKEL.OR.OP2DA.OR.((OP2EA-1)*"10)
	GOTO 7000
C
C....	PROCESS COMPLEX DESTINATION OPERAND
C
2118	CALL PROCOP(OPNPT2)
	OBJBUF(1) = OPSKEL .OR. OPNWRD(1)
	OBJBUF(3) = OPNWRD(2)
	IF (OPNWC.EQ.2) OBJBUF(3) = OPNWRD(3)
	IF (OPNWC.EQ.2) OBJBUF(4) = OPNWRD(2)
	OBJWC = OBJWC + OPNWC
	GOTO 7000
C
C
C....	PROCESS LDM INSTRUCTION
C
C
2150	OPSKEL = OPSKEL.OR."2000
C
C....	CHECK IF DESTINATION IS LEGAL FOR LDM INSTRUCTION
C....	(AN)+ AND CTL ADR MODES ARE LEGAL
C
	IF ((OP2EA.EQ.3).OR.(OP2EA.EQ.4)) GOTO 2152
	IF (OP2EA.EQ.0) GOTO 2152
	GOTO 8500
C
C....	PROCESS SOURCE OPERAND
C
2152	IF(OP1EA.EQ.0) GOTO 2155
	OBJBUF(1) = OPSKEL.OR.OP1DA.OR.((OP1EA-1)*"10)
	GOTO 2160
C
2155	CALL PROCOP(OPNPTR)
	OBJBUF(1) = OPSKEL .OR. OPNWRD(1)
	OBJBUF(2) = OPNWRD(2)
	IF (OPNWC.EQ.2) OBJBUF(2) = OPNWRD(3)
	IF (OPNWC.EQ.2) OBJBUF(3) = OPNWRD(2)
	OBJWC = OBJWC + OPNWC
C
C....	PROCESS REGISTER LIST
C
2160	OP = OPNPT2
	CALL RLSTDC(OP,DLIST,ALIST)
	IF ((DLIST.EQ.0).AND.(ALIST.EQ.0)) GOTO 8500	! NO REGISTER LIST!
C
C....	REFORMAT DATA AND ADR BITMAPS FOR LDM INSTRUCTION
C
	CALL BLDMAP(DLIST,ALIST,OBJBUF(OBJWC+1))
	OBJWC = OBJWC + 1
	GOTO 7000
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	HANDLE 'NORMAL' SIZE FIELD SPECIFICATIONS
C	USING INFORMATION FROM VARIABLE 'IMODE'
C
C	SIZE FIELD NORMALLY IS IN BITS 6 AND 7 OF
C	INSTRUCTION WITH THE FOLLOWING DEFINITION
C
C	      00 = .B  01 = .W  10 = .L
C
C	INSTRUCTIONS WITH IMODE = 0 DEFAULT TO
C	A SIZE OF 'WORD'
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
6000	IF(IMODE.EQ.1) GOTO 7000
	IF(IMODE.EQ.3) OBJBUF(1) = OBJBUF(1).OR."200
	IF((IMODE.EQ.2).OR.(IMODE.EQ.0)) OBJBUF(1)=OBJBUF(1).OR."100
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
C	PROCESS LABEL FIELD
C	CURRENT PC VAL IS STORED AS SYMBOL VAL
C
C ++++++++++++++++++++++++++++++++++++++++++++++++++
C
7000	CALL I4CLR(SYMVAL)
	I=JADD(SYMVAL,PC,SYMVAL)
	OBJWC=OBJWC*2
	I=JICVT(OBJWC,NEWPC)
	OBJWC=OBJWC/2
7005	IF(LABEL(1).EQ.0) RETURN
	CALL SYMTBL(2,SYMVAL,LABEL)
	IF((SYMFLG(STIND).AND."10).EQ."10) CALL ERROR(409)
	RETURN
C
C	ERROR DETECTED
C
8500	PRFLG = 0
C
C	IF AN ERROR IS DETECTED, ZERO OBJ BUFFER
C
	DO 8510 I=1,OBJWC
8510	OBJBUF(I) = 0
	IF(PASS.EQ.2) CALL ERROR(406)
	GOTO 7000
	END
	SUBROUTINE RLSTDC(OP,DLIST,ALIST)
	IMPLICIT INTEGER (A-Z)
C
C	THIS SUBROUTINE WILL ATTEMPT TO PROCESS A REGISTER
C	LIST IN THE SOURCE LINE POINTED TO BY 'OP' INTO
C	A PAIR OF WORDS WHICH CAN BE CONVERTED INTO A REGISTER
C	BITMAP FOR THE 'MOVEM' INSTRUCTION
C
	COMMON /SRC   / LNELEN,ISERR,NOCARD,SRCLNE
	LOGICAL*1 SRCLNE(81)
C
C...	INITIALIZE DEFAULT OUTPUT VALUES
C
	DLIST = 0
	ALIST = 0
C
C...	TRY TO FIND A REGISTER TO DECODE
C
10	CALL RDECOD(OP,REGTYP,REGNUM)
	IF (REGTYP.NE.0) GOTO 20
	IF (GRPFLG.EQ.1) GOTO 999
C
C...	A REGISTER WASN'T DETECTED, AND NONE
C...	WAS NECESSARY (REG GROUPS), SO JUST RETURN
C
	RETURN
C
C...	CHECK FOR '/'
C
20	IF(SRCLNE(OP).NE."57) GOTO 300
C
C...	'/' DETECTED
C
30	IF(GRPFLG.EQ.0) GOTO 200		! NOT REGISTER GROUP
	IF(STREG.GE.REGNUM) GOTO 999		! R7-R0 IS ILLEGAL
	IF(STREGT.NE.REGTYP) GOTO 999		! A0-D0 IS ILLEGAL
C
C...	SET BITS IN REGISTER LIST BITMAP
C
	IF (REGTYP.EQ.2) GOTO 100
	DO 50,I=STREG,REGNUM
50	DLIST = (DLIST.OR.(2**I))
	GOTO 150
100	DO 120,I=STREG,REGNUM
120	ALIST = (ALIST.OR.(2**I))
150	STREG = 0
	REGNUM= 0
	GRPFLG= 0
	OP = OP+1
	GOTO 10
C
C...	ADD AN INDIVIDUAL REGISTER TO LIST
C
200	IF(REGTYP.EQ.1) DLIST = DLIST.OR.(2**REGNUM)
	IF(REGTYP.EQ.2) ALIST = ALIST.OR.(2**REGNUM)
	OP = OP+1
	GOTO 10
C
C....	CHECK FOR '-' OR END OF REGISTER LIST
C
300	IF(SRCLNE(OP).NE."55) GOTO 30
C
C....	'-' DETECTED, SET UP FOR REG GROUP
C
	STREG = REGNUM
	STREGT= REGTYP
	GRPFLG= 1
	OP = OP+1
	GOTO 10
C
C....	ERROR PROCESSING
C
999	DLIST = 0
	ALIST = 0
	RETURN
	END

	SUBROUTINE RDECOD(OP,REGTYP,REGNUM)
	IMPLICIT INTEGER (A-Z)
C
C	THIS SUBROUTINE RETURNS THE REGISTER TYPE AND NUMBER
C	IF THE NEXT TWO CHARS IN A SOURCE LINE SPECIFY REGISTERS
C
C       REGTYP = 0  NEXT TWO CHRS DON'T SPECIFY A REGISTER
C                1  DATA REGISTER
C                2  ADDRESS REGISTER
C
C       REGNUM =    REGISTER NUMBER (0-7)
C
C       OP     =    OP + 2 UNLESS A REGISTER WASN'T FOUND
C
C
	COMMON /SRC   / LNELEN,ISERR,NOCARD,SRCLNE
	LOGICAL*1 SRCLNE(81)
C
	REGTYP = 0
	IF (SRCLNE(OP).EQ."101) REGTYP = 2
	IF (SRCLNE(OP).EQ."104) REGTYP = 1
	IF (REGTYP.EQ.0) RETURN
	OP = OP+1
	IF ((SRCLNE(OP).LT."60).OR.(SRCLNE(OP).GT."67)) RETURN
	REGNUM = (SRCLNE(OP).AND."7)
	OP = OP+1
	RETURN
	END
	SUBROUTINE PROCOP(OP)
C
C	EVALUATE COMPLEX EFFECTIVE ADDRESSES
C
C
C	OUTPUT WORDS:
C
C	OPNFLG  0 IF OPERAND CAN BE USED IN 'QUICK' INSTRUCTIONS
C               1 IF OPERAND CONTAINED A FWD REF SYMBOL
C
C       OPNWC   NUMBER OF BYTES GENERATED (6 MAX)
C
C       OPNWRD  OPERAND WORDS GENERATED
C               FIRST WORD - ADR TYPE
C               NEXT  WORD - OPN DATA <LOW  WORD>
C               NEXT  WORD - OPN DATA <HIGH WORD>
C
	IMPLICIT INTEGER (A-Z)
C
	COMMON /SYMT  / STIND,SYMADR,PC,NOSYM,NEWPC,SYMFLG
C
	COMMON /OPWD  / OPNFLG,OPNWC,OPNWRD
C
	COMMON /OBJOUT/ OBJBUF,OBJWC,LFLG,RFLG,BRFLG
C
	COMMON /LST   / LUNIT,PASS,NAME,NOPAGE,NOLINE,MEFLG,IERCNT
C
	COMMON /PRSE  / OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
     +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
C
	COMMON /SRC   / LNELEN,ISERR,NOCARD,SRCLNE
C
	COMMON /SYMN  /	SYMSYM,SYMLIN
	DIMENSION OBJBUF(40),OPNWRD(3),SYMLIN(512),SYMSYM(4,512)
	LOGICAL*1 TMPSYM(8),SYMFLG(513),NAME(8),SRCLNE(81),LABEL(8)
	INTEGER*4 SYMVAL,TMPVAL,SYMADR(512),J2,J4,J10
	INTEGER*4 PC,NEWPC,J0
C
C....	INITIALIZE I*4 CONSTANTS
C
	J0  = 0
	J2  = 2
	J4  = 4
	J10 = 10
	J256 = 256
C
C....	ZERO OPERAND RESULT BUFFER
C
	DO 10,I=1,3
10	OPNWRD(I) = 0
C
C....	SET PARSE POINTER TO START OF OPN FOR ERROR PROCESSOR
C
	SCANPT = OP
C
C....	DEFAULT IS NON-IMMEDIATE MODE
C....	WITH SUB-OPNS ADDED TO ORIG OPN
C
	IMD   = 0
	AMD   = 1
	OPNWC = 0
	OPNFLG= 0
	STIND = 0
	OPNFLG = 0
	CALL I4CLR(SYMVAL)
	CALL I4CLR(TMPVAL)
C
C....	CHECK FOR '#' <IMMEDIATE MODE>
C
20	IF(SRCLNE(OP).NE."43) GOTO 30
	IMD=1
25	OP=OP+1
	CALL I4CLR(TMPVAL)
C
C....	CHECK FOR ASCII LITERAL '
C
30	IF (SRCLNE(OP).NE."47) GOTO 35
	IMD = 1
	OP = OP+1
	NOCHRS = 0
	CALL I4CLR(TMPVAL)
31	IF (SRCLNE(OP).EQ."47) GOTO 32
	I=JMUL(J256,TMPVAL,TMPVAL)
	NVAL = SRCLNE(OP)
	I=JICVT(NVAL,JADN)
	I=JADD(TMPVAL,JADN,TMPVAL)
	OP = OP+1
	NOCHRS = NOCHRS+1
	IF (NOCHRS.LT.5) GOTO 31
32	IF (SRCLNE(OP).EQ."47) OP = OP+1
C
C....	CHECK FOR '*' <PC>
C
35	IF(SRCLNE(OP).NE."52) GOTO 60
	IF(AMD.NE.1) GOTO 40
	I=JADD(SYMVAL,PC,SYMVAL)
	GOTO 25
40	IF(AMD.NE.2) GOTO 9000
	I=JSUB(SYMVAL,PC,SYMVAL)
	GOTO 25
C
C....	CHECK FOR '$' <HEXADECIMAL>
C
60	IF(SRCLNE(OP).NE."44) GOTO 80
C
C....	HEXADECIMAL LITERAL
C
65	OP=OP+1
	IF(SRCLNE(OP).GE."60.AND.SRCLNE(OP).LE."71) GOTO 70
	IF(SRCLNE(OP).GE."101.AND.SRCLNE(OP).LE."106) GOTO 75
	GOTO 200
70	NVAL=SRCLNE(OP)-"60
	GOTO 78
75	NVAL=SRCLNE(OP)-"67
78	I=JLSHF(TMPVAL,J4,TMPVAL)
	I=JICVT(NVAL,JADN)
	I=JOR(TMPVAL,JADN,TMPVAL)
	GOTO 65

C
C....	CHECK FOR 0-9 <DECIMAL>
C
80	IF(SRCLNE(OP).LT."60.OR.SRCLNE(OP).GT."71) GOTO 100
C
C....	DECIMAL LITERAL
C
85	NVAL=(SRCLNE(OP)-"60)
	I=JMUL(J10,TMPVAL,TMPVAL)
	I=JICVT(NVAL,JADN)
	I=JADD(TMPVAL,JADN,TMPVAL)
	OP=OP+1
	IF(SRCLNE(OP).GE."60.AND.SRCLNE(OP).LE."71) GOTO 85
	GOTO 200

C
C....	CHECK FOR A-Z <SYMBOLIC>
C
100	IF(SRCLNE(OP).LT."101.OR.SRCLNE(OP).GT."132) GOTO 200
	N=1
	DO 110 OP=OP,OP+7
	IF(SRCLNE(OP).GE."60.AND.SRCLNE(OP).LE."71) GOTO 105
	IF(SRCLNE(OP).LT."101.OR.SRCLNE(OP).GT."132) GOTO 120
105	TMPSYM(N)=SRCLNE(OP)
110	N=N+1
115	IF(SRCLNE(OP).LT."60) GOTO 120
	IF(SRCLNE(OP).GT."71.AND.SRCLNE(OP).LT."101) GOTO 120
	IF(SRCLNE(OP).GT."132) GOTO 120
	OP=OP+1
	GOTO 115
C
C....	FILL EXTRA CHRS WITH SPACES
C
120	IF(N.GT.8) GOTO 125
	TMPSYM(N) = "40
	N=N+1
	GOTO 120

C
C....	SEARCH SYMBOL TBL
C
125	I=1
	CALL SYMTBL(I,0,TMPSYM)
C
C....	IF SYMLIN LESS THAN CURRENT LINE AND NOT 0
C....	THEN SYMBOL IS DEFINED AND IS NOT A FWD REF
C
	IF((SYMLIN(STIND).LT.NOCARD).AND.(SYMLIN(STIND).NE.0)) GOTO 130
C
C....	CHECK FOR UNDEFINED SYMBOL
C
	IF(SYMLIN(STIND).EQ.0     ) GOTO 150	! SYMBOL UNDEFINED
C
C....	WE GET TO HERE IF THE SYMBOL IS DEFINED
C....	BUT WASNT AS OF THIS LINE IN THE ASSEMBLY DURING PASS ONE
C
	OPNFLG = 1				! SYMBOL WAS FWD REF
C
C....	LABEL HAS BEEN DEFINED
C....	GET VALUE OF LABEL AND PUT IN TMPVAL
C
130	CALL I4CLR(TMPVAL)
	I=JADD(TMPVAL,SYMADR(STIND),TMPVAL)
	GOTO 200
C
C....	GO HERE ON UNDEFINED FIRST AND SECOND PASS SYMBOLS
C
150	IF (PASS.EQ.2) CALL ERROR(407)		! UNDEFINED SYMBOL !!
C
C	IF THIS IS THE FIRST PASS, THEN THE LENGTH
C	OF ALL OPERANDS OTHER THAN IMMEDIATE BYTE AND WORD
C	ARE FORCED TO TWO WORDS
C
	OPNFLG = 1
	IF((IMD.EQ.1).AND.(IMODE.NE.3)) GOTO 160
	OPNWC = 2
	RETURN
160	OPNWC = 1
	RETURN
C
C....	PROCESS +,-,*,/,&,!,<<,>>
C
200	IF(AMD.EQ.1)  I=JADD(SYMVAL,TMPVAL,SYMVAL)
	IF(AMD.EQ.2)  I=JSUB(SYMVAL,TMPVAL,SYMVAL)
	IF(AMD.EQ.3)  I=JMUL(SYMVAL,TMPVAL,SYMVAL)
	IF(AMD.EQ.4)  GOTO 205
	IF(AMD.EQ.5)  I=JAND(SYMVAL,TMPVAL,SYMVAL)
	IF(AMD.EQ.6)  I=JOR (SYMVAL,TMPVAL,SYMVAL)
	IF(AMD.EQ.7)  I=JLSHF(SYMVAL,TMPVAL,SYMVAL)
	IF(AMD.EQ.8)  I=JRSHF(SYMVAL,TMPVAL,SYMVAL)
	GOTO 210
C
C....	DIVIDING BY ZERO IS BAD NEWS
C
205	IF(TMPVAL.EQ.0) GOTO 9000
	I=JDIV(SYMVAL,TMPVAL,SYMVAL)
210	AMD=1
C
C....	CHECK FOR +,-,*,/
C
	IF(SRCLNE(OP).NE."53) GOTO 220
	AMD=1
	GOTO 25
C
220	IF(SRCLNE(OP).NE."55) GOTO 230
	AMD=2
	GOTO 25
C
230	IF(SRCLNE(OP).NE."52) GOTO 240
	AMD=3
	GOTO 25
C
240	IF(SRCLNE(OP).NE."57) GOTO 245
	AMD=4
	GOTO 25
C
245	IF(SRCLNE(OP).NE."46) GOTO 246
	AMD = 5
	GOTO 25
C
246	IF(SRCLNE(OP).NE."41) GOTO 247
	AMD = 6
	GOTO 25
C
247	IF(SRCLNE(OP).NE."74) GOTO 248
	IF(SRCLNE(OP+1).NE."74) GOTO 9000
	OP = OP+1
	AMD = 7
	GOTO 25
C
248	IF(SRCLNE(OP).NE."76) GOTO 249
	IF(SRCLNE(OP+1).NE."76) GOTO 9000
	OP = OP+1
	AMD = 8
	GOTO 25
C
249	IF(SRCLNE(OP).NE."50) GOTO 300
	IF(IMD.EQ.1) GOTO 9000
	IF(SRCLNE(OP+3).NE."51) GOTO 250
C
C....	A(An)
C
	IF(SRCLNE(OP+1).NE."101) GOTO 9000
	IF(SRCLNE(OP+2).LT."60.OR.SRCLNE(OP+2).GT."67) GOTO 9000
	OPNWC=1
	OPNWRD(1)=(SRCLNE(OP+2)-"60)+"50
	CALL DBLSGL(SYMVAL,OPNWRD(2),OPNWRD(3))
	RETURN
C
C....	A(An,Rn.m)
C
250	CALL DBLSGL(SYMVAL,OPNWRD(2),OPNWRD(3))
	I = ICKVAL(OPNWRD(2))
	IF (I.EQ.0) GOTO 252
	CALL ERROR(408)
	RETURN
C
C....	INDEX OK..DO THE REST
C
252	OPNWC=1
	IF(SRCLNE(OP+1).NE."101)GOTO 9000
	IF(SRCLNE(OP+2).LT."60.OR.SRCLNE(OP+2).GT."67) GOTO 9000
	OPNWRD(1)=(SRCLNE(OP+2)-"60)+"60
C
C....	CHECK FOR DATA OR ADR REG
C
	IF(SRCLNE(OP+4).EQ."101.OR.SRCLNE(OP+4).EQ."104) GOTO 255
	GOTO 9000
255	IF(SRCLNE(OP+4).EQ."101) OPNWRD(2)=OPNWRD(2)+"100000
	IF(SRCLNE(OP+5).LT."60.OR.SRCLNE(OP+5).GT."67) GOTO 9000
	OPNWRD(2)=OPNWRD(2)+((SRCLNE(OP+5)-"60)*"10000)
	IF(SRCLNE(OP+7).EQ."114) OPNWRD(2)=OPNWRD(2)+"4000
	RETURN
C
C....	CHECK FOR END OF OPERAND
C
300	IF(SRCLNE(OP).EQ.0.OR.SRCLNE(OP).EQ."40) GOTO 350
	IF(SRCLNE(OP).NE."54) GOTO 25
C
C....	IF BRANCH INSTRUCTION PROC VAL AS PC REL OFFSET
C
350	IF(BRFLG.EQ.1) GOTO 355
C
C....	PROCESS VAL AS PC REL UNLESS ITS ABS OR IMMEDIATE
C
	IF(RFLG.NE.0.OR.IMD.EQ.1) GOTO 400
C
C....	IF OPERAND CONTAINED AN EQUATED SYMBOL PROC VAL AS IMMEDIATE
C
	IF((SYMFLG(STIND).AND."20).EQ."20) GOTO 400
C
C....	GENERATE PC RELATIVE OFFSET
C
355	OPNWRD(1)="72
	I=JSUB(SYMVAL,J2,SYMVAL)
	I=JSUB(SYMVAL,PC,OPNWRD(2))
	OPNWC=1
	RETURN
C
C....	PROCESS IMMEDIATE DATA
C
400	CALL DBLSGL(SYMVAL,OPNWRD(2),OPNWRD(3))
	IF(IMD.NE.1) GOTO 450
405	OPNWC = 1
	IF(IMODE.EQ.3) OPNWC=2
	OPNWRD(1)="74
	RETURN
C
410	OPNWC=2
	OPNWRD(1)="74
	RETURN
C
C....	PROCESS ABSOLUTE ADR
C....	GENERATE LONG ADR FORM IF INSTR MODE LONG
C
450	IF(OPNFLG.EQ.1) GOTO 460
	IF(OPNWRD(3).NE.0) GOTO 460
	IF(OPNWRD(3).LT.0) GOTO 460
	OPNWC=1
	OPNWRD(1)="70
	RETURN
C
460	OPNWC=2
	OPNWRD(1)="71
	RETURN

C
C....	FATAL ERROR DETECTED
C
9000	OPNWC=7
C
C....	MARK POSITION WHERE ERROR OCCURED
C
	SCANPT = OP
	RETURN
	END

	SUBROUTINE DBLSGL(IN,OUT1,OUT2)
C
C	CONVERT INTEGER*4 TO TWO INTEGER*2 NUMBERS
C
	IMPLICIT INTEGER (A-Z)
	DIMENSION IN(2)
	OUT1=IN(1)
	OUT2=IN(2)
	RETURN
	END

	SUBROUTINE EATYP(TYP,REG)
C
C	DETERMINE GENERAL TYPE OF OPERAND
C IN:
C	TYP	= POINTER TO START OF OPERAND
C
C OUT:
C TYP	0	= NOT REGISTER OR IMMEDIATE EA
C	1	= Dn
C	2	= An
C	3	= (An)
C	4	= (An)+
C	5	=-(An)
C	6	=#DATA
C	7	= SR
C	8	= CCR
C	9	= USP
C	10	= ERROR DETECTED
C
C REG	REG#	0-7
C
	IMPLICIT INTEGER (A-Z)
	COMMON/PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
     +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
	COMMON/SRC/ LNELEN,ISERR,NOCARD,SRCLNE
	BYTE SRCLNE(81),LABEL(8)
	OP=TYP
100	TYP=0
	IF(SRCLNE(OP).EQ."43)GOTO 700
	IF(SRCLNE(OP).EQ."50)GOTO 500
	IF(SRCLNE(OP).EQ."55.AND.SRCLNE(OP+1).EQ."50)GOTO 400
	IF(SRCLNE(OP).EQ."104.OR.SRCLNE(OP).EQ."101) GOTO 300
210	IF(SRCLNE(OP).EQ."123.AND.SRCLNE(OP+1).EQ."122)GOTO 800
220	IF(SRCLNE(OP).EQ."103.AND.SRCLNE(OP+1).EQ."103)GOTO 900
	IF(SRCLNE(OP).EQ."125.AND.SRCLNE(OP+1).EQ."123)GOTO 1000
240	RETURN
300	IF(SRCLNE(OP+1).LT."60.AND.SRCLNE(OP+1).GT."67) RETURN
	IF(SRCLNE(OP).EQ."101)GOTO 310
	TYP=1
	REG=(SRCLNE(OP+1)-"60)
	GOTO 1085
310	TYP=2
	REG=(SRCLNE(OP+1)-"60)
	GOTO 1085
400	IF(SRCLNE(OP+2).EQ."101.AND.(SRCLNE(OP+3).GE."60.AND.
     +SRCLNE(OP+3).LE."67).AND.SRCLNE(OP+4).EQ."51)GOTO 410
	RETURN
410	TYP=5
	REG=(SRCLNE(OP+3)-"60)
	GOTO 1070
500	IF(SRCLNE(OP+1).EQ."101.AND.(SRCLNE(OP+2).GE."60.AND.
     +SRCLNE(OP+2).LE."67).AND.SRCLNE(OP+3).EQ."51)GOTO 510
	RETURN
510	IF(SRCLNE(OP+4).EQ."53)GOTO 530
	TYP=3
	REG=(SRCLNE(OP+2)-"60)
	GOTO 1075
530	TYP=4
	REG=(SRCLNE(OP+2)-"60)
	GOTO 1070
700	TYP=6
	RETURN
800	TYP=7
	GOTO 1085
900	IF(SRCLNE(OP+2).NE."122)GOTO 240
	TYP=8
	GOTO 1080
1000	IF(SRCLNE(OP+2).NE."120)GOTO 240
	TYP=9
	GOTO 1080
1070	IO=SRCLNE(OP+5)
	GOTO 1090
1075	IO=SRCLNE(OP+4)
	GOTO 1090
1080	IO=SRCLNE(OP+3)
	GOTO 1090
1085	IO=SRCLNE(OP+2)
1090	IF(IO.EQ.0.OR.IO.EQ."40.OR.IO.EQ."54) RETURN
	IF(TYP.LE.5.AND.TYP.GE.3) GOTO 1110
1100	TYP=0
	RETURN
1110	TYP=10
	RETURN
	END

	SUBROUTINE DECOPC
C
C	LOOKUP OPCODE
C
C	INPUT:OPCODE STARTS AT SRCLNE(OPPTR)
C
	IMPLICIT INTEGER (A-Z)
C
	BYTE LABEL(8),SRCLNE(81),PSUOP3(15),PSUOP4(12)
	BYTE PSUOP5(5),OP4BIG(28),OP4PTY(7),OP3BIG(33)
	BYTE OP3PTY(11),OP3NAM(144),OP3TYP(48),OP4NAM(120)
	BYTE OP4TYP(30),OP5NAM(15)
	DIMENSION OP4OPC(14),OP3OPC(22),OP2OPS(3),OP3OPS(48)
	DIMENSION OP4OPS(30),OP5OPS(3)

C
	COMMON/PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
     +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
C
	COMMON/SRC/ LNELEN,ISERR,NOCARD,SRCLNE
C
	COMMON/OPCPTS/ OPTYP,OPSKEL,OPSK2,OPIDX
C
	DATA PSUOP3/'O','R','G','E','N','D'
     +,'E','Q','U','N','A','M','S','E','T'/
C
	DATA PSUOP4/'R','O','R','G','P','A','G','E'
     +,'L','I','S','T'/
C
	DATA PSUOP5/'N','L','I','S','T'/
C
	DATA OP4BIG/'M','O','V','E','B','C','H','G','B','C','L','R',
     +'B','S','E','T','B','T','S','T','R','O','X','L','R','O','X','R'/
C
	DATA OP4OPC/0,0,"1100,"4100,"700,"4300,"600,"4200
     +,"400,"4000,"160420,"162700,"160020,"162300/
C
	DATA OP4PTY/3,10,10,10,10,8,8/
C
	DATA OP3BIG/'A','D','D','A','S','L','A','S','R','S','U','B'
     +,'A','N','D','C','M','P','E','O','R','L','S','L','L','S','R'
     +,'R','O','L','R','O','R'/
C
	DATA OP3OPC/"150000,"3000,"160400,"160700
     +,"160000,"160300,"110000,"2000
     +,"140000,"1000,"130000,"6000,"130400,"5000
     +,"160410,"161700,"160010,"161300
     +,"160430,"163700,"160030,"163300/
C
	DATA OP3PTY/4,8,8,4,6,5,7,8,8,8,8/
C
	DATA OP2OPS/"100000,"50700,"50300/
C
	DATA OP3NAM/
     +'B','E','Q', 'B','N','E', 'B','P','L', 'B','M','I', 'B','G','T',
     +'B','L','T', 'B','G','E', 'B','L','E', 'B','H','I', 'B','L','S',
     +'B','C','S', 'B','C','C', 'B','V','S', 'B','V','C', 'B','R','A',
     +'B','S','R', 'C','H','K', 'C','L','R', 'E','X','G', 'E','X','T',
     +'J','M','P', 'J','S','R', 'L','D','M', 'L','E','A', 'N','E','G',
     +'N','O','P', 'N','O','T', 'P','E','A', 'R','T','E', 'R','T','R',
     +'R','T','S', 'S','E','Q', 'S','N','E', 'S','P','L', 'S','M','I',
     +'S','G','T', 'S','L','T', 'S','G','E', 'S','L','E', 'S','H','I',
     +'S','L','S', 'S','C','S', 'S','C','C', 'S','T','M', 'S','V','S',
     +'S','V','C', 'T','A','S', 'T','S','T'/
C
	DATA OP3OPS/"63400,"63000,"65000,"65400,"67000,"66400,
     +"66000,"67400,"61000,"61400,"62400,"62000,"64400,"64000,
     +"60000,"60400,"40600,"41000,"140000,
     +"44200,"47300,"47200,"46200,"40700,"42000,"47161,"43000,
     +"44100,"47163,"47167,"47165,"53700,"53300,"55300,"55700,
     +"57300,"56700,"56300,"57700,"51300,"51700,"52700,"52300,
     +"44200,"54700,"54300,"45300,"45000/
C
	DATA OP3TYP/9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,9,11,12
     +,14,15,12,12,21,16,12,2,12,12,2,2,2,12,12,12,12,12,12
     +,12,12,12,12,12,12,21,12,12,12,12/
C
	DATA OP4NAM/'A','B','C','D','A','D','D','X','D','B','R','A', 
     +'D','B','H','I','D','B','L','S','D','B','C','C','D','B','C','S',
     +'D','B','N','E','D','B','E','Q','D','B','V','C','D','B','V','S',
     +'D','B','P','L','D','B','M','I','D','B','G','E','D','B','L','T',
     +'D','B','G','T','D','B','L','E','D','I','V','S','D','I','V','U',
     +'L','I','N','K','M','U','L','S','M','U','L','U','N','B','C','D',
     +'N','E','G','X','S','B','C','D','S','T','O','P','S','U','B','X',
     +'S','W','A','P','T','R','A','P','U','N','L','K'/
C
	DATA OP4OPS/"140400,"150400,"50710,"51310,"51710,"52310
     +,"52710,"53310,"53710,"54310,"54710,"55310,"55710,"56310
     +,"56710,"57310,"57710,"100700,"100300,"47120,"140700
     +,"140300,"44000,"40000,"100400,"47162,"110400
     +,"44100,"47100,"47130/
C
	DATA OP4TYP/19,19,13,13,13,13,13,13,13,13,
     +13,13,13,13,13,13,13,11,11,17,11,11,12,12,19,2,19
     +,15,18,20/
C
	DATA OP5NAM/'M','O','V','E','M','R','E','S','E','T',
     +'T','R','A','P','V'/
C
	DATA OP5OPS/"44200,"47160,"47166/
C
C 	START OF OPCODE PROCESSING
C
	OPTYP=0
	OPSKEL=0
	SCANPT = OPPTR
	IF(OPCLEN.LE.1.OR.OPCLEN.GT.5) RETURN
C
C....	PROCESS OPCODE BY SIZE
C
	GOTO (1000,2000,3000,4000),OPCLEN-1
C
C....	TWO CHR OPCODES
C
1000	IF(SRCLNE(OPPTR).EQ."104.OR.SRCLNE(OPPTR).EQ."117)GOTO 1010
	RETURN
1010	IF(SRCLNE(OPPTR).EQ."117.AND.SRCLNE(OPPTR+1).EQ."122)GOTO 1020
	IF(SRCLNE(OPPTR+1).EQ."103)GOTO 1030
	IF(SRCLNE(OPPTR+1).EQ."123)GOTO 1040
	RETURN
1020	OPTYP=6
	OPIDX=0
	OPSKEL="100000
	OPSK2=0
	RETURN	
1030	OPTYP=1
	OPIDX=1
	OPSKEL=0
	OPSK2=0
	RETURN
1040	OPTYP=1
	OPIDX=2
	OPSKEL=0
	OPSK2=0
	RETURN
C
C....	THREE CHR OPCODES
C
2000	CALL OPLOOK(5,3,PSUOP3,OP3TYP,0)
	IF(OPTYP.NE.1) GOTO 2010
	OPIDX=OPIDX+2
	OPSKEL=0
	OPSK2=0
	RETURN
2010	CALL OPLOOK(11,3,OP3BIG,OP3PTY,1)
	IF(OPTYP.EQ.0) GOTO 2020
	OPSKEL=OP3OPC((OPIDX*2)-1)
	OPSK2=OP3OPC(OPIDX*2)
	RETURN
2020	CALL OPLOOK(48,3,OP3NAM,OP3TYP,1)
	OPSKEL=OP3OPS(OPIDX)
	OPSK2=0
	RETURN
C
C....	FOUR CHAR OPCODES
C
3000	CALL OPLOOK(3,4,PSUOP4,OP3NAM,0)
	IF(OPTYP.NE.1) GOTO 3010
	OPIDX=OPIDX+7
	OPSKEL=0
	OPSK2=0
	RETURN
3010	CALL OPLOOK(7,4,OP4BIG,OP4PTY,1)
	IF(OPTYP.EQ.O) GOTO 3020
	OPSKEL=OP4OPC((OPIDX*2)-1)
	OPSK2=OP4OPC(OPIDX*2)
	RETURN
3020	CALL OPLOOK(30,4,OP4NAM,OP4TYP,1)
	IF(OPTYP.EQ.0)  RETURN
	OPSKEL=OP4OPS(OPIDX)
	OPSK2=0
	RETURN
C
C....	FIVE CHAR OPCODES
C
4000	CALL OPLOOK(1,5,PSUOP5,OP3TYP,0)
	IF(OPTYP.NE.1) GOTO 4010
	OPIDX=11
	OPSKEL=0
	OPSK2=0
	RETURN
4010	CALL OPLOOK(3,5,OP5NAM,OP5OPS,1)
	IF(OPTYP.EQ.0) RETURN
	IF(OPIDX.NE.1) GOTO 4012
	OPTYP=21
	GOTO 4014
4012	OPTYP=2
4014	OPSKEL=OP5OPS(OPIDX)
	OPSK2=0
	RETURN
	END

	SUBROUTINE OPLOOK(ISIZ,ISTEP,ITBL,ITYP,IPSF)
C
C....	LOOK UP OPCODE IN TABLES
C
	IMPLICIT INTEGER (A-Z)
C
	BYTE LABEL(8)
C
	COMMON/PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
     +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
C
	COMMON /OPCPTS/ OPTYP,OPSKEL,OPSK2,OPIDX
C
	COMMON /SRC/ LNELEN,ISERR,NOCARD,SRCLNE
C
	BYTE SRCLNE(81),ITBL(1),ITYP(1)
C
	IDX=ISIZ * ISTEP
	K=1
	I=1
5	DO 20 IS=1,ISTEP
	IF(SRCLNE(OPPTR+(IS-1)).NE.ITBL(I+(IS-1))) GOTO 10
20	CONTINUE
	OPIDX=K
	IF(IPSF.EQ.0) GOTO 30
	OPTYP=ITYP(K)
	RETURN
10	I=I+ISTEP
	K=K+1
	IF(I.GE.IDX) RETURN
	GOTO 5
30	OPTYP=1
	RETURN
	END

	SUBROUTINE PARSE
C
C	PARSE INCOMING SOURCE LINE
C
C IN:
C	SRCLNE	= LINE TO BE PARSED
C	LNELEN	= LENGTH OF SOURCE LINE
C OUT:
C	LABEL	= LABEL FIELD (LABEL(0)=0 IF NO LABEL)
C	OPPTR	= POINTER TO OPCODE FIELD
C	OPCLEN	= LENGTH  OF OPCODE FIELD NOT INCLUDING MODE
C	MODPTR	= POINTER TO MODE FIELD
C	IMODE	= 0 NO MODE FIELD
C		= 1 .B
C		= 2 .W
C		= 3 .L
C		= 4 .S
C	OPNPTR	= POINTER TO FIRST OPERAND
C	OPNPT2	= POINTER TO SECND OPERAND
C	CMTPTR	= POINTER TO COMMENT FIELD
C	PRFLG	= PARSE FLAG - ZERO IF ERROR DETECTED
C
	IMPLICIT INTEGER (A-Z)
	COMMON /SRC/ LNELEN,ISERR,NOCARD,SRCLNE
	COMMON/PRSE/ OPPTR,MODPTR,OPNPTR,LABEL,CMTPTR
     +,PRFLG,SCANPT,OPCLEN,OPNPT2,IMODE
	BYTE SRCLNE(81),IC,LABEL(8),MODTBL(4)
	DATA MODTBL/"102,"127,"114,"123/
	IPF   = 0
	IMODE = 0
	PRFLG = 1
	LABEL(1)=0
C
C	INITALIZE LABEL ARRAY TO ALL SPACES
C
	DO 10 I=2,8
	LABEL(I)=32
10	CONTINUE

	SCANPT = 1
	OPCLEN = 0
	OPPTR = 0
	OPNPTR = 0
	OPNPT2 = 0
	MODPTR = 0
	CMTPTR = 0
C
C	IF NULL LINE IGNORE IT
C
	IF(LNELEN.NE.1) GOTO 15
12	PRFLG=0
	RETURN
C
C	CHECK FOR A LINE OF COMMENTS
C
15	IF(SRCLNE(1).NE."52) GOTO 16
	CMTPTR=1
	RETURN
C
C	SEE IF LABEL PRESENT
C
16	IF(SRCLNE(SCANPT).EQ."40) GOTO 60
C
C	LABELS HAVE TO START WITH A-Z
C
	IF(SRCLNE(1).GE."101.AND.SRCLNE(1).LE.90) GOTO 30
20	CALL ERROR(202)
	RETURN
C
30	DO 40 SCANPT=1,8
	IF (SRCLNE(SCANPT).GE.48.AND.SRCLNE(SCANPT).LE.57) GOTO 35
	IF(SRCLNE(SCANPT).LT.65.OR.SRCLNE(SCANPT).GT.90) GOTO 45
35	LABEL(SCANPT)=SRCLNE(SCANPT)
40	CONTINUE
45	IF(SCANPT.GE.4) GOTO 50
	IF(LABEL(1).EQ."101.OR.LABEL(1).EQ."104) GOTO 46
	IF(LABEL(1).EQ."123) GOTO 47
	IF(LABEL(1).EQ."103) GOTO 48
	IF(LABEL(1).NE."125) GOTO 50
	IF(LABEL(2).EQ."123.AND.LABEL(3).EQ."120) GOTO 49
	GOTO 50
C
46	IF(SCANPT.GT.3) GOTO 50
	IF(LABEL(2).GE."60.AND.LABEL(2).LE."67) GOTO 49
	GOTO 50
C
47	IF(LABEL(2).EQ."120.OR.LABEL(2).EQ."122) GOTO 49
	GOTO 50
C
48	IF(LABEL(2).EQ."103.AND.LABEL(3).EQ."122) GOTO 49
	GOTO 50
C
49	PRFLG=0
	CALL ERROR(204)
	RETURN
C
50	IF(SRCLNE(SCANPT).EQ."40.OR.SRCLNE(SCANPT).EQ."72) GOTO 60
	PRFLG=0
	CALL ERROR(205)
	RETURN
C
60	SCANPT=SCANPT+1
	PRFLG=1
62	IF(SRCLNE(SCANPT).NE."40) GOTO 70
	SCANPT=SCANPT+1
	GOTO 62
C
70	IF(SRCLNE(SCANPT).EQ.0) GOTO 12
	OPPTR=SCANPT
	DO 80 I=1,5
	IF(SRCLNE(SCANPT).LT.65.OR.SRCLNE(SCANPT).GT.90) GOTO 90
	SCANPT=SCANPT+1
80	CONTINUE
C
C....	LENGTH OF OPCODE IS ONE LESS THAN # SCANNED
90	OPCLEN=I-1
C
C....	CHECK FOR END OF LINE
	IF(SRCLNE(SCANPT).EQ.0) RETURN
C
C....	CHECK FOR SPACE
	IF(SRCLNE(SCANPT).EQ."40) GOTO 112
C
C....	CHECK FOR xxx.x
	IF(SRCLNE(SCANPT).EQ."56) GOTO 100
C
C....	IF NOT EOL,SPC,OR PERIOD GEN ERROR
95	OPPTR=0
	PRFLG=0
	CALL ERROR(207)
	RETURN
C
C....	CHECK FOR .B .W .L .S
C....	POINT TO SIZE SUBFIELD
100	SCANPT=SCANPT+1
C
C....	SCAN FOR VALID SIZE
	DO 102,IMODE = 1,4
102	IF(MODTBL(IMODE).EQ.SRCLNE(SCANPT))GOTO 105
C
C....	IF NOT IN TABLE IT'S INVALID
	IMODE = 0
	GOTO 95
C
C....	SAVE POSITION OF MODE FIELD
105	MODPTR=SCANPT
C
C....	CHECK FOR SPACE AFTER OPCODE
110	SCANPT=SCANPT+1
	IF(SRCLNE(SCANPT).NE."40) GOTO 95
C
C....	PARSE FIRST OPERAND IF THERE
112	SCANPT=SCANPT+1
	IC=SRCLNE(SCANPT)
	IF(IC.EQ. 0 ) RETURN
	IF(IC.EQ."40) GOTO 112
	IF(IC.EQ."44.OR.IC.EQ."52) GOTO 114
	IF ((IC.EQ."50).OR.(IC.EQ."47)) GOTO 114
	IF(IC.EQ."55.OR.IC.EQ."43) GOTO 114
	IF(IC.GE."60.AND.IC.LE."71) GOTO 114
	IF(IC.LT."101.OR.IC.GT."132) GOTO 95
C
C....	SAVE START OF FIRST OPERAND
C
114	OPNPTR=SCANPT
	IF ((SRCLNE(SCANPT).NE."47).AND.(SRCLNE(SCANPT+1).NE."47))
     +     GOTO 116
	IF (SRCLNE(SCANPT+1).EQ."47) SCANPT = SCANPT + 1
115	SCANPT = SCANPT+1
	IF(SRCLNE(SCANPT).EQ.0) GOTO 118
	IF(SRCLNE(SCANPT).NE."47) GOTO 115
116	SCANPT=SCANPT+1
	IC=SRCLNE(SCANPT)
	IF((IC.EQ.0).OR.(IC.EQ."40)) GOTO 118
	IF(IC.EQ."50) IPF=1
	IF(IC.EQ."51) IPF=0
	IF(IC.EQ."54.AND.IPF.EQ.0) GOTO 120
	GOTO 116
118	OPNPT2=0
	IF (IC.NE."40) RETURN
119	SCANPT = SCANPT+1
	IF (SRCLNE(SCANPT).EQ."40) GOTO 119
	CMTPTR = SCANPT
	RETURN
C
C....	SAVE START OF SECOND OPERAND
C
120	OPNPT2=SCANPT+1
125	SCANPT = SCANPT + 1
	IF (SRCLNE(SCANPT).EQ."40) GOTO 130
	IF (SRCLNE(SCANPT).EQ.0  ) RETURN
	IF (SRCLNE(SCANPT).NE."47) GOTO 125
127	SCANPT = SCANPT + 1
	IF (SRCLNE(SCANPT).EQ.0  ) RETURN
	IF (SRCLNE(SCANPT).NE."47) GOTO 127
	GOTO 125
130	SCANPT = SCANPT + 1
	IF (SRCLNE(SCANPT).EQ."40) GOTO 130
	CMTPTR = SCANPT
	RETURN
	END