C	File Name:  UNMAC0.FOR			!Rev 8302.031
C
C******************* UNMAC ROUTINES CALLED ONLY ONCE *******************
C
	SUBROUTINE QUERY				!Rev 8302.021
C
C==============>> Find out what to do from the user. <<=================
C
	IMPLICIT INTEGER (A-Z)
C
C------------------------------- COMMONS -------------------------------
C
	COMMON /LUN/ LUN IN, LUN OUT, LUN TT
	COMMON /MACRO/ MACRO
	LOGICAL MACRO
C
C------------------ LOCAL VARIABLES AND DATA ---------------------------
C
	BYTE FIL NAM (30), STRING (31)
	EQUIVALENCE (FILNAM(1),STRING(1))
C
C=======================================================================
C
C--------------------------- FIND INPUT FILE ---------------------------
C
   10	WRITE (LUN TT,20)
   20	FORMAT(' Input filename: ',$)
	READ (LUN TT,30) LEN, FIL NAM
   30	FORMAT (Q,30A1)
	IF (LEN.GT.30) CALL FTL ERR (24,'Filename too long')
	FIL NAM (LEN+1) = 0
	OPEN (UNIT=LUN IN, NAME=FIL NAM, TYPE='OLD', ACCESS='DIRECT',
     1	RECORDSIZE=128, READONLY, ERR=40)
	GO TO 60
   40		WRITE (LUN TT,50)
   50		FORMAT (' ?UNMAC-W-Can not find input file.  Try again.')
	CALL ERRSNS (IRES,IUNIT)
	WRITE (LUN TT,55) IRES,IUNIT
   55	FORMAT (' (FORTRAN error 'I3' on unit 'I2')')
		GO TO 10
   60	CONTINUE
C
C-------------------------- OPEN OUTPUT FILE --------------------------
C
  100	WRITE (LUN TT,110)
  110	FORMAT(' Output filename: ',$)
	READ (LUN TT,120) LEN, FIL NAM
  120	FORMAT (Q,30A1)
	IF (LEN.GT.30) CALL FTL ERR (24,'Filename too long')
	FIL NAM (LEN+1) = 0
	OPEN (UNIT=LUN OUT, NAME=FIL NAM, TYPE='NEW',
     1	CARRIAGECONTROL='LIST',ERR=130)
	GO TO 150
  130		WRITE (LUN TT,140)
  140		FORMAT (' ?UNMAC-W-Can not open output file.  Try again.')
	CALL ERRSNS (IRES,IUNIT)
	WRITE (LUN TT,145) IRES,IUNIT
  145	FORMAT (' (FORTRAN error 'I3' on unit 'I2')')
		GO TO 100
  150	CONTINUE
C
C--------------------- GET TYPE OF OUTPUT DESIRED ----------------------
C
  200	WRITE (LUN TT,210)
  210	FORMAT(' Do you want a listing (L) or a source (S)? ',$)
	READ (LUN TT,220) LCHAR
  220	FORMAT(A1)
	IF (LCHAR.NE.'L' .AND. LCHAR.NE.'S') GO TO 200
	MACRO = LCHAR.EQ.'S'
C
C------------------------ GET DEBUG INFORMATION ------------------------
C
D	CALL Q DEBUG
C
	RETURN
	END
	LOGICAL FUNCTION LIB FND (IDUMMY)		!Rev 8301.291
C
C==================>> See if input file is a library <<=================
C
	IMPLICIT INTEGER (A-Z)
C
C------------------------------- COMMONS -------------------------------
C
	COMMON /INPUT/ BLOCK, COUNT, INPUT(512)
	BYTE INPUT
	COMMON /LIB/ FND LIB
	LOGICAL FND LIB
	COMMON /LUN/ LUN IN, LUN OUT, LUN TT
	COMMON /SYSTEM/ SYSTEM, RT, RSX
C
D	COMMON /DEBUG/ DEBUG(50)
D	LOGICAL DEBUG
C
C=======================================================================
C
C------------------------- Determine the system ------------------------
C
	READ (LUNIN'1) INPUT
	I = INPUT(1)
	IF (I.EQ.1) SYSTEM=RT
	IF (I.NE.1) SYSTEM=RSX
C
C---------------------- See if input is a library ----------------------
C
	IF (SYSTEM .EQ. RT ) CODE = INPUT(5)
	IF (SYSTEM .EQ. RSX) CODE = INPUT(2)
	IF (SYSTEM.EQ. RT) FND LIB = CODE .EQ. 7
	IF (SYSTEM.EQ.RSX) FND LIB = CODE .EQ. 2
	LIB FND = FND LIB
C
C------------------------- Diagnostic printout -------------------------
C
C BEGIN DEBUG
D	IF (.NOT.DEBUG(3)) GO TO 20
D		CALL NEWLIN
D		CALL OUT TXT ('; System is ')
D		IF (SYSTEM.EQ. RT) CALL OUT TXT ('RT-11')
D		IF (SYSTEM.EQ.RSX) CALL OUT TXT ('RSX')
D		IF (.NOT.FND LIB) GO TO 10
D			CALL NEWLIN
D			CALL OUT TXT (';Input file is a library.')
D  10		CONTINUE
D  20	CONTINUE
C END DEBUG
C
	RETURN
C
	END
	SUBROUTINE ONCE				!Rev 8302.031
C
C====================> Once-only initialization <=====================
C
	IMPLICIT INTEGER (A-Z)
C
	COMMON /LUN/ LUN IN, LUN OUT, LUN TT
	COMMON /OUTPUT/ OUT(132), NOUT
	BYTE OUT
	COMMON /XFR/ XFR ADR, XFR NAM(2), STARTF
	LOGICAL STARTF
C
C---------------------------------------------------------------------
C
	LUN IN  = 2
	LUN OUT = 3
	LUN TT  = 5
C
	NOUT = 1
C
	XFR ADR = 1
	STARTF = .FALSE.
C
	RETURN
	END
	SUBROUTINE GET DIR				!Rev 8301.291
C
C======>>  Gets directory information if object is a library  <<======
C
C
	IMPLICIT INTEGER (A-Z)
C
C------------------------------ COMMONS ------------------------------
C
	COMMON /INPUT/ BLOCK, COUNT, INPUT(512)
	BYTE INPUT
	COMMON /SAVE/ SAV BLK, SAV CNT
	COMMON /SYSTEM/ SYSTEM, RT, RSX
C
C=====================================================================
C-------- If a library, call system dependent library routine --------
C
	IF (SYSTEM.EQ. RT) CALL RTLIB
	IF (SYSTEM.EQ.RSX) CALL RSXLIB
C
C----------- Set the starting location of first module ---------------
C
	SAV BLK = BLOCK + 1
	SAV CNT = 1
C
	RETURN
	END
	SUBROUTINE RTLIB				!Rev 8301.291
C
C===============> Process header for an RT library <==================
C
	IMPLICIT INTEGER (A-Z)
C
C------------------------------ COMMONS ------------------------------
C
	COMMON /INPUT/ BLOCK, COUNT, INPUT(512)
	BYTE INPUT
	COMMON /LUN/ LUN IN, LUN OUT, LUN TT
C
D	COMMON /DEBUG/ DEBUG(50)
D	LOGICAL DEBUG
C
C---------------------- LOCAL VARIABLES ------------------------------
C
	INTEGER INWORD(256), NRAD50(2)
	EQUIVALENCE (INPUT(1),INWORD(1))
	BYTE NAME(7)
	DATA NAME /7*0/
C
C====================================================================
C------------------ Get header pointers and count -------------------
C
	BLOCK = 1
	READ (LUNIN'BLOCK) INPUT
	OFFSET = INWORD(12)
	START = OFFSET/2 + 13
	NREC = (INWORD(13)/2 - (START-1))/4
C
C BEGIN DEBUG
D	IF (.NOT.DEBUG(4)) GO TO 1
D		CALL NEWLIN
D		CALL OUT TXT (';RT library of ')
D		CALL OUT OCT (NREC)
D		CALL OUT TXT (' records begins at word ')
D		CALL OUT OCT (START)
D   1	CONTINUE
C END DEBUG
C
C------------------------ Output title line -------------------------
C
	CALL NEWLIN
	CALL OUT TXT ('; OBJECT LIBRARY')
	CALL CRLF
	CALL NEWLIN
	CALL OUT TXT ('; MODULE   BLOCK   OFFSET')
	PTR = START
C
C------------------ Get and print module data -----------------------
C
	DO 100 N = 1,NREC
		IF (PTR.LT.256.) GO TO 10
			BLOCK = BLOCK + 1
			READ (LUNIN'BLOCK) INPUT
			PTR = 1
   10		CONTINUE
C
		NRAD50(1) = INWORD(PTR)
		NRAD50(2) = INWORD(PTR+1)
		NBLOCK    = INWORD(PTR+2)
		OFFSET    = INWORD(PTR+3)
		PTR = PTR + 4
C
		CALL NEWLIN
		CALL OUT TXT ('; ')
		CALL R50ASC (6,NRAD50,NAME)
		CALL OUT TXT (NAME)
		CALL OUT TXT ('  ')
		CALL OUT OCR (NBLOCK)
		CALL OUT TXT ('   ')
		CALL OUT OCR (OFFSET)
  100	CONTINUE
C
	CALL CRLF
	CALL CRLF
C
C BEGIN DEBUG
D	IF (.NOT.DEBUG(4)) GO TO 200
D		CALL NEWLIN
D		CALL OUT TXT (';RT library ends at block ')
D		CALL OUT OCT (BLOCK)
D 200	CONTINUE
C END DEBUG
C
	RETURN
	END
	SUBROUTINE RSXLIB				!Rev 8301.291
C
C======>> Get entry point and module name info from RSX lib <<=======
C
	IMPLICIT INTEGER (A-Z)
C
C----------------------------- COMMONS ------------------------------
C
	COMMON /INPUT/ BLOCK, COUNT, INPUT(512)
	BYTE INPUT
	COMMON /LUN/ LUN IN, LUN OUT, LUN TT
C
D	COMMON /DEBUG/ DEBUG(50)
D	LOGICAL DEBUG
C
C-------------------------- LOCAL VARIABLES -------------------------
C
	INTEGER IWORD(256),NRAD50(2)
	EQUIVALENCE (INPUT(1),IWORD(1))
	BYTE NAME(7)
	DATA NAME /7*0/
C
C====================================================================
C
C---------------- Get information from header block -----------------
C
	BLOCK = 1
	READ (LUNIN'BLOCK) INPUT
	EPTSIZ = INPUT(19)
	EPTSB  = IWORD(11)
	NEPT   = IWORD(13)
	MNTSIZ = INPUT(27)
	MNTSB  = IWORD(15)
	NMNT   = IWORD(17)
C
C BEGIN DEBUG
D	IF (.NOT.DEBUG(5)) GO TO 1
D		CALL NEWLIN
D		CALL OUT TXT (';RSX library')
D		CALL NEWLIN
D		CALL OUT TXT (';  ')
D		CALL OUT OCT (NEPT)
D		CALL OUT TXT (' entry point entries of length ')
D		CALL OUT OCT (EPTSIZ)
D		CALL OUT TXT (' words starting at block ')
D		CALL OUT OCT (EPTSB)
D		CALL NEWLIN
D		CALL OUT TXT (';  ')
D		CALL OUT OCT (NMNT)
D		CALL OUT TXT (' module entries of length ')
D		CALL OUT OCT (MNTSIZ)
D		CALL OUT TXT (' words starting at block ')
D		CALL OUT OCT (MNTSB)
D		CALL CRLF
D   1	CONTINUE
C END DEBUG
C
C--------------------- Output entry point table ---------------------
C
	CALL NEWLIN
	CALL OUT TXT ('; RSX LIBRARY')
	CALL CRLF
	CALL NEWLIN
	CALL OUT TXT ('; Entry Point Table')
	CALL CRLF
	CALL NEWLIN
	CALL OUT TXT ('; NAME     BLOCK   OFFSET')
C
	BLOCK = EPTSB
	NCOUNT = 0
	NPTR = 257
C
   10	IF (NPTR .LE. 256) GO TO 20
		READ (LUNIN'BLOCK) INPUT
		BLOCK = BLOCK + 1
		NPTR = 1
   20	IF (IWORD(NPTR) .EQ. "177777) GO TO 30
		NRAD50(1) = IWORD (NPTR)
		NRAD50(2) = IWORD (NPTR+1)
		NBLOCK    = IWORD (NPTR+2)
		OFFSET    = IWORD (NPTR+3)
		NPTR = NPTR + EPTSIZ
		NCOUNT = NCOUNT + 1
		CALL R50ASC (6,NRAD50,NAME)
C
		CALL NEWLIN
		CALL OUT TXT ('; ')
		CALL OUT TXT (NAME)
		CALL OUT TXT ('  ')
		CALL OUT OCR (NBLOCK)
		CALL OUT TXT ('   ')
		CALL OUT OCR (OFFSET)
		GO TO 10
   30	CONTINUE
C
C--------------------- Output module name table ---------------------
C
	CALL CRLF
	CALL NEWLIN
	CALL OUT TXT ('; Module Name Table')
	CALL CRLF
	CALL NEWLIN
	CALL OUT TXT ('; MODULE   BLOCK   OFFSET')
C
	BLOCK = MNTSB
	NCOUNT = 0
	NPTR = 257
C
   40	IF (NPTR .LE. 256) GO TO 50
		READ (LUNIN'BLOCK) INPUT
		BLOCK = BLOCK + 1
		NPTR = 1
   50	IF (IWORD(NPTR).EQ."177777) GO TO 60
		NRAD50(1) = IWORD (NPTR)
		NRAD50(2) = IWORD (NPTR+1)
		NBLOCK    = IWORD (NPTR+2)
		OFFSET    = IWORD (NPTR+3)
		NPTR = NPTR + MNTSIZ
		NCOUNT = NCOUNT + 1
		CALL R50ASC (6,NRAD50,NAME)
C
		CALL NEWLIN
		CALL OUT TXT ('; ')
		CALL OUT TXT (NAME)
		CALL OUT TXT ('  ')
		CALL OUT OCR (NBLOCK)
		CALL OUT TXT ('   ')
		CALL OUT OCR (OFFSET)
		GO TO 40
   60	CONTINUE
C
C------------------------------ Finish up ------------------------------
C
	CALL CRLF
	CALL CRLF
	BLOCK = BLOCK - 1
C
C BEGIN DEBUG
D	IF (.NOT.DEBUG(5)) GO TO 100
D		CALL NEWLIN
D		CALL OUT TXT (';RSX library ends at block ')
D		CALL OUT OCT (BLOCK)
D 100	CONTINUE
C END DEBUG
C
	RETURN
	END