C	File Name:  UNMAC1.FOR			!Rev 8302.031
C
C	This module performs the first pass through an input module
C
C**********************************************************************
C
	SUBROUTINE PASS 1			!Rev 8301.291
C
C	On pass 1, get information from the global symbol blocks about
C	how to assign addresses and how to allocate memory.
C
C	Each data block starts with an identification code in the
C	first word that describes the type of information contained
C	in the rest of the data block:
C
C	CODE  TYPE     FUNCTION OF BLOCK
C
C	  1   GSD      Holds Global Symbol Directory information
C	  2   ENDGSD   Signals the end of GSD blocks in the module
C	  3   TXT      Holds the actual binary text of the module
C	  4   RLD      Holds Relocation Directory information
C	  5   ISD      Holds Internal Symbol Directory information
C	               (Not supported in RT-11)
C	  6   ENDMOD   Signals the end of the module
C	  7   LIBHDR   Holds status of a library file
C	  8   LIBEND   Signals end of a library file
C
C	An object module must begin with a Global Symbol Directory (GSD)
C	block and end with an End of Module (ENDMOD) block.  Additional
C	GSD blocks can occur anywhere in the file, but must appear before
C	an End of Global Symbol Directory (ENDGSD) block.  An ENDGSD
C	block must appear before the ENDMOD block, and at least one
C	Relocation Directory (RLD) block must appear before the first
C	Text Information (TXT) block.  Additional RLD and TXT blocks
C	can appear anywhere in the file.  The Internal Symbol Directory
C	(ISD) block can appear anywhere in the file between the initial
C	GSD and ENDMOD blocks.
C
C	All program sections (PSECTs, VSECTs, and CSECTs) must be declared
C	by defining them in GSD blocks.  The word size of each program
C	section definition contains the size in bytes to be reserved
C	for the section.  If a program section is declared more than
C	once in a single object module, the linker uses the largest
C	declared size for that section.  All global symbols that are
C	defined in a given program section must appear in the GSD items
C	immediately following the definition item of that program section.
C
C	A special program section, called the absolute section (. ABS.),
C	is allocated by the linker beginning at location 0 in memory.
C	Immediately after the GSD item that defines the absolute section,
C	all global symbols that contain absolute (non-relocatable) values
C	must be declared.  If the size word is zero, no memory space
C	is allocated for the absolute section.
C
C	Global symbols that are referenced but not defined in the current
C	object module must also appear in GSD items.  These global
C	references may appear in any GSD item except the very first,
C	which contains the module name.  In MACRO, referenced globals
C	are seen in a GSD block under the . ABS. p-sect.
C
C---------------------------------------------------------------------------
C
	IMPLICIT INTEGER (A-Z)
C
D	COMMON /DEBUG/ DEBUG(50)
D	LOGICAL DEBUG
C
C---------------------- Get the next data block ---------------------------
C
   10	CALL GET BLK
C
C--------------------------------------------------------------------------
C	Get data block identification code and jump to appropriate
C	routine to process the data block
C
	CALL RD WORD (CODE)
	IF (CODE.GE.0 .AND. CODE.LE.8) GO TO 15
		CALL NEWLIN
		CALL OUT TXT ('PASS1:  Illegal identification code = ')
		CALL OUT OCT (CODE)
		CALL FTL ERR (ERR,'Data block ident. code out of range')
   15	CONTINUE
C
C BEGIN DEBUG
D	IF (.NOT.DEBUG(21)) GO TO 20
D		CALL NEWLIN
D		IF (CODE.EQ.0) CALL OUT TXT(';Skip RSX LIB header')
D		IF (CODE.EQ.1) CALL OUT TXT(';GSD')
D		IF (CODE.EQ.2) CALL OUT TXT(';ENDGSD')
D		IF (CODE.EQ.3) CALL OUT TXT(';TXT')
D		IF (CODE.EQ.4) CALL OUT TXT(';RLD')
D		IF (CODE.EQ.5) CALL OUT TXT(';ISD')
D		IF (CODE.EQ.6) CALL OUT TXT(';ENDMOD')
D		IF (CODE.EQ.7) CALL OUT TXT(';Librarian header')
D		IF (CODE.EQ.8) CALL OUT TXT(';Librarian end')
D		CALL OUT TXT (' - Pass 1')
D  20	CONTINUE
C END DEBUG
C
	GO TO (10,100,10,300,400,10,600,10,10), CODE+1
C
C----------- GSD - Global symbol directory information --------------------
C
  100	CALL GSD 1
	GO TO 10
C
C--------------- TXT - Binary text information block ----------------------
C
  300	CALL TXT1
	GO TO 10
C
C--------------- RLD - Relocation directory block ------------------------
C
  400	CALL RLD1
	GO TO 10
C
C----------------------- ENDMOD - End of module ---------------------------
C
  600	CALL END MOD
	RETURN
	END
	SUBROUTINE GSD 1				!Rev 8302.031
C
C	GSD - Get global symbol directory information for pass 1
C
C	Global Symbol Directory blocks contain all the information the
C	linker needs to assign addresses to global symbols and to
C	allocate the memory a job requires.  There are eight types of
C	entries that GSD blocks can contain:
C
C		Entry type	Description
C		----------      -----------
C		     0          Module Name
C		     1          Control Section Name (CSECT)
C		     2          Internal Symbol Name
C		     3          Transfer Address
C		     4          Global Symbol Name
C		     5          Program Section Name
C		     6          Program Version Identification (IDENT)
C		     7          Mapped Array Declaration (VSECT)
C
C	Each type of entry is represented by four words in the GSD data
C	block.  The first two words contain six Radix-50 characters.  The
C	third word contains a flag byte and the entry type identification.
C	The fourth word contains additional information about the entry.
C		==================================
C		|       0       |        1       |
C		==================================
C		|           RADIX - 50           |
C		-----                        -----
C		|              NAME              |
C		----------------------------------
C		|   ENTRY TYPE  |      FLAGS     |
C		----------------------------------
C		|             VALUE              |
C		==================================
C		|           RADIX - 50           |
C		-----                        -----
C		|              NAME              |
C		----------------------------------
C		|   ENTRY TYPE  |      FLAGS     |
C		----------------------------------
C		|             VALUE              |
C		==================================
C		                :
C		                :
C		==================================
C		|           RADIX - 50           |
C		-----                        -----
C		|              NAME              |
C		----------------------------------
C		|   ENTRY TYPE  |      FLAGS     |
C		----------------------------------
C		|             VALUE              |
C		==================================
C
	IMPLICIT INTEGER (A-Z)
C
C------------------------ COMMON -----------------------------------
C
	COMMON /RECORD/ LEN, NXT CHR, RECORD(256)
	BYTE RECORD
	COMMON /MACRO/ MACRO
	LOGICAL MACRO
	COMMON /XFR/ XFR ADR, XFR NAM (2), STARTF
	LOGICAL STARTF
	COMMON /PSECTS/ NPSECT,PSNAME(2,100),PSFLAG(100),PSVALU(100)
	BYTE PSFLAG
	COMMON /GLOBLS/ NGLBLS,GNAME(2,400),GFLAGS(400),GVALUE(400),
     1		GPSECT(400)


	BYTE GFLAGS,GPSECT
D	COMMON /DEBUG/ DEBUG(50)
D	LOGICAL DEBUG
C
C---------------- LOCAL VARIABLES AND DATA -------------------------
C
	INTEGER NRAD50 (2)
	BYTE ABS NAM (6), NAME (7), BLANK
	DATA ABS NAM /'.',' ','A','B','S','.'/
	DATA BLANK /' '/
	DATA BIT3, BIT4, BIT5, BIT6, BIT7
     1	   /  "10,  "20,  "40, "100, "200/
C
C====================== START OF CODE ==============================
C
C-------------------Get the next GSD record ------------------------
C
  100	CALL RD NAME (NAME,NRAD50)
	CALL RD BYTE (FLAGS)
	FLAGS = FLAGS .AND. "377
	CALL RD BYTE (TYPE)
	CALL RD WORD (VALUE)
C
C BEGIN DEBUG
D	IF (.NOT.DEBUG(23)) GO TO 101
D		CALL NEWLIN
D		CALL OUT TXT (';GSD:  ')
D		CALL OUT TXT (NAME)
D		CALL OUT TXT ('; Type = ')
D		CALL OUT OCT (TYPE)
D		CALL OUT TXT ('; Value = ')
D		CALL OUT OCT (VALUE)
D		CALL OUT TXT ('; Flags = ')
D		CALL OUT BYT (FLAGS)
D 101	CONTINUE
C END DEBUG
C
	IF (TYPE.GE.0 .AND. TYPE.LE.7) GO TO 102
		CALL NEWLIN
		CALL OUT TXT (';GSD 1:  Illegal type = ')
		CALL OUT OCT (TYPE)
		CALL FTL ERR ("10,'GSD entry type out of range')
  102	CONTINUE
C
	GO TO (110,120,130,140,150,160,170,180), TYPE+1
C
C---->>	TYPE 0:  Module name <<--------------------------------------
C
C	Declares the name of the object module.  The name need not be
C	unique with respect to other object modules  because modules
C	are identified by file, not module name.  However, only one
C	module name declaration can occur in a single object module.
C
C		-----------------------------------
C		|         RADIX-50 MODULE         |
C		----                           ----
C		|              NAME               |
C		-----------------------------------
C		|        0       |        0       |
C		-----------------------------------
C		|                0                |
C		-----------------------------------
C
  110	CALL CRLF
	CALL CRLF
	CALL NEWLIN
	CALL OUT TXT ('	.TITLE	')
	CALL OUT TXT (NAME)
	CALL CRLF
	CALL NEWLIN
	CALL OUT TXT (';Floating point register assignments:')
	DO 111 I=0,3
		CODE = I+"60
		CALL NEWLIN
		CALL OUT TXT ('AC')
		CALL OUT TXT (CODE)
		CALL OUT TXT ('=%')
		CALL OUT TXT (CODE)
  111	CONTINUE
	CALL CRLF
	GO TO 1000
C
C---->>	TYPE 1:  Control section name (CSECT) <<---------------------
C
C	Declares the name of a control section.  The linker converts
C	control sections - which include ASECTs, blank CSECTS, and
C	named CSECTS - to PSECTs.  For convenience, control sections
C	are converted as follows:
C	     Blank CSECT:     .PSECT     ,RW,I,LCL,REL,CON
C	     Named CSECT:     .PSECT     name,RW,I,GBL,REL,OVR
C	     ASECT:           .PSECT     . ABS.,RW,I,GBL,ABS,OVR
C
C		----------------------------------
C		|        RADIX-50 CONTROL        |
C		-----                        -----
C		|             NAME               |
C		----------------------------------
C		|       1       |     IGNORED    |
C		----------------------------------
C		|         MAXIMUM LENGTH         |
C		----------------------------------
C
  120	DO 121 I=1,6
		IF (NAME(I) .NE. ABS NAM(I)) GO TO 122
  121	CONTINUE
	FLAGS = "104		! ASECT
	GO TO 160
C
  122	DO 123 I=1,6
		IF (NAME(I) .NE. BLANK) GO TO 124
  123	CONTINUE
	FLAGS =  "40		! Blank CSECT
	GO TO 160
C
  124	FLAGS = "144		! Named CSECT
	GO TO 160
C
C---->>	TYPE 2:  Internal symbol name <<-----------------------------
C
C	Declares the name of an internal symbol with respect to the
C	module.  Because the linker does not support internal symbol
C	tables, the detailed format of this entry is not defined.
C	If the linker encounters an internal symbol entry while
C	reading the GSD, it ignores it.
C
C		----------------------------------
C		|             SYMBOL             |
C		-----                        -----
C		|              NAME              |
C		----------------------------------
C		|       2       |        0       |
C		----------------------------------
C		|           UNDEFINED            |
C		----------------------------------
C
  130	CALL NEWLIN
	CALL OUT TXT (';  Internal symbol name')
	CALL OUT TXT (NAME)
	CALL OUT TXT (', value = ')
	CALL OUT OCT (VALUE)
	GO TO 1000
C
C---->>	TYPE 3:  Transfer address <<----------------------------------
C
C	Declares the transfer address of a module relative to
C	a p-sect.  The first two words of the entry define the name
C	of the p-sect.  The fourth word indicates the relative offset
C	from the beginning of that p-sect.  If no transfer address
C	is declared in a module, the transfer address entry must
C	not be included in the GSD, or else a transfer address 000001
C	relative to the default absolute p-sect (. ABS.) must be
C	specified.
C
C		----------------------------------
C		|             SYMBOL             |
C		-----                        -----
C		|              NAME              |
C		----------------------------------
C		|       3       |        0       |
C		----------------------------------
C		|             OFFSET             |
C		----------------------------------
C
C		               NOTE
C	When the p-sect is absolute, OFFSET is the actual transfer
C	address if it is not equal to 000001.
C
  140	XFRADR = VALUE
	DO 141 I=1,2
  141	XFR NAM (I) = NRAD50 (I)
	GO TO 1000
C
C---->>	TYPE 4:  Global symbol name <<-----------------------------------
C
C	Declares either a global reference or a definition.  All
C	definition entries must appear after the declaration of the
C	p-sect under which they are defined, and before the declaration
C	of another p-sect.  Global references can appear anywhere within
C	the GSD.
C		+--------------------------------+
C		|             SYMBOL             |
C		+---                          ---+
C		|              NAME              |
C		+--------------------------------+
C		|       4       |     FLAGS      |
C		+--------------------------------+
C		|             VALUE              |
C		+--------------------------------+
C
C	The first two words of the entry define the name of the global
C	symbol.  The flag byte declares the attributes of the symbol.
C	The fourth word contains the value of the symbol relative to
C	the p-sect under which it is defined.
C
C	The flag byte of the symbol declaration entry has the bit
C	assignments as shown in the following table.  Bits 0, 1, 2,
C	4, 6, and 7 are not used.
C
C		Bit             Meaning
C	................................................................
C		 3	Definition
C			0 = Global symbol reference
C			1 = Global symbol definition
C		 5	Relocation
C			0 = Absolute symbol value
C			1 = Relative symbol value
C	................................................................
C
  150	N GLBLS = N GLBLS + 1
	IF (N GLBLS .GT. 400) CALL FTL ERR ("12,'More than 400 globals')
	G NAME (1, N GLBLS) = NRAD50(1)
	G NAME (2, N GLBLS) = NRAD50(2)
	G FLAGS (N GLBLS) = FLAGS
	G VALUE (N GLBLS) = VALUE
	G PSECT (N GLBLS) = N PSECT
  154	GO TO 1000
C
C---->>	TYPE 5:  Program section name (PSECT) <<------------------------
C
C	Declares the name of a p-sect and its maximum length in the
C	module.  It also uses the flag byte to declare the attributes
C	of the p-sect.  The default attributes of the p-sect are as
C	follows:
C		.PSECT	,RW,I,LCL,REL,CON
C
C	NOTE:  The length of all absolute sections is zero
C
C	GSD records must be constructed in such a way that once a p-sect
C	name has been declared, all global symbol definitions pertaining
C	to it must appear  before another p-sect name is declared.
C	Global symbols are declared by means of symbol declaration
C	entries.  Thus the normal format is a series of p-sect names,
C	each followed by optional symbol declarations.
C
C		+--------------------------------+
C		|             P-SECT             |
C		+---                          ---+
C		|              NAME              |
C		+--------------------------------+
C		|       5       |     FLAGS      |
C		+--------------------------------+
C		|         MAXIMUM LENGTH         |
C		+--------------------------------+
C 
C	The following table shows the bit assignments of the flag byte.
C	Bits 0, 1, and 3 are not used.
C
C		Bit	Meaning
C	...............................................................
C		 2	Allocation
C			0 = P-sect references are to be concatenated with
C			    other references to the same p-sect to form the
C			    total amount of memory allocated to the section.
C			1 = P-sect references are to be overlaid.  The total
C			    amount of memory allocated to the p-sect is the
C			    size of the largest request made by individual
C			    references to the same p-sect.
C		 4	Access (not supported by RT-11 monitors)
C			0 = P-sect has read/write access.
C			1 = P-sect has read-only access.
C		 5	Relocation
C			0 = P-sect is absolute and requires no relocation.
C			1 = P-sect is relocatable and references to the
C			    control section must have a relocation bias
C			    added before they become absolute.
C		 6	Scope
C			0 = The scope of the p-sect is local.  References
C			    to the same p-sect will be collected only within
C			    the overlay segment in which the p-sect is
C			    defined.
C			1 = The scope of the p-sect is global.  References
C			    to the p-sect are collected across overlay
C			    segment boundaries.
C		 7	Type
C			0 = The p-sect contains instruction (I) references.
C			    Concatenation of this p-sect will be by word
C			    boundary.  Globals will be given overlay
C			    control blocks.
C			1 = The p-sect contains data (D) references.  Con-
C			    catentation of this p-sect will be by byte
C			    boundary.  Globals will not go through the
C			    overlay handler.
C	....................................................................
C
  160	IF (N PSECT .EQ. 0) GO TO 166
	DO 162 I = 1,N PSECT
		IF (PSNAME(1,I).NE.NRAD50(1)) GO TO 162
		IF (PSNAME(2,I).NE.NRAD50(2)) GO TO 162
		GO TO 168
  162	CONTINUE
C
  166	NPSECT = NPSECT + 1
	IF (NPSECT .GT. 100) CALL FTL ERR ("13,'More than 100 PSECTS.')
	I = NPSECT
	PSNAME (1,I) = NRAD50 (1)
	PSNAME (2,I) = NRAD50 (2)
  168	PSFLAG (I) = FLAGS
	IF (PSVALU(I).LT.VALUE) PSVALU (I) = VALUE
	GO TO 1000
C
C---->>	TYPE 6:  Program version identification (IDENT) <<-------------
C
C	Declares the version of the module.  The linker saves the
C	version identification, or IDENT, of the first module that
C	declares a nonblank version.  It then includes this ident-
C	ification on the memory allocation map.
C
C	The first two words of the entry contain the version ident-
C	ification.  The linker does not use either the flag byte or
C	the fourth word because they contain no meaningful information.
C
C		+--------------------------------+
C		|             SYMBOL             |
C		+---                          ---+
C		|              NAME              |
C		+--------------------------------+
C		|       6       |        0       |
C		+--------------------------------+
C		|               0                |
C		+--------------------------------+
C
  170	CALL NEWLIN
	CALL OUT TXT ('	.IDENT	/')
	CALL OUT TXT (NAME)
	CALL OUT TXT ('/')
	GO TO 1000
C
C---->>	TYPE 7:  Mapped array declaration (VSECT) <<--------------------
C
C	Allocates space within the mapped array area of the job's
C	memory.  The linker adds the length (in units of 32-word
C	blocks) to the job's mapped area allocation.  It rounds
C	up the total amount of memory allocated to each mapped
C	array to the nearest 256-word boundary.  The contents of
C	the flag byte are reserved and assumed to be zero.
C	(Only the FORTRAN IV produces this VSECT.)  For convenience,
C	VSECT statements are translated into PSECTs as follows:
C		.PSECT     . VIR.,RW,D,GBL,REL,CON
C	The size is equal to the number of 32-word blocks required.
C	There must never be globals under this section, which starts
C	at a base of 0.
C				NOTE
C	One additional address window is allocated whenever a mapped
C	array is declared.
C
C		----------------------------------
C		|         RADIX-50 MAPPED        |
C		-----                        -----
C		|           ARRAY NAME           |
C		----------------------------------
C		|       7       |    RESERVED    |
C		----------------------------------
C		|             LENGTH             |
C		----------------------------------
C
  180	CALL NEWLIN
	CALL OUT TXT ('	.VSECT	/')
	CALL OUT TXT (NAME)
	CALL OUT TXT ('/')
	CALL OUT TXT ('	;length = ')
	CALL OUT INT (VALUE)
	CALL OUT TXT ('. 32-word blocks')
C
C======================= Check for end of GSD ========================
C
 1000	IF (LEN .GT. 1) GO TO 100
C
C	End of binary block
C
	RETURN
	END
	SUBROUTINE TXT 1				!Rev 8302.031
C
C====================> Scan text for branch labels <====================
C
	IMPLICIT INTEGER (A-Z)
C
C--------------------------------- COMMONS -----------------------------
C
	COMMON /LABELS/ NLABEL,LABL PS(2,1000),LABL OF(1000),
     1			PL NAME(2), L OFF
	COMMON /RECORD/ LEN, NXT CHR, RECORD(256)
	BYTE RECORD
C
D	COMMON /DEBUG/ DEBUG(50)
D	LOGICAL DEBUG
D	BYTE NAME(7)
D	DATA NAME /7*0/
C
C=======================================================================
C
	CALL RD WORD (COUNT)
	LOC TXT = COUNT
C
C---------------------------- Get the text -----------------------------
C
   40	CALL RD WORD (TEXT)
C
C-------------------------- Look for a branch --------------------------
C
	IN = TEXT .AND. "77777
	IF (IN .NE. TEXT) GO TO 50
	IF (IN .LT. "400) GO TO 100
   50	IF (IN .GE. "4000) GO TO 100
		OFFSET = TEXT .AND. "377
		IF (OFFSET.GE."200) OFFSET = OFFSET - "400
		OFFSET = 2*(OFFSET+1) + L OFF
		NLABEL = NLABEL + 1
		IF (NLABEL .GT. 1000)
     1			CALL FTL ERR("14,'More than 1000 labels')
		LABL PS (1,NLABEL) = PL NAME(1)
		LABL PS (2,NLABEL) = PL NAME(2)
		LABL OF (NLABEL) = OFFSET
C
C BEGIN DEBUG
D		IF (.NOT.DEBUG(23)) GO TO 200
D			CALL NEWLIN
D			CALL OUT TXT (';TXT 1: label ')
D			CALL OUT OCT (NLABEL)
D			CALL OUT TXT (' in psect #')
D			CALL R50ASC (6,LABL PS (1,NLABEL),NAME)
D			CALL SHORTN (NAME)
D			CALL OUT TXT (NAME)
D			CALL OUT TXT (', ')
D			CALL OUT OCT (L OFF)
D			CALL OUT TXT (' = ')
D			CALL OUT OCT (OFFSET)
D			CALL OUT TXT ('$ for text = ')
D			CALL OUT OCT (TEXT)
D 200		CONTINUE
C END DEBUG
C
  100	CONTINUE
C
	L OFF = L OFF + 2
	IF (LEN .GT. 1) GO TO 40
	RETURN
C
	END
	SUBROUTINE RLD 1				!Rev 8301.311
C
C====================> Process RLD record on pass 1 <=====================
C
	IMPLICIT INTEGER (A-Z)
C
	COMMON /LABELS/ NLABEL,LABL PS(2,1000),LABL OF(1000),
     1			PL NAME(2), L OFF
C
D	COMMON /DEBUG/ DEBUG(50)
D	LOGICAL DEBUG
C
C--------------------------- LOCAL VARIABLES ----------------------------
C
	BYTE NAME(7)
	DATA NAME /7*0/
C
C========================================================================
C
	N RLD = 0
	N R PTR = 1
C
   10	B = "40
	CALL RD BYTE (CODE)
	TYPE = CODE.AND."177
	IF ((CODE.AND."200) .NE. 0) B="102
	CALL RD BYTE (CODE)
	RELOC = CODE
C
C BEGIN DEBUG
D	IF (.NOT.DEBUG(24)) GO TO 15
D		CALL NEWLIN
D		CALL OUT TXT (';RLD:  Type = ')
D		CALL OUT OCT (TYPE)
D		CALL OUT TXT (', Reloc = ')
D		CALL OUT OCT (RELOC)
D		IF (B.EQ."102) CALL OUT TXT (' B')
D  15	CONTINUE
C END DEBUG
C
	IF (TYPE.GE.1 .AND. TYPE.LE."17) GO TO 20
		CALL NEWLIN
		CALL OUT TXT ('RLD 1:  Illegal type = ')
		CALL OUT OCT (TYPE)
		CALL FTL ERR ("15,'RLD entry type out of range')
   20	CONTINUE
C
	IF (TYPE .NE. 7) GO TO 100
C
C------------------- Process location counter definition -----------------
C
	CALL RD NAME (NAME,PL NAME)
	CALL SHORTN (NAME)
	CALL RD WORD (L OFF)
C
C BEGIN DEBUG
D	IF (.NOT. DEBUG(24)) GO TO 50
D		CALL OUT TXT (', Psect ')
D		CALL OUT TXT (NAME)
D		CALL OUT TXT (', offset = ')
D		CALL OUT OCT (L OFF)
D  50	CONTINUE
C
C--------------------------- All types go here ---------------------------
C
  100	CONTINUE
	IF (LEN .GT. 0) GO TO 10
C
	RETURN
	END
	SUBROUTINE ENDMOD				!Rev 8302.031
C
C===============>> Process an ENDMOD in pass 1 of UNMAC <<================
C
	IMPLICIT INTEGER (A-Z)
C
C-------------------------------- COMMONS --------------------------------
C
	COMMON /INPUT/ BLOCK,COUNT,INPUT(512)
	BYTE INPUT
	COMMON /GLOBLS/ NGLBLS,GNAME(2,400),GFLAGS(400),GVALUE(400),
     1		GPSECT(400)
	BYTE GFLAGS,GPSECT
	COMMON /PSECTS/ NPSECT,PSNAME(2,100),PSFLAG(100),PSVALU(100)
	BYTE PSFLAG
	COMMON /SAVE/ SAV BLK, SAV CNT
C
C---------------------------- LOCAL VARIABLES ----------------------------
C
	BYTE NAME(7)
	DATA BIT2,BIT3,BIT4,BIT5,BIT6,BIT7 /"4,"10,"20,"40,"100,"200/
	DATA ZERO /0/, NAME /7*0/
C
C------------------------------------------------------------------------
C
C	Reset pointers to the beginning of the module and force
C	a read of the first record
C
	BLOCK = SAV BLK - 1
	COUNT = 513
	CALL RD NEXT (CODE)
	COUNT = SAV CNT
C
C------------------ Print out global symbol references ------------------
C
	IF (N GLBLS .EQ. 0) GO TO 60
		CALL CRLF
		N G OUT = 5
		DO 50 I = 1, N GLBLS
			FLAGS = GFLAGS (I)
			STATE = FLAGS .AND. BIT3
			IF (STATE .NE. 0) GO TO 40
				N G OUT = N G OUT + 1
				IF (N G OUT .NE. 6) GO TO 30
					CALL NEWLIN
					N G OUT = 0
					CALL OUT TXT ('	.GLOBL	')
   30				CONTINUE
				CALL R50ASC (6,GNAME(1,I),NAME)
				CALL OUT GBL (NAME)
   40			CONTINUE
   50		CONTINUE
   60	CONTINUE
C
C------------------ Print out the global definitions -----------------
C
	IF (NGLBLS.EQ.0) GO TO 120
		CALL CRLF
		DO 110 I = 1, N GLBLS
			FLAGS = GFLAGS (I)
			STATE = FLAGS .AND. BIT3
			IF (STATE .EQ. 0) GO TO 100
			STATE = FLAGS .AND. BIT5
			IF (STATE .NE. 0) GO TO 100
				CALL R50ASC (6,GNAME(1,I),NAME)
				CALL NEWLIN
				CALL OUT TXT (NAME)
				CALL OUT TXT ('==')
				CALL OUT OCT (GVALUE(I))
  100			CONTINUE
  110		CONTINUE
  120	CONTINUE
C
C---------------------------- Output PSECTS ----------------------------
C
  200	IF (N PSECT .EQ. 0) GO TO 230
		CALL CRLF
		DO 220 I = 1, N PSECT
			II = I
			CALL R50ASC (6,PSNAME(1,II),NAME)
			CALL NEWLIN
			CALL OUT TXT ('	.PSECT	')
			CALL OUT TXT (NAME)
			FLAGS = PSFLAG(II)
			VALUE = PSVALU(II)
C
			STATE = FLAGS .AND. BIT 4
			IF (STATE.EQ.ZERO) CALL OUT TXT (',RW')
			IF (STATE.EQ.BIT4) CALL OUT TXT (',RO')
			STATE = FLAGS .AND. BIT 7
			IF (STATE.EQ.ZERO) CALL OUT TXT (',I')
			IF (STATE.EQ.BIT7) CALL OUT TXT (',D')
			STATE = FLAGS .AND. BIT 6
			IF (STATE.EQ.ZERO) CALL OUT TXT (',LCL')
			IF (STATE.EQ.BIT6) CALL OUT TXT (',GBL')
			STATE = FLAGS .AND. BIT 5
			IF (STATE.EQ.ZERO) CALL OUT TXT (',ABS')
			IF (STATE.EQ.BIT5) CALL OUT TXT (',REL')
			STATE = FLAGS .AND. BIT 2
			IF (STATE.EQ.ZERO) CALL OUT TXT (',CON')
			IF (STATE.EQ.BIT2) CALL OUT TXT (',OVR')
C
			IF (VALUE .EQ. 0) GO TO 210
				CALL OUT TXT ('	;Length = ')
				CALL OUT OCT (VALUE)
  				CALL NEWLIN
				CALL OUT TXT (NAME)
				CALL OUT TXT ('=.')
  210			CONTINUE
  220		CONTINUE
  230	CONTINUE
	CALL CRLF
C
C-----------------------------------------------------------------------
C
	RETURN
	END