|
|
The listing module provides a number of procedures to generate a neat listing. Each of the pages of the listing has a header on the first two lines with information about the listing, such as the input filename, date, time, page number and version number of the program. This module contains procedures to control the beginning and end of the printing process in the listing.
It also contains a left margin mechanism for indentation. All printing is done between the current left margin and the fixed right margin. The left margin can be moved relatively, set absolutely or changed temporarily. This allows the user to generate output with a suitable layout.
The printing is not character oriented, but word oriented. This means that all printing procedures print a number of characters in a certain format—namely, as a row of adjacent characters. If there is not enough room on the current line, printing will proceed on the next line, or page, in the case that the current page is full.
The module also contains two procedures that can be used for echoing entire lines from the input, and for printing error markings under these lines at the correct position.
There are two procedures that control the beginning and the end of the listing. The first initializes the listing. It opens an output file using the name of the input file with extension ".LST". When this is not possible the program is halted. Otherwise, a number of variables controlling the printing are initialized and the first page header is printed. This initialization procedure can only be called after the input file name has been read [scanner 1]. The header of this procedure is:
PROCEDURE init_listing;
The second procedure finalizes the listing. It prints in the listing, and on the terminal, the elapsed time, together with the number of pages of the listing. The output file is also closed. The header of this procedure is:
PROCEDURE fini_listing;
Printing is done between the left margin and the fixed right margin. There are two exceptions. Firstly, if one of the printing routines gets an argument that does not fit between the margins, then the argument will be printed right justified to the right margin. Secondly, the echoing procedures that can be used to echo the input file always work with a fixed margin on the first position, regardless of the position of the left margin. Initially, the left margin is zero. The value of the left margin is stored in the variable left margin.
There are three ways in which the left margin can be changed. We describe them in the following subsections. Changes to the left margin only become active after printing proceeds on the next line in the listing. Changes to the left margin, therefore, do not effect the printing on the current line.
The left margin can be moved a number of positions to the right or to the left using the following two procedures:
PROCEDURE shift_right(number : integer); PROCEDURE shift_left(number : integer);
Sometimes one wants to move the left margin some distance depending on the length of certain text rather than a fixed number of positions. For this purpose there are two procedures that allow the left margin to be changed temporarily to the current printing position in the listing. These procedures have the following headings:
PROCEDURE set_left_margin(VAR save : integer); PROCEDURE reset_left_margin(save : integer);
These two procedures have to be called successively with the same integer variable, which is used to save the current left margin position. When the procedure set left margin is called after something is printed, everything (as far as possible) is printed to the left of what was printed before, until the following call to the procedure reset left margin. After this call, printing proceeds from the previous left margin position.
To temporarily change the left margin to an absolute position, the procedure replace left margin is used in combination with the procedure reset left margin. The usage of the former procedure is the same as the above set left margin. Instead of the current printing position it uses the second parameter. The header of the procedure is:
PROCEDURE replace_left_margin(VAR save : integer;
new_pos : integer);
To change the left margin to a given new position without saving the previous value, the procedure reset left margin can be used instead. This is useful when one has lost track of its relative movements (due to errors for example) and wants to reset it to zero again.
There are two procedures that can be used to control the printing of pages and newlines. The variables listing line nr and listing page nr contain the current page number and the current line number of the listing file where printing will proceed. The procedure print page skips to the next page, and a listing page header is written. The header of the procedure is:
PROCEDURE print_page;
The procedure print newline with parameter nr will generate nr newlines, and skip to the left margin position of the last line. If the parameter nr is absent, a single newline is generated. The header of the procedure is:
PROCEDURE print_newline(nr : integer := 1);
In this section we describe the actual printing routines. All printing should be done through these procedures, otherwise the internal administration will be corrupted, which could lead to rubbish in the listing file. The internal administration consists of the variables pos, listing line nr and listing page nr containing the current position in the current line and page of the printing file (respectively). In the last subsection of this section we explain how exceptions should be implemented.
We first describe all regular printing routines. All these routines work with the same principle that they print their argument on the listing file as an adjacent row of characters. If the argument does not fit on the current line, it will be printed on the next line. The left margin is adjusted temporarily if the row does not fit between the margins, which causes the row to be printed right adjusted to the right margin.
The procedure print char prints a single char on the listing file. The procedure print space prints a space if it still fits on the current line, otherwise nothing happens. So printing a space character with the procedure print char may not have the same effect as calling print space. The idea of the procedure print space is to print a separating space where a newline would have the same effect. For example, this procedure should be used while printing an enumeration of words separated by spaces. If, for example, a word would just fit on the current line, calling print char would result in a space char just after the left margin on the next line. So a straight left margin is lost. Using print space instead, no space would be printed, if the next printing action would proceed to the left margin of the next line.
The header of these procedures are:
PROCEDURE print_char(which_char : char); PROCEDURE print_space;
The alfa type is used to store identifiers. There are two procedures that can print arguments of the type alfa.
The procedure print alfa prints its argument using its current length. This results in a row of characters which will contain the current value, together with the current length. The header of the procedure is:
PROCEDURE print_alfa(name : alfa);
The procedure print fixed prints its argument as a row of characters of fixed length. The length is determined by the second argument only. If the first argument is longer than the second argument, then only the initial characters are printed. If the length is shorter, spaces are added to the right. This procedure is useful when one wants to print a table. The header of the procedure is:
PROCEDURE print_fixed(name : alfa; size : integer);
VMS Pascal has the capability of passing arguments of arbitrary length to procedures. The procedure print info prints such an argument. There is a restriction on the maximum length of the argument, which is the same as the maximum length of the records in a text file. In this case, equal to 132 characters. Arguments longer than 132 will result in a run time error. This procedure can be used effectively in combination with the standard procedure writev which works the same as write, except that instead of writing to a file, it writes to a string (varying of char). The header of this procedure is:
PROCEDURE print_info(info : VARYING[s] OF char);
To make printing on the listing file possible without using these procedures, the output text file variable listing must be visible outside of the listing module.
The usage of the procedure writeln will always corrupt the internal line counting and neglect the left margin. It will cause page headers to be printed on the wrong place if the internal line counting concludes that the current page is full. The line counting can be reset by calling the procedure print page, which causes printing to proceed on the next page.
The usage of the procedure write will corrupt the character counting in the line. This can be prevented by preceding each call to write with a call to the procedure check pos with the exact number of positions that are written. The procedure check pos frees the required number of positions according to the normal conventions. Actually, all other printing procedures call this procedure before they print their argument. The header of this procedure is:
PROCEDURE check_pos(number : integer);
One could also neglect the internal position counting. Instead of using the writeln procedure, one should use the procedure print newline. Attempting to print more on one line than is possible will lead to a run time error.
In this section we describe the two procedures that can be used during echoing the input file and signaling error messages.
The procedure echo line in listing makes it possible to print an entire line from the input, preceded by a 3 digit input line number. The header of the procedure is:
PROCEDURE echo_line_in_listing(nr : integer;
buf : input_line);
The procedure set error pointer prints error pointers under the current line of the input. There are tree kinds of error pointers used in this program. Two of them are used to show what was skipped during skipping actions. These are the characters "<" and ">", which indicate the first and last character (if possible) that were skipped. Because skipping actions are not reported with an explicit message, more than one skipping action can occur under a line from the input file.
The third character "^" is used to indicate the position of an error. These always come together with an explicit error message on a separate line. Because of this, printing proceeds on the next line when the procedure is called with this error pointer.
The variable error pos contains the last position of an error pointer in the current line. If there is no such error pointer then the value is equal to the value of the constant no error pos.
The header of this procedure is:
PROCEDURE set_error_pointer(kind : char;
at_pos : integer);
This module uses the following modules:
openfiles, definitions.
The exported variable is:
listing : text;
We list the exported procedures, followed by a short description of their usage taken from the listing file:
PROCEDURE print_page;
This procedure prints a new page on the listing. See section 3
PROCEDURE print_newline(nr : integer := 1);
This procedure prints nr newlines and sets the left margin. See section 3
PROCEDURE shift_right(number : integer);
This procedure shifts the left margin number positions to the right. See section 2.1
PROCEDURE shift_left(number : integer);
This procedure shifts the left margin number positions to the left. See section 2.1
PROCEDURE set_left_margin(VAR save : integer);
This procedure sets the left margin to the current position, and saves the old position in the variable save. See section 2.2
PROCEDURE reset_left_margin(save : integer);
This procedure resets the left margin to the position of save. See section 2.2
PROCEDURE replace_left_margin(VAR save : integer;
new_pos : integer);
This procedure replaces the left margin to the position new pos, and saves the old position in the variable save. See section 2.3
PROCEDURE check_pos(number : integer);
This procedure checks the current position in the output line. If, added with number, it is too large, a newline is generated. See section 4.4
PROCEDURE print_char(which_char : char);
This procedure prints the character which char. See section 4.1
PROCEDURE print_space;
This procedure prints a space, if it still fits on the current line. See section 4.1
PROCEDURE print_alfa(name : alfa);
This procedure prints the contents of name. See section 4.2
PROCEDURE print_fixed(name : alfa; size : integer);
This procedure prints the contents of name, in size positions. See section 4.2
PROCEDURE print_info(info : VARYING[s] OF char);
This procedure prints the string info, with length s. See section 4.3
PROCEDURE echo_line_in_listing(nr : integer;
buf : input_line);
This procedure echoes the input line buf, preceded with the line number nr. See section 5
PROCEDURE set_error_pointer(kind : char; at_pos : integer);
This procedure prints an arrow under the current output line in the listing, at the beginning of the last read symbol. See section 5
PROCEDURE init_listing;
This procedure initializes the listing. See section 1
PROCEDURE fini_listing;
This procedure finalizes the listing. See section 1
[ENVIRONMENT ('listing.pen'),
INHERIT ('[schaapbiblio.screen]openfiles.pen'
,'definitions.pen')]
MODULE listing;
[HIDDEN] CONST
(* local for this module *)
max_output_line = 130; (* the maximum length of an output line *)
max_outp_pl_1 = 131; (* the maximum length of an output line + 1 *)
max_lines = 58; (* max number of lines on an output page *)
apsgn_listing = '-listing : ';
apsgn_file = '-input file : ';
apsgn_start = '-start : ';
apsgn_time = '-compiletime : ';
no_error_pos = -3;
VAR
(* local for this module *)
pos , (* the current position in a line of the listing *)
left_margin , (* the current left margin in the listing *)
error_pos , (* position of last error in output line *)
listing_line_nr , (* line number of current page of the listing file *)
listing_page_nr (* page number of current page of the listing file *)
: [HIDDEN] integer;
(* shared with other modules *)
listing : TEXT; (* listing file *)
|
[HIDDEN]
PROCEDURE listing_heading;
(* This procedure produces a nice heading *)
(* at the top of the listing file. *)
BEGIN
listing_page_nr := listing_page_nr + 1;
write (listing, version, ' on ':(50-length(version)),
today, ' at ', now, ' page ' : 30);
writeln (listing, listing_page_nr : 2);
writeln (listing, apsgn_file, input_filename);
writeln (listing); writeln(listing);
listing_line_nr := 4;
END;
PROCEDURE print_page;
(* This procedure prints a new page *)
BEGIN
page(listing);
listing_heading
END;
[HIDDEN]
PROCEDURE listing_newline(number: integer);
(* This procedure produces number newlines in the listing *)
(* file. If necessary, a newpage is generated. *)
VAR i : integer;
BEGIN
listing_line_nr := listing_line_nr + number;
IF listing_line_nr >= max_lines
THEN print_page
ELSE FOR i:=1 TO number DO writeln (listing)
END;
PROCEDURE print_newline (nr:integer := 1);
(* This procedure generates nr newlines and sets the left margin *)
BEGIN
listing_newline (nr);
write (listing, ' ': left_margin);
pos := left_margin
END;
|
PROCEDURE shift_right (number: integer);
(* This procedure shifts the margin to the right *)
BEGIN
left_margin := (left_margin + number) MOD max_outp_pl_1
END;
PROCEDURE shift_left (number: integer);
(* This procedure shifts the margin to the left *)
BEGIN
left_margin := (left_margin - number) MOD max_outp_pl_1
END;
PROCEDURE set_left_margin (VAR save: integer);
(* This procedure sets the left margin to current position and saves *)
(* the old position *)
BEGIN
save := left_margin;
left_margin := pos
END;
PROCEDURE reset_left_margin (save: integer);
(* This procedure resets the left_margin to the saved position *)
BEGIN
left_margin := save
END;
PROCEDURE replace_left_margin (VAR save: integer; new_pos: integer);
(* This procedures replaces the current value of the left *)
(* margin by new_pos. Before doing so, the old value is saved. *)
BEGIN
save := left_margin;
left_margin := new_pos
END;
|
PROCEDURE check_pos (number: integer);
(* This procedure checks the current position on the output. *)
(* line. If, added with number, it is too large, a newline *)
(* is generated. *)
VAR save_pos : integer;
BEGIN
IF pos + number > max_output_line
THEN IF left_margin + number > max_output_line
THEN BEGIN
replace_left_margin (save_pos, max_output_line - number);
print_newline(1);
reset_left_margin (save_pos)
END
ELSE print_newline(1);
pos := pos + number
END;
PROCEDURE print_char(which_char : char);
(* This procedure prints which_char *)
BEGIN
check_pos(1);
write(listing, which_char)
END;
PROCEDURE print_space;
(* This procedure prints a space if it still fits on the same line *)
BEGIN
IF pos < max_output_line
THEN BEGIN
write(listing, ' ');
pos := pos + 1;
END;
END;
PROCEDURE print_alfa (name: alfa);
(* This procedure prints a name of type alfa *)
BEGIN
check_pos (length(name));
write (listing, name);
END;
PROCEDURE print_fixed (name: alfa; size: integer);
(* This procedure prints a name of type alfa in size positions *)
BEGIN
check_pos(size);
IF size > length(name)
THEN write(listing, name, ' ':(size-length(name)))
ELSE write(listing, name:size)
END;
PROCEDURE print_info (info: VARYING[s] OF char);
(* This procedure prints a string info with maximum length s *)
BEGIN
check_pos(length(info));
write(listing, info);
END;
|
PROCEDURE echo_line_in_listing(nr:integer; buf:input_line);
(* This procedure echoes the inputline buf with length length in the *)
(* listing, preceded with the input line number nr. *)
VAR i : integer;
BEGIN
IF error_pos <> no_error_pos
THEN BEGIN
listing_newline(1);
error_pos := no_error_pos
END;
write(listing,nr : 3, ' ', buf);
listing_newline(1)
END;
PROCEDURE set_error_pointer(kind:char; at_pos:integer);
(* This procedure prints an arrow under the current output line in the *)
(* listing, at the beginning of the last read symbol. Error_pos is used to *)
(* determine where the last arrow was printed, and updated afterwards. *)
(* There are tree kinds of arrows, two to show what was skipped during *)
(* skipping process ("<" and ">"), and one to show the place of an error *)
(* ("^") *)
VAR
shift_pos : integer;
BEGIN
shift_pos := max(at_pos - error_pos, 1);
(* shift_pos = number of shift positions, at least one *)
print_fixed(' ', shift_pos);
print_char(kind);
IF kind <> '^'
THEN error_pos := error_pos + shift_pos
ELSE BEGIN
print_newline(1);
error_pos := no_error_pos
END
END;
|
PROCEDURE init_listing;
(* This procedure initializes the listing. It does this by first opening *)
(* the listing file with the same name as the input file, but with the *)
(* extension .LST . The page counter is initialized and the procedure *)
(* listing_heading is called once, to make output ready for the first page. *)
BEGIN
IF NOT open_output_file (listing, new_filename('LST')) THEN halt;
writeln(apsgn_listing, new_filename('LST'));
listing_page_nr := 0;
pos := 0;
left_margin := 0;
date(today);
time(now);
listing_heading;
END;
PROCEDURE fini_listing;
(* This procedure finalizes the listing *)
VAR
compile_time : real;
BEGIN
compile_time := clock/1000;
writeln( apsgn_time, compile_time:6:3, ' second(s)');
write(listing, apsgn_time, compile_time:6:3, ' second(s)');
writeln(apsgn_listing, listing_page_nr:1, ' page(s)');
close(listing);
END;
END.
|
My life as a hacker | My home page