Google
 

Trailing-Edge - PDP-10 Archives - BB-4157E-BM - fortran-compiler/listou.bli
There are 26 other files named listou.bli in the archive. Click here to see a list.
!THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
!  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.

!COPYRIGHT (C) 1973,1981 BY DIGITAL EQUIPMENT CORPORATION
!AUTHOR F.INFANTE/DCE/SJW/JNG/TFV

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

!	REQUIRES FIRST, TABLES, REQREL

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

GLOBAL BIND LISTOV = 6^24 + 0^18 + 69;		! Version Date:	21-Jul-81

%(

***** 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. .

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

)%

!THE ROUTINES IN THIS MODULE ARE FOR THE PURPOSE
!OF GENERATING THE FOLLOWING THINGS:
%	THE MACRO EXPANDED LISTING OF THE CODE GENERATED
I	.THE GENERATION OF THE RELOCATABLE BINARY INFORMATION IN THE
	 .REL FILE
%
EXTERNAL ZOUTMSG,ZOUTSYM,ZOUTOCT,RADIX50,ZOUDECIMAL,ZOUOFFSET;
EXTERNAL HEADCHK;	!CHECKS LINE COUNT AND OUTPUTS HEADINGS
EXTERNAL RDATWD,RELOUT;	!CONTAINS CURRENT REL DATA WD
EXTERNAL ZOUTBLOCK;

EXTERNAL LSTOUT,ERROUT,
	LOWLOC,	!CURRENT LOWSEG AVAILABLE LOCATION
	HILOC,	!CURRENT HISEG AVAILABLE LOCATION
	RELBLOCK,	!RELOCATABLE BINARY BLOCK
	RELDATA,	!DATA WORD <LEFT> = CURRENT BLOCK NUMBER
				   !<RIGHT> = CURRENT DATA COUNT
	RELOCWD;	!THE RELOCATION WORD FOR THE BLOCK
!
MACRO EXITUUO = #047000000012$;
!
!
ROUTINE DMPSYMTAB=	!DUMPS THE SYMBOL TABLE TO REL FILE
BEGIN
EXTERNAL SYMTBL,LABTBL,FRSTLNK,RADIX50,ZOUTBLOCK,PROGNAME;
EXTERNAL FORMPTR;	!PTR TO 1ST FORMAT STMNT IN PROGRAM
OWN LABL;
LOCAL BASE  SYMPTR;
EXTERNAL ENDSCAA;


	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
				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
							FOLLOWING ITS TRUE DEFINITION, WHERE THIS ENTRY
							POINTS TO THE DIMENSION INFORMATION**)%

						REGISTER BASE T1;
						R2_.SYMPTR[IDSYMBOL];
						RDATWD_RLOCDDTSUP+RADIX50();	!SUPPRESS THIS 2ND
								! DEF FROM DDT
						ZOUTBLOCK(RSYMBOL,RELN);
						T1_.SYMPTR[IDDIM];	!PTR TO DIMENS TABLE ENT
						T1_.T1[ARADLBL];	!PTR TO LABEL TABLE ENTRY FOR
								!LABEL ON DIMENS INFO ARG BLOCK
						RDATWD_.T1[SNADDR];	!REL ADDR OF LABEL
						ZOUTBLOCK(RSYMBOL,RELRI);
					END
				END;


				IF .SYMPTR[IDATTRIBUT(INCOM)]
				THEN
				  BEGIN
					MAP BASE R2;
					R2 _ .SYMPTR[IDSYMBOL]; RDATWD _ RLOCREQ+RADIX50();
					ZOUTBLOCK(RSYMBOL,RELN);
					RDATWD _ .SYMPTR[IDADDR];	!COMMON BLOCK OFFSET
					ZOUTBLOCK(RSYMBOL,RELN);
					R2 _ .SYMPTR[IDCOMMON]; R2 _ .R2[COMNAME];
					RDATWD _ RGLOBREQ + RADIX50();
					ZOUTBLOCK(RSYMBOL,RELN);
					R2 _ .SYMPTR[IDSYMBOL]; RDATWD _ RLOCFIX + RADIX50();
					ZOUTBLOCK(RSYMBOL,RELN);

				  END
				ELSE
				IF .SYMPTR[OPRSP1] NEQ FNNAME1 AND
				NOT .SYMPTR[IDATTRIBUT(NOALLOC)] THEN
				  BEGIN
					R2 _ .SYMPTR[IDSYMBOL];
					RDATWD _ RLOCREQ + RADIX50();
					ZOUTBLOCK(RSYMBOL,RELN);
					RDATWD _ .SYMPTR[IDADDR];
					ZOUTBLOCK(RSYMBOL,RELRI);

				  END;

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

	!OUTPUT A SYMBOL FOR THE WD AFTER THE END OF THE SCALARS AND ARRAYS
	R2_SIXBIT'.VEND';
![1003]	Suppress DDT output of .VEND
%[1003]%	RDATWD_RLOCDDTSUP+RADIX50();
	ZOUTBLOCK(RSYMBOL,RELN);
	RDATWD_.ENDSCAA;	!LOC AFTER END OF ARRAYS/SCALARS
				! (SET IN ALLSCA)
	ZOUTBLOCK(RSYMBOL,RELRI);

![1003]	Output the global symbol ..GFL. if compiling /GFLOAT for FORDDT support
%[1003]%	IF .GFLOAT
%[1003]%	THEN
%[1003]%	BEGIN
%[1003]%		R2_SIXBIT'..GFL.';
%[1003]%		RDATWD_RGLOBDDTSUP+RADIX50();
%[1003]%		ZOUTBLOCK(RSYMBOL,RELN);
%[1003]%		RDATWD_1;	! give it the value of 1
%[1003]%		ZOUTBLOCK(RSYMBOL,RELN);
%[1003]%	END;
	!
	!
	!DUMP THE LOCAL LABLES 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"

				R2 _ .LABL;
				RDATWD _ RLOCREQ + RADIX50();
				ZOUTBLOCK(RSYMBOL,RELN);
				RDATWD _ .SYMPTR[SNADDR];
				ZOUTBLOCK(RSYMBOL,RELRI);
%[636]%			END;
!
		     END WHILE (SYMPTR _ .SYMPTR[CLINK]) NEQ 0;
		END;
	END;
!
!DUMP THE LOCAL TEMPORARIES NAMES
!
	WHILE .FRSTLNK NEQ 0
	DO (
		MAP BASE FRSTLNK;
		R2 _ .FRSTLNK[IDSYMBOL];
			RDATWD _ RLOCREQ + RADIX50();
			ZOUTBLOCK(RSYMBOL,RELN);
			RDATWD _ .FRSTLNK[IDADDR];
			ZOUTBLOCK(RSYMBOL,RELRI);
		FRSTLNK _ .FRSTLNK[CLINK]
	   );

	!
	!DEFINE A LABEL OF THE FORM <STMNT NUMBER>F ON THE LAST WD
	! OF EACH FORMAT SRING
	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>P
			R2_.LABL;
			RDATWD_RLOCREQ+RADIX50();
			ZOUTBLOCK(RSYMBOL,RELN);
			RDATWD_.FPTR[FORADDR]+.FPTR[FORSIZ]-1;	!ADDR OF LAST WD OF STRING
			ZOUTBLOCK(RSYMBOL,RELRI);
			FPTR_.FPTR[FMTLINK]	!GO ON TO NEXT FORMAT
		END;
	END;
END;	!OF DMPSYMTAB
ROUTINE ZSIXBIT(ZVAL)=	!CONVERT ZVAL TO SIXBIT SYMBOL
BEGIN
R2 _ SIXBIT 'P';
DECR I FROM 5 TO 0 DO
BEGIN
	R2 _ .R2^(-6); R2<30,6> _ (.ZVAL MOD 10) + #40; ZVAL _ .ZVAL/10;
	IF .ZVAL EQL 0 THEN EXITLOOP;
END;
RETURN .R2
END;
!
%[650]%	EXTERNAL STRNGOUT;
%[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;
%[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:
%[650]%		!    [ASCIZ /STRING/{...}]
%[650]%		MAP BASE ADDR;
%[650]%		LOCAL STRING[3];
%[650]%		MACRO LASTCHAR=1,7$;
%[650]%	
%[650]%		STRNGOUT(PLIT ASCIZ '[ASCIZ /');
%[650]%	
%[650]%		STRING[0]_.ADDR[CONST1];
%[650]%		STRING[1]_.ADDR[CONST2];
%[650]%		STRING[2]_0;
%[650]%	
%[650]%		STRNGOUT(STRING);
%[650]%	
%[650]%		!IS IT A LONG OR SHORT STRING?
%[650]%		IF .STRING[0]<LASTCHAR> NEQ 0 AND .STRING[1]<LASTCHAR> NEQ 0
%[650]%			AND .ADDR[CW5] NEQ 0
%[650]%			THEN STRNGOUT(PLIT ASCIZ '/...]')
%[650]%			ELSE STRNGOUT(PLIT ASCIZ '/]');
%[650]%	END;
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;
ROUTINE COMCOM=
BEGIN
	EXTERNAL LSTOUT;
	CHR_",";LSTOUT();LSTOUT()
END;


ROUTINE LSTINST(IPTR)=
BEGIN
%
ROUTNE LISTS ON LISTING DEVICE THE MACRO -10 MNEMONICS OF THE INSTRUCTIONS BEING GENERATED
%
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>$;
EXTERNAL CODELINES;
MACRO HEADRSW = CODELINES<LEFT>$;
LOCAL OPPOINT;
EXTERNAL OPMNEM;
!
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 ROUTINE ZMAKLABL

%[734]%	LOCAL DINSTF; !DOUBLE WORD INSTRUCTION FLAG
EXTERNAL  HEADCHK;		!CHECK AND COUNT LINES ON PAGE
EXTERNAL ZOUDLB;	!ROUTINE TO ADD TO THE MACRO EXPANDED LISTING A
			! LABEL THAT IS INSERTED ON THE 1ST INSTR OF EACH STMNT WHEN
			! THE USER HAS SPECIFIED THE "DEBUG" SWITCH
%[645]%	EXTERNAL PAGELINE;
IF .HEADRSW NEQ #777777
	THEN(		CODELINES _ 0;
		HEADRSW _ #777777
	    );
CRLF;
HEADCHK();
IF (R1 _ .IISN) GEQ 0
	THEN IF .R1 EQL 0 THEN ( CHR _ "*"; LSTOUT()) ELSE ZOUDECIMAL();
CHR _ #11; LSTOUT(); !TAB
IF .IADDRPTR EQL PBFENTRY
	THEN(MAP BASE R2;
		!ENTRY NAME TAKES UP ONE LISTING LINE - ACCOUNT FOR IT
%[645]%		CRLF; PAGELINE_.PAGELINE-1; CHR_#11; LSTOUT();
		R2 _ .IEFFADDR; R2 _ .R2[IDSYMBOL]; ZOUTSYM();
		CHR _ ":"; LSTOUT();
		RETURN
	    );
!
!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 	(
	 LOCAL BASE LABPT;
	 LABPT _ .ILABEL;
	 DO
	 (
	 ZLABLMAK(.LABPT);
	 CHR _ ":"; LSTOUT(); CRLF; HEADCHK();
	 CHR _ #11; LSTOUT(); LSTOUT(); !TAB
         ) WHILE (LABPT _ .LABPT[SNNXTLAB]) NEQ 0;
	);

	IF (R1_.IISN) GTR 0 AND .FLGREG<DBGLABL>	!IF THE USER SPECIFIED THE "DEBUG" SWITCH
				! THEN IFTHIS INSTR STARTS A STMNT, LIST
				! AN "L" LABEL ON THIS INSTR
	THEN ZOUDLB();


CHR _ #11; LSTOUT();	!TAB
%[734]%	DINSTF_0;
!NOW DO THE INSTRUCTION LISTING
!
IF .IOPCODE NEQ 0
THEN(
!First mnemonic is now GFAD (#103)
%[761]%	OPPOINT _ (OPMNEM-#103)[.IOPCODE]<0,6>;	!MNEMONIC TABLE POINTER
	INCR I FROM 0 TO 5 DO
	  (CHR _SCANI(OPPOINT,CHR);	!GET A CHARACTER
	   IF(CHR _ .CHR + #40 ) LEQ #100 THEN EXITLOOP;
%[734]%	   IF .I EQL 0 THEN DINSTF_.CHR; ! PICK UP FIRST CHAR OF INSTRUCTION
	   LSTOUT()
	  )
    );
CHR _ #11;	LSTOUT();	!TAB
!AC FIELD
!
IF .IAC LEQ 7 
  THEN (CHR _ .IAC + #60; LSTOUT())
   ELSE (CHR _ "1"; LSTOUT();
	 CHR _ (.IAC + #50); LSTOUT()
 	);
CHR _ ","; LSTOUT();
!
!INDIRECT BIT
!
IF .IINDIR NEQ 0 THEN (CHR _ "@"; LSTOUT());
!
!ADDRESS
!
BEGIN BIND ZADDR = IADDRPTR; MAP BASE ZADDR;
  IF .IADDRPTR GTR PBF2LABREF
    THEN
	(IF SYMBOL(ZADDR)
	  THEN ( R2 _ .ZADDR[IDSYMBOL];
		ZOUTSYM()
		)
	  ELSE IF .ZADDR[OPERSP] EQL CONSTANT
		THEN ( IF .ZADDR[DBLFLG] OR .ZADDR[VALTYPE] EQL REAL
			THEN(IF .ZADDR[CONADDR] EQL .IEFFADDR
![650] IN THE CONSTANT CASE, DISTINGUISH BETWEEN SINGLE AND
![650] DOUBLE WORD CONSTANTS.
%[650]%				THEN (R2 _ .ZADDR[CONST1];
![734] ONLY PRINT AS DOUBLE OCTAL IF INSTRUCTION IS DOUBLE WORD, I. E.,
![734] THE FIRST CHARACTER BEGINS WITH "D" (AVOID CAMXX).
![761] also if instruction starts with "G" (GFAD, etc.)
%[761]%					IF .ZADDR[DBLFLG] AND
%[761]%					   (.DINSTF EQL "D" OR .DINSTF EQL "G")
%[761]%					THEN RETURN ZDOUTCON(.ZADDR[CONST2]))
				ELSE R2 _ .ZADDR[CONST2]
			    )
			ELSE R2 _ .ZADDR[CONST2]; !ELSE INTEGER OR LOGICAL OR BYTE
			RETURN ZOUTCON()
		     )
		ELSE
			(R2_.ZADDR[IDSYMBOL]; ZOUTSYM(););
	IF (R1 _ EXTSIGN(.IEFFADDR) -.ZADDR[IDADDR]) NEQ 0 THEN ZOUOFFSET();
       )
  ELSE IF .IADDRPTR GTR 3 THEN BEGIN END
    ELSE IF .IADDRPTR GTR 2
	THEN BEGIN MAP BASE R2;
		R2_.IEFFADDR; R2 _ .R2[IDSYMBOL];
		ZOUTSYM()
	     END
	ELSE IF .IADDRPTR GTR 1
		THEN !DOTTED FUNCTION NAME
		  (R2 _@(.IEFFADDR);
		   ZOUTSYM()
		  )
		ELSE  IF .IADDRPTR GTR 0	!NO SYMBOLIC ADDR
			THEN (R2<LEFT> _ .IEFFADDR; ZOUTOCT()) !IMMEDIATE MODE VALUE
			ELSE  ZLABLMAK(.IEFFADDR);
END;
!
!INDEX FIELD
!
IF .IINDEX NEQ 0
  THEN ( CHR _ "("; LSTOUT();
	IF .IINDEX LEQ 7
		THEN (CHR _ .IINDEX +#60; LSTOUT())
		ELSE (CHR _ "1"; LSTOUT();CHR _ .IINDEX +#50; LSTOUT()
		     );
	 CHR _ ")"; LSTOUT();
	);
END;	!OF ROUTINE LSTINST

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

BEGIN

EXTERNAL  CODELINES, HEADCHK;
EXTERNAL  LMLINO,		! CURRENT SOURCE LINE NUMBER
	  LMRONO,		! CURRENT MAP ROW NUMBER
	  LMCONO;		! CURRENT MAP COLUMN NUMBER

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 BEGIN
		    CHR _ #11;
		    LSTOUT ();
		  END
	      END
	      WHILE  (LMLINO _ .LMLINO + 1) LSS .IISN;
	    R2<LEFT> _ .CODELINES<RIGHT>;
	    ZOUTOCT ();
	  END;
	CODELINES _ .CODELINES + 1;
END;					! OF ROUTINE LINEMAP

ROUTINE ROUIMFUN(FUNCPTR,FUNAME)=	!OUTPUT FUNCTION REQUEST GLOBAL
BEGIN
			RDATWD_.FUNCPTR<LEFT>^18; ZOUTBLOCK(RCODE,RELN);
			R2 _ .FUNAME; !SIXBIT SYMBOL NAME
			RDATWD_(RGLOBREQ +RADIX50()); ZOUTBLOCK(RSYMBOL,RELN);
			RDATWD_RGLOB0^18 + .HILOC;
			ZOUTBLOCK(RSYMBOL,RELRI)
END;
ROUTINE ROURLABEL(LABLPTR)=
BEGIN
MAP BASE LABLPTR;
		 RDATWD<LEFT> _ .LABLPTR<LEFT>;
		IF .LABLPTR[SNSTATUS] NEQ OUTPBUFF  THEN 
%[636]%			IF NOT .LABLPTR[SNDEFINED]
%[636]%			THEN
%[636]%			BEGIN
%[636]%				LABLPTR[SNADDR]_0;
%[636]%				LABLPTR[SNDEFINED]_TRUE;
%[636]%			END;
		 RDATWD<RIGHT> _ .LABLPTR[SNADDR];
!
!AT THIS POINT RDATWD<RIGHT> CONTAINS EITHER 0 (IF FIRST TIME LABEL REFERENCED)
! OR A HI-SEG CHAIN ADDRESS IF NOT FIRST REFERENCE AND STILL UNDEFINED
! OR THE HI-SEG ADDRESS OF THE INSTRUCTION THE LABEL DEFINES
! THE VALUE OUTPBUFF MEANS THE LABEL HAS BEEN DEFINED TO LOADER
!
		 ZOUTBLOCK(RCODE,IF .LABLPTR[SNADDR] EQL 0 THEN RELN ELSE RELRI);
		!RELOCATE (RELRI) ONLY IF NOT FIRST REFERENCE
%[636]%		IF  .LABLPTR[SNSTATUS] NEQ OUTPBUFF
%[636]%		THEN
%[636]%		BEGIN
%[636]%			LABLPTR[SNADDR] _ .HILOC;	!CHAIN THE REQUEST
%[636]%			LABLPTR[SNDEFINED]_TRUE;
%[636]%		END;
END;	!END OF ROURLABEL
ROUTINE ROUSYM(INSTRUCTION,INSADDR)=	!RELOCATABLE SYMBOLIC OUTPUT
BEGIN
	MACRO ADD=3$,SUBT=4$;
	MACRO POLISHREL(OP,OPER1,RELOC1,OPER2,RELOC2,SYM)=
	BEGIN
		RDATWD _ OP;	!MEANS NEXT WD IS FULL WD OPERAND
		ZOUTBLOCK(RPOLISH,RELN);
		RDATWD _ OPER1;	!FULL WORD
		ZOUTBLOCK(RPOLISH,RELOC1);
		RDATWD _ OPER2;
		ZOUTBLOCK(RPOLISH,RELOC2);
		RDATWD _ #777777^18 + .HILOC;	!RIGHT HALF CHAINED FIXUP,, ADDRESS
		ZOUTBLOCK(RPOLISH,RELRI);
	END$;
		MAP BASE R2;
		LOCAL BASE SYMPTR; SYMPTR _ .INSADDR<RIGHT>;
		!NOW CHECK FOR SUBROUTINE OR FUNCTION CALL
		IF NOT SYMBOL(SYMPTR)
		THEN (RDATWD _ .INSTRUCTION;  ZOUTBLOCK(RCODE,RELRI);
			RETURN
		     );
		IF .SYMPTR[OPRSP1] EQL FNNAME1 
		  THEN 
			IF (NOT .SYMPTR[IDATTRIBUT(FENTRYNAME)])
				THEN IF (NOT .SYMPTR[IDATTRIBUT(DUMMY)])
					THEN (ROUIMFUN(.INSTRUCTION,.SYMPTR[IDSYMBOL]);
				RETURN
			);
		!HERE IF NOT A FUNCTION CALL OR SUBROUTINE CALL
		RDATWD _ .INSTRUCTION;
		IF ( EXTSIGN(.INSTRUCTION<RIGHT>)) LSS (-#400)
		THEN
			(RDATWD<RIGHT> _ 0;
			 ZOUTBLOCK(RCODE,RELN);
				IF NOT .SYMPTR[IDATTRIBUT(INCOM)] THEN
				 POLISHREL(ADD^18+1,EXTSIGN(.INSTRUCTION<RIGHT>),
					RELN,0,RELRI,.SYMPTR)	!GENERAT A POLISH FIXUP BLOCK
	   		ELSE
			   BEGIN
				RDATWD _ ADD^18+2;	!NEXT WD IS GLOBAL REQUEST
				ZOUTBLOCK(RPOLISH,RELN);
				R2 _ .SYMPTR[IDCOMMON]; R2 _ .R2[COMNAME];
				 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);
				 RDATWD _ .HILOC^18;
				  ZOUTBLOCK(RPOLISH,RELL);  !FINALLY O/P THE FIXUP ADDRESS
			   END;
			   RETURN
			)
		ELSE
		IF .SYMPTR[IDATTRIBUT(INCOM)]
		    THEN	!GENERATE INSTRUCTION
		      (
			ZOUTBLOCK(RCODE,RELN);	!OUTPUT THE INSTRUCTION
			R2 _ .SYMPTR[IDCOMMON]; R2 _ .R2[COMNAME];
			RDATWD _ (RGLOBREQ + RADIX50());
			ZOUTBLOCK(RSYMBOL,RELN);	!OUTPUT SYMBOL BLOCK
			RDATWD _ RGLOB4^18 + .HILOC;	!THE FIXUP REQUEST
			ZOUTBLOCK(RSYMBOL,RELRI);
			RETURN
		      )
			ELSE ZOUTBLOCK(RCODE,RELRI);	!OUTPUT THE INSTRUCTION
 END;
FORWARD GMULENTRY;
ROUTINE OUTMOD(CODEPTR,	!PTR TO BLOCK OF CODE TO BE GENERATED
		COUNT)=		!#OF INSTRUCTIONS TO BE GENERATED
BEGIN
%
ROUTINE GENERATES THE RLOCATABLE BINARY INSTRUCTIONS FOR THE OMPILER. ALSO
RESPONSIBLE OFR CALLING ROUTINES THAT GENERATE THE MACRO CODE LISTING
AND THE ROUTINES THAT GENERATE SYMBOL INGORMATION FOR THE LOADER
%
EXTERNAL DEFISN;	!ROUTINE CALLED FOR 1ST INSTR OF EACH LINE TO
			! PUT OUT A LABEL CORRESPONDING TO THE LINE SEQ NUMBER
REGISTER CODEBLOCK;
MAP BASE R2;
MAP PEEPHOLE CODEPTR;
!
!LOOP ON COUNT WHERE COUNT IS THE NUMBER OF INSTRUCTIONS TO BE GENERATED
!BUT ONE-HALF THE SIZE OF THE CODE BLOCK
!
CODEBLOCK _ .CODEPTR<RIGHT>;
!OUTPUT LINE-NUMBER/OCTAL-LOCATION MAP IF NO MACRO LISTING
	IF .FLGREG<LISTING>
	  THEN 
	    INCR I FROM 0 TO .COUNT-1
	      DO BEGIN
		IF .FLGREG<MACROCODE>
		  THEN LSTINST ((.CODEBLOCK)[.I*3])
		  ELSE
		    IF .FLGREG<MAPFLG>
		      THEN LINEMAP ((.CODEBLOCK)[.I*3]);
	      END;
!START RELOCATABLE BINARY GENERATON IF REQUESTED
IF .FLGREG<OBJECT>
THEN 
     INCR I FROM 0 TO (.COUNT-1) DO
     BEGIN
	LABEL REL1;
  REL1: IF .CODEPTR[.I,PBFSYMPTR] GTR PBFENTRY
	  THEN (ROUSYM(.CODEPTR[.I,PBFINSTR],.CODEPTR[.I,PBFSYMPTR]); LEAVE REL1)	!SYMBOLIC- IDENTIFIER,CONSTANT OR TEMP
	  ELSE		!EITHER NOT SYMBOLIC, OR LABEL OR FUNCTION CALL OR LIBRARY FUNCTION CALL "DOTTED"
	   CASE .CODEPTR[.I,PBFSYMPTR] OF SET
	%
	0 - LABEL ADDRESS - PTR TO LABEL IN RH OF INSTRUCTION
	%
		ROURLABEL(.CODEPTR[.I,PBFINSTR]);	!RELOCATABLE LABEL O/P
	%
	1- NO SYMBOLIC ADDRESS OUTPUT THE INSTRUCTION
	%
		BEGIN
			RDATWD _ .CODEPTR[.I,PBFINSTR];
			ZOUTBLOCK(RCODE,RELN);
			LEAVE REL1
		END;
	%
	2- FUNCTION CALL DOTTED
	%
		ROUIMFUN(.CODEPTR[.I,PBFINSTR],@(.CODEPTR[.I,PBFADDR]));	!RELOCATABLE  IMPLICIT FUNCTION CALL
	%3- FUNCTION CALL NOT "DOTTED"
	%
		BEGIN MAP BASE R2;
			R2_.CODEPTR[.I,PBFADDR];
			ROUIMFUN(.CODEPTR[.I,PBFINSTR],.R2[IDSYMBOL]);
		END;
	%4-USED IN OUTMDA, NOT HERE
	%
	BEGIN END;
	%5-USED IN OUTMDA, NOT HERE
	%
	BEGIN END;
	%6-USED IN OUTMOD, NOT HERE
	%
	BEGIN END;
	%7-USED IN OUTMDA, NOT HERE
	%
	BEGIN END;
	%8-PBFENTRY, A GLOBAL ENTRY SYMBOL
	%
	BEGIN
		GMULENTRY(.CODEPTR[.I,PBFADDR]); !SPECIAL CASE FOR GLOBAL ENTRY DEFINITIONS(NOT AN INSTRUCTION)
		HILOC _ .HILOC-1; !DECREMENT HILOC TO OFFSET THE INCREMENT
					!COMING AT END OF LOOP SO THAT
					!NEXT INSTRUCTION WILL HAVE SAME ADDR
					!AS THAT ASSIGNED TO ENTRY SYMBOL
	END
	TES;
!
!LEAVE REL1 EXPRESSION COMES HERE
!
	IF .CODEPTR[.I,PBFLABEL] NEQ 0
	 THEN
	(LOCAL BASE LINLABEL;
	 LINLABEL _ .CODEPTR[.I,PBFLABEL];
	 DO
	 BEGIN
%[636]%	IF .LINLABEL[SNDEFINED]
	 THEN (
		RDATWD _ .LINLABEL[SNADDR]^18+.HILOC;
		ZOUTBLOCK(RLOCAL,RELB);
		);
	   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;
	);

	%(***IF THIS INSTRUCTION STARTS A SOURCE LINE, THEN
		IF THE "DEBUG" SWITCH WAS SPECIFIED BY THE USER, OUPUT A LABEL FOR THIS INSTR**)%
	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 ROUTINE
GLOBAL ROUTINE OUTMDA(ARPTR,ARCOUNT)=
BEGIN
%
	ROUTINE OUTPUTS TO THE REL FILE THE ARG BLOCKS
	FOR ALL STATEMENTS THAT USE THEM. THESE INCLUDE IOLISTS,
	FUNCTION OR SUBROUTINE ARGUMENTS LISTS, AND
	OTHER ARG LISTS.

	THE CALL IS MADE TO THIS ROUTINE WITH A PTR TO THE ARGUMENT
	CODE WORDS AND A COUNT OF THE NUMBER OF WORDS TO GENERATE.
	THE FORMAT OF THE BLOCK OF WORDS IS SIMILAR TO THAT USED
	IN A CAL TO OUTMOD TO OUTPUT INSTRUCTIONS.
%

EXTERNAL ZOUDECIMAL;
EXTERNAL ZOUOFFSET;
EXTERNAL CODELINES,LSTOUT,ZLABLMAK,ZOUTOCT,COMCOM,OUTMSG,ZOUTSYM;
MAP BASE R1:R2;
OWN HDRSW;
MACRO ILABEL = (@ARPTR)[.I+1]<LEFT>$,
	IADDRPTR = (@ARPTR)[.I+1]<RIGHT>$,
	ILADDR = (@ARPTR)[.I+2]<LEFT>$,
	IRADDR = (@ARPTR)[.I+2]<RIGHT>$,
	IARGWD = (@ARPTR)[.I+2]<FULL>$;

!
INCR I FROM 0 TO (.ARCOUNT-1)*3 BY 3 DO
  BEGIN
	IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE> 
	THEN
	BEGIN
		EXTERNAL HEADCHK;
		CRLF;
		HEADCHK();
		CHR _ #11;LSTOUT();
		!SUBROUTINE SIXBIT NAME SHOULD NOT PRINT LOCATION 0 (NONE AT ALL!)
%[646]%		IF .CODELINES<RIGHT> NEQ 0 THEN (R2<LEFT>_.CODELINES<RIGHT>;
%[646]%			ZOUTOCT());
%[646]%		CHR_#11;	LSTOUT();
		CODELINES _ .CODELINES+1;
		IF .ILABEL NEQ 0 THEN(ZLABLMAK(.ILABEL); CHR_":"; LSTOUT());
		CHR_#11; LSTOUT(); !TAB
	!FOR VARIOUS DATA (ENTRY POINTS) UPDATE OCTAL LOCATION COUNTER
	END ELSE IF .FLGREG<MAPFLG> THEN CODELINES_.CODELINES+1;
	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
			 (RDATWD _ .IARGWD; ZOUTBLOCK(RCODE,RELN));
			);
	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
			 (RDATWD _ .IARGWD; ZOUTBLOCK(RCODE,RELN));

			);
	PBFIMFN:	EXITSELECT
			(
			IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE>  THEN
			BEGIN
			 R2<LEFT> _ .ILADDR; ZOUTOCT();
			 COMCOM();
			 R2 _ @.IRADDR; ZOUTSYM();
			END;
			IF .FLGREG<OBJECT> THEN
			  ROUIMFUN(.IARGWD,@.IRADDR);

			);
	PBFEXFN:	EXITSELECT
			(
			IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE>  THEN
			BEGIN
			 R2<LEFT> _ .ILADDR; ZOUTOCT();
			 COMCOM();
			 R2 _ .IRADDR; R2 _ .R2[IDSYMBOL]; ZOUTSYM();
			END;
			IF .FLGREG<OBJECT> THEN
			 (R2_.IRADDR; ROUIMFUN(.IARGWD,.R2[IDSYMBOL]));
			);
	PBF2LABREF:	EXITSELECT
			(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

				CHR_"P"; LSTOUT();	!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
				 ZOUTBLOCK(RCODE,RELRI);
			   END;
			END;
	OTHERWISE:	BEGIN
			IF .FLGREG<LISTING> THEN IF .FLGREG<MACROCODE>  THEN
			(
			 R2<LEFT> _ .ILADDR; ZOUTOCT();
			 COMCOM();
			  R2 _ .IADDRPTR;
			   IF .R2[OPERSP] EQL CONSTANT
![650] IN ARGUMENT LISTS, TAKE CARE OF ARGUMENTS BASED ON THEIR TYPE.
%[650]%	THEN BEGIN
%[650]%			LOCAL TMP;
%[650]%			IF .(@ARPTR)[.I+2]<23,4> EQL #17 THEN %STRING% ZSOUTCON(.R2) ELSE
%[650]%			IF .R2[DBLFLG] THEN !DP OR COMPLEX CONSTANT
%[650]%				(TMP_.R2[CONST2];
%[650]%				R2_.R2[CONST1];
%[650]%				ZDOUTCON(.TMP))
%[650]%			ELSE (IF .R2[VALTYPE] EQL REAL
%[650]%				THEN R2_.R2[CONST1]
%[650]%				ELSE R2_.R2[CONST2];
%[650]%				ZOUTCON());
%[650]%			END
				ELSE (R2 _ .R2[IDSYMBOL]; ZOUTSYM();
					R2 _ .IADDRPTR;
					IF (R1 _ EXTSIGN(.IRADDR) - .R2[IDADDR]) NEQ 0 THEN ZOUOFFSET();
				     );
			);
			IF .FLGREG<OBJECT> THEN ROUSYM(.IARGWD,.IADDRPTR);
			END;
	TESN;
	IF .FLGREG<OBJECT> THEN
	(IF .ILABEL NEQ 0
	THEN
	BEGIN
		REGISTER BASE LABENT;
		LABENT_.ILABEL;
%[636]%		IF .LABENT[SNDEFINED]
		THEN (
			RDATWD _ .LABENT[SNADDR]^18+.HILOC;
			ZOUTBLOCK(RLOCAL,RELB);
		     );
		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; !OF INCR I DO
END;	!OF OUTMDA
GLOBAL ROUTINE ZENDALL(STADDR)=	!FINISHES OUTPUT OF REL FILE
			!FOR CURRENT PROGRAM
			!DUMPS SYMBOL DTABLE
			!DUMPS NEWLY DEFINED SYMBOLS
			!OUTPUTS "END" BLOCK
BEGIN
EXTERNAL ISN,E142; !NEW ERROR MESSAGE - PROGRAM TOO LARGE
EXTERNAL FATLER; !NEED THIS FOR PRINTING ERROR MESSAGE
EXTERNAL ENDISNRLBLK;
EXTERNAL DMPRLBLOCK;	!ROUTINE TO DUMP A BUFFERED REL-FILE BLOCK OUT
EXTERNAL ZOUTBLOCK,RADIX50,PROGNAME,DMPSYMTAB;
EXTERNAL SYMRLBF,LOCRLBF,MAINRLBF;	!REL FILE  BUFFERS
	EXTERNAL DMPMAINRLBF;	!TO DUMP THE MAIN REL-FILE BUFFER
MAP RELBUFF SYMRLBF:LOCRLBF:MAINRLBF;
	IF .FLGREG<DBGLABL> THEN ENDISNRLBLK();	!IF THE  USER SPECIFIED
					! THE "DEBUG" SWITCH, OUTPUT THE SYMBOL DEFS FOR ANY
					! LABELS REMAINING IN THE BUFFER OF LABELS TO BE INSERTED
					! ON EACH SOURCE LINE
	DMPSYMTAB();	!DUMP THE SYMBOL TABLE TO REL FILE

	%(**DUMP ANY LOCAL REQUESTS,GLOBAL REQUESTS, AND SYMBOL DEFS THAT
		ARE STILL IN THEIR BUFFERS**)%
	DMPMAINRLBF();	!MUST OUTPUT ANY CODE BLOCKS TO THE REL FILE
			! BEFORE DUMPING LOCAL AND G;LOBAL REQUESTS
	!PUT OUT GLOBAL SYMBOL FOR MAIN PROGRAM
	! SO LINK CAN WARN ABOUT TWO MAIN PROGRAMS
	IF .FLGREG<PROGTYP> EQL MAPROG THEN
	BEGIN
		R2 _ SIXBIT'MAIN.';
		RDATWD _ RGLOBDEF+RADIX50();
		ZOUTBLOCK(RSYMBOL,RELN);
		RDATWD _ .STADDR;
		ZOUTBLOCK(RSYMBOL,RELRI);
![705] IF A REAL PROGRAM NAME WAS GIVEN TO THE PROGRAM, USE IT AS
![705] AN ENTRY POINT FOR THE MAIN PROGRAM - THIS IS THE ONLY WAY
![705] (SHORT OF A MACRO PROGRAM) TO GET THIS EFFECT.
%[705]%		IF .PROGNAME NEQ SIXBIT'MAIN.' THEN
%[705]%		BEGIN
%[705]%			R2 _ .PROGNAME;
%[705]%			RDATWD _ RGLOBDEF+RADIX50();
%[705]%			ZOUTBLOCK(RSYMBOL,RELN);
%[705]%			RDATWD _ .STADDR;
%[705]%			ZOUTBLOCK(RSYMBOL,RELRI);
%[705]%		END
	END;
	IF .SYMRLBF[RDATCNT] NEQ 0 THEN DMPRLBLOCK(SYMRLBF,.SYMRLBF[RDATCNT]+2);
	IF .LOCRLBF[RDATCNT] NEQ 0 THEN DMPRLBLOCK(LOCRLBF,.LOCRLBF[RDATCNT]+2);

	IF .FLGREG<PROGTYP> EQL MAPROG  THEN (RDATWD _ .STADDR; ZOUTBLOCK(RSTART,RELRI)); !START ADDRESS BLOCK
	 RDATWD_.HILOC; ZOUTBLOCK(REND,RELRI);
	RDATWD _ .LOWLOC; ZOUTBLOCK(REND,RELRI);
	IF .MAINRLBF[RDATCNT] NEQ 0 THEN DMPRLBLOCK(MAINRLBF,.MAINRLBF[RDATCNT]+2);
	!CHECK FOR HIGH AND LOW OVERFLOWS IF PROGRAM TOO LARGE
		IF .HILOC GEQ 1^18 OR .LOWLOC GEQ 1^18
		THEN FATLER(.ISN,E142<0,0>);
END;
ROUTINE GMULENTRY(MULSYM)=
BEGIN
!GENERATE AN ENTRY DEFINITION (GLOBAL) IN REL FILE FOR MULTIPLE ENTRY
!NAMES; OUTMOD MUST HAVE  ALREADY BEEN CALLED TO DUMP ANY CODE IN PBUFF
!
MAP BASE MULSYM;
	R2 _ .MULSYM[IDSYMBOL];
	RDATWD _ (RGLOBDEF+RADIX50());
	ZOUTBLOCK(RSYMBOL,RELN);
	RDATWD _ .HILOC<RIGHT>;
	ZOUTBLOCK(RSYMBOL,RELRI)
END;



GLOBAL ROUTINE LSTFORMATS=
%(***************************************************************************
	ROUTINE TO LIST ALL THE FORMAT STMNTS IN A PROGRAM.
	ASSUMES THAT THE GLOBAL "FORMPTR" POINTS TO THE 1ST
	FORMAT STMNT. EACH FORMAT STMNT IS LINKED TO THE
	NEXT BY THE "FMTLINK" FIELD
***************************************************************************)%
BEGIN
	EXTERNAL PAGELINE,STRNGOUT,HEADING;
	EXTERNAL ZOUDECIMAL;
	EXTERNAL FORMPTR;
	LOCAL RLOC;	!RELATIVE LOC IN LOW SEG OF THE WD BEING LISTED
	LOCAL BASE SNENTRY;	!THE STMNT NUMBER TABLE ENTRY FOR
				! THE STMNT NUMBER FOR A GIVEN FORMAT STMNT
	REGISTER BASE FPTR;	!PTR TO THE FORMAT STMNT BEING PRINTED
	REGISTER CPTR;		!BYTE PTR TO THE CHARACTER IN THE STRING
				! TO BE LISTED



	IF (FPTR_.FORMPTR<LEFT> ) EQL 0	!IF THERE ARE NO FORMAT STMNTS IN THIS PROGRAM
	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 STMNTS IN PROGRAM**)%
	UNTIL .FPTR EQL 0
	DO 
	BEGIN
		R1_.FPTR[SRCISN]; ZOUDECIMAL();	!LINE NUMBER OF THIS FORMAT STMNT
		CHR_#11; LSTOUT();	!TAB
		RLOC_.FPTR[FORADDR];	!RELATIVE ADDRESS OF THE 1ST WD OF THE
					! STRING
		R2<LEFT>_.RLOC;  ZOUTOCT();	!LIST IT
		CHR_#11; LSTOUT();	!TAB

		!LIST THE "P" LABEL
		SNENTRY_.FPTR[SRCLBL];	!LABEL TABLE ENTRY FOR THE STMNT NUMBER
		R1_.SNENTRY[SNUMBER];	!STMNT NUMBER
		ZOUDECIMAL();		!LIST IT
		CHR_"P"; LSTOUT();	! FOLLOWED BY "P"
		CHR_":"; LSTOUT();	! FOLLOWED BY ":"
		CHR_#11;  LSTOUT();	!TAB


		!LIST THE 1ST WD OF THIS FORMAT STRING
		CPTR_(.FPTR[FORSTRING]-1)<0,7>;	!BYTE PTR TO CHAR PRECEEDING
					! THE 1ST CHAR OF THE STRING
		DECR I FROM 4 TO 0	!LIST 5 CHARS
		DO
		(CHR_SCANI(CPTR); LSTOUT());	!INCR BYTE PTR TO NEXT CHAR AND LIST THAT CHAR

		CRLF;
		HEADCHK();

		!LIST ALL WDS OF THE FORMAT STRING AFTER THE 1ST,
		! PRECEEDING EACH BY ITS RELATIVE ADDRESS
		DECR I FROM .FPTR[FORSIZ]-2 TO 0	
		DO
		BEGIN
			CHR_#11;  LSTOUT();	!TAB
			RLOC_.RLOC+1;		!RELATIVE LOC OF THIS WD
			R2<LEFT>_.RLOC;
			ZOUTOCT();		!LIST IT
			CHR_#11;  LSTOUT();	!TAB
			CHR_#11;  LSTOUT();
			DECR I FROM 4 TO 0	!LIST 5 CHARS
			DO
			(CHR_SCANI(CPTR); LSTOUT());	!INCR BYTE PTR TO NEXT CHAR AND LIST IT

			CRLF;
			HEADCHK();
		END;

		FPTR_.FPTR[FMTLINK];	!GO ON TO THE NEXT FORMAT STMNT
	END;
END;	!OF ROUTINE LSTFORMATS