Google
 

Trailing-Edge - PDP-10 Archives - bb-4157h-bm_fortran20_v10_16mt9 - fortran-compiler/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, 1985
!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

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


GLOBAL BIND UNENDV = #10^24 + 0^18 + #2447;	! Version Date:	10-Aug-84

%(

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

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

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

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


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

FORWARD
	ZZOUTMSG,
	ENDUNIT,
%1133%	STATS,		! Routine to print out statistics
%1133%	OUTTIME,	! Routine to output times
%1633%	OUTNUM,		! Output a number
	CREFIT;

%[1047]% PORTAL ROUTINE ENDUNIT =
BEGIN
	%OUTPUT THE MESSGES AT THE END OF THE PROGRAM UNIT%
	REGISTER T1,T2;
	EXTERNAL  JOBERR,DIGITS,CCLSW,NUMWARN,NUMFATL,HEADPTR,STRNGOUT;

%1133%	IF .F2<STA> THEN STATS();	! Print out statistics

		BEGIN	%CROSS REFERENCE END OF PROGRAM SYMBOL %
			EXTERNAL CREFIT;
			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;
			BASENO _ 10;	!FOR DIGITS()
			T1 _ STRN[2]<36,7>;
			STRN[3] _ ' 	';	!<BLANK><TAB>
			T2 _ PROGNAME<36,6>;
			DECR I FROM 5 TO 0 DO
				REPLACEI ( T1, SCANI(T2)+#40 ) ;

			IF .NUMFATL NEQ 0 OR .NUMWARN NEQ 0
			THEN
			BEGIN
				ZZOUTMSG(PLIT'?M?J');
				IF .NUMFATL  EQL  0
				THEN
				BEGIN
					STRN[0] _ '%FTNW';
					STRN[1] _ 'RN   ';
					STRN[3] _ .STRN[3] + '?0?0No'
				END
				ELSE
				BEGIN
					STRN[0] _ '??FTNF';
					STRN[1] _ 'TL   ';
					JOBERR<RIGHT>_.JOBERR<RIGHT>+.NUMFATL;
					FLGREG<FATALERR> _ -1;
%[1160]%				FLAGS2<FTLCOM> _ -1;	!Fatal compile errors
					HEADPTR _ STRN[3]<22,7>;	!INITIAL POINTER
					DIGITS(.NUMFATL);
					REPLACEI( HEADPTR,0);
				END;
				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');
				ZZOUTMSG(STRN[2]<0,0>);
				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

	EXTERNAL DIGITS,HEADPTR,ZZOUTMSG,BASENO,OUTTIME;
	EXTERNAL RTIME,CTIME,MAXFF,LOWLOC,HILOC,JOBSA;

EXTERNAL
%tfv%	LINCNT,
%tfv%	STCNT;

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

REGISTER
	TIME,NUM;
REGISTER
	AC1=1,AC2=2,AC3=3;
LOCAL
	STG[2],RSV[3],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:		');

	NUM _ 0;
	IF FTTENEX
	THEN
	BEGIN	! TOPS-20

		RSV[0] _ .AC1;	! Save AC1
		RSV[1] _ .AC2;	! Save AC2
		RSV[2] _ .AC3;	! Save AC3
		AC1 _ #400000;	! Fork is .FHSLF
		JSYS(0,#15);	! RUNTM JSYS
		NUM _ .AC1;	! Run time is in AC1
	END
	ELSE	NUM _ CALLI(NUM,#27);	! RUNTIM UUO for TOPS-10

	TIME _ .NUM - .RTIME;	! Subtract original runtime then output it
%1633%	ERTIME = .TIME;
	RTIME _ .NUM;		! Reset runtime to new value
	OUTTIME(.TIME);

	! Output connect time

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

	IF FTTENEX
	THEN
	BEGIN	! TOPS-20

		NUM _ .AC3;	! Connect time is in AC3
		AC1 _ .RSV[0];	! Restore AC1
		AC2 _ .RSV[1];	! Restore AC2
		AC3 _ .RSV[2];	! Restore AC3
	END
	ELSE	NUM _ CALLI(NUM,#23);	! MSTIME UUO for TOPS-10

	TIME _ .NUM - .CTIME;	! Subtract original connect time then output it
	CTIME _ .NUM;		! Reset connect time to new value

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

	OUTTIME(.TIME);

	! 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

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

%1633%	ZZOUTMSG(UPLIT ASCIZ '?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');

END;	! STATS
ROUTINE OUTTIME(TIME)=
BEGIN

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

	EXTERNAL DIGITS,HEADPTR,BASENO,ZZOUTMSG;

	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];

	EXTERNAL
		HEADPTR,
		DIGITS,
		BASENO;

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

END;	! of OUTNUM

	GLOBAL ROUTINE 
CREFIT	( SYM, TYPE )   =

BEGIN
	% THIS ROUTINE WILL OUTPUT THE CREF INFORMATION INTO THE
	  LISTING FILE.
	  TYPE - TYPE OF THE SYMBOL
	  SYM - THE SYMBOL
		(SYM IS OPTIONAL DEPENDING UPON TYPE )
%

	EXTERNAL  CHAROUT,HEADPTR,STRNGOUT,ENTRY,DIGITS,STRNG6,BASENO,NUMODIG;
	EXTERNAL
%2447%		ICLEVEL,	!CURRENT INCLUDE FILE LEVEL
		SAVFLG;		!SAVE OF INCLUDE FILE FLGREG
	MAP BASE SYM;

	BIND	RUBOUT = #177;

	OWN CREFBUF[3];	!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
			%THERE IS SOME SORT OF SYMBOL TO BE OUTPUT %
		BEGIN

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

			CASE  .TYPE  OF  SET

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

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

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

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

			TES;

			ENDOFCREF;
			STRNGOUT ( CREFBUF<0,0>)
	END
END;	%CREFIT%


	GLOBAL ROUTINE
ZZOUTMSG(PTR)=

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

	EXTERNAL  STRNGOUT, TTYSTR;
	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