Trailing-Edge
-
PDP-10 Archives
-
BB-D480F-SB_FORTRAN10_V10
-
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