	SUBROUTINE MACRPT
C
C	FOR FURTHER INFORMATION CONTACT:
C
C	ROBERT WATSON
C	CISCO, INC.
C	4135 S. 100 E. AVE.
C	TULSA OK 74145
C
	INTEGER*4	INST,		PC,		ADR
	INTEGER*4	NN,		IBEG,		IEND
	INTEGER*4	IENDS
	INTEGER*2	BLK(256),	OPSUB,		PCDUM(2)
	INTEGER*2	ADRDUM(2),	HIPC,		LOPC
	INTEGER*2	HIADR,		LOADR,		SEGTAB(3,50)
	INTEGER*2	Q
	EQUIVALENCE	(PC,PCDUM(1)),		(ADR,ADRDUM(1))
	EQUIVALENCE	(PCDUM(1),LOPC),	(PCDUM(2),HIPC)
	EQUIVALENCE	(ADRDUM(1),LOADR),	(ADRDUM(2),HIADR)
	BYTE		LINE(78),	MAC(6),		LOC(6)
	BYTE		WRK(6),		VALID,		OPC(4)
	BYTE		ANS,		Z,		CLVZ(7)
	BYTE		SUBR,		BHIS(4),	BLO(4)
	BYTE		SNAM(25)
	COMMON	/TSKCOM/  BLK, IREC, ISUB, PC, SEGTAB, IZRWRD, SNAM
	DATA		CLVZ	/'C','L','V',"41,'C','L','Z'/
	DATA		BHIS	/'B','H','I','S'/
	DATA		BLO	/'B','L','O',' '/
680	ILINE = 53
	IPAGE = 0
	SUBR = .FALSE.
690	WRITE  (5, 700)
700	FORMAT (/,' ENTER SEGMENT NUMBER, BEGINNING ADDRESS ',$)
	READ   (5, 800, ERR=690, END=9999) ISEG, IBEG
800	FORMAT (I3,O6,O6)
830	WRITE  (5, 840)
840	FORMAT (/,' ENTER ENDING ADDRESS ',$)
	READ   (5, 850, ERR=830, END=9999) IEND
850	FORMAT (O6)
	IF ((IBEG.AND.1) .EQ. 0) GO TO 900
	WRITE  (5, 820) 7
820	FORMAT (/,' WORD ADDRESS MUST BE EVEN',A1)
	GO TO 680
900	WRITE  (5, 1010)
1010	FORMAT (/,' RETURN FOR OUTPUT TO TI OR ENTER ANY CHARACTER',
	1	  ' FOR OUTPUT TO PRINTER ',$)
	READ   (5, 1020, ERR=900, END=9999) Q, ANS
1020	FORMAT (Q,A1)
	LUN = 5
	IF (Q .NE. 0) LUN = 6
	CALL INIT (ISEG, IBEG)
	IENDS = SEGTAB(3,ISEG)
	IENDS = (IENDS .AND. "177777)
	IF (ISUB .LT. 0) GO TO 680
	IF (LUN .EQ. 5) WRITE (5, 1030)
1030	FORMAT ('  ')
1040	IF (PC.GT.IEND .OR. PC.GE.IENDS) GO TO 3600
	DO 1050 I = 1, 78
	LINE(I) = ' '
1050	CONTINUE
	IF (ISUB .LE. 256) GO TO 1200
	IREC = IREC + 1
	CALL FILL
1200	Z = .TRUE.
	CALL OCTL (LOPC, LOC, Z)
	CALL OCTL (BLK(ISUB), MAC, Z)
	DO 1300 I = 1, 6
	LINE(I) = LOC(I)
1300	CONTINUE
	DO 1400 I = 1, 6
	LINE(I+8) = MAC(I)
1400	CONTINUE
	PC = PC + 2
	IF (BLK(ISUB) .NE. "000246) GO TO 1450	!UNDOCUMENTED PSEUDO OP-CODE
	DO 1410 I = 1, 7
	LINE(I+39) = CLVZ(I)
1410	CONTINUE
	GO TO 3400
1450	INST = BLK(ISUB)
	INST = (INST .AND. "177777)
	CALL BAD (INST, VALID, LINE)
	IF (.NOT. VALID) GO TO 3400
	CALL OP (INST, OPC, OPSUB)
	IF (OPSUB.LT.65 .OR. OPSUB.GT.66) GO TO 1490
	IF (SUBR) GO TO 1490
	IF (OPSUB .EQ. 66) GO TO 1460
	DO 1455 I = 1, 4
	OPC(I) = BHIS(I)
1455	CONTINUE
	GO TO 1490
1460	DO 1470 I = 1, 4
	OPC(I) = BLO(I)
1470	CONTINUE
1490	SUBR = .FALSE.
	DO 1500 I = 1, 4
1500	LINE(I+39) = OPC(I)
	IF (OPSUB .EQ. 6) LINE(44) = 'T'
	IF (OPSUB.LT.8 .OR. OPSUB.EQ.11) GO TO 3400
	IF (OPSUB.GT.11 .AND. OPSUB.LT.22) GO TO 3400
	IF ((OPSUB.GT.22 .AND. OPSUB.LT.30) .OR.
	1   (OPSUB.GT.58 .AND. OPSUB.LT.67)) GO TO 1600
	GO TO 1700
1600	CALL BRA (LINE)
	GO TO 3400
1700	IF (OPSUB .NE. 9) GO TO 1900
	LINSUB = 49
	CALL REG (MAC(6), LINE, LINSUB)
	GO TO 3400
1900	IF (OPSUB .NE. 10) GO TO 2000
	LINE(49) = MAC(6)
	GO TO 3400
2000	IF (OPSUB .NE. 43) GO TO 2100
	LINE(49) = MAC(5)
	LINE(50) = MAC(6)
	GO TO 3400
2100	IF (OPSUB .NE. 58) GO TO 2300
	LINSUB = 49
	CALL REG (MAC(4), LINE, LINSUB)
	LINE(LINSUB) = ','
	LINSUB = LINSUB + 1
	NN = (BLK(ISUB) .AND. "77)
	ADR = PC - (2 * NN)
	Z = .FALSE.
	CALL OCTL (LOADR, WRK, Z)
	DO 2200 I = 1, 6
	IF (WRK(I) .EQ. ' ') GO TO 2200
	LINE(LINSUB) = WRK(I)
	LINSUB = LINSUB + 1
2200	CONTINUE
	GO TO 3400
2300	IF (OPSUB.NE.67 .AND. OPSUB.NE.68) GO TO 2800
	IWRK = (BLK(ISUB) .AND. "377)
	Z = .FALSE.
	CALL OCTL (IWRK, WRK, Z)
	LINSUB = 49
	DO 2700 I = 1, 6
	IF (WRK(I) .EQ. ' ') GO TO 2700
	LINE(LINSUB) = WRK(I)
	LINSUB = LINSUB + 1
2700	CONTINUE
	GO TO 3400
2800	LINSUB = 49
	IF (OPSUB .NE. 30) GO TO 3000
	CALL REG (MAC(4), LINE, LINSUB)
	LINE(LINSUB) = ','
	LINSUB = LINSUB + 1
3000	NO = 3
	IF (OPSUB.GT.46 .AND. OPSUB.LT.53) GO TO 3100
	IF (OPSUB.GT.82) GO TO 3100
	GO TO 3200
3100	CALL DOIT (MAC, LINE, LINSUB, NO, ISEG)
	IF (LINSUB .LT. 0) GO TO 3600
	GO TO 3400
3200	IF (OPSUB.NE.57) GO TO 3300
	CALL REG (MAC(4), LINE, LINSUB)
	LINE(LINSUB) = ','
	LINSUB = LINSUB + 1
3300	NO = 5
	CALL DOIT (MAC, LINE, LINSUB, NO, ISEG)
	IF (LINSUB .LT. 0) GO TO 3600
	IF (OPSUB.LT.53 .OR. OPSUB.GT.56) GO TO 3400
	LINE(LINSUB) = ','
	LINSUB = LINSUB + 1
	CALL REG (MAC(4), LINE, LINSUB)
3400	ISUB = ISUB + 1
	IF (OPSUB.EQ.30 .OR. OPSUB.EQ.67 .OR. OPSUB.EQ.68) SUBR = .TRUE.
	ILINE = ILINE + 1
	IF (ILINE.LE.53 .OR. LUN.EQ.5) GO TO 3450
	IPAGE = IPAGE + 1
	WRITE  (6, 3410) SNAM, ISEG, IPAGE
3410	FORMAT ('1MACRO SOURCE FROM FILE ',25A1,'  SEGMENT ',I2,
	1	 10X,'PAGE ',I3,//)
	ILINE = 0
3450	WRITE  (LUN,3500) LINE
3500	FORMAT (' ',78A1)
	GO TO 1040
3600	RETURN
9999	CLOSE (UNIT=1)
	STOP
	END
