Google
 

Trailing-Edge - PDP-10 Archives - bb-4157j-bm_fortran20_v11_16mt9 - fortran-compiler/listou.bli
There are 26 other files named listou.bli in the archive. Click here to see a list.
!COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1973, 1987
!ALL RIGHTS RESERVED.
!
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
!ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
!INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
!COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
!OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
!TRANSFERRED.
!
!THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
!AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
!CORPORATION.
!
!DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
!SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.

!AUTHOR F.INFANTE/DCE/SJW/JNG/TFV/CKS/RVM/AHM/CDM/AlB/PLB/MEM

MODULE LISOUT(RESERVE(0,1,2,3),SREG=#17,FREG=#16,VREG=#15,DREGS=4,GLOROUTINES)=
BEGIN

GLOBAL BIND LISTOV = #11^24 + 0^18 + #4554;	! Version Date:	3-Dec-86

%(

***** Begin Revision History *****

39	-----	------	GENERATE SYMBOL TABLE ENTRIES FOR FORMAT STMNTS,
			USE THE SYMBOL "STMNT-NUMBER F"
40	-----	-----	FIX BUG IN EDIT 39
41	-----	-----	ADD ROUTINE "LSTFORMATS" TO LIST ALL FORMAT STMNTS
			AT THE END OF A MACRO-EXPANDED LISTING
42	-----	-----	FIX BUG IN LSTFORMATS TO LIST RELATIVE ADDRS
			CORRECTLY
43	-----	-----	CHANGE "OUTMDA" SO THAT WHEN PSYMPTR IS THE CODE
			"PBFFORMAT" WE EXPECT THE RIGHT HALF OF THE INSTR
			IN THE PEEPHOLE BUFFER TO CONTAIN A PTR TO THE
			FORMAT STMNT (RATHER THAN THE REL ADDR OF THE FORMAT STRING)
44	-----	-----	TAKE OUT DEFINITIONS OF LOADER BLOCK TYPES - PUT
			THEM INTO A SEPARATE "REQUIRE" FILE.
			ALSO REMOVE THE ROUTINES "ZOUTBLOCK" AND 
			"ZDMPBLK". ZOUTBLOCK HAS BEEN MOVED TO THE MODULE
			RELBUF. ZDMPBLK IS NO LONGER NEEDED.
			ALSO, EDIT "ZENDALL" TO OUTPUT ANY CODE
			LEFT IN THE BUFFERS SYMRLBF,LOCRLBF, AND MAINRLBF.
			ALSO REMOVE THE ROUTINE "DATAOUT", MAKE OUTDATA CALL
			ZOUTBLOCK INSTEAD.
			ALSO REMOVE THE ROUTINE DMPRELONLST.
			ALSO REMOVE ALL REFERENCES TO "RELOCPTR" AND "RELBLOCK"
			AND DELETE THEIR DEFINITIONS.
45	-----	-----	REMOVE THE ROUTINES: ZOUTMSG,ZOUTSYM,ZOUTOCT,RADIX50,
			ZOUDECIMAL,ZOUOFFSET.
			THESE HAVE BEEN PUT INTO THE MODULE "RELBUFF"
46	-----	-----	REMOVE THE ROUTINE LSTRLWD WHICH HAS BEEN
			PUT INTO THE MODULE RELBUF
47	-----	-----	TAKE OUT DEF OF THE MACRO "CRLF" - IT IS NOW
			IN THE REQUIRE FILE "REQREL"
48	-----	-----	REMOVE THE ROUTINE OUTDATA - ITS NOT NEEDED IN
			FORTG
49	-----	-----	IN ZENDALL - MUST CALL DMPMAINRLBF (TO DUMP
			ANY CODE IN THE BUFFER) BEFORE DUMPING
			THE CONTENTS OF THE FIXUP BUFFERS
50	-----	-----	IN LSTINST  MOVE THE OUTPUT OF THE MACRO
			LISTING HEADING TO PHA3 SO THAT THE SIXBIT FUNCTION
			NAME WILL COME OUT AFTER THE HEADING

			IN OUTMDA - CHANGE IT SO THAT IT PUTS OUT
			A CRLF AT THE BEGINNING OF EACH LINE INSTEAD OF
			AT THE END.  THIS WILL MATCH THE WAY LSTINST DOES
			IT AND STRAIGHTEN OUT THE LISTING

			PUT PAGEHEADING CHECKS IN BOTH OF THE ABOVE ROUTINES

51	-----	-----	PUT OUT F LABELS AT THE END OF FORMAT STRINGS IF
			THE FLAG "DBGLABL" IS SET; OUTPUT L LABELS FOR
			THE LINES IF THE FLAG "DBGLABL" IS SET. HAVE P
			LABELS AT START OF FORMAT STMNTS.
52	-----	-----	PUT OUT THE SYMBOL '.VEND' AFTER THE END
			OF THE SCALARS AND ARRAYS
53	-----	------	DO NOT PUT OUT THE EXIT UUO (HAVE CALL TO FOROTS
			EXIT.)
54	15349	247	CHANGE ALL REFERENCES TO FORMAT LABELS TO XXXXP, (JNT)
55	QAR	317	FIX 247 TO STILL PUT XXF ON END, FIX SYMBOL TABLE, (JNT)
56	18015	356	PUT OUT GLOBAL MAIN. FOR MAIN PROG, (DCE)
57	19477	461	CHECK SIZES OF HIGH AND LOW SEGMENTS FOR OVERFLOW, (DCE)
58	QA754	464	ADD LINE/OCTAL MAP OUTPUT IF NO MACRO LISTING, (SJW)
59	QA754	476	MAKE LINE/OCTAL MAP OPTIONAL UNDER /MAP=MAPFLG, (SJW)

***** Begin Version 5A *****

60	22281	555	FIX MAP WITH ENTRY POINTS, (DCE)
61	23760	614	OUTPUT ONLY NON-BLANK LINES IN /LNMAP, (SJW)

***** Begin Version 5B *****

62	23066	636	DON'T DUMP LABELS TO THE REL FILE THAT WE DON'T
			  KNOW THE VALUE OF.  ALSO SET SNDEFINED WHEN
			  WE FILL IN THE SNADDR FIELD., (JNG)
63	25249	645	ENTRY POINTS CAUSE LINE COUNT TO BE OFF BY ONE, (DCE)
64	25250	646	SIXBIT SUBROUTINE NAMES HAVE LOCATION 0, (DCE)
65	25247	650	IMPROVE LISTING FILE WITH RESPECT TO DOUBLE
			PRECISION AND STRING LITERAL CONSTANTS, (DCE)
66	26442	705	USE NAME FROM PROGRAM STATEMENT AS THE ENTRY 
			POINT FOR THE MAIN PROGRAM, (DCE)
67	-----	734	ONLY PRINT DP CONSTANTS IN LISTING WHEN APPROPRIATE,
			(DCE)

***** Begin Version 6 *****

68	761	TFV	1-Mar-80	-----
	Adjust mnemonic table offset to deal with GFAD, etc.
	Print double octal literals for GFAD, etc. (/GFLOATING)

69	1003	TFV	1-Jul-80
	Add global symbol ..GFL. if compiling /GFLOATING for FORDDT
	support.  Suppress DDT output of .VEND and ..GFL. .

***** Begin Version 7 *****

70      1221    CKS     4-Jun-81
	Use LIT1 and LIT2 instead of CONST1 and CONST2 when referring to
	literal nodes.  Also test for end of ASCIZ string by using word
	count instead of literal-entry[CW5] EQL 0 check.

71      1224	CKS	12-Jun-81
	One more try at 1221... Remove dependence of ASCIZ lister on LITSIZ;
	have it output the whole string.  For the record, LITSIZ is the number
	of words in the character string including the null word at the end.

72	1245	TFV	3-Aug-81	------
	Fix ROUSYM to handle HISEG character descriptors.

73	1251	CKS	14-Aug-81	------
	LSTINST types addresses as NAME+OFFSET or NAME-OFFSET.  The calculation
	it uses to get the offset is OFFSET = EXTSIGN(ADDR) - NAME.  This does
	not work if ADDR is above 400000 octal.   Make it EXTSIGN(ADDR-NAME).

74	1261	CKS	21-Sep-81
	Do not output common block fixup for descriptor of character variable

75	1274	TFV	20-Oct-81	------
	Fix DMPSYMTAB to output all the .Qnnnn variables to the DDT symbol
	table

76	1406	TFV	27-Oct-81	------
	Fix DMPSYMTAB to output all the .Dnnnn variables to the DDT symbol
	table

77	1424	RVM	19-Nov-81
	Precede the formats in the object program and in the listed code
	by a count of the number of words in the format (in other words,
	make formats look like BLISS-10 PLIT's).  This is needed for
	assignable formats.

78	1433	RVM	14-Dec-81
	Rewrite LSTFORMAT to print as much format text per line as possible,
	instead of listing format text one word at a time.  Also, suppress
	listing nulls in format text.

79	1434	TFV	14-Dec-81	------
	Fix ROUSYM  to handle  external  character functions.   In  argument
	blocks, it should use the decriptor  for the function, not a  global
	request for its address.

1506	AHM	14-Mar-82
	Delete call  to ENDISNRLBLK  in ZENDALL  since the  output  of
	statement labels in DEBUG is now done with ZOUTBLOCK.

1512	AHM	26-Mar-82
	Convert all calls to  ZOUTBLOCK that created symbols  (RSYMBOL
	rel blocks) to  call the ZSYMBOL  routine instead.  Also  make
	flushing of SYMRLBF in ZENDALL work properly for 1070 blocks.

1525	AHM	1-Apr-82
	Various changes for  psected REL  files.  Emit  type 22  psect
	index blocks before dumping the type 10 local fixup buffer and
	before writing the type 7 start address block.  Write out type
	24 psect  end blocks  with  the values  of LOWLOC,  HILOC  and
	LARGELOC.  Also,  write out  a single  segment break  of  zero
	because LINK still needs a  type 5 END block.  Finally,  don't
	emit polish for instructions with negative Y fields that  look
	like hiseg references.

1526	AHM	7-Apr-82
	Change all the calls to ZOUTBLOCK for RCODE (type 1) blocks to
	calls to ZCODE to prepare  for psected REL files.  Call  CGERR
	if a peephole buffer entry of type PBF2LABREF is  encountered,
	since I  can't  find anything  that  uses them.   If  LARGELOC
	exceeds 30 bits, give the  error message "Program too  large".
	Use the proper relocation counter  to allocate space for  each
	psect instead of  always using  HILOC to  tell ZOUTBLOCK  what
	address is  being output.   Make DUMPSYMTAB  use SNPSECT  when
	defining labels.

1547	AHM	1-Jun-82
	Make ZENDALL complain  if the  size of all  the COMMON  blocks
	plus the sizes of the high and low segments exceeds 18 bits of
	address space, or if .LARG. exceeds 30 bits of address  space.

1562	TFV	18-Jun-82
	Fix ROUSYM to handle TYPECNV nodes in argument lists.  These are
	inserted over .Qnnnn variables used as the result descriptor for
	concatenations.  They cause the VALTYPE for the .Qnnnn  variable
	to be CHARACTER.

1564	AHM	21-Jun-82
	Make ZENDALL output /SYMSEG and /PVBLOCK to LINK if  compiling
	/EXTENDED.

1567	CDM	24-Jun-82
	Don't put out .Dnnn variables if NOALLOC is lit.

1572	AHM	29-Jun-82
	Move check for ?Program too large from ZENDALL to MRP3 so that
	the check is performed even if object code isn't generated.

1576	AHM	7-Jul-82
	Make the compiler emit a JRST to the start address of programs
	under /EXTENDED and have ZENDALL make that the entry vector.

1614	CDM	16-Aug-82
	Move the call to ARGCHECK for arg checking rel blocks from  PHA3
	to ZENDALL, after symbol table is dumped.


***** Begin Version 10 *********

2306	AlB	13-Feb-84
	Added code to DMPSYMTAB to put out global definitions of FLGVX.
	and FLG77. if Compatibility Flaggng is being done.

	FLGVX. is defined as all ones if /FLAG:VAX is used.
	FLG77. is defined as all ones if /FLAG:STANDARD is used.

2311	PLB	19-Feb-84	FREEDOM IS SLAVERY
	Use new routine ZOUSMOFFSET instead of ZOUOFFSET.
	OUTOFFSET now uses ZOUTADDR and outputs 24 bits
	and we are outputting instruction offsets to listing.

2321	AHM	13-Mar-84
	Make ROUSYM recognize references to EFIW table entries.  It
	calls a new routine named ROUEFIW to process such references.

2334	AHM	5-Apr-84
	Make the type 7 (Start) rel block output by ZENDALL reference
	the entry vector which lives in .DATA. under /EXTEND.

2337	CDM	8-Apr-84
	Output EFIW references /LISTING/MACRO.

2346	AHM	23-Apr-84
	Get rid of EXTERNAL for COMTSIZ, since no one uses it anymore,
	and the variable has been removed from GLOBAL.

2433	CDM	23-Jul-84
	Use VMSIZE  for  the size  of  virtual memory  in  the  decision
	whether to declare  the "Program too  large".  Should have  been
	done in edit 2322.
	Also delete use of ARGCHK, used for disabling argument  checking
	in V7 field test.  No reason to continue this!

2455	MEM	30-Aug-84
	Replace all occurrences of VAX with VMS.

2464	AHM	10-Oct-84
	When listing an EFIW in LSTEFIW don't output the variable name
	or use IDADDR in the offset computation for an EFIW with PSABS
	in EFEXTERN - it is an unrelocated formal array reference.

***** End V10 Development *****

***** End Revision History *****

4512	CDM	26-Aug-85
	Delete old never called routines.  TMPGEN, STRNGSCAN, ZSIXBIT.

4513	CDM	12-Sep-85
	Improvements to /STATISTICS for reporting symbol table size
	and COMMON block size.

4520	MEM	17-Sep-85
	Change reference of CLINK to DLINK.

4527	CDM	1-Jan-86
	VMS Long symbols phase II.  Convert all internal symbols from
	one word of Sixbit to [length,,pointer].  The lengths will be one
	(word) until a later edit, which will store and use long symbols.

4530	MEM	17-Feb-86
	Add long symbol support in routine ROUSYM.

4531	MEM	17-Feb-86
	Output secondary symbol table for FORDDT.

4535	CDM	13-May-86
	Make Link do a 30 bit fixup for a one word pointer to a label
	/EXTEND.  This shows up in NAMELIST processing, since we have
	labels pointing to Sixbit for the names.
	Also clean up peephole buffer output in LISTOU to stop using
	magic numbers.

4552	MEM	7-Oct-86
	When ROUSYM calls RADIX50 it should put the sixbit name to be converted
	into R2.
	Module:	
		LISTOU

4554	MEM	3-Dec-86
	Add parameter to all calls to ZOUTSYM indicating whether to blank pad
	or not. We don't want to blank pad symbols in the generated machine
	code.

ENDV11
)%

	! The routines in this module are for the purpose of generating  the
	! macro expanded listing of the code generated and the generation of
	! the relocatable binary information in the .REL file.

SWITCHES NOLIST;
REQUIRE FIRST.BLI;
REQUIRE TABLES.BLI;
REQUIRE REQREL.BLI;
SWITCHES LIST;

FORWARD
%2321%	ROUEFIW,	! Output a reference to an EFIW
	GMULENTRY,	! Generate a global symbol definition for multiple
			!  entry point names
%2337%	LSTEFIW;	! Outputs an EFIW ref to the listing file


EXTERNAL
	CHDSTART,
%1526%	CGERR,		! Fatal error message
%4531%	CMPSYM,		! Compare two long symbols
	CODELINES,
%1406%	DANCHOR,	! Start of .Dnnnn variable linked list
	DEFISN,		! Routine called for first instruction of each line to
			! put out a label corresponding to the line seq number
	DMPRLBLOCK,	! Routine to dump a buffered rel-file block out
	DMPMAINRLBF,	! Routine to dump the main rel-file buffer
	ENDSCAA,
%2334%	ENTADDR,	! Address of entry vector
	ERROUT,
	FORMPTR,	! Pointer to the first format statement in program
	HEADCHK,	! Checks line count and outputs headings
	HEADING,
	HILOC,		! Current hiseg available location
	HIORIGIN,	! Origin of high segment for twoseg compilations
	ISN,
	LABTBL,
%1526%	LARGELOC,	! Next available location in .LARG.
	LMCONO,		! Current map column number
	LMLINO,		! Current source line number
	LMRONO,		! Current map row number
	LOCRLBF,	! Rel file buffer
%4530%	LONGREL,	! Boolean indicating whether long symbols are put out
%4530%	LONGUSED,	! Boolean indicating whether long symbols were used
	LOWLOC,		! Current lowseg available location
	LSTOUT,
	MAINRLBF,	! Rel file buffer
%4513%	NSYMTBL,	! Number of buckets in symbol table.
%4527%	ONEWPTR,	! Returns [1,,pointer] to Sixbit argument passed
	OPMNEM,
	OUTMSG,
%645%	PAGELINE,
%4527%	BASE PROGNAME,
%1274%	QANCHOR,	! Start of .Qnnnn variable linked list
	RADIX50,
%2321%	OBJECTCODE RDATWD,	! Contains current rel data word
	RELBLOCK,	! Relocatable binary block
	RELDATA,	! Data word - current block number,,current data count
	RELOCWD,	! The relocation word for the block
	RELOUT,
%4530%	STADDR,		! Program start address
%650%	STRNGOUT,
	SYMRLBF,	! Rel file buffer
	SYMTBL,
%1614%	ZARGCHECK,	! Argument checking rel block routine.
%4531%	Z30CODE,
%1526%	ZCODE,		! Outputs type 1 or 1010 data blocks to rel file
	ZLABLMAK,
%4530%	ZNEWBLOCK,	
	ZOUDLB,		! Routine to  add to  the macro  expanded listing  a
			! label that is inserted on the first instruction of
			! each statement when the user has specified /DEBUG
	ZOUDECIMAL,
%2337%	ZOUOFFSET,	! Output 18 or 30 bit offset to listing
	ZOUTBLOCK,
	ZOUTMSG,
	ZOUTOCT,
%2311%	ZOUSMOFFSET,	! Outputs (+/-) offset to listing file
	ZOUTSYM,
%1512%	ZSYMBOL;	! Outputs a type 2 or 1070 symbol block to the REL file

MACRO
	CHROUT(C) = (CHR = (C);  LSTOUT()) $,	! Outputs a char to the listing
						! Argument  "C"   must  be   in
						! double (") rather than single
						! (') quotes.
%2337%	DECOUT(X) = (R1 = (X);  ZOUDECIMAL()) $,    ! Outputs a decimal number
%2337%	OCTOUT(X) = (R2<LEFT> = (X);  ZOUTOCT()) $; ! Outputs an octal number
ROUTINE DMPSECSYMTAB =	!New [4531]

!++
! FUNCTIONAL DESCRIPTION:
!
!	Dumps out entire secondary symbol table to rel file if /DEBUG and long
!	symbols used. Entry points will always be dumped out even if not /DEBUG
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	FLGREG		! Flag register containing /DEBUG flags
!
!	HILOC
!
! IMPLICIT OUTPUTS:
!
!	HILOC
!
!	RDATWD
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	Can flush main rel buffer to rel file
!
!--


BEGIN	
	BIND	DEBUGFLGS =
			! FLGREG bit positions for the various
			! DEBUG modifiers
			1^DBGDIMNBR +
			1^DBGINDXBR +
			1^DBGLABLBR +
			1^DBGTRACBR +
			1^DBGBOUNBR +
			1^DBGARGMBR;	

	! fields in a secondary symbol table entry
	MACRO 	SPTR = 0,30$,	![4531]	Pointer to name
		SCNT = 30,3$,	![4531] word count
		SFLG = 33,3$;	![4531] flag

	BIND	LOCL  = 1,	!LOCAL
	 	GLOBL = 2,	!GLOBAL
                PNAME = 6;	!PROGRAM NAME
	LOCAL BASE SYMPTR,
		DEBUGSPECIFIED,	! Boolean is true if /DEBUG was specified
	 	NAMOFFSET,
		NSYMTB,		! Number of long symbols
	      BASE TMP;		! Ptr to common block name

	! Set DEBUGSPECIFIED to true if any /DEBUG flags are set
	DEBUGSPECIFIED = (.FLGREG<FULL> AND DEBUGFLGS) NEQ 0;

	NAMOFFSET = .HILOC;
	NSYMTB = 1;

	! Dump out program name

	INCR J FROM 0 TO .PROGNAME<SYMLENGTH>-1
	DO
	BEGIN
		RDATWD=@(.PROGNAME<SYMPOINTER> +.J);
		Z30CODE(PSABS,PSCODE);
		HILOC = .HILOC + 1;
	END;

	DECR I FROM SSIZ-1 TO 0
	DO !Loop through symbol table
	   IF (SYMPTR _ .SYMTBL[.I]) NEQ 0 !If we have an non-zero entry here
	   THEN
	   BEGIN
		DO	!Loop through this entry and its collisions
		BEGIN
			IF .SYMPTR[OPRSP1] NEQ FNNAME1 	! not function name
			THEN IF NOT CMPSYM(.SYMPTR[IDSYMBOL],.PROGNAME) !not program name
			THEN IF (.DEBUGSPECIFIED AND .LONGUSED)	! /DEBUG and long symbols
			OR .SYMPTR[IDATTRIBUT(FENTRYNAME)]! entry point
			THEN 
			BEGIN
				! FOR /DEBUG we put out 2 entries for arrays
				IF .FLGREG<DBGDIMN>	
				AND .SYMPTR[OPRSP1] EQL ARRAYNM1
				AND ((NOT .SYMPTR[IDATTRIBUT(NOALLOC)])
				OR .SYMPTR[IDATTRIBUT(INCOM)])	!PUT IN COMMON
				THEN NSYMTB = .NSYMTB + 2
				ELSE NSYMTB = .NSYMTB + 1;

				INCR J FROM 0 TO .SYMPTR[IDSYMLENGTH]-1
				DO
				BEGIN
					RDATWD=@(.SYMPTR[IDSYMPOINTER] +.J);
					Z30CODE(PSABS,PSCODE);
					HILOC = .HILOC + 1;
				END;
			END;
		END
	        WHILE (SYMPTR _ .SYMPTR[CLINK]) NEQ 0;
	   END;

	! Associate label on symtable with this loc
	ZSYMBOL(LOCDEF,ONEWPTR(SIXBIT '.SYMTB'),.HILOC,PSCODE);

	! Put out the count
	RDATWD = .NSYMTB;
	IF .DEBUGSPECIFIED		! If /DEBUG then put out entire symbol table
	THEN IF .LONGUSED		! Long symbols exist
	THEN RDATWD<LEFT> = -1;	
	Z30CODE(PSABS,PSCODE);	
	HILOC = .HILOC + 1;

	! Output count,,pointer to program name
	
        RDATWD = 0;
	RDATWD<SPTR> = .NAMOFFSET;
	RDATWD<SCNT> = .PROGNAME<SYMLENGTH>;
	RDATWD<SFLG> = PNAME;	!PROGRAM NAME
	Z30CODE(PSCODE,PSCODE);
	HILOC = .HILOC + 1;
	
	! Output pointer to symbol value
	RDATWD = IF .FLGREG<PROGTYP> EQL MAPROG THEN .STADDR
		 ELSE .STADDR + .PROGNAME<SYMLENGTH> + 2;
	Z30CODE(PSCODE,PSCODE);
	HILOC = .HILOC + 1;

	NAMOFFSET = .NAMOFFSET + .PROGNAME<SYMLENGTH>;
	
	IF .NSYMTB GTR 1	
	THEN DECR I FROM SSIZ-1 TO 0
	DO !Loop through symbol table
	BEGIN
	   IF (SYMPTR _ .SYMTBL[.I]) NEQ 0 !If we have an non-zero entry here
	   THEN
	      DO	!Loop through this entry and its collisions
	      BEGIN			
			IF .SYMPTR[OPRSP1] NEQ FNNAME1 	! not function name
			THEN IF NOT CMPSYM(.SYMPTR[IDSYMBOL],.PROGNAME) !not program name
			THEN IF (.DEBUGSPECIFIED AND .LONGUSED)	! /DEBUG and long symbols
			OR .SYMPTR[IDATTRIBUT(FENTRYNAME)]! entry point
			THEN
			BEGIN	!  Long symbol
				! Output count and pointer to name

			        RDATWD = 0;
				RDATWD<SPTR> = .NAMOFFSET;	!ptr to symbol
				RDATWD<SCNT> = .SYMPTR[IDSYMLENGTH];
				IF .SYMPTR[IDATTRIBUT(FENTRYNAME)] !GLOBAL?
				THEN RDATWD<SFLG> = GLOBL  !GLOBAL
				ELSE RDATWD<SFLG> = LOCL; !LOCAL	
				Z30CODE(PSCODE,PSCODE);
				HILOC = .HILOC + 1;

				! Output pointer to symbol value
				RDATWD = .SYMPTR[IDADDR];
				IF .SYMPTR[IDATTRIBUT(INCOM)]
				   AND .SYMPTR[VALTYPE] NEQ CHARACTER
				THEN
				BEGIN
					! The Y field is the
					! subject of a fixup because of a
					! reference to COMMON so
					! don't relocate it.

					Z30CODE(PSABS, PSCODE);

					! Output a a global additive fixup to
					! add the external's value to the
					! COMMON's Y field.

					TMP = .SYMPTR[IDCOMMON];
					ZSYMBOL(GLB30ADDFIX, .TMP[COMNAME],
						.HILOC, PSCODE);
				END
				ELSE Z30CODE(.SYMPTR[IDPSECT],PSCODE);

				HILOC = .HILOC + 1;

				IF .FLGREG<DBGDIMN>	!IF USER SPECIFIED THE "DEBUG" SWITCH
				THEN	! THEN FOR ALL ARRAYS WE WANT TO
					! PUT A PTR IN THE SYMBOL TABLE ENTRY POINTING
					! TO THE DIMENSION INFORMATION FOR THE ARRAY
				BEGIN
					IF .SYMPTR[OPRSP1] EQL ARRAYNM1
					AND ((NOT .SYMPTR[IDATTRIBUT(NOALLOC)])
					OR .SYMPTR[IDATTRIBUT(INCOM)])	!PUT IN COMMON
					THEN
					BEGIN
					! Use the kluge of  adding a 2nd entry  for the same symbol  immediately
					! after its true definition which points to the dimension  information.
					! Note that since FORDDT searches the symbol table forwards, this means
					! it will see the symbol for the variable before it sees the pointer  to
					! the dimension table.
						REGISTER BASE T1;
						T1_.SYMPTR[IDDIM];	!PTR TO DIMENS TABLE ENT
						T1_.T1[ARADLBL];	!PTR TO LABEL TABLE ENTRY FOR
									!LABEL ON DIMENS INFO ARG BLOCK

						! Output count and pointer to name
	
				        	RDATWD = 0;
						RDATWD<SPTR> = .NAMOFFSET;	!ptr to symbol
						RDATWD<SCNT> = .SYMPTR[IDSYMLENGTH];
						RDATWD<SFLG> = LOCL; !LOCAL
						Z30CODE(PSCODE,PSCODE);
						HILOC = .HILOC + 1;

						! Output pointer to symbol value (ptr to dimension info)
						RDATWD = .T1[SNADDR];
						Z30CODE(.T1[SNPSECT],PSCODE); 
						HILOC = .HILOC + 1;
					END
				END;

				! Increment to next name	
				NAMOFFSET = .NAMOFFSET + .SYMPTR[IDSYMLENGTH];
			END;	! Long name
	      END
	      WHILE (SYMPTR _ .SYMPTR[CLINK]) NEQ 0;
	END;	
END;	! of DMPSECSYMTAB
ROUTINE DMPSYMTAB =
!++
!DUMPS THE SYMBOL TABLE TO REL FILE
!--
BEGIN

OWN	LABL;

%1274%	REGISTER BASE  SYMPTR;	! Pointer to the symbol to be output

	ROUTINE BLDLABL=
	%(***************************
		LOCAL ROUTINE TO BUILD THE SIXBIT FOR THE
		DECIMAL FORM OF THE STMNT NUMBER IN THE REG "R1".
		CALLED WITH THE VAR "LABL" CONTAINING ONE
		SIXBIT CHAR IN THE LEFTMOST SIX BITS. LEAVES "LABL" CONTAINING
		THE STMNT NUMBER FOLLOWED BY THAT CHAR.
	****************************)%
	BEGIN
			DO (
				LABL _ .LABL ^(-6);
				R2 _ .R1 MOD 10; R1 _ .R1/10;
				LABL<30,6> _ (#20[.R2]<0,0>); !MAKING ROOM FOR NEXT
				IF .R1 EQL 0 THEN EXITLOOP;
	   		   ) WHILE 1;
	END;


	%(**DUMP THE SYMBOL TABLE***)%
	DECR I FROM SSIZ-1 TO 0 DO
	BEGIN
		IF (SYMPTR _ .SYMTBL[.I]) NEQ 0
		THEN 
		BEGIN
			DO 
			BEGIN
%4513%				NSYMTBL = .NSYMTBL + 1;	! One more symbol

				IF .FLGREG<DBGDIMN>	!IF USER SPECIFIED THE "DEBUG" SWITCH
				THEN		! THEN FOR ALL ARRAYS WE WANT TO
						! PUT A PTR IN THE SYMBOL TABLE ENTRY POINTING
						! TO THE DIMENSION INFORMATION FOR THE ARRAY
				BEGIN
					IF .SYMPTR[OPRSP1] EQL ARRAYNM1
						AND ((NOT .SYMPTR[IDATTRIBUT(NOALLOC)])
						OR .SYMPTR[IDATTRIBUT(INCOM)])	!PUT IN COMMON
					THEN
					BEGIN
						! Use the kluge of  adding a 2nd entry  for the same symbol  immediately
						! before its true definition which points to the dimension  information.
						! Note that since FORDDT searches the symbol table backwards, this means
						! it will see the symbol for the variable before it sees the pointer  to
						! the dimension table.

						REGISTER BASE T1;
						T1_.SYMPTR[IDDIM];	!PTR TO DIMENS TABLE ENT
						T1_.T1[ARADLBL];	!PTR TO LABEL TABLE ENTRY FOR
									!LABEL ON DIMENS INFO ARG BLOCK

%1512%						ZSYMBOL(LOCSUPDEF,.SYMPTR[IDSYMBOL],.T1[SNADDR],PSCODE)
					END
				END;


				IF .SYMPTR[IDATTRIBUT(INCOM)]
%1261%				   AND .SYMPTR[VALTYPE] NEQ CHARACTER
				THEN
				  BEGIN
					MAP BASE R2;
%1512%					ZSYMBOL(LOCDEF,.SYMPTR[IDSYMBOL],.SYMPTR[IDADDR],PSABS);	! Common block offset
					R2 _ .SYMPTR[IDCOMMON];						! Add to symbol when the
%1512%					ZSYMBOL(GLBSYMFIX,.R2[COMNAME],.SYMPTR[IDSYMBOL],PSABS)		!  common address is set
				  END
				ELSE IF .SYMPTR[OPRSP1] NEQ FNNAME1
					AND NOT .SYMPTR[IDATTRIBUT(NOALLOC)]
%1512%				THEN ZSYMBOL(LOCDEF,.SYMPTR[IDSYMBOL],.SYMPTR[IDADDR],.SYMPTR[IDPSECT])	! Define vanilla symbol as
													!  an unsuppressed local
			   END WHILE (SYMPTR _ .SYMPTR[CLINK]) NEQ 0;
		      END;
	END;


! Output a  symbol for  the word  after  the end  of the  scalars  and
! arrays.  ENDSCAA contains the location  after the end of arrays  and
! scalars and is set in ALLSCA.

%1003%	! Suppress DDT output of .VEND

%4527%	ZSYMBOL(LOCSUPDEF,ONEWPTR(SIXBIT '.VEND'),.ENDSCAA,PSDATA);

%1003%	! Output the global symbol ..GFL. if compiling /GFLOAT for FORDDT
%1003%	! support

%1003%	IF .GFLOAT	! Give it the value of 1
%4527%	THEN ZSYMBOL(GLBSUPDEF,ONEWPTR(SIXBIT '..GFL.'),1,PSABS);

![2455] Output the global symbols FLGV. (if /FLAG:VMS) and FLG77. (if
![2306] /FLAG:STANDARD).  These globals tell FOROTS that there is Compatibility
![2306] flagging to do at runtime.

%2455%	IF FLAGVMS
%4527%	THEN ZSYMBOL(GLBSUPDEF,ONEWPTR(SIXBIT 'FLGV.'),-1,PSABS);
%2306%	IF FLAGANSI
%4527%	THEN ZSYMBOL(GLBSUPDEF,ONEWPTR(SIXBIT 'FLG77.'),-1,PSABS);

%4531%	DMPSECSYMTAB();

! Dump the local labels now

	DECR I FROM LASIZ-1 TO 0 DO
	BEGIN
	  IF (SYMPTR _ .LABTBL[.I]) NEQ 0 THEN
		BEGIN
		  DO BEGIN
%636%			IF .SYMPTR[SNDEFINED]
%636%			THEN
%636%			BEGIN
				LABL _ 0;
				R1 _ .SYMPTR[SNUMBER];
				LABL<30,6> _ IF .R1 GTR 99999 THEN (R1 _ .R1-99999; SIXBIT "M" ) ELSE SIXBIT "P";
				BLDLABL();	!IN "LABL" BUILD THE SIXBIT FOR
						! THE STMNT NUMBER IN R1 (FOLLOWED BY THE CHAR
						! ALREADY IN "LABL"

%4527%				ZSYMBOL(LOCDEF,ONEWPTR(.LABL),.SYMPTR[SNADDR],
%1526%					.SYMPTR[SNPSECT])
%636%			END;

		     END WHILE (SYMPTR _ .SYMPTR[CLINK]) NEQ 0;
		END;
	END;

%1274%	! Dump the .Qnnnn variable names

%1274%	SYMPTR = .QANCHOR;	! Start at the beginning (including those used
				!  for statement functions)

%1274%	WHILE .SYMPTR NEQ 0 DO
%1274%	BEGIN
%1512%		ZSYMBOL(LOCDEF,.SYMPTR[IDSYMBOL],.SYMPTR[IDADDR],PSDATA);
%1274%		SYMPTR = .SYMPTR[CLINK]
%1274%	END;

%1406%	! Dump the .Dnnnn variable names

%1406%	SYMPTR = .DANCHOR;	! Start at the beginning

%1406%	WHILE .SYMPTR NEQ 0 DO
%1406%	BEGIN
%1567%		! Only if we want to allocate it.
%1567%		IF NOT .SYMPTR[IDATTRIBUT(NOALLOC)]
%1567%		THEN
%1567%		BEGIN
%1512%			ZSYMBOL(LOCDEF,.SYMPTR[IDSYMBOL],.SYMPTR[IDADDR],
%1512%				PSCODE);
%1567%		END;
%4520%		SYMPTR = .SYMPTR[DLINK]
%1406%	END;

	!DEFINE A LABEL OF THE FORM <STMNT NUMBER>F ON THE LAST WD
	! OF EACH FORMAT STRING
	IF .FLGREG<DBGLABL>
	THEN
	!
	BEGIN
		REGISTER BASE FPTR;	!PTR TO FORMAT STMNT NODE
		FPTR_.FORMPTR<LEFT>;	!1ST FORMAT STMNT IN PROGRAM
		UNTIL .FPTR EQL 0
		DO
		BEGIN
			SYMPTR_.FPTR[SRCLBL];	!STMNT NUMBER TABLE
					! ENTRY FOR THE LABEL ON THE FORMAT
			R1_.SYMPTR[SNUMBER];	!STMNT NUMBER ON THE FORMAT STMNT
			LABL_0;
			LABL<30,6>_SIXBIT"F";
			BLDLABL();	!SET "LABL" TO THE SIXBIT FOR
					! <STMNT NUMBER>F
%1512%			! Address of last word of string
%4527%			ZSYMBOL(LOCDEF, ONEWPTR(.LABL),
%1512%				.FPTR[FORADDR]+.FPTR[FORSIZ]-1, PSDATA);
			FPTR_.FPTR[FMTLINK]	!GO ON TO NEXT FORMAT
		END;
	END;
END;	! of DMPSYMTAB
%650%	ROUTINE ZDOUTCON(WORD2)=
%650%	BEGIN
%650%		!LIST A DOUBLE WORD CONSTANT IN OCTAL
%650%		!WORD ONE IS IN R2; SECOND WORD IS IN WORD2
%650%	
%650%		STRNGOUT(PLIT ASCIZ '[EXP  ');
%650%	
%650%		DECR I FROM 11 TO 0 DO
%650%		BEGIN
%650%			R1_0; LSHC(R1,3);
%650%			CHR_.R1+#60; LSTOUT();
%650%		END;
%650%	
%650%		CHR_","; LSTOUT();
%650%	
%650%		R2_.WORD2;
%650%		DECR I FROM 11 TO 0 DO
%650%		BEGIN
%650%			R1_0; LSHC(R1,3);
%650%			CHR_.R1+#60; LSTOUT();
%650%		END;
%650%	
%650%		CHR_"]"; LSTOUT();
%650%	END;	! of ZDOUTCON
%650%	ROUTINE ZSOUTCON(ADDR)=
%650%	BEGIN
%650%		!OUTPUT A STRING STARTING FROM ADDR AND BEING NO
%650%		!MORE THAN 10 CHARACTERS.   THE FORMAT WILL BE:
%1224%		!    [ASCIZ /STRING/]
%650%		MAP BASE ADDR;
%650%	
%650%		STRNGOUT(UPLIT ASCIZ '[ASCIZ /');
%1224%		STRNGOUT(ADDR[LIT1]);
%1224%        	STRNGOUT(UPLIT ASCIZ '/]');
%650%	END;	! of ZSOUTCON
ROUTINE ZOUTCON=
BEGIN
	!LIST A CONSTANT IN OCTAL ; R2 CONTAINS VALUE
	CHR _ "["; LSTOUT();
	DECR I FROM 11 TO 0 DO
	BEGIN
		R1 _ 0; LSHC(R1,3);
		CHR _ .R1 + #60; LSTOUT();
	END;
	CHR _ "]"; LSTOUT()
END;	! of ZOUTCON
ROUTINE COMCOM=
!++
! Outputs two commas ",,"
!--
BEGIN
	CHR_",";
	LSTOUT();
	LSTOUT()
END;	! of COMCOM
ROUTINE LSTINST(IPTR)=

!++
! FUNCTIONAL DESCRIPTION:
!
!	Lists the MACRO-10 mnemonics of the instructions being generated
!	in the listing file.
!
! FORMAL PARAMETERS:
!
!	IPTR		Pointer to peephole buffer containing the
!			instruction being output.
!
! IMPLICIT INPUTS:
!
!	Unknown
!
! IMPLICIT OUTPUTS:
!
!	Unknown
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	Instruction line is output to the listing file.
!
!--


BEGIN

MACRO
	IISN	= (@IPTR)<FULL>$,	!LINENUMBER OF INSTRUCTION
	ILABEL	= (@IPTR+1)<LEFT>$,
	IADDRPTR	= (@IPTR+1)<RIGHT>$,
	IOPCODE	= (@IPTR+2)<27,9>$,
	IAC	= (@IPTR+2)<23,4>$,
	IINDIR = (@IPTR+2)<22,1>$,
	IINDEX = (@IPTR+2)<18,4>$,
	IEFFADDR = (@IPTR+2)<RIGHT>$;

MACRO	HEADRSW = CODELINES<LEFT>$;

LOCAL	OPPOINT;

BIND	ZADDR = IADDRPTR;
MAP	BASE ZADDR,
	BASE R2;

	ROUTINE ZLABLMAK(ILABLPT)=
	BEGIN
		! R1 contains label in binary
		MAP BASE ILABLPT;

		R1_.ILABLPT[SNUMBER];
		IF .R1 GTR 99999 THEN R1 _ .R1-99999;	!REDUCE TO NICE RANGE
		ZOUDECIMAL();			!OUTPUT VALUE OF R1 IN DECIMAL
		IF .ILABLPT[SNUMBER] GTR 99999
		THEN CHR _ "M"
		ELSE CHR _ "P";
		LSTOUT();
		.VREG

	END;	!Of ZMAKLABL

%734%	LOCAL DINSTF; !DOUBLE WORD INSTRUCTION FLAG


	IF .HEADRSW NEQ #777777
	THEN
	BEGIN
		CODELINES _ 0;
		HEADRSW _ #777777
	END;

	CRLF;
	HEADCHK();
	IF (R1 _ .IISN) GEQ 0
	THEN IF .R1 EQL 0
		THEN
		BEGIN
			CHR _ "*";
			LSTOUT()
		END
		ELSE ZOUDECIMAL();

	CHR _ #11;
	LSTOUT(); !TAB
	IF .IADDRPTR EQL PBFENTRY
	THEN
	BEGIN
		!ENTRY NAME TAKES UP ONE LISTING LINE - ACCOUNT FOR IT
%645%		CRLF;
%645%		PAGELINE_.PAGELINE-1;
%645%		CHR_#11;
%645%		LSTOUT();
		R2 _ .IEFFADDR;
		R2 _ .R2[IDSYMBOL];
%4554%		ZOUTSYM(TRUE);
		CHR _ ":";
		LSTOUT();
		RETURN
	END;

	!GEN THE RELATIVE LOCATION (OCTAL)

	R2<LEFT> _ .CODELINES<RIGHT>;
	ZOUTOCT();
	CHR _ #11;
	LSTOUT();	! TAB
	CODELINES _ .CODELINES + 1;

	IF .ILABEL NEQ 0 	!LIST A LABEL
	THEN
	BEGIN
		LOCAL BASE LABPT;
		LABPT _ .ILABEL;
		DO
		BEGIN
			ZLABLMAK(.LABPT);
			CHR _ ":";
			LSTOUT();
			CRLF;
			HEADCHK();
			CHR _ #11;
			LSTOUT();
			LSTOUT(); !TAB
		END
		WHILE (LABPT _ .LABPT[SNNXTLAB]) NEQ 0;
	END;

	! IF THE USER SPECIFIED  THE "DEBUG" SWITCH  THEN IF THIS  INSTR
	! STARTS A STMNT, LIST AN "L" LABEL ON THIS INSTR

	IF (R1_.IISN) GTR 0 AND .FLGREG<DBGLABL>
	THEN ZOUDLB();


	CHR _ #11;
	LSTOUT();	!TAB
%734%	DINSTF_0;

	! Now do the instruction listing

	IF .IOPCODE NEQ 0
	THEN
	BEGIN
		!First mnemonic is now GFAD (#103)
%761%		OPPOINT _ (OPMNEM-#103)[.IOPCODE]<0,6>;	!MNEMONIC TABLE POINTER
		INCR I FROM 0 TO 5 DO
		BEGIN		
			CHR _SCANI(OPPOINT,CHR);	!GET A CHARACTER
			IF(CHR _ .CHR + #40 ) LEQ #100 THEN EXITLOOP;
			! PICK UP FIRST CHAR OF INSTRUCTION
%734%			IF .I EQL 0 THEN DINSTF_.CHR;
			LSTOUT()
		END
	END;

	CHR _ #11;
	LSTOUT();	!TAB

	!AC field

%2337%	OCTOUT(.IAC);

	CHR _ ",";
	LSTOUT();

	! Output address field of instruction.  Do it differently if  we
	! have an EFIWREF.

%2337%	IF .ZADDR[OPRCLS] EQL EFIWREF
%2337%	THEN LSTEFIW(.ZADDR)
%2337%	ELSE
%2337%	BEGIN	! Not EFIWREF

		! Indirect bit.  Output "@".

		IF .IINDIR NEQ 0
		THEN
		BEGIN
			CHR _ "@";
			LSTOUT();
		END;

		!Address field in instruction

		IF .IADDRPTR GTR PBF2LABREF
		THEN
		BEGIN
			IF SYMBOL(ZADDR)
			THEN
			BEGIN	! Symbol
				R2 _ .ZADDR[IDSYMBOL];
%4554%				ZOUTSYM(FALSE)
			END
			ELSE
			BEGIN	! Not symbol

				IF .ZADDR[OPERSP] EQL CONSTANT
				THEN
				BEGIN	! Constant

					IF .ZADDR[DBLFLG]
					  OR .ZADDR[VALTYPE] EQL REAL
					THEN
					BEGIN	! Double prec or real

						IF .ZADDR[CONADDR] EQL .IEFFADDR
%650%						THEN
						BEGIN
							! 1st word of constant
							R2 _ .ZADDR[CONST1];

%734%							! Only print as  double
%734%							! octal if  instruction
%734%							! is  double  word,  i.
%734%							! e.,     the     first
%734%							! character begins with
%734%							! "D"  or  "G"   (avoid
%734%							! CAMxx).

%761%							IF .ZADDR[DBLFLG] AND
%761%							   (.DINSTF EQL "D"
%761%							 OR .DINSTF EQL "G")
%761%							THEN RETURN ZDOUTCON(.ZADDR[CONST2])
						END
						ELSE R2 _ .ZADDR[CONST2]

					END	! Double prec or real
					ELSE R2 _ .ZADDR[CONST2]; ! INTEGER or LOGICAL or BYTE

					RETURN ZOUTCON();
	
				END	! Constant
				ELSE
				BEGIN	! Not constant
					R2_.ZADDR[IDSYMBOL];
%4554%					ZOUTSYM(FALSE);
				END;

			END;	! Not symbol

%1251%			IF (R1 _ EXTSIGN(.IEFFADDR -.ZADDR[IDADDR])) NEQ 0
%2311%			THEN ZOUSMOFFSET();	!OUTPUT 18 BIT OFFSET

		END
		ELSE IF .IADDRPTR GTR 3 
			THEN BEGIN END
			ELSE IF .IADDRPTR GTR 2
				THEN
				BEGIN
					MAP BASE R2;
					R2_.IEFFADDR;
					R2 _ .R2[IDSYMBOL];
%4554%					ZOUTSYM(FALSE)
				END
				ELSE IF .IADDRPTR GTR 1
					THEN !DOTTED FUNCTION NAME
					BEGIN
%4527%					  	R2 = ONEWPTR( @(.IEFFADDR) );
%4554%						ZOUTSYM(FALSE)
					END
					ELSE  IF .IADDRPTR GTR 0	!NO SYMBOLIC ADDR
						THEN
						BEGIN
							R2<LEFT> _ .IEFFADDR;
							ZOUTOCT() !IMMEDIATE MODE VALUE
						END
						ELSE  ZLABLMAK(.IEFFADDR);


		!Index field  "(register)"

		IF .IINDEX NEQ 0 
%2337%		THEN
%2337%		BEGIN
%2337%			CHROUT("(");
%2337%			OCTOUT(.IINDEX);	! Register to use
%2337%			CHROUT(")");
%2337%		END;

%2337%	END;	! Not EFIWREF

END;	! of LSTINSTF
ROUTINE  LINEMAP (IPTR) =
!LIST ON LISTING DEVICE A LINE-NUMBER/OCTAL-LOCATION MAP IF
! NO MACRO LISTING WAS REQUESTED

BEGIN


MACRO	  IISN		= (@IPTR)<FULL>$,
	  IADDRPTR	= (@IPTR+1)<RIGHT>$,
	  HEADRSW	= CODELINES<LEFT>$;

	IF .HEADRSW NEQ #777777
	THEN
	BEGIN
		CODELINES _ 0;
		HEADRSW _ #777777;
	END;

	IF .IADDRPTR EQL PBFENTRY
	  THEN RETURN;

	IF .IISN GTR 0
		AND .LMLINO LSS .IISN	! BEWARE 1 LINE NUM FOR >1 OCTAL LOC
	THEN
	BEGIN
	    DO
	      BEGIN
		IF (LMCONO _ .LMCONO + 1) EQL 10
		  THEN BEGIN
		    LMCONO _ 0;
		    CRLF;
		    HEADCHK ();
		    CHR _ "0";
		    IF (LMRONO _ (.IISN DIV 10) - 1) LSS 999
		      THEN BEGIN
			LSTOUT ();
			IF .LMRONO LSS 99
			  THEN BEGIN
			    LSTOUT ();
			    IF .LMRONO LSS 9
			      THEN LSTOUT ();
			  END
		      END;
		    R1 _ LMRONO _ .LMRONO + 1;
		    ZOUDECIMAL ();
		    CHR _ "0";
		    LSTOUT ();
		    CHR _ " ";
		    LSTOUT ();
		    CHR _ ":";
		    LSTOUT ();
		    CHR _ " ";
		    LSTOUT ();
		    LMLINO _ .LMRONO * 10 - 1;
		  END
		  ELSE CHROUT("?I")
	      END
	      WHILE  (LMLINO _ .LMLINO + 1) LSS .IISN;
	    R2<LEFT> _ .CODELINES<RIGHT>;
	    ZOUTOCT ();
	  END;
	CODELINES _ .CODELINES + 1;
END;	! of LINEMAP
ROUTINE ROUIMFUN(FUNCPTR,FUNAME)=	!OUTPUT FUNCTION REQUEST GLOBAL
BEGIN
	RDATWD = .FUNCPTR<LEFT>^18;
%1526%	ZCODE(PSABS,PSCODE);		! Output PUSHJ P,0 to .CODE.

! Output a chained global  fixup request so that  LINK will place  the
! address of the start of the named  routine in the right half of  the
! PUSHJ instruction when the global symbol named in FUNAME is defined.

%1512%	ZSYMBOL(GLB18CHNFIX,.FUNAME,.HILOC,PSCODE)
END;	! of ROUIMFUN
ROUTINE ROURLABEL(LABLPTR)=
BEGIN
MAP
	BASE LABLPTR;
REGISTER
%1526%	MYPSECT;	! Psect to relocate the RH of the reference by

	RDATWD<LEFT> _ .LABLPTR<LEFT>;

! Instructions that  reference  labels are  either  defined  (backward
! references) or not  defined (forward references).   If the label  is
! defined, then it is in .CODE. unless it is for a FORMAT statement in
! .DATA.  ASSIGN statements that reference FORMATs come through  here,
! while I/O argument blocks are done right in OUTMDA.  If the label is
! not  defined,  then  the  first  reference  to  the  label  gets  an
! unrelocated 0 put out to mark the end of a fixup chain and the  rest
! of the references become the address of the previous instruction  in
! the .CODE. psect.

%1526%	IF .LABLPTR[SNSTATUS] EQL OUTPBUFF	! Is the label defined ?
%1526%	THEN MYPSECT = .LABLPTR[SNPSECT]	! Yes, use its psect
%1526%	ELSE IF .LABLPTR[SNDEFINED]		! No, first reference ?
%1526%	THEN MYPSECT = PSCODE			! No, the fixup uses .CODE. 
%636%	ELSE					! Yes, the first reference in a
%636%	BEGIN					!  chain contains absolute 0
%1526%		MYPSECT = PSABS;		! So don't relocate it
%636%		LABLPTR[SNADDR]_0;		! Store the zero
%636%		LABLPTR[SNDEFINED]_TRUE		! Say SNADDR is valid
%636%	END;

	 RDATWD<RIGHT> _ .LABLPTR[SNADDR];

! At this point RDATWD<RIGHT> contains  either 0 (if first time  label
! referenced) or  a hiseg  chain address  if not  first reference  and
! still undefined or the hiseg or  lowseg address of the location  the
! label defines.  The value OUTPBUFF means the label has been  defined
! to the loader.

%4535%	! If /EXTEND and nothing to overwrite in the left half (like
%4535%	! an instruction!), then do a 30 bit fixup.  We need this for
%4535%	! a word pointing to a label.  Link must insert any section
%4535%	! number.
%4535%
%4535%	IF EXTENDED AND .RDATWD<LEFT> EQL 0
%4535%	THEN Z30CODE(.MYPSECT,PSCODE)		! 30 bit relocation
%4535%	ELSE
%1526%	ZCODE(.MYPSECT,PSCODE);			! Relocate with the right psect

%636%	IF  .LABLPTR[SNSTATUS] NEQ OUTPBUFF
%636%	THEN
%636%	BEGIN
%636%		LABLPTR[SNADDR] _ .HILOC;	!CHAIN THE REQUEST
%636%		LABLPTR[SNDEFINED]_TRUE;
%636%	END;
END;	! of ROURLABEL
ROUTINE ROUEFIW(INSTRUCTION, EFIW) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Output an instruction or arg block which references an EFIW.
!
!	Clear the index field and set the indirect bit so that the
!	EFIW will be used as an indirect word.
!
!	Place a fixup backpointer to previous EFIW references in the
!	instruction's Y field and relocate it by .CODE.  If this is
!	the first reference to the EFIW, use unrelocated zero instead.
!
!	Update the header of the fixup chain in the EFIW table entry's
!	TARGADDR field to point to the current instruction.
!
! FORMAL PARAMETERS:
!
!	INSTRUCTION	Instruction word to be output.
!
!	EFIW		Pointer to EFIW table entry for instruction.
!			This is used to find the representative EFIW,
!			which holds the head of the fixup chain.
!
! IMPLICIT INPUTS:
!
!	HILOC		Unrelocated object address of the instruction
!			to be output to .CODE.
!
! IMPLICIT OUTPUTS:
!
!	EFIW[EFREP][TARGADDR]
!			Representative's TARGADDR gets updated with
!			the new head of this EFIW's fixup chain.
!
!	RDATWD		Destroyed.
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	Can flush main rel buffer to the object file.
!
!--


BEGIN	![2321] New

MAP
	BASE EFIW;			! Points to an EFIW table entry

	RDATWD = .INSTRUCTION;		! Get instruction for object file
	RDATWD[OTSIND] = 1;		! Set indirect bit
	RDATWD[OTSINX] = 0;		! Clear out index register field

	EFIW = .EFIW[EFREP];		! Find the representative EFIW
	RDATWD[OBJADDR] = .EFIW[TARGADDR];	! Point at the most recent
						!  reference, or 0 if none
	IF .EFIW[TARGADDR] EQL 0	! Is there a fixup chain?
	THEN ZCODE(PSABS,PSCODE)	! No, this is the start, absolute 0
	ELSE ZCODE(PSCODE,PSCODE);	! Yes, back pointer points to hiseg

	EFIW[TARGADDR] = .HILOC;	! Remember where the most recent
					!  reference to the EFIW is
END;	! of ROUEFIW
ROUTINE ROUSYM(INSTRUCTION,INSADDR,INARGBLOCK)=
BEGIN
	! Relocatable symbolic output

	MACRO ADD=3$,SUBT=4$;
%4530%	MACRO LADD=100$;

	MAP BASE R2;
%4530%	LOCAL SYM;	! count,,ptr to common block name
	LOCAL BASE SYMPTR; SYMPTR _ .INSADDR<RIGHT>;

%2321%	IF .SYMPTR[OPRCLS] EQL EFIWREF	! Is it an EFIW?
%2321%	THEN				! Yes, process specially
%2321%	BEGIN	! EFIWREF
%2321%		ROUEFIW(.INSTRUCTION, .SYMPTR);	! Emit the EFIW reference
%2321%		RETURN;			! Punt immediately
%2321%	END	! EFIWREF
%2321%	ELSE IF NOT SYMBOL(SYMPTR)	! No, is it a CONSTANT or TEMPORARY ?
	THEN				! Yes
	BEGIN
		RDATWD = .INSTRUCTION;
%1526%		IF .SYMPTR[OPERATOR] EQL CHARCONST	! Character constant ?
%1526%		THEN ZCODE(PSCODE,PSCODE)	! Yes, descriptor is in hiseg
%1526%		ELSE ZCODE(PSDATA,PSCODE);	! No, data is in lowseg
		RETURN
	END
%1562%	ELSE IF .SYMPTR[OPRCLS] EQL TYPECNV
%1562%	THEN	! Type convert node above .Qnnnn TEMPORARY
%1562%	BEGIN
%1562%		RDATWD = .INSTRUCTION;
%1562%		ZCODE(PSDATA, PSCODE);	! TEMPORARY is in the lowseg
%1562%		RETURN			! Done
%1562%	END;

	! Now check for subroutine or function call

	IF .SYMPTR[OPRSP1] EQL FNNAME1
	THEN IF (NOT .SYMPTR[IDATTRIBUT(FENTRYNAME)])
	THEN IF (NOT .SYMPTR[IDATTRIBUT(DUMMY)])
%1434%	THEN IF NOT (.SYMPTR[IDATTRIBUT(INEXTERN)] AND
%1434%		.SYMPTR[VALTYPE] EQL CHARACTER AND .INARGBLOCK EQL 1)
	THEN
	BEGIN
		ROUIMFUN(.INSTRUCTION,.SYMPTR[IDSYMBOL]);
		RETURN
	END;

! Here if  not a  function call  or subroutine  call, unless  it is  a
! character external function in an argument block since they now have
! descriptors.

	RDATWD _ .INSTRUCTION;

%1245%	! Don't try to output polish for character descriptors

%1245%	IF .SYMPTR[IDPSECT] EQL PSCODE
%1245%	THEN
%1245%	BEGIN
%1526%		ZCODE(PSCODE,PSCODE);
%1245%		RETURN
%1245%	END;

! Does an array offset look like a hiseg address ?

	IF EXTSIGN(.INSTRUCTION<RIGHT>) LSS -#400
%1525%		AND NOT EXTENDED	! Don't need kludge for psects
	THEN				! Yes, do polish fixup for instruction
	BEGIN
		RDATWD<RIGHT> _ 0;
%1526%		ZCODE(PSABS,PSCODE);

		IF NOT .SYMPTR[IDATTRIBUT(INCOM)]	! In common ?
		THEN			! No, normal fixup
%1245%		BEGIN
%1245%			RDATWD _ ADD^18+1;	!MEANS NEXT WD IS FULL WD OPERAND
%1245%			ZOUTBLOCK(RPOLISH,RELN);
%1245%			RDATWD _ EXTSIGN(.INSTRUCTION<RIGHT>);	!FULL WORD
%1245%			ZOUTBLOCK(RPOLISH,RELN);
%1245%			RDATWD _ 0;
%1245%			ZOUTBLOCK(RPOLISH,RELRI);
%1526%			RDATWD _ #777777^18 + (.HILOC+.HIORIGIN);	! Right half chained fixup,,address
%1245%			ZOUTBLOCK(RPOLISH,RELRI)
		END
	   	ELSE			! Operand is in common, additive global
		BEGIN			!  fixup needed
			R2 _ .SYMPTR[IDCOMMON];
%4530%			IF .LONGUSED AND .LONGREL
%4530%			THEN
%4530%			BEGIN
%4530%				SYM = .R2[COMNAME];
%4530%				RDATWD = LADD^18 + 010 + (.SYM<SYMLENGTH>*2)-1;
%4530%				ZNEWBLOCK(RLONGPOLISH);!NEXT WD IS GLOBAL REQUEST
%4530%				INCR I FROM 0 TO .SYM<SYMPOINTER> - 1
%4530%				DO
%4530%				BEGIN	!Loop to dump out name
%4530%					RDATWD = @(.SYM<SYMPOINTER>)[.I];
					ZNEWBLOCK(RLONGPOLISH);
%4530%				END;
%4530%				
%4530%				RDATWD = 001001^18 + #777777;
%4530%				ZNEWBLOCK(RLONGPOLISH);
%4530%				RDATWD = .INSTRUCTION<RIGHT>^18 + #000777;
%4530%				ZNEWBLOCK(RLONGPOLISH);
%4530%				RDATWD = (.HILOC+.HIORIGIN)^18;
%4530%				ZNEWBLOCK(RLONGPOLISH);
%4530%			END
%4530%			ELSE	!SHORT SYMBOLS
%4530%			BEGIN
				RDATWD _ ADD^18+2;   !NEXT WD IS GLOBAL REQUEST
				ZOUTBLOCK(RPOLISH,RELN);
%4552%				R2 = @@R2[COMNPTR];
				RDATWD _ RGLOBDEF + RADIX50();  !A GLOBAL REQUEST POLISH FIXUP
				ZOUTBLOCK(RPOLISH,RELN);
				RDATWD _ #1777777;	!1^18 + -1
				ZOUTBLOCK(RPOLISH,RELN);
				RDATWD _ .INSTRUCTION<RIGHT>^18+#777777;
				ZOUTBLOCK(RPOLISH,RELN);
%1526%				RDATWD _ (.HILOC+.HIORIGIN)^18;
				ZOUTBLOCK(RPOLISH,RELL)  ! Emit the fixup address
%4530%			END;
		END
	END		! So much for strange polish
	ELSE IF .SYMPTR[IDATTRIBUT(INCOM)]	! In common ?
	THEN				! Yes, need additive global fixup
	BEGIN
%1526%		ZCODE(PSABS,PSCODE);	! Output the instruction
		R2 _ .SYMPTR[IDCOMMON];	! Get pointer to common block

! Add the address  of the common  block to the  RH of the  instruction
! when LINK defines it.

%1512%		ZSYMBOL(GLB18ADDFIX,.R2[COMNAME],.HILOC,PSCODE)
	END
%1526%	ELSE ZCODE(.SYMPTR[IDPSECT],PSCODE)	! Not in common, normal case
END;	! of ROUSYM
ROUTINE OUTMOD(CODEPTR,COUNT)=
BEGIN

! Generates the  relocatable  binary instructions  for  the  compiler.
! Also responsible for calling routines  that generate the macro  code
! listing and the  routines that generate  symbol information for  the
! loader.   The  arguments  are  a  pointer  to  the  peephole  buffer
! containing code to be generated,  and the number of peephole  buffer
! entries to emit code for.

MAP
	PEEPHOLE CODEPTR,
	BASE R2;
REGISTER
	CODEBLOCK;

	CODEBLOCK = .CODEPTR<RIGHT>;

! Output line-number/octal-location map only if no macro listing

	IF .FLGREG<LISTING>
	THEN INCR I FROM 0 TO .COUNT-1
	    DO IF .FLGREG<MACROCODE>
%4535%		THEN LSTINST ((.CODEBLOCK)[.I*PBFENTSIZE])
		ELSE IF .FLGREG<MAPFLG>
%4535%		    THEN LINEMAP ((.CODEBLOCK)[.I*PBFENTSIZE]);

! Start relocatable binary generation if requested

	IF .FLGREG<OBJECT>
	THEN INCR I FROM 0 TO (.COUNT-1)
	DO
	BEGIN
		IF .CODEPTR[.I,PBFSYMPTR] GTR PBFENTRY	! Symbolic reference ?
%1434%		THEN ROUSYM(.CODEPTR[.I,PBFINSTR],.CODEPTR[.I,PBFSYMPTR],0)
		ELSE CASE .CODEPTR[.I,PBFSYMPTR] OF
		SET

! Either not symbolic, or label or  function call or call to a  dotted
! library function

		! Label address - pointer to label in RH of instruction
% PBFLABREF %	ROURLABEL(.CODEPTR[.I,PBFINSTR]);

		! No symbolic address, output the instruction
% PBFNOSYM %	BEGIN
			RDATWD = .CODEPTR[.I,PBFINSTR];
%1526%			ZCODE(PSABS,PSCODE)
		END;

		! Implicitly called function, RH points directly to SIXBIT name
% PBFIMFN %	ROUIMFUN(.CODEPTR[.I,PBFINSTR],
%4527%			ONEWPTR( @(.CODEPTR[.I,PBFADDR]) ));

		! Explicitly called function, RH points to STE for name
% PBFEXFN %	BEGIN
			R2 = .CODEPTR[.I,PBFADDR];
			ROUIMFUN(.CODEPTR[.I,PBFINSTR],.R2[IDSYMBOL])
		END;

		! Used in OUTMDA, not here
% PBF2LABREF %	BEGIN
		END;

		! Used in OUTMDA, not here
% PBF2NOSYM %	BEGIN
		END;

		! Used in OUTMDA, not here
% PBFFORMAT %	BEGIN
		END;

		! Used in OUTMDA, not here
% PBFLLABREF %	BEGIN
		END;

		! A global entry symbol definition
% PBFENTRY %	BEGIN

! Special case for global entry definitions (generates no data or instructions)

			GMULENTRY(.CODEPTR[.I,PBFADDR]);

! Decrement HILOC to make  up for the increment  coming at end of  the
! INCR loop so that the next instruction will have the same address as
! that assigned to the entry symbol

			HILOC = .HILOC-1
		END

		TES;

! If there are labels on the present peephole buffer entry, output them

		IF .CODEPTR[.I,PBFLABEL] NEQ 0
		THEN
		BEGIN	REGISTER BASE LINLABEL;

			LINLABEL = .CODEPTR[.I,PBFLABEL];

			DO		! Loop over all labels
			BEGIN
%636%				IF .LINLABEL[SNDEFINED]
				THEN
				BEGIN
					RDATWD = .LINLABEL[SNADDR]^18+.HILOC;
					ZOUTBLOCK(RLOCAL,RELB)
				END;

				LINLABEL[SNSTATUS] = OUTPBUFF;	!DEFINE IT (HAS
								!  PASSED THRU
								!  PBUFF)
				LINLABEL[SNADDR] = .HILOC;	!DEFINING THE
								! SYMBOL NOW
%636%				LINLABEL[SNDEFINED] = TRUE
			END WHILE (LINLABEL = .LINLABEL[SNNXTLAB]) NEQ 0
		END;

! If this instruction starts a source line and the user specified  the
! /DEBUG:LABELS switch, output a label for this instruction.

		IF .CODEPTR[.I,PBFISN] GTR 0 AND .FLGREG<DBGLABL>
		THEN DEFISN(.CODEPTR[.I,PBFISN]);

		HILOC = .HILOC + 1	!INCREMENT HISEG AVAILABLE LOCATION

	END;	!END OF INCR LOOP

	.VREG
END;	! of OUTMOD
GLOBAL ROUTINE OUTMDA(ARPTR,ARCOUNT)=
BEGIN

!++
! FUNCTIONAL DESCRIPTION:
!
!	Outputs to the REL file the  arg blocks for all statements that  use
!	them.  These  include I/O  lists,  function or  subroutine  argument
!	lists, and other arg lists.
!
!	The call to this routine is made with a pointer to the argument code
!	words and a count of the number of words to generate.  The format of
!	the block of words is the similar  to that used in a call to  OUTMOD
!	to output instructions.
!
! FORMAL PARAMETERS:
!
!	Unknown
!
! IMPLICIT INPUTS:
!
!	Unknown
!
! IMPLICIT OUTPUTS:
!
!	Unknown
!
! ROUTINE VALUE:
!
!	Unknown
!
! SIDE EFFECTS:
!
!	Unknown
!
!--


MAP
	BASE R1:R2;

%4535%	REGISTER PPEEPFRAME PTR;	! Register to use in macros;

MACRO
%4535%	ILABEL =	(PTR = (@ARPTR)[.I];	 PTR[PBFLABEL]) $,
%4535%	IADDRPTR =	(PTR = (@ARPTR)[.I];	 PTR[PBFSYMPTR]) $,
%4535%	ILADDR = 	(PTR = (@ARPTR)[.I];	 PTR[PBFLINSTR]) $,
%4535%	IRADDR = 	(PTR = (@ARPTR)[.I];	 PTR[PBFADDR]) $,
%4535%	IARGWD =	(PTR = (@ARPTR)[.I];	 PTR[PBFINSTR]) $;

LOCAL
%2337%	BASE CNODE;

%4535%	INCR I FROM 0 TO (.ARCOUNT-1) * PBFENTSIZE BY PBFENTSIZE
	DO
	BEGIN
		IF .FLGREG<LISTING>
		THEN IF .FLGREG<MACROCODE>
		THEN
		BEGIN
			CRLF;
			HEADCHK();
			CHROUT("?I");

! Subroutine SIXBIT name should not print location 0 (none at all!)

%646%			IF .CODELINES<RIGHT> NEQ 0
%646%			THEN
%646%			BEGIN
%646%				R2<LEFT> = .CODELINES<RIGHT>;
%646%				ZOUTOCT()
%646%			END;
%646%			CHROUT("?I");
			CODELINES = .CODELINES+1;

			IF .ILABEL NEQ 0
			THEN
			BEGIN
				ZLABLMAK(.ILABEL);
				CHROUT(":")
			END;
			CHROUT("?I")
		END
		ELSE IF .FLGREG<MAPFLG>
		THEN CODELINES = .CODELINES+1;	! Update octal location counter
						!  for entry points

		SELECT .IADDRPTR OF NSET
	PBFLABREF:	EXITSELECT
			(
			IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE>  THEN
			BEGIN
			 R2<LEFT> = .ILADDR; ZOUTOCT();
			 COMCOM(); ! ",,"
			 ZLABLMAK(.IRADDR); 
			END;
			IF .FLGREG<OBJECT> THEN
				ROURLABEL(.IARGWD);
			);

	PBFNOSYM:	EXITSELECT
			(
			IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE>  THEN
			BEGIN
			 R2<LEFT> = .ILADDR; ZOUTOCT();
			 COMCOM();
			 R2<LEFT> = .IRADDR; ZOUTOCT();
			END;
			IF .FLGREG<OBJECT> THEN
%1526%			 (RDATWD = .IARGWD; ZCODE(PSABS,PSCODE));
			);
	PBF2NOSYM:	EXITSELECT
			(
			IF .FLGREG<LISTING>
			THEN IF .FLGREG<MACROCODE>
			THEN
			BEGIN
				R2<LEFT> = .ILADDR; ZOUTOCT();
				COMCOM();
				R2<LEFT> = .IRADDR; ZOUTOCT();
			END;
			IF .FLGREG<OBJECT>
			THEN
			BEGIN
				RDATWD = .IARGWD;
%1526%				ZCODE(PSABS,PSCODE)
			END;

			);
	PBFIMFN:	EXITSELECT
			(
			IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE>  
			THEN
			BEGIN
				R2<LEFT> = .ILADDR; ZOUTOCT();
				COMCOM();
%4527%				R2 = CNODE = ONEWPTR( @.IRADDR ); 
%4554%				ZOUTSYM(FALSE);
			END;
			IF .FLGREG<OBJECT>
%4527%			THEN ROUIMFUN(.IARGWD, .CNODE);

			);
	PBFEXFN:	EXITSELECT
			(
			IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE>  THEN
			BEGIN
			 R2<LEFT> = .ILADDR; ZOUTOCT();
			 COMCOM();
%4554%			 R2 = .IRADDR; R2 = .R2[IDSYMBOL]; ZOUTSYM(FALSE);
			END;
			IF .FLGREG<OBJECT> THEN
			 (R2 = .IRADDR; ROUIMFUN(.IARGWD,.R2[IDSYMBOL]));
			);
	PBF2LABREF:	EXITSELECT
%1526%			(CGERR(); ! Label,,label is no longer used as of V6
!			IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE>  THEN
!			BEGIN
!			 ZLABLMAK(.ILADDR); COMCOM(); ZLABLMAK(.IRADDR);
!			END;
!			IF .FLGREG<OBJECT> THEN
!			 (R1 = .ILADDR; R2 = .IRADDR;
!			  RDATWD = .R1[SNADDR]^18 +  .R2[SNADDR];
!			  ZOUTBLOCK(RCODE,RELB);
!			 );
			);
	PBFFORMAT:	EXITSELECT
			BEGIN
			  REGISTER BASE TPTR;	!TEMPORARY PTR
			  IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE>  THEN
			   BEGIN
				R2<LEFT> = .ILADDR; ZOUTOCT();
				COMCOM();
				!TYPE THE P LABEL FOR THE RIGHT HALF
				TPTR = .IRADDR;	!PTR TO THE FORMAT STMNT
				TPTR = .TPTR[SRCLBL];	!STMNT NUMBER TABLE ENTRY FOR THE LABEL
				R1 = .TPTR[SNUMBER]; ZOUDECIMAL();	!THE STMNT NUMBER OF THE FORMAT

				CHROUT("P");	!FOLLOWED BY "P"
			   END;
			  IF .FLGREG<OBJECT> THEN
			   BEGIN
				TPTR = .IRADDR;	!PTR TO FORMAT STMNT
				RDATWD = .ILADDR^18	!LEFT HALF OF OUTPUT WD COMES DIRECTLY FROM PBUFF
					+ .TPTR[FORADDR];	!RIGHT HALF IS REL ADDR OF THE FORMAT STMNT
%1526%				 ZCODE(PSDATA,PSCODE)
			   END;
			END;
	OTHERWISE:
		BEGIN
			IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE>  
			THEN
			BEGIN	! /LIST/MACRO

				CNODE = .IADDRPTR;

%2337%				IF .CNODE[OPRCLS] EQL EFIWREF
%2337%				THEN
%2337%				BEGIN	! EFIW
%2337%
%2337%					MAP OBJECTCODE R2;
%2337%
%2337%					R2<LEFT> = .ILADDR;
%2337%					R2[OTSIND] = 1;	! Indirect
%2337%					R2[OTSINX] = 0;	! No register
%2337%					ZOUTOCT();	! Arg in R2<LEFT>
%2337%					COMCOM();	! ",,"
%2337%
%2337%					LSTEFIW(.CNODE); ! List EFIW
%2337%
%2337%				END	! EFIW
%2337%				ELSE
%2337%				BEGIN	! Not EFIW

					R2<LEFT> = .ILADDR;
					ZOUTOCT();
					COMCOM();

					R2 = .IADDRPTR;
					IF .R2[OPERSP] EQL CONSTANT
%650%					THEN
%650%					BEGIN	! Constant

						![650] IN ARGUMENT LISTS,  TAKE
						![650] CARE OF ARGUMENTS  BASED
						![650] ON THEIR TYPE.
%650%						LOCAL TMP;

						TMP = .(@ARPTR)[.I+2]<23,4>;

						! Output constant depending
						! on what type it is.

%650%						IF .TMP EQL #17
%1245%						THEN	ZSOUTCON(.R2)	! Hollerith
%1245%						ELSE	IF .TMP EQL #15
%1245%							THEN 
%1245%							BEGIN	! Character
%1245%
%1245%								STRNGOUT(UPLIT
%1245%									ASCIZ
%1245%									'.HSCHD');
%1245%								R1 = .R2[IDADDR]
%1245%									- .CHDSTART;
%2311%								ZOUSMOFFSET(); !OUTPUT 18 BIT OFFSET
%1245%							END
%1245%							ELSE
%650%							IF .R2[DBLFLG]
%650%							THEN
%650%							BEGIN	!DP OR COMPLEX CONSTANT
%650%								TMP = .R2[CONST2];
%650%								R2 = .R2[CONST1];
%650%								ZDOUTCON(.TMP)
%650%							END
%650%							ELSE
%650%							BEGIN
%650%								IF .R2[VALTYPE] EQL REAL
%650%								THEN R2 = .R2[CONST1]
%650%								ELSE R2 = .R2[CONST2];
%650%								ZOUTCON();
%650%							END;
%650%
%650%					END	! Constant
					ELSE
					BEGIN	! Not constant

						R2 = .R2[IDSYMBOL];
%4554%						ZOUTSYM(FALSE);
						R2 = .IADDRPTR;
%2311%				 		!Output offset
%1251%						IF (R1 = EXTSIGN(.IRADDR
%1251%							- .R2[IDADDR])) NEQ 0
%2311%						THEN ZOUSMOFFSET();

					END;	! Not constant

%2337%				END;	! Not EFIW

			END;	! /LIST/MACRO

%1434%			IF .FLGREG<OBJECT> THEN ROUSYM(.IARGWD,.IADDRPTR,1);

		END;

		TESN;

		IF .FLGREG<OBJECT>
		THEN
		BEGIN	! Create .REL file

			IF .ILABEL NEQ 0
			THEN
			BEGIN
				REGISTER BASE LABENT;
				LABENT = .ILABEL;

%636%				IF .LABENT[SNDEFINED]
				THEN
				BEGIN
					RDATWD = .LABENT[SNADDR]^18+.HILOC;
					ZOUTBLOCK(RLOCAL,RELB)
				END;

				LABENT[SNSTATUS] = OUTPBUFF;	!THRU THE OUTPUT BUFFFER
				LABENT[SNADDR] = .HILOC;	!DEFINING THE SYMBOL NOW
%636%				LABENT[SNDEFINED] = TRUE;
			END;
			HILOC = .HILOC + 1;	!INCREMENT HISEG AVAILABLE LOCATION

		END;	! Create .REL file

	END; !Of INCR I DO

END;	! of OUTMDA
GLOBAL ROUTINE ZENDALL =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Finishes output of REL file for current program unit.  Dumps
!	symbol table.  Defines global symbol(s) for start of main
!	program.  Flushes symbol, local fixup and main rel buffers.
!	Outputs type 1120 (argument descriptor), type 7 (start), type
!	23 (psect break) and type 5 (end) rel blocks.  Puts LINK
!	switches in the object file in ASCII.
!
! FORMAL PARAMETERS:
!
!	None
!
! IMPLICIT INPUTS:
!
!	ENTADDR		Address of the entry vector (relative to
!			beginning of lowseg).  This contains valid
!			data only under /EXTEND.
!
!	F2<EXTENDFLAG>	Flag for /EXTEND.
!
!	FLGREG<PROGTYP>	Distinguishes main programs from other kinds
!			of program units.
!
!	PROGNAME	Name of main program from PROGRAM statement
!
!	PSECTS		Relocation counters of all the psects.  Output
!			as the psect breaks in type 23 blocks.
!
! IMPLICIT OUTPUTS:
!
!	RDATWD		Smashed numerous times by output to REL buffer.
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	Outputs many kinds of REL blocks to the object file.
!
!--


BEGIN

BIND
%1564%	PDVTEXT = PLIT(ASCIZ '/SYMSEG:PSECT:.DATA./PVBLOCK:PSECT:.CODE.');

! Note: The length  of every  PLIT (in words)  is stored  as the  word
! preceding the PLIT.  Hence, in the last example, .PDVTEXT[-1] = 9.

MAP RELBUFF
	SYMRLBF:	! Holds type 2 and 1070 symbol data
	LOCRLBF:	! Holds type 10 local fixup data
	MAINRLBF;	! Holds all other types of data

LOCAL
%1525%	MYRELBUF[3];	! Holds type 22 block for E/A

	! Dump the symbol  table to  REL file. This  merely stuffs  data
	! into SYMRLBF,  it  does not  guarantee  that the  symbols  are
	! output to the rel file yet.

%4531%	DMPSYMTAB();



	! Dump any local requests, global requests, and symbol 	definitions
	! that are still in their buffers

	DMPMAINRLBF();	! Must output any code blocks to the REL file
			!  before dumping local and global requests
			! (This routine call only dumps MAINRLBF)

	! Put out a  global symbol  for main  program so  LINK can  warn
	! about two main programs.

	IF .FLGREG<PROGTYP> EQL MAPROG THEN
	BEGIN
%4527%		ZSYMBOL(GLBDEF,ONEWPTR(SIXBIT 'MAIN.'),.STADDR,PSCODE);

%705%		! If a real program name was  given to the program, use  it
%705%		! as an entry point for the main program - this is the only
%705%		! way (short of a MACRO program) to get this effect.

%4527%		IF @@PROGNAME<SYMPOINTER> NEQ SIXBIT 'MAIN.'
%1512%		THEN ZSYMBOL(GLBDEF,.PROGNAME,.STADDR,PSCODE)
	END;

	IF .SYMRLBF[RDATCNT] NEQ 0
	THEN
%1512%	BEGIN
%1512%		IF .SYMRLBF[RTYPE] EQL RSYMBOL
%1512%		THEN DMPRLBLOCK(SYMRLBF,.SYMRLBF[RDATCNT]+2)
%1512%		ELSE DMPRLBLOCK(SYMRLBF,.SYMRLBF[RDATCNT]+1)
%1512%	END;


%1614%	! Output the argument checking rel blocks for subprogram  calls.
%1614%	! We output it  here so  that Link  will have  the symbol  table
%1614%	! values for better error message diagnostics.

%2433%	ZARGCHECK();


	IF .LOCRLBF[RDATCNT] NEQ 0	! Anything left in the fixup buffer ?
	THEN				! Yes, dump it
	BEGIN
		! We always set the default psect index every time  we
		! output a block which depends on it.  This is because
		! LINK is suspected  of destroying  the variable  that
		! holds the  default during  the processing  for  some
		! blocks.  It  will work  if it  is set  before  every
		! block that depends on it, however.

%1525%		IF EXTENDED		! Psected object code ?
%1525%		THEN			! Yes, set the default psect index
%1525%		BEGIN
%1525%			MYRELBUF[0] = RPSECTORG^18 OR 1;
%1525%			MYRELBUF[1] = 0;	! No relocation
%1525%			MYRELBUF[2] = PXCODE;	! All local fixups are for code
%1525%			DMPRLBLOCK(MYRELBUF,3)
%1525%		END;

		DMPRLBLOCK(LOCRLBF,.LOCRLBF[RDATCNT]+2)
	END;

	IF .FLGREG<PROGTYP> EQL MAPROG
	THEN
	BEGIN
%1525%		IF EXTENDED	! If doing psected object code, then set the
%1525%		THEN		!  default psect index.  See comment above
%1525%		BEGIN		!  about why we always set the index
%1564%			DMPRLBLOCK(PDVTEXT,.PDVTEXT[-1]); ! Pass LINK switches

%2334%			RDATWD = PXDATA;		! Relocate by .DATA.
%1525%			ZOUTBLOCK(RPSECTORG,RELN);
%2334%			RDATWD = ENTVECSIZE^18 OR .ENTADDR	! Entry vector
%1525%		END
%1526%		ELSE RDATWD = .STADDR + .HIORIGIN;	! Not psected, hisegize
							!  the start address

		ZOUTBLOCK(RSTART,RELRI) ! Start address block
	END;


	! Time to output the segment breaks or psect breaks (type 5 or 23)

%1525%	IF EXTENDED	! Psected REL file ?
%1525%	THEN		! Yes, output psect breaks
%1525%	BEGIN		! Psected REL files tell LINK where their psects end
%1525%
%1525%		RDATWD = PXCODE;	! Psect index
%1525%		ZOUTBLOCK(RPSECTEND,RELN);
%1525%		RDATWD = .HILOC;	! Psect break
%1525%		ZOUTBLOCK(RPSECTEND,RELRI);
%1525%		DMPMAINRLBF();		! Only one psect per block
%1525%
%1525%		RDATWD = PXDATA;	! Again for .DATA.
%1525%		ZOUTBLOCK(RPSECTEND,RELN);
%1525%		RDATWD = .LOWLOC;
%1525%		ZOUTBLOCK(RPSECTEND,RELRI);
%1525%		DMPMAINRLBF();
%1525%
%1525%		RDATWD = PXLARGE;	! And again for .LARG.
%1525%		ZOUTBLOCK(RPSECTEND,RELN);
%1525%		RDATWD = .LARGELOC;
%1525%		ZOUTBLOCK(RPSECTEND,RELRI);
%1525%		DMPMAINRLBF();
%1525%
%1525%		! Even though we  have an entirely  psected REL  file,
%1525%		! the signal that LINK expects  to recieve to tell  it
%1525%		! that it is done with  a program unit is the  reading
%1525%		! of a type 5 END block.   So we will output one,  but
%1525%		! it will only give the lower segment break, and  that
%1525%		! will be 0.  (Just putting out header and  relocation
%1525%		! words would be better, but it gets LINK upset).
%1525%
%1525%		RDATWD = 0;		! Say as little as possible
%1525%		ZOUTBLOCK(REND,RELN)	! Output the block
%1525%	END
%1525%	ELSE	! NOT EXTENDED
%1525%	BEGIN
%1526%		RDATWD = .HILOC+.HIORIGIN;
		ZOUTBLOCK(REND,RELRI);
		RDATWD = .LOWLOC;
		ZOUTBLOCK(REND,RELRI)
%1525%	END;

	IF .MAINRLBF[RDATCNT] NEQ 0
	THEN DMPRLBLOCK(MAINRLBF,.MAINRLBF[RDATCNT]+2)

END;	! of ZENDALL
ROUTINE GMULENTRY(MULSYM)=
BEGIN

! Generate a global definition in  rel file for multiple entry  names.
! OUTMOD must have already been called to dump any code in PBUFF.

MAP BASE MULSYM;

%1512%	ZSYMBOL(GLBDEF,.MULSYM[IDSYMBOL],.HILOC,PSCODE)
END;	! of GMULENTRY
GLOBAL ROUTINE LSTFORMATS=

!*** [1433]  Rewritten to print multiple words of format text per line

%(***************************************************************************
	Routine to list all the format stmnts in a program.
	Assumes that the global "FORMPTR" points to the 1st
	FORMAT stmt.  Each FORMAT stmt is linked to the
	next by the "FMTLINK" field.
***************************************************************************)%
BEGIN

	!(*** Define some handy macros:			***)
	!(***	TAB	outputs a tab			***)

	MACRO	TAB	  = CHROUT(#11) $;

	BIND	LINEWIDTH = 55;	!Number of characters of format text per line


	LOCAL CHARSLEFT;	!Number of chars left to print in format text
	LOCAL LISTLABEL;	!Flag controling the printing of the label
				!   on the first line of format text
	LOCAL BASE SNENTRY;	!The stmt number table entry for the stmt
				!   number for a given format stmt
	REGISTER BASE FORMAT;	!Ptr to the format stmt being printed
	REGISTER RLOC;		!Relative loc in low seg of the wd being listed
	REGISTER TEXTPTR;	!Byte ptr to the character in the string
				!   to be listed


	!(*** If there are no format stmnts in this program ***)%
	IF (FORMAT_.FORMPTR<LEFT> ) EQL 0
	THEN RETURN;

	%(*** Print header ***)%
	IF ( PAGELINE_.PAGELINE-4) LEQ 0
	THEN	( HEADING();  PAGELINE_.PAGELINE-4);
	STRNGOUT(PLIT ASCIZ'?M?J?M?JFORMAT STATEMENTS (IN LOW SEGMENT):?M?J?M?J');


	%(*** List all format stmts in program ***)%
	UNTIL .FORMAT EQL 0
	DO 
	BEGIN	!Loop to list all format stmts in program

		!(*** The first line for this format--the size word ***)
		DECOUT(.FORMAT[SRCISN]);    !ISN line number of the format stmt
		TAB;
		OCTOUT(.FORMAT[FORADDR]-1); !Relative address of the count of
					    ! the number of words in the format
		TAB;
		TAB;
		OCTOUT(.FORMAT[FORSIZ]);    !Count of number of words in format
		CRLF;
		HEADCHK();


		!(*** Second through N lines--Format text ***)
		TEXTPTR = (.FORMAT[FORSTRING])<36,7>; !Byte pointer to fmt text
		CHARSLEFT = .FORMAT[FORSIZ] * 5;      !Five chars per word
		LISTLABEL = TRUE;		      !Label goes on 1st line
		RLOC = .FORMAT[FORADDR];

		!(*** Loop while there is text in this format to be listed ***)
		WHILE .CHARSLEFT GTR 0
		DO
		BEGIN	! While text to print in this format

			TAB;
			OCTOUT(.RLOC);	!Relative address of the 1st wd of the
					! format text
			TAB;

			!(*** If this is the first line of text for this ***)
			!(***  then list the stmt label of the format    ***)
			IF .LISTLABEL
			THEN
			BEGIN	! List the statement label
				!(*** Get the label table entry for format ***)
				!(*** Print the stmt number followed by a  ***)
				!(*** "P" and a colon.			   ***)
				SNENTRY_.FORMAT[SRCLBL];
				DECOUT(.SNENTRY[SNUMBER]);
				CHROUT("P");
				CHROUT(":");

				!(*** Any other lines of text for this ***)
				!(*** format do have stmt labels       ***)
				LISTLABEL = FALSE;
			END;	! of list the statement label


			TAB;


			!(*** Output the at least 'LINEWIDTH' chars of ***)
			!(*** format text			       ***)
			DECR I FROM (IF LINEWIDTH LSS .CHARSLEFT THEN LINEWIDTH ELSE .CHARSLEFT) TO 1
			DO
			BEGIN
				CHR = SCANI(TEXTPTR);
				IF .CHR NEQ 0 THEN CHROUT(.CHR);
			END;

			CRLF;
			HEADCHK();

			CHARSLEFT = .CHARSLEFT - LINEWIDTH;
			RLOC = .RLOC + LINEWIDTH / 5;
		END;	! of while text to print in this format

		FORMAT_.FORMAT[FMTLINK];     !Go on to the next format stmt

	END;	! of loop to list all format stmts in program

END;	! of LSTFORMATS
ROUTINE LSTEFIW(EFIW)=		![2337] New

!++
! FUNCTIONAL DESCRIPTION:
!
!	Output EFIW references to the listing file.  (/MACRO is assumed
!	to have been given).
!
!	Format:
!
!	"@[.EFIW " [ name ] [ ( "+" | "-" ) offset ] [ "(" register ")" ] "]"
!
! FORMAL PARAMETERS:
!
!	EFIW		The EFIW reference to output.
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	CHR		Global argument to LSTOUT in CHROUT.
!
!	R1		Global argument to ZOUOFFSET.
!
!	R2		Global argument to ZOUTSYM.
!
! ROUTINE VALUE:
!
!	None
!
! SIDE EFFECTS:
!
!	An EFIW reference is output to the listing file.
!
!--


BEGIN
	MAP 	BASE EFIW,
		BASE R2;
	REGISTER
		BASE SYMTAB;	! Pointer to the symbol table reference.


	SYMTAB = .EFIW[EFSYMPTR];	! Symbol table pointer

	STRNGOUT(UPLIT ASCIZ '@[.EFIW ');	! Indirection through literal

	! Output symbol name

%2464%	IF .EFIW[EFEXTERN] NEQ PSABS	! Absolute reference?
%2464%	THEN				! Nope, output the variable name
%2464%	BEGIN	! NOT PSABS
		R2 = .SYMTAB[IDSYMBOL];		! Symbol; argument to ZOUTSYM
%4554%		ZOUTSYM(FALSE);
%2464%	END;	! NOT PSABS

	IF (R1 = .EFIW[EFY]) NEQ 0	! Does offset exist?
	THEN
	BEGIN	! Has offset

		! If negative,  then  extend  the  sign  of  the
		! offset.

		IF .EFIW[EFYSIGN] THEN R1 = .R1 OR #770000000000;

%2464%		IF .EFIW[EFEXTERN] NEQ PSABS		! Absolute reference?
%2464%		THEN R1 = .R1 - .SYMTAB[IDADDR];	! Nope, subtract base

		! Output ("+" | "-") offset if there still is one.
		IF .R1 NEQ 0 THEN ZOUOFFSET();

	END;	! Has offset

	! Output index field, if it exists

	IF .EFIW[EFX] NEQ 0
	THEN
	BEGIN
		! "(" index ")"

		CHROUT("(");
		OCTOUT(.EFIW[EFX]);	! Index register
		CHROUT(")");
	END;

	CHROUT("]");			! End of literal

END;	! of LSTEFIW

END
ELUDOM