C	File name:  UNMAC4.FOR			!Rev 8303.091
C
C******************** Support routines for UNMAC2 *********************
C
	SUBROUTINE LABEL (I)			!Rev 8303.091
C
C=======================> Fill the label field <=======================
C
	IMPLICIT INTEGER (A-Z)
C
C------------------------------- COMMONS -----------------------------
C
	COMMON /GLOBLS/ NGLBLS,GNAME(2,400),GFLAGS(400),GVALUE(400),
     1		GPSECT(400)
	BYTE GFLAGS,GPSECT
	COMMON /LABELS/ NLABEL,LABL PS(2,1000),LABL OF(1000),
     1	PL NAME(2),L OFF
	COMMON /PSECTS/ NPSECT,PSNAME(2,100),PSFLAG(100),PSVALU(100)
	BYTE PSFLAG
	COMMON /PSECT2/ N CUR PS, N OLD PS, CUR PS(8), PS LOC(100)
	BYTE CUR PS
	COMMON /XFR/ XFR ADR, XFR NAM(2), STARTF
	LOGICAL STARTF
C
C--------------------------LOCAL VARIABLES ---------------------------
C
	BYTE STRING(9)
	DATA STRING /9*0/
	DATA BIT3, BIT5 /"10,"40/
C
C=====================================================================
C-------------------------- Check for start --------------------------
C
	IF (STARTF) GO TO 100
	IF (XFRNAM(1) .NE. PS NAME(1,N OLD PS)) GO TO 100
	IF (XFRNAM(2) .NE. PS NAME(2,N OLD PS)) GO TO 100
	IF (I .NE. XFR ADR) GO TO 100
		CALL OUT TXT ('START')
		STARTF = .TRUE.
		GO TO 1000
  100	CONTINUE
C
C------------------- Look for subroutine name table -------------------
C
	IF (NGLBLS .EQ. 0) GO TO 300
	IF (NGLBLS .GT. 400) CALL FTL ERR (29,'NGLBLS > 400 in LABEL')
	DO 200 II=1,NGLBLS
		NP = GPSECT (II)
		IF (NP .NE. N OLD PS) GO TO 200
		VALUE = GVALUE(II)
		IF (I .NE. VALUE) GO TO 200
		FLAGS = G FLAGS (II)
		IF ((FLAGS.AND.BIT3).EQ.0) GO TO 200
		IF ((FLAGS.AND.BIT5).EQ.0) GO TO 200
			CALL R50ASC (6,GNAME(1,II),STRING)
			DO 110 III = 6,2,-1
				N = III
				IF (STRING(N).NE."40) GO TO 120
  110			CONTINUE
  120			STRING(N+1) = ':'
			STRING(N+2) = ':'
			N = N+2
  130			CONTINUE
			STRING(N+1) = 0
			CALL OUT TXT (STRING)
			IF (N.LT.8) CALL OUT TXT ('	')
			RETURN
  200		CONTINUE
  300	CONTINUE
C
C---------------------- Look for branch label -----------------------
C
	IF (NLABEL .EQ. 0) GO TO 500
		DO 400 II=1,NLABEL
		  IF (LABLPS(1,II).NE.PSNAME(1,NOLDPS)) GOTO 400
		  IF (LABLPS(2,II).NE.PSNAME(2,NOLDPS)) GOTO 400
		  IF (LABL OF(II).NE.I) GO TO 400
		    CALL OUT OCT (I)
		    CALL OUT TXT ('$')
		    GO TO 1000
  400		CONTINUE
  500	CONTINUE
C
C-------------------------- No label found ---------------------------
C
	CALL OUT TXT ('	')
	RETURN
C
C---------------- Do extra processing for real labels ----------------
C
 1000	CALL OUT TXT (':	')
	RETURN
	END
	SUBROUTINE CHECK (NEXT)				!Rev 8301.245
C
C=====> Examine the next instruction to determine the arguments <=====
C
C	NOTE:  If you want to understand what is going on in this
C	       subroutine, take a look at a PDP11 numerical op
C	       code list.
C
	IMPLICIT INTEGER (A-Z)
C
	COMMON /INSTR/ INST, NARG, ARG1, ARG2, NWRDS
C
C=====================================================================
C
	NARG = 0
	ARG1 = 0
	ARG2 = 0
	INST = NEXT
	IF (INST .LT. 0) GO TO 10
C
C-------Instructions with bit 15=0
C
	IF (INST.GE."10000 .AND. INST.LT."70000) GO TO 200
	IF (INST.LT."100) GO TO 1000
	I = INST/"100
	IF (I.EQ.2) GO TO 1000
	IF (I.GE.4 .AND. I.LT."40) GO TO 1000
	IF (I.EQ."64) GO TO 1000
	IF (I.GE."700 .AND. I.LT."750) GO TO 300
	IF (I.GE."750) GO TO 1000
	GO TO 100
C
C------Instructions with bit 15=1
C
   10	IN = INST.AND."77777
	IF (IN.GE."10000 .AND. IN.LT."70000) GO TO 200
	IF (IN.LT."5000) GO TO 1000
	IF (IN.LT."10000) GO TO 100
C
C------Floating point instructions
C
	IF (IN.LT."70100) GO TO 1000
	IF (IN.LT."71000) GO TO 100
	NARG = 2
	ARG2 = (INST.AND."300)/"100 + "100
	ARG1 = INST .AND. "77
	IF (IN.LT."74000) GO TO 1000
	IF (IN.GE."74400 .AND. IN.LT."75000) GO TO 1000
	IF (IN.GE."76400) GO TO 1000
	TEMP = ARG1
	ARG1 = ARG2
	ARG2 = TEMP
	GO TO 1000
C
C------Process one-argument instructions
C
  100	NARG = 1
	ARG1 = INST.AND."77
	GO TO 1000
C
C------Process two-argument instructions
C
  200	NARG = 2
	ARG2 = INST.AND."77
	ARG1 = (INST.AND."7777)/"100
	GO TO 1000
C
C------Process arithmetic operations
C
  300	NARG = 2
	ARG1 = INST.AND."77
	ARG2 = (INST.AND."777)/"100
C
C------Compute the number of extra words included with instuction
C
 1000	CONTINUE
	NWRDS = NWORD(ARG1)+NWORD(ARG2)
C
	RETURN
	END
	FUNCTION NWORD (N)				!Rev 8301.243
C
C=======> Compute the number of words required by an argument <=========
C
	NWORD = 0
	IF (N .GE. "60	.AND. N .LT. "100) NWORD = 1
	IF (N .EQ. "27) NWORD = 1
	IF (N .EQ. "37) NWORD = 1
	IF (N .EQ. "67) NWORD = 1
	IF (N .EQ. "77) NWORD = 1
C
	RETURN
	END
	SUBROUTINE OUT ARG (ARG,N,I)			!Rev 8301.246
C
C==================> Output an instruction argument <==================
C
	IMPLICIT INTEGER (A-Z)
C
	MODE = ARG/"10
	R = ARG.AND.7
	IF (ARG.EQ."27) GO TO 20
	IF (ARG.EQ."37) GO TO 30
	IF (ARG.EQ."67) GO TO 60
	IF (ARG.EQ."77) GO TO 70
	GO TO (10,11,12,13,14,15,16,17,100),MODE+1
10	CALL OUT REG (R)
	RETURN
11	CALL OUT TXT ('(')
	CALL OUT REG (R)
	CALL OUT TXT (')')
	RETURN
12	CALL OUT TXT ('(')
	CALL OUT REG (R)
	CALL OUT TXT (')+')
	RETURN
13	CALL OUT TXT ('@')
	GO TO 12
14	CALL OUT TXT ('-(')
	CALL OUT REG (R)
	CALL OUT TXT (')')
	RETURN
15	CALL OUT TXT ('@')
	GO TO 14
16	CALL OUT ADR (N,I)
	CALL OUT TXT ('(')
	CALL OUT REG (R)
	CALL OUT TXT (')')
	RETURN
17	CALL OUT TXT ('@')
	GO TO 16
C
20	CALL OUT TXT ('#')
	CALL OUT ADR (N,I)
	RETURN
30	CALL OUT TXT ('@#')
	CALL OUT ADR (N,I)
	RETURN
60	CALL OUT ADR (N,I)
	RETURN
70	CALL OUT TXT ('@')
	CALL OUT ADR (N,I)
	RETURN
C
100	R = ARG .AND. 3
	CALL OUT TXT ('AC')
	CALL OUT OCT (R)
	RETURN
C
	END
	SUBROUTINE OUT REG (R)				!Rev 8301.053
C
C==================> Output a register expression <===================
C
	IMPLICIT INTEGER (A-Z)
C
	NREG = R.AND.7
	IF (NREG.EQ.6) GO TO 60
	IF (NREG.EQ.7) GO TO 70
	CALL OUT TXT ('R')
	CALL OUT OCT (NREG)
	RETURN
60	CALL OUT TXT ('SP')
	RETURN
70	CALL OUT TXT ('PC')
	RETURN
C
	END
	SUBROUTINE OUT ADR (N,I)			!Rev 8302.011
C
C===========> Output next argument from TXT or RLD buffer <===========
C
	IMPLICIT INTEGER (A-Z)
C
	COMMON /RLD/ NRLD,NRPTR,NPOFF(50),NBOFF(50),NRBUFF(512)
	BYTE NRBUFF
	COMMON /TXT/ N TXT, LOC TXT, TXT(256), INST PS, N TXT OF
	LOGICAL INST PS
	BYTE CHAR(4)
	EQUIVALENCE (CHAR(1),CHARS)
C
	IF (NRLD .EQ. 0) GO TO 200
C
	DO 100 J=1,NRLD
		NN = N P OFF(J)
		IF (NN .NE. N) GO TO 100
			M = NBOFF(J)
   10			LCHAR = NRBUFF(M)
			M = M+1
			IF (LCHAR .EQ. 0) GO TO 300
			CALL OUT TXT (LCHAR)
			GO TO 10
  100	CONTINUE
C
  200	IF (N .NE. (N/2)*2) GO TO 210
	CALL OUT OCT (TXT(I))
	GO TO 230
  210	CHARS = TXT(I)
	CALL OUT TXT ('.BYTE	')
	LCHAR = CHAR(1)
	LCHAR = LCHAR.AND."377
	CALL OUT BYT (LCHAR)
	CALL OUT TXT (',')
	LCHAR = CHAR(2)
	LCHAR = LCHAR.AND."377
	CALL OUT BYT (LCHAR)
C
  230	IF (INST PS) GO TO 300
		CALL OUT TXT ('		;')
		NOUT = 0
		CHARS = TXT(I)
		DO 250 II=1,2
			LCHAR = CHAR(II)
			LCHAR = LCHAR .AND. "377
			IF (LCHAR .GE."177) GO TO 240
			IF (LCHAR .LT. "40) GO TO 240
			CALL OUT TXT (LCHAR)
			NOUT = NOUT + 1
			GO TO 250
  240			CALL OUT TXT ('<')
			CALL OUT OCT (LCHAR)
			CALL OUT TXT ('>')
			NOUT = NOUT + 3
			IF (LCHAR .GE. "10) NOUT = NOUT + 1
			IF (LCHAR .GE. "100) NOUT = NOUT + 1
  250		CONTINUE
C
		DO 260 II=NOUT,15
			CALL OUT TXT (' ')
  260		CONTINUE
C
		LCHAR = TXT(I)
		K = R50ASC (3,LCHAR,CHAR)
		CHAR(4) = 0
		CALL OUT TXT (CHAR)
C
  300	I = I+1
	N = N+2
	RETURN
C
	END
	SUBROUTINE OUT INS (NADR,INSTR)			!Rev 8303.091
C
C===================> Output an instruction code <====================
C
	IMPLICIT INTEGER (A-Z)
C
	COMMON /FPI/ RFLAG,IFLAG
	LOGICAL RFLAG,IFLAG
C
	INST = INSTR
	IF (INST.LT.     0) GO TO 500
	IF (INST.GE."10000) GO TO 100
	IF (INST.GE. "5000) GO TO  45
	IF (INST.GE.  "400) GO TO  30
	IF (INST.GE.  "100) GO TO  20
	IF (INST.GT.     6) RETURN
C
C	Misc. instructions
C
	GO TO (10,11,12,13,14,15,16),INST+1
10	CALL OUT TXT ('HALT')
	RETURN
11	CALL OUT TXT ('WAIT')
	RETURN
12	CALL OUT TXT ('RTI')
	RETURN
13	CALL OUT TXT ('BPT')
	RETURN
14	CALL OUT TXT ('IOT')
	RETURN
15	CALL OUT TXT ('RESET')
	RETURN
16	CALL OUT TXT ('RTT')
	RETURN
C
20	IN = INST/"100
	GO TO (21,22,23),IN
21	CALL OUT TXT ('JMP')
	GO TO 1005
22	IF (INST.GT."240) GO TO 24
	IF (INST.EQ."240) CALL OUT TXT ('NOP')
	IF (INST.GE."210) RETURN
	CALL OUT TXT ('RTS     ')
	CALL OUT REG (INST)
	RETURN
23	CALL OUT TXT ('SWAB')
	GO TO 1004
24	I = INST.AND."17
	IF (I.EQ."17) GO TO 28
	N = 0
	I = INST.AND.1
	IF (I.EQ.0) GO TO 25
	IF (INST.LT."260) CALL OUT TXT ('CLC')
	IF (INST.GE."260) CALL OUT TXT ('SEC')
	N = 1
25	I = INST.AND.2
	IF (I.EQ.0) GO TO 26
	IF (N.EQ.1) CALL OUT TXT (',')
	IF (INST.LT."260) CALL OUT TXT ('CLV')
	IF (INST.GE."260) CALL OUT TXT ('SEV')
	N = 1
26	I = INST.AND.4
	IF (I.EQ.0) GO TO 27
	IF (N.EQ.1) CALL OUT TXT (',')
	IF (INST.LT."260) CALL OUT TXT ('CLZ')
	IF (INST.GE."260) CALL OUT TXT ('SEZ')
	N = 1
27	I = INST.AND."10
	IF (I.EQ.0) RETURN
	IF (N.EQ.1) CALL OUT TXT (',')
	IF (INST.LT."260) CALL OUT TXT ('CLN')
	IF (INST.GE."260) CALL OUT TXT ('SEN')
	RETURN
28	IF (INST.EQ."257) CALL OUT TXT ('CCC')
	IF (INST.EQ."277) CALL OUT TXT ('SCC')
	RETURN
C
C	Branch instructions
C
30	IF (INST.GE."4000) GO TO 40
	IN = INST/"400
	GO TO (31,32,33,34,35,36,37),IN
31	CALL OUT TXT ('BR  ')
	GO TO 38
32	CALL OUT TXT ('BNE ')
	GO TO 38
33	CALL OUT TXT ('BEQ ')
	GO TO 38
34	CALL OUT TXT ('BGE ')
	GO TO 38
35	CALL OUT TXT ('BLT ')
	GO TO 38
36	CALL OUT TXT ('BGT ')
	GO TO 38
37	CALL OUT TXT ('BLE ')
	GO TO 38
38	OFFSET = INST .AND. "377
	IF (OFFSET .GE. "200) OFFSET = OFFSET - "400
	OFFSET = 2*(OFFSET+1) + NADR
	CALL OUT TXT ('	')
	CALL OUT OCT (OFFSET)
	CALL OUT TXT ('$')
	RETURN
C
C	JSR
C
40	CALL OUT TXT ('JSR     ')
	REG = (INST.AND."777)/"100
	CALL OUT REG (REG)
	CALL OUT TXT (',')
	RETURN
C
C	Single argument instructions
C
45	IF (INST.GE."7000) RETURN
	IN = INST/"100 - "47
	GO TO (50,51,52,53,54,55,56,57,60,61,62,63,64,49,49,67),IN
49	RETURN
50	CALL OUT TXT ('CLR')
	GO TO 68
51	CALL OUT TXT ('COM')
	GO TO 68
52	CALL OUT TXT ('INC')
	GO TO 68
53	CALL OUT TXT ('DEC')
	GO TO 68
54	CALL OUT TXT ('NEG')
	GO TO 68
55	CALL OUT TXT ('ADC')
	GO TO 68
56	CALL OUT TXT ('SBC')
	GO TO 68
57	CALL OUT TXT ('TST')
	GO TO 68
60	CALL OUT TXT ('ROR')
	GO TO 68
61	CALL OUT TXT ('ROL')
	GO TO 68
62	CALL OUT TXT ('ASR')
	GO TO 68
63	CALL OUT TXT ('ASL')
	GO TO 68
64	CALL OUT TXT ('MARK    ')
	NN = INST - (INST/"100)*"100
	CALL OUT OCT (NN)
	RETURN
67	CALL OUT TXT ('SXT')
68	IF (INSTR.GT.0) GO TO 1005
	CALL OUT TXT ('B')
	GO TO 1004
C
100	IF (INST.LT."75040) GO TO 110
	IF (INST.LT."77000) RETURN
	NN = INST.AND."77
	REG = (INST.AND."777)/"100
	CALL OUT TXT ('SOB     ')
	CALL OUT REG (REG)
	CALL OUT TXT (',.-')
	CALL OUT OCT (2*NN-2)
	RETURN
110	IF (INST.LT."75000) GO TO 140
	REG = INST.AND.7
	IN = (INST.AND."77)/"10 + 1
	GO TO (120,121,122,123),IN
120	CALL OUT TXT ('FADD')
	GO TO 130
121	CALL OUT TXT ('FSUB')
	GO TO 130
122	CALL OUT TXT ('FMUL')
	GO TO 130
123	CALL OUT TXT ('FDIV')
130	CALL OUT TXT ('    ')
	CALL OUT REG (REG)
	RETURN
140	IF (INST.LT."70000) GO TO 170
	REG = (INST.AND."777)/"100
	IN = (INST.AND."7777)/"1000 + 1
	GO TO (150,151,152,153,154),IN
150	CALL OUT TXT ('MUL ')
	GO TO 160
151	CALL OUT TXT ('DIV ')
	GO TO 160
152	CALL OUT TXT ('ASH ')
	GO TO 160
153	CALL OUT TXT ('ASHC')
	GO TO 160
154	CALL OUT TXT ('XOR ')
160	CALL OUT TXT ('    ')
	RETURN
C
C	Two argument instructions
C
170	IN = INST/"10000
	GO TO (171,172,173,174,175,176),IN
171	CALL OUT TXT ('MOV')
	GO TO 177
172	CALL OUT TXT ('CMP')
	GO TO 177
173	CALL OUT TXT ('BIT')
	GO TO 177
174	CALL OUT TXT ('BIC')
	GO TO 177
175	CALL OUT TXT ('BIS')
	GO TO 177
176	CALL OUT TXT ('ADD')
177	IF (INSTR.GE.0) GO TO 1005
	CALL OUT TXT ('B')
	GO TO 1004
C
C	Instructions with bit 15=1
C
500	INST = INSTR.AND."77777
	IF (INST.GE."70000) GO TO 900
	IF (INST.GE."10000) GO TO 800
	IF (INST.GE. "5000) GO TO 700
	IF (INST.GE. "4000) GO TO 640
	I = (INST.AND."3777)/"400 + 1
	GO TO (600,604,610,614,620,624,630,634),I
600	CALL OUT TXT ('BPL ')
	GO TO 38
604	CALL OUT TXT ('BMI ')
	GO TO 38
610	CALL OUT TXT ('BHI ')
	GO TO 38
614	CALL OUT TXT ('BLOS')
	GO TO 38
620	CALL OUT TXT ('BVC ')
	GO TO 38
624	CALL OUT TXT ('BVS ')
	GO TO 38
630	CALL OUT TXT ('BCC ')
	GO TO 38
634	CALL OUT TXT ('BCS ')
	GO TO 38
C
640	IF (INST.LT."4400) CALL OUT TXT ('EMT     ')
	IF (INST.GE."4400) CALL OUT TXT ('TRAP    ')
	I = INST.AND."377
	CALL OUT OCT (I)
	RETURN
C
700	IF (INST.LT."6400) GO TO 45
	IF (INST.LT."6700) CALL OUT TXT ('MTPS')
	IF (INST.GE."6700) CALL OUT TXT ('MFPS')
	RETURN
C
800	IF (INST.LT."60000) GO TO 170
	CALL OUT TXT ('SUB')
	GO TO 1005
C
C	Floating point instructions
C
900	IF (INST .GE. "70100) GO TO 930
	I = INST.AND."17
	IF (I .GT. 2) GO TO 920
	GO TO (910,911,912),I+1
910	CALL OUT TXT ('CFCC')
	GO TO 1004
911	CALL OUT TXT ('SETF')
	RFLAG = .TRUE.
	GO TO 1004
912	CALL OUT TXT ('SETI')
	IFLAG = .TRUE.
	GO TO 1004
C
920	GO TO (921,922),I-"10
921	CALL OUT TXT ('SETD')
	RFLAG = .FALSE.
	GO TO 1004
922	CALL OUT TXT ('SETL')
	RFLAG = .FALSE.
	GO TO 1004
C
930	IF (INST .GE. "71000) GO TO 940
	I = (INST .AND. "700)/"100
	GO TO (931,932,933,934,935,936,937),I
931	CALL OUT TXT ('LDFPS')
	GO TO 1003
932	CALL OUT TXT ('STFPS')
	GO TO 1003
933	CALL OUT TXT ('STST')
	GO TO 1004
934	IF (     RFLAG) CALL OUT TXT ('CLRF')
	IF (.NOT.RFLAG) CALL OUT TXT ('CLRD')
	GO TO 1004
935	IF (     RFLAG) CALL OUT TXT ('TSTF')
	IF (.NOT.RFLAG) CALL OUT TXT ('TSTD')
	GO TO 1004
936	IF (     RFLAG) CALL OUT TXT ('ABSF')
	IF (.NOT.RFLAG) CALL OUT TXT ('ABSD')
	GO TO 1004
937	IF (     RFLAG) CALL OUT TXT ('NEGF')
	IF (.NOT.RFLAG) CALL OUT TXT ('NEGD')
	GO TO 1004
C
940	I = (INST.AND."7400)/"400
	GO TO (941,942,943,944,945,946,947,948,949,950,951,952,
     1		953,954),I-1
941	CALL OUT TXT ('MUL')
	GO TO 2004
942	CALL OUT TXT ('MOD')
	GO TO 2004
943	CALL OUT TXT ('ADD')
	GO TO 2004
944	CALL OUT TXT ('LD')
	GO TO 2005
945	CALL OUT TXT ('SUB')
	GO TO 2004
946	CALL OUT TXT ('CMP')
	GO TO 2004
947	CALL OUT TXT ('ST')
	GO TO 2005
948	CALL OUT TXT ('DIV')
	GO TO 2004
949	CALL OUT TXT ('STEXP')
	GO TO 1003
950	CALL OUT TXT ('STC')
	GO TO 2100
951	CALL OUT TXT ('STC')
	GO TO 2200
952	CALL OUT TXT ('LDEXP')
	GO TO 1003
953	CALL OUT TXT ('LDC')
	GO TO 2100
954	CALL OUT TXT ('LDC')
	GO TO 2200
C
2004	IF (     RFLAG) CALL OUT TXT ('F')
	IF (.NOT.RFLAG) CALL OUT TXT ('D')
	GO TO 1004
2005	IF (     RFLAG) CALL OUT TXT ('F')
	IF (.NOT.RFLAG) CALL OUT TXT ('D')
	GO TO 1005
2100	IF (     IFLAG) CALL OUT TXT ('I')
	IF (.NOT.IFLAG) CALL OUT TXT ('L')
	IF (     RFLAG) CALL OUT TXT ('F')
	IF (.NOT.RFLAG) CALL OUT TXT ('D')
	GO TO 1003
2200	IF (     RFLAG) CALL OUT TXT ('FD')
	IF (.NOT.RFLAG) CALL OUT TXT ('DF')
	GO TO 1003
C
C-------------------------------------------------------------------
C
1008	CALL OUT TXT ('        ')
	RETURN
1005	CALL OUT TXT ('     ')
	RETURN
1004	CALL OUT TXT ('    ')
	RETURN
1003	CALL OUT TXT ('   ')
	RETURN
C
	END
�������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������