Trailing-Edge
-
PDP-10 Archives
-
decuslib20-07
-
decus/20-0172/lsting.bli
There is 1 other file named lsting.bli in the archive. Click here to see a list.
!<BLF/lowercase_user>
!<BLF/uppercase_key>
MODULE lsting ( !
%IF %BLISS (BLISS32)
%THEN
ADDRESSING_MODE (EXTERNAL = LONG_RELATIVE, !
NONEXTERNAL = LONG_RELATIVE) ,
%FI
IDENT = '02'
) =
BEGIN
!++
! Facility:
!
! BLISS Language Formatter ("PRETTY")
!
! Abstract:
!
! This module contains global routines to produce a listing file
! for PRETTY. This file includes the following features:
! 1) Indentation is indicated by ". " instead of the logical
! tab produced in the source output file.
! 2) Header lines include %TITLE and %SBTTL information, visual
! and SOS page numbers, and SOS line numbers related to
! the source output file.
!
! Environment:
!
! Transportable, with XPORT.
!
! REVISION HISTORY
!
! 12-Jan-82 TT LST$LINE was dropping characters in bodies
! of macro declarations when the body began
! and ended on one line, and consisted of
! patterns of three characters followed by a
! space. Now, if we find a space, check that
! there are three more before printing ": ",
! if not, just put out the space. Also fixed
! bug in same routine where if line was equal
! to Sw_page_width we were one tab short before
! the line number was printed.
!--
!<BLF/page>
!
! Table of contents:
!--
FORWARD ROUTINE !
list_heading : NOVALUE,
lst$dot : NOVALUE, ! Set up dot switch for listing
lst$file : NOVALUE, ! Set up file switch for listing
lst$line : NOVALUE, ! copy source line to listing
lst$module : NOVALUE, ! Save current module name
lst$on, ! Switch = true if producing listing
lst$routine : NOVALUE, ! Save current routine name
lst$subtitle : NOVALUE, ! Save subtitle for listing
lst$title : NOVALUE; ! Save title for listing
!
! Include files:
!--
REQUIRE 'BLFCSW'; ! Defines control switches, i.e. 'sw_...'
REQUIRE 'BLFIOB';
REQUIRE 'BLFMAC'; ! Defines macros 'lex', 'msg', 'write'
!
! Macros:
!--
MACRO
next_tab (col) =
(((col+7)/8)*8) + 1 %;
!
! Equated symbols:
!--
LITERAL
true = 1 EQL 1,
false = 1 NEQ 1;
LITERAL
buf_len = 132,
name_length = 31;
LITERAL
form_feed = %O'14',
space = %C' ',
tab = %O'11';
LITERAL
! These numbers are scaled by 10 to fit in the PDP-11.
sos_max = 9990,
sos_start = 10,
sos_step = 10;
!
! Own storage:
!--
OWN
cp_lst, ! Character pointer to listing line
cp_src,
dot_3sp : INITIAL (CH$PTR (UPLIT (': '))),
len_lst, ! Length of listing line
len_mod_name, ! Length of module name
len_rout_name, ! Length of routine name
len_subtitle,
len_title,
lines_per_page : INITIAL (54),
listing_buf : VECTOR [CH$ALLOCATION (buf_len)],
lst_dot : INITIAL (true), ! switch for vertical dots
lst_req, ! Is listing requested?
module_name : VECTOR [CH$ALLOCATION (name_length)],
page_ascii : VECTOR [CH$ALLOCATION (3)],
routine_name : VECTOR [CH$ALLOCATION (name_length)],
sos_ascii : VECTOR [CH$ALLOCATION (5)],
sos_line, ! Source file line number
sos_page, ! Source file page number
subtitle : VECTOR [CH$ALLOCATION (buf_len)],
title : VECTOR [CH$ALLOCATION (buf_len)],
vis_column, ! Apparent length of listing line
vis_line,
vis_page;
!
! External references:
!--
EXTERNAL ROUTINE !
ctl$switch, ! CONTRL
cvt$put_dec, ! CONVRT
scn$verbatim; ! SCANNR
ROUTINE list_heading : NOVALUE = !
!++
! Functional description:
!
! This routine puts the page heading at the top of each page
! of the listing file. The lines are:
! 1) Module name; routine name; visual page; SOS page
! 2) Title line
! 3) Subtitle line
! 4) a blank line.
!
! Formal parameters:
!
! None
!
! Implicit inputs:
!
! Title and Subtitle lines, from LEX$GETSYM.
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! None
!
! Side effects:
!
! None
!
!--
BEGIN
cvt$put_dec (.vis_page, 3, CH$PTR (page_ascii));
CH$WCHAR (form_feed, CH$PTR (listing_buf));
CH$COPY ((IF .len_mod_name NEQ 0 THEN 7 ELSE 0), !
CH$PTR (UPLIT ('Module ')), !
.len_mod_name, CH$PTR (module_name), !
(IF .len_rout_name NEQ 0 THEN 9 ELSE 0), !
CH$PTR (UPLIT (' Routine ')), !
.len_rout_name, CH$PTR (routine_name), !
5, CH$PTR (UPLIT (%STRING (%CHAR (9), %CHAR (9), %CHAR (9), %CHAR (9), %CHAR (9)))), ! tabs
9, CH$PTR (UPLIT ('Page no. ')), !
3, CH$PTR (page_ascii), !
space, ! Fill char.
2*name_length + 7 + 9 + 5 + 9 + 3 - 1, !
CH$PTR (listing_buf, 1));
$xpo_put ( !
string = (2*name_length + 7 + 9 + 5 + 9 + 3, !
CH$PTR (listing_buf)), !
iob = list_iob);
!+
! Title and Subtitle
!-
CH$MOVE (.len_title, CH$PTR (title), CH$PTR (listing_buf));
$xpo_put ( !
string = (.len_title, CH$PTR (listing_buf)), !
iob = list_iob);
CH$MOVE (.len_subtitle, CH$PTR (subtitle), CH$PTR (listing_buf));
$xpo_put ( !
string = (.len_subtitle, CH$PTR (listing_buf)), !
iob = list_iob);
$xpo_put ( !
string = (0, 0), ! Blank line
iob = list_iob);
END; ! End of routine 'list_heading'
GLOBAL ROUTINE lst$dot (arg) : NOVALUE = !
!++
! Functional description:
!
! This routine sets the flag 'lst_dot' to the value of the
! routine argument. This flags whether the following lines of the
! listing are to be dotted or not. (Mainly to handle imbedded
! comment lines.)
!
! Formal parameters:
!
! arg = the value of the flag (true or false).
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! None
!
! Side effects:
!
! None
!
!--
BEGIN
lst_dot = .arg;
END; ! End of routine 'lst$dot'
GLOBAL ROUTINE lst$file (arg) : NOVALUE = !
!++
! Functional description:
!
! This routine sets the flag 'lst_req' to the value of the
! routine argument. This flags whether the file spec is a file
! name (true) or empty (false).
!
! Formal parameters:
!
! arg = the length of the filespec: 0 if none specified.
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! None
!
! Side effects:
!
! None
!
!--
BEGIN
lst_req = .arg NEQ 0;
END; ! End of routine 'lst$file'
GLOBAL ROUTINE lst$init : NOVALUE = !
!++
! Functional description:
!
!
! Formal parameters:
!
! None
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! None
!
! Side effects:
!
! None
!
!--
BEGIN
CH$FILL (space, len_mod_name = name_length, CH$PTR (module_name));
CH$FILL (space, len_rout_name = name_length, CH$PTR (routine_name));
CH$FILL (space, buf_len, CH$PTR (title));
CH$FILL (space, buf_len, CH$PTR (subtitle));
sos_page = 1;
sos_line = sos_start;
vis_line = vis_page = 1;
END; ! End of routine 'lst$init'
GLOBAL ROUTINE lst$line (len, cp) : NOVALUE = !
!++
! Functional description:
!
! This routine accepts a character string descriptor (len, cp)
! as the description of an input line. The line is copied into
! the listing buffer; in the process, leading tabs and spaces
! are converted into ": " sequences. Trailing tabs and spaces
! are added to fill out the line and the current SOS line
! number is appended to the line. The line is then written to the
! listing file.
!
! Formal parameters:
!
! len = length of the source text line
! cp = character pointer to the source text line
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! None
!
! Side effects:
!
! None
!
!--
BEGIN
LOCAL
chr, ! An input character
leading, ! Flag for leading whitespace
rem_src; ! Remaining source characters
IF NOT .lst_req
THEN
RETURN ! Listing suppressed.
ELSE
BEGIN
leading = NOT scn$verbatim(); ! Unformatted leading whitespace: ignore
rem_src = .len;
cp_src = .cp;
len_lst = 0;
cp_lst = CH$PTR (listing_buf);
vis_column = 1;
WHILE (.rem_src GTR 0) AND .leading DO
BEGIN
chr = CH$RCHAR_A (cp_src);
rem_src = .rem_src - 1;
SELECTONE .chr OF
SET
[form_feed] :
BEGIN
sos_page = .sos_page + 1;
vis_page = .vis_page + 1;
vis_line = 1;
sos_line = sos_start;
list_heading ();
END; ! Of form_feed handler
[tab] :
BEGIN
IF .lst_dot
THEN
INCR i FROM 0 TO 1 DO
BEGIN
cp_lst = CH$MOVE (4, .dot_3sp, .cp_lst);
len_lst = .len_lst + 4;
END
ELSE
BEGIN
CH$WCHAR_A (.chr, cp_lst);
len_lst = .len_lst + 1;
END;
vis_column = next_tab (.vis_column);
END; ! Of leading tab handler
[space] :
IF NOT CH$EQL (3, .cp_src, 3, CH$PTR (UPLIT (' '))) ! TT 12-Jan-82
THEN
BEGIN
leading = false;
cp_lst = CH$MOVE (4, .dot_3sp, .cp_lst);
len_lst = .len_lst + 4;
vis_column = .vis_column + 4;
CH$WCHAR_A (.chr, cp_lst);
vis_column = .vis_column + 1;
len_lst = .len_lst + 1;
END
ELSE
IF .lst_dot
THEN
BEGIN
cp_lst = CH$MOVE (4, .dot_3sp, .cp_lst);
len_lst = .len_lst + 4;
vis_column = .vis_column + 4;
cp_src = CH$PLUS (.cp_src, 3);
rem_src = .rem_src - 3;
END
ELSE
BEGIN
CH$WCHAR_A (.chr, cp_lst);
len_lst = .len_lst + 1;
END; ! Of leading space handler
[OTHERWISE] :
BEGIN
leading = false;
CH$WCHAR_A (.chr, cp_lst);
vis_column = .vis_column + 1;
len_lst = .len_lst + 1;
END; ! Of first nonblank handling
TES;
END; ! Of leading whitespace
WHILE .rem_src GTR 0 DO
BEGIN
chr = CH$RCHAR_A (cp_src);
rem_src = .rem_src - 1;
SELECTONE .chr OF
SET
[tab] :
BEGIN
vis_column = next_tab (.vis_column);
END;
[OTHERWISE] :
vis_column = .vis_column + 1;
TES;
CH$WCHAR_A (.chr, cp_lst);
len_lst = .len_lst + 1;
END; ! Of input text line
! Fill out the line with tabs
UNTIL .vis_column GTR ctl$switch (sw_page_width) DO
BEGIN
CH$WCHAR_A (tab, cp_lst);
len_lst = .len_lst + 1;
vis_column = next_tab (.vis_column);
END;
IF .len_lst EQL ctl$switch (sw_page_width) AND ! TT 12-Jan-82
.vis_column NEQ .len_lst + 3
THEN
BEGIN
CH$WCHAR_A (tab, cp_lst);
len_lst = .len_lst + 1;
vis_column = next_tab (.vis_column);
END;
! Append the SOS line number
BEGIN
cvt$put_dec (.sos_page, 3, CH$PTR (sos_ascii));
cp_lst = CH$COPY (1, CH$PTR (UPLIT ('/')), !
3, CH$PTR (sos_ascii), !
space, !
4, .cp_lst);
cvt$put_dec (.sos_line*10, 5, CH$PTR (sos_ascii));
cp_lst = CH$COPY (1, CH$PTR (UPLIT ('.')), !
5, CH$PTR (sos_ascii), !
space, !
6, .cp_lst);
len_lst = .len_lst + 10;
END;
! Finally, write the line
$xpo_put ( !
string = (.len_lst, CH$PTR (listing_buf)), !
iob = list_iob);
!++++++++++++++++++++++++++++++++++++++++++++
! Update the line and page numbers
!--------------------------------------------
vis_line = .vis_line + 1;
IF .vis_line GTR .lines_per_page
THEN
BEGIN
vis_page = .vis_page + 1;
vis_line = 1;
list_heading ();
END;
sos_line = .sos_line + sos_step;
IF .sos_line GTR sos_max
THEN
BEGIN
sos_page = .sos_page + 1;
sos_line = sos_start;
list_heading ();
END;
END ! Of generation of new listing line.
END; ! End of routine 'lst$line'
GLOBAL ROUTINE lst$module (len, cp) : NOVALUE = !
!++
! Functional description:
!
! This routine saves the module name for the listing heading lines.
!
! Formal parameters:
!
! len = length of module name
! cp = character pointer to name string
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! None
!
! Side effects:
!
! None
!
!--
BEGIN
CH$COPY (len_mod_name = .len, .cp, !
space, !
name_length, CH$PTR (module_name));
lst$routine (0, 0); ! Erase routine name
END; ! End of routine 'lst$module'
GLOBAL ROUTINE lst$on = !
!++
! Functional description:
!
! This routine returns true if we are producing a listing file.
!
! Formal parameters:
!
! None
!
! Implicit inputs:
!
! None
!
! Implicit listings:
!
! None
!
! Routine value:
!
! true if listing filespec was given,
! false if listing filespec was empty.
!
! Side effects:
!
! None
!
!--
BEGIN
RETURN .lst_req;
END; ! End of routine 'lst$on'
GLOBAL ROUTINE lst$routine (len, cp) : NOVALUE = !
!++
! Functional description:
!
! This routine saves the routine name for the listing heading lines.
!
! Formal parameters:
!
! len = length of routine name
! cp = character pointer to name string
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! None
!
! Side effects:
!
! None
!
!--
BEGIN
CH$COPY (len_rout_name = .len, .cp, !
space, !
name_length, CH$PTR (routine_name));
END; ! End of routine 'lst$routine'
GLOBAL ROUTINE lst$subtitle (len, cp) : NOVALUE = !
!++
! Functional description:
!
! This routine copies the text of a %SBTTL lexical function
! into a buffer for use in the listing page heading.
!
! Formal parameters:
!
! len = the length of the text string
! cp = the character pointer to the text.
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! None
!
! Side effects:
!
! None
!
!--
BEGIN
CH$COPY (len_subtitle = .len, .cp, !
space, !
buf_len, CH$PTR (subtitle));
END; ! End of routine 'lst$subtitle'
GLOBAL ROUTINE lst$title (len, cp) : NOVALUE = !
!++
! Functional description:
!
! This routine copies the text of a %SBTTL lexical function
! into a buffer for use in the listing page heading.
!
! Formal parameters:
!
! len = the length of the text string
! cp = the character pointer to the text.
!
! Implicit inputs:
!
! None
!
! Implicit outputs:
!
! None
!
! Routine value:
!
! None
!
! Side effects:
!
! None
!
!--
BEGIN
CH$COPY (len_title = .len, .cp, !
space, !
buf_len, CH$PTR (title));
END; ! End of routine 'lst$title'
%TITLE 'Last page of LSTING.BLI'
END ! End of module 'LSTING'
ELUDOM