Trailing-Edge
-
PDP-10 Archives
-
fortv11
-
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