Trailing-Edge
-
PDP-10 Archives
-
BB-4157F-BM_1983
-
fortran/compiler/unend.bli
There are 12 other files named unend.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) DIGITAL EQUIPMENT CORPORATION 1973, 1983
!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 = 7^24 + 0^18 + #1563; ! Version Date: 18-Jun-82
%(
***** 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 Revision History *****
)%
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)
%1633% ELSE ZZOUTMSG(UPLIT ASCIZ '0');
%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)
%1633% ELSE ZZOUTMSG(UPLIT ASCIZ '0');
%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 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>
THEN IF NOT .FLGREG<ININCLUD> OR NOT .SAVFLG<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