Google
 

Trailing-Edge - PDP-10 Archives - CFS_TSU04_19910205_1of1 - update/ftncsr/unend.bli
There are 12 other files named unend.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: D. B. TOLMAN/DCE/TFV/EGM/AHM/PLB/MEM

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


GLOBAL BIND UNENDV = #11^24 + 0^18 + #4530;	! Version Date:	17-Feb-86

%(

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

1	-----	-----	FIX CREFIT TO CREF INCLUDED FILES EVEN IF THEY
			ARE NOT LISTED

			LOWER THE VERBOSITY LEVEL OF ERRORLESS PROGRAMS

2	-----	-----	PUT [NO ERRORS DETECTED] ON LISTING BUT NOT TTY

3	-----	-----	CREF - CHANGE ^G TO ^Q SO VERSION 51 WILL RUN
4	747	-----	MAKE ALL STRINGS LOWER CASE FOR PRINTOUT

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

5	760	TFV	1-Mar-80	-----
	Use singular for 1 warning and/or 1 error

6	1047	EGM	22-Jan-81	Q10-05325
	Add support for TOPS-10 execute only.

7	1133	TFV	28-Sep-81	------
	Add routines STATS and OUTTIME for /STATISTICS output.
	Print out size of generated code and data, runtime, connect time,
	and dynamic memeory used by the compiler.

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

1160	EGM	14-Jun-82
	Set 'fatal errors this compile command' flag if any fatal errors.

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

1526	AHM	12-Apr-82
	Don't subtract CHDSTART from HILOC in STATS because relocation
	counters don't have their origins added into them anymore.

1563	PLB	18-Jun-82
	Change ZZOUTMSG for native TOPS-20 operation
	to use TTYSTR instead of TTCALL.

1633	TFV	1-Sep-82
	Improve  /STATISTICS  to  print  source  lines  per  minute  and
	executable statements per minute.

***** End V7 Development *****

1731	TFV	10-Mar-83
	Fix calls to  ZZOUTMSG in  STATS. Routine  STATS calls  ZZOUTMSG
	with a UPLIT.  ZZOUTMSG tries to modify the PLIT which is in the
	hiseg causing a memory protection failure.

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

2447	PLB	10-Aug-84
	Changes for nested INCLUDE files; SAVFLG is now a vector
	indexed by EXTERNAL ICLEVEL.

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

***** Begin Version 11 *****

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

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 for typing program name to tty and listing.

ENDV11
)%


	REQUIRE FIRST.BLI;
%4527%	REQUIRE TABLES.BLI;
%1133%	REQUIRE FTTENX.REQ;	! needed for /STATISTICS

FORWARD
%4530%	OUTNAM,		! Outputs a long name to tty
	ZZOUTMSG,
	ENDUNIT,
%1133%	STATS,		! Routine to print out statistics
%1133%	OUTTIME,	! Routine to output times
%1633%	OUTNUM,		! Output a number
	CREFIT;

EXTERNAL
	BASENO,
	CCLSW,
	CHAROUT,
%4513%	CONTIME,	! Connect time from GETIME.
	CTIME,
	DIGITS,
	ENTRY,
%4513%	GETIME,		! Get run and connect time.
	HEADPTR,
	HILOC,		! Location in hiseg
%2447%	ICLEVEL,	!Current INCLUDE file level
	JOBERR,
	JOBSA,
	LINCNT,
	LOWLOC,		! Location in lowseg
	MAXFF,
%4513%	NCOMMON,	! Number of COMMON blocks
%4513%	NSYMTBL,	! Number of symbol table locations
	NUMFATL,	! Number of fatal errors
	NUMODIG,
	NUMWARN,	! Number of warnings
	PROGNAME,	! Program name
	RTIME,
%4513%	RUNTIME,	! Runtime returned from GETIME.
	SAVFLG,		!Save of INCLUDE file FLGREG
%4513%	STATIME,	! Special status time.
	STCNT,
	STRNG6,
	STRNGOUT,
	TTYSTR;


GLOBAL ROUTINE OUTNAM(NAM) =

!++
! FUNCTIONAL DESCRIPTION:
!
!	Outputs NAM to the listing/tty
!
! FORMAL PARAMETERS:
!
!	NAM		Long or short name to be output to listing/tty
!
! IMPLICIT INPUTS:
!
!	None
!
! IMPLICIT OUTPUTS:
!
!	None
!
! ROUTINE VALUE:
!
!	None
!				
! SIDE EFFECTS:
!
!	None
!
!--



BEGIN	! New [4530]

	LOCAL	STRN[2],I;
	REGISTER T1,T2;

	STRN[0]=0;	STRN[1]=0;	! STRN must have 2 words - one for the
					! string followed a 0 word so that we
					! have ASCIZ string
	I=0;	
	T2=STRN<36,7>; 
	INCR W FROM 0 TO .NAM<SYMLENGTH>-1	!Loop for each word
	DO 
	BEGIN
		T1=(.NAM<SYMPOINTER>)[.W]<36,6>;
		DECR X FROM SIXBCHARSPERWORD-1 TO 0	!Loop for each character
		DO 
		BEGIN
			IF (I=.I+1) GTR SIXBCHARSPERWORD-1
			THEN
			BEGIN
				!Output current contents to TTY and LISTING FILE

				IF NOT .FLGREG<TTYDEV>
				THEN IF NOT .FLGREG<NOERRORS>
				THEN IF FTTENEX
				THEN TTYSTR(STRN<0,0>) !DOES A PSOUT FOR TWENTIES
				ELSE
				BEGIN
					I = STRN<0,0>;	
					TTCALL(3,I,0,1);	!OUTSTR @I
				END;	
				IF .FLGREG<LISTING> THEN  STRNGOUT(STRN<0,0>);

				I=1;	STRN=0;
				T2=STRN<36,7>; 
			END;
			REPLACEI(T2,SCANI(T1)+" ");
		END;
	END;
	!The space is needed to prevent having to change lots of orgs in the
	!test system

	IF .PROGNAME<SYMLENGTH> EQL 1		! one word symbol
	THEN IF .PROGNAME<SYM6THCHAR> EQL 0	! less than 6 chars
	THEN REPLACEI(T2," ");	!<SPACE>

	REPLACEI(T2,"	");	!<TAB>

	!Output current contents to TTY and LISTING FILE

	IF NOT .FLGREG<TTYDEV>
	THEN IF NOT .FLGREG<NOERRORS>
	THEN IF FTTENEX
	THEN TTYSTR(STRN<0,0>) !DOES A PSOUT FOR TWENTIES
	ELSE
	BEGIN
		I = STRN<0,0>;	
		TTCALL(3,I,0,1);	!OUTSTR @I
	END;
	
	IF .FLGREG<LISTING> THEN  STRNGOUT(STRN<0,0>);
END;
%[1047]% PORTAL ROUTINE ENDUNIT =
!++
! Output the messages at the end of the program unit.
!--
BEGIN
	REGISTER T1,T2;

%1133%	IF .F2<STA>	! If /STAT
%1133%	THEN STATS();	! print out statistics

	BEGIN	%CROSS REFERENCE END OF PROGRAM SYMBOL %
		BIND  ENDSUBR = 5;
		IF .FLGREG<CROSSREF>  THEN CREFIT( ENDSUBR)
	END;

	IF .CCLSW EQL 0 OR .NUMFATL NEQ 0 OR NUMWARN NEQ 0
	THEN
	BEGIN
		LOCAL STRN[6];

			EXTERNAL PROGNAME,HEADPTR,BASENO;
			IF .NUMFATL NEQ 0 OR .NUMWARN NEQ 0
			THEN
			BEGIN
				ZZOUTMSG(PLIT'?M?J');
				IF .NUMFATL  EQL  0
				THEN
				BEGIN
%4530%					ZZOUTMSG(PLIT'%FTNWRN   ');
%4530%					STRN = 'No';
				END
				ELSE
				BEGIN
%4530%					ZZOUTMSG(PLIT'??FTNFTL   ');
					JOBERR<RIGHT>_.JOBERR<RIGHT>+.NUMFATL;
					FLGREG<FATALERR> _ -1;
%[1160]%				FLAGS2<FTLCOM> _ -1;	!Fatal compile errors

					BASENO _ 10;	!FOR DIGITS()
%4530%					HEADPTR = STRN<36,7>;	!INITIAL POINTER					
                                        DIGITS(.NUMFATL); !Stores NUMFATL into HEADPTR 
					REPLACEI( HEADPTR,0);
				END;

%4530%				OUTNAM(.PROGNAME);
%4530%				ZZOUTMSG ( STRN<0,0> );
![760]Use singular if only one error
%[760]%			IF .NUMFATL EQL 1
%[760]%			THEN ZZOUTMSG(PLIT' fatal error and ?0')
%[760]%			ELSE ZZOUTMSG(PLIT' fatal errors and ?0');
			IF .NUMWARN  EQL  0
			THEN	STRN[0] _ 'no'
			ELSE
			BEGIN
				FLGREG<WARNGERR> _ 1;
				HEADPTR _ STRN<36,7>;
				DIGITS(.NUMWARN);
				REPLACEI(HEADPTR,0)
			END;
			ZZOUTMSG ( STRN<0,0> );
![760] Use singular if only one warning
%[760]%			IF .NUMWARN EQL 1
%[760]%			THEN ZZOUTMSG(PLIT' warning?M?J?0')
%[760]%			ELSE ZZOUTMSG(PLIT' warnings?M?J?0');
		END
		ELSE
		BEGIN
			%CRLF FOR THE END OF LISTING%
			IF .FLGREG<LISTING> THEN STRNGOUT(PLIT'?M?J');
%4530%			OUTNAM(.PROGNAME);
%4530%			IF .FLGREG<LISTING> THEN STRNGOUT(PLIT'[ No errors detected ]?0');
			ZZOUTMSG(PLIT'?M?J');
		END
	END;

END;	! ENDUNIT
GLOBAL ROUTINE STATS=
BEGIN

	! Output various statistics for performance analysis
%1133%	! Written 21-Sep-81 by TFV

	MACHOP	CALLI=#047,JSYS=#104;		! For MSTIME, RUNTIM, RUNTM
	BIND	DAY = 1000 * 60 * 60 *24;	! Number of ms in a day

REGISTER
	NUM,
	TIME;

LOCAL
	STG[2],
	ERTIME;


	BASENO = 10;	! Radix for DIGITS()


	! Output size of generated code and data

	ZZOUTMSG(UPLIT ASCIZ '?M?J Size:			');

%1526%	IF .HILOC GTR 0
	THEN
	BEGIN
		HEADPTR = STG<36,7>;	! Output generated hiseg size
%1526%		DIGITS(.HILOC);
		REPLACEI(HEADPTR,0);
		ZZOUTMSG(STG<0,0>);
	END
	ELSE	ZZOUTMSG(UPLIT ASCIZ 'no');	! No code generated

	ZZOUTMSG(UPLIT ASCIZ ' code + ');

	HEADPTR = STG<36,7>;	! Output generated lowseg size
	DIGITS(.LOWLOC);
	REPLACEI(HEADPTR,0);

	ZZOUTMSG(STG<0,0>);
	ZZOUTMSG(UPLIT ASCIZ ' data words?M?J');


	! Output run time 

	ZZOUTMSG(UPLIT ASCIZ ' Run time:		');

%4513%	GETIME();			! Calculate RUNTIME and CONTIME

%4513%	TIME = .RUNTIME - .RTIME;	! Subtract original runtime
%1633%	ERTIME = .TIME;
	OUTTIME(.TIME);

	! Output connect time

	ZZOUTMSG(UPLIT ASCIZ '?M?J Elapsed time:		');

%4513%	TIME = .CONTIME - .CTIME;	! Subtract original connect time then output it
%4513%	CTIME = .CONTIME;		! Reset connect time to new value

	IF .TIME LSS 0 THEN TIME = .TIME + DAY;	! Be careful if near midnight

	OUTTIME(.TIME);


%4513%	! Something special is being timed?  Setup in STATIME by
%4513%	! routines TIMEON and TIMEOFF.
%4513%
%4513%	IF .STATIME GTR 0
%4513%	THEN
%4513%	BEGIN	! Special status time
%4513%
%4513%		ZZOUTMSG(UPLIT ASCIZ '?M?J  Special run time:	');
%4513%		OUTTIME(.STATIME);
%4513%
%4513%	END;	! Special status time

%4513%	RTIME = .RUNTIME;		! Reset runtime to new value

	! Output memory used in compiler lowseg

	ZZOUTMSG(UPLIT ASCIZ '?M?J Dynamic memory used:	');
	
	NUM = .MAXFF - .JOBSA<LEFT>;	! Only dynamic compiler lowseg

	IF .NUM GTR 0
	THEN
	BEGIN
		HEADPTR = STG<36,7>;	! Some dynamic storage was used
		DIGITS(.NUM);
		REPLACEI(HEADPTR,0);
		ZZOUTMSG(STG<0,0>);
	END
	ELSE	ZZOUTMSG(UPLIT ASCIZ 'no');	! Null program - get it right

	ZZOUTMSG(UPLIT ASCIZ ' words?M?J');

	MAXFF = 0;	! Reset maximum compiler lowseg size


%4513%	! Statistics on symbols.
%4513%
%4513%	! Symbol table
%4513%
%4513%	ZZOUTMSG(UPLIT ASCIZ '?M?J Number of symbols in table:	');
%4513%	OUTNUM(.NSYMTBL);
%4513%	ZZOUTMSG(UPLIT ASCIZ '?M?J  Size of storage:		');
%4513%	OUTNUM(.NSYMTBL * IDSIZ);
%4513%
%4513%	IF .NCOMMON NEQ 0
%4513%	THEN
%4513%	BEGIN	! COMMON blocks
%4513%
%4513%		ZZOUTMSG(UPLIT ASCIZ '?M?J Number of COMMON blocks:	');
%4513%		OUTNUM(.NCOMMON);
%4513%		ZZOUTMSG(UPLIT ASCIZ '?M?J  Size of storage:		');
%4513%		OUTNUM(.NCOMMON * COMSIZ);
%4513%
%4513%	END;	! COMMON blocks

%1633%	! Print number of source lines and lines per minute rate	

%4513%	ZZOUTMSG(UPLIT ASCIZ '?M?J?M?J Compiled:	');
%1633%	OUTNUM(.LINCNT);	! Output number of lines
%1633%	ZZOUTMSG(UPLIT ASCIZ ' Source lines at:	');

%1633%	NUM = (.LINCNT * 60000 * 100) / .ERTIME;
%1633%	OUTNUM(.NUM / 100);

%1633%	NUM = .NUM MOD 100;
%1633%	ZZOUTMSG(UPLIT ASCIZ '.');
%1633%	NUM = (.NUM + 5) / 10;

%1633%	IF .NUM GTR 0
%1633%	THEN OUTNUM(.NUM)
%1731%	ELSE ZZOUTMSG(UPLIT ASCIZ ' ');

%1633%	ZZOUTMSG(UPLIT ASCIZ ' lines per minute');

%1633%	! Print number of executable statements and statements per minute rate	

%1633%	NUM = .STCNT - 1;
%1633%	ZZOUTMSG(UPLIT ASCIZ '?M?J Compiled:	');
%1633%	OUTNUM(.NUM);		! Output number of statements
%1633%	ZZOUTMSG(UPLIT ASCIZ ' Executable statements at:	');

%1633%	NUM = (.NUM * 60000 * 100) / .ERTIME;
%1633%	OUTNUM(.NUM / 100);

%1633%	NUM = .NUM MOD 100;
%1633%	ZZOUTMSG(UPLIT ASCIZ '.');
%1633%	NUM = (.NUM + 5) / 10;

%1633%	IF .NUM GTR 0
%1633%	THEN OUTNUM(.NUM)
%1731%	ELSE ZZOUTMSG(UPLIT ASCIZ ' ');

%1633%	ZZOUTMSG(UPLIT ASCIZ ' statements per minute?M?J?M?J');

END;	! of STATS
ROUTINE OUTTIME(TIME)=
BEGIN

	! Output time as mm:ss.s
%1133%	! Written 21-Sep-81 by TFV

	REGISTER NUM;
	LOCAL STG[2];

	BASENO _ 10;	! Radix for DIGITS()

	HEADPTR _ STG<36,7>;

	NUM _ .TIME / 60000;	! Get minutes

	IF .NUM NEQ 0		! Output if non-zero
	THEN
	BEGIN
		DIGITS(.NUM);
		REPLACEI(HEADPTR,":");
	END;

	NUM _ (.TIME MOD 60000) / 1000;	! Get seconds

	IF .NUM NEQ 0 THEN DIGITS(.NUM);	! Output if non-zero

	REPLACEI(HEADPTR,".");

%tfv%	NUM _ .TIME MOD 1000;		! Get milliseconds

	IF .NUM LSS 100
	THEN REPLACEI(HEADPTR,"0");	! .0 milliseconds

	IF .NUM LSS 10
	THEN REPLACEI(HEADPTR,"0");	! .00 milliseconds

	IF .NUM EQL 0
	THEN REPLACEI(HEADPTR,"0")	! .00 milliseconds
	ELSE DIGITS(.NUM);		! nnn milliseconds

	REPLACEI(HEADPTR,0);

	ZZOUTMSG(STG<0,0>);		! Output the time

END;	! OUTTIME
ROUTINE OUTNUM(NUMBER)=
BEGIN

%1633%	! Written by TFV on 1-Sep-82

	! Output a number for /STATISTICS

	LOCAL
		STG[3];

	HEADPTR = STG<36,7>;
	BASENO = 10;
	DIGITS(.NUMBER);
	REPLACEI(HEADPTR,0);
	ZZOUTMSG(STG<0,0>);

END;	! of OUTNUM
GLOBAL ROUTINE CREFIT	( SYM, TYPE )   =
!++
! This routine will output the CREF information into the listing file.
!
!	  TYPE	Type of the symbol
!	  SYM	The symbol  (optional depending upon TYPE).
!--

BEGIN

	MAP BASE SYM;

	BIND	RUBOUT = #177;

%4530%	OWN CREFBUF[2+(MAXSYMCHARS/CHARSPERWORD)];	!USED TO BUILD UP THE CREF STRING

	MACRO 
		NXT(X) = REPLACEI ( HEADPTR, X ) $,
		COUNT = CREFBUF<8,7> $,	!SYMBOL CHARACTER COUNT FIELD
		
		ENDOFCREF =  NXT(RUBOUT);NXT("D");NXT(0) $;	! TERMINATING CHARACTER SEQUENCE FOR CREF INFO

	BIND
		SYMDF = 0,	!SYMBOL DEFINITION
		SYMRF = 1,	!SYMBOL REFERENCE
		LINNE = 2,	!LINE NUMBER
		LABDF = 3,	!LABEL DEFINITION
		LABRF = 4,	!LABEL REFERENCE
		ENDSUBR = 5;	!END OF PROGRAM UNIT

	BIND
		SYMBL = '?0B?A' + RUBOUT^29,	!BEGINNING OF SYMBOL DEFINITION
		LINNUM = '?0B?O' + RUBOUT^29,	!BEGINNING OF LINE NUMBER DEFINTION
		DEFND="?B";		!SYMBOL INDICATING DEFINITION


	IF NOT .FLGREG<LISTING> 
%2447%	THEN	IF NOT .FLGREG<ININCLUD> OR  NOT .SAVFLG[.ICLEVEL]<LISTING>
		THEN	RETURN;

		IF .TYPE EQL  ENDSUBR
		THEN
			STRNGOUT ( PLIT('?0E?0' + RUBOUT^29) )

		ELSE
		BEGIN	! There is some sort of symbol to be output

			HEADPTR _ CREFBUF<8,7>;	!FIRST CHARACTER POS
			BASENO _ 10;	!DIGITS BASE
			NUMODIG _ 0;	!DIGITS RETURN
			CREFBUF[0] _ SYMBL;

			CASE  .TYPE  OF  SET

			BEGIN	! SYMDF
				%SYMBOL DEFINITON / SETTING %
				COUNT _ STRNG6(.SYM[IDSYMBOL]);
				NXT(DEFND)
			END;	! SYMDF

			BEGIN	! SYMRF
				%SYMBOL REFERENCE%
				COUNT _ STRNG6( .SYM[IDSYMBOL] )
			END;	! SYMRF
		
			BEGIN	! LINNE
				%STATEMENT LINE NUMBER FOR FOLLOWING REFS%
				CREFBUF[0] _ LINNUM;
				DIGITS ( .SYM );
				COUNT _ .NUMODIG;
			END;	! LINNE

			BEGIN	! LABDF
				%STATEMENT LABEL DEFINITION %
				DIGITS ( .SYM );
				COUNT _ .NUMODIG + 1;
				NXT("P");
				NXT(DEFND)
			END;	! LABDF

			BEGIN	! LABRF
				%STATEMENT LABEL REFERENCE%
				DIGITS(.SYM);
				COUNT _ .NUMODIG + 1;
				NXT("P")
			END	! LABRF

			TES;

			ENDOFCREF;
			STRNGOUT ( CREFBUF<0,0>)
	END	! There is some sort of symbol to be output

END;	! of CREFIT
GLOBAL ROUTINE ZZOUTMSG(PTR)=

BEGIN
	% THIS ROUTINE IS USED TO OUTPUT NON-STANDARD ERROR MESSAGES APPROPRIATELY %

	MACHOP TTCALL = #051;

	% CLEAR ANY LEADING ZEROS %
	LABEL  NOZERO;
	REGISTER T1;
	T1_(.PTR)<36,7>;
	NOZERO:DECR I FROM  3 TO 0
		DO	IF SCANI(T1)  NEQ  "0"
			THEN	LEAVE NOZERO
			ELSE	REPLACEN ( T1, " ") ;

	IF NOT .FLGREG<TTYDEV>
%1563%	THEN IF NOT .FLGREG<NOERRORS>
%1563%	THEN IF FTTENEX
%1563%	THEN TTYSTR(.PTR)	!DOES A PSOUT FOR TWENTIES
%1563%	ELSE TTCALL(3,PTR,0,1);	!OUTSTR @PTR 

	IF .FLGREG<LISTING> THEN  STRNGOUT(.PTR);
	.VREG
END;

END
ELUDOM