LISTINGS 3-Oct-1986 09:25:18 VAX Pascal V3.4-114 Page 1 V1.1 Source Listing 3-Oct-1986 09:25:10 ACE$DISK:[DECUS.LISTER]LISTINGS.PAS;16 (1) -LINE-IDC-PL-SL- 00001 C 0 0 {+++ 00002 C 0 0 This module is helpful when producing listing files from Pascal 00003 C 0 0 programs. A user-supplied header routine is called to start each 00004 C 0 0 page. Output is buffered until an `end-of-group' signal is given, 00005 C 0 0 which allows a block of text to be printed without spanning a page 00006 C 0 0 break. 00007 C 0 0 00008 C 0 0 Bob Langford 00009 C 0 0 MCV Academic Computing 00010 C 0 0 Medical College of Virginia 00011 C 0 0 March 1986 00012 C 0 0 ---} 00013 0 0 00014 0 0 [inherit('sys$library:rtl'), environment('listings'), ident('V1.1')] 00015 0 0 module Listings; 00016 0 0 00017 0 0 [hidden] const 00018 0 0 MAX_WIDTH = 133; { This is the record length of the output file. } 00019 0 0 MAX_HELD_LINES = 60; { This is the number of lines the buffer will hold. } 00020 0 0 FOOTING_LINES = 3; { This is the size of the bottom margin. } 00021 0 0 type { This structure is used to hold all necessary 00022 C 0 0 information about the listing, including the 00023 C 0 0 buffered text and housekeeping data. } 00024 0 0 aListingControlBlock = [volatile] record 00025 0 0 OutFile : text; 00026 0 0 CurrentLine : integer; 00027 0 0 PageLength : integer; 00028 0 0 BufferPointer : integer; 00029 0 0 HeaderAddr : integer; 00030 0 0 NullFileFlag : boolean; 00031 0 0 Buffer : array [1..MAX_HELD_LINES] of varying [MAX_WIDTH] of char 00032 0 0 end; LISTINGS 3-Oct-1986 09:25:18 VAX Pascal V3.4-114 Page 2 V1.1 Source Listing 3-Oct-1986 09:25:10 ACE$DISK:[DECUS.LISTER]LISTINGS.PAS;16 (2) -LINE-IDC-PL-SL- 00034 1 0 [global] procedure OpenListing ( 00035 1 0 var lcb : aListingControlBlock; 00036 1 0 FileSpec : varying [a] of char; 00037 1 0 HeadingProcedureAddr : integer; 00038 1 0 PageSize : integer := 0 00039 1 0 ); 00040 C 1 0 {+++ 00041 C 1 0 Functional Description: Opens a new listing file, and initializes the data 00042 C 1 0 structure required (a Listing Control Block). 00043 C 1 0 00044 C 1 0 Calling Sequence: See above. 00045 C 1 0 00046 C 1 0 Formal Arguments: LCB - a Listing Control Block. Allocated by caller, 00047 C 1 0 of type `aListingControlBlock' (defined in 00048 C 1 0 this file). 00049 C 1 0 FileSpec - a standard VMS file-spec. This is the 00050 C 1 0 name of the file to be created. A default 00051 C 1 0 file-spec of `.lis' is used to supply 00052 C 1 0 any missing fields. If a null string is 00053 C 1 0 given for FileSpec, no listing file will 00054 C 1 0 be created; all further calls will be 00055 C 1 0 ignored for this listing. 00056 C 1 0 HeadingProcedureAddr - address of a procedure that 00057 C 1 0 will be called each time a new page is started 00058 C 1 0 on the listing file. This procedure should 00059 C 1 0 have no arguments, and should return (as 00060 C 1 0 a function value) an integer indicating 00061 C 1 0 exactly how many lines the header procedure 00062 C 1 0 wrote to the listing file. This parameter 00063 C 1 0 is an integer, passed by reference, and 00064 C 1 0 is saved in the LCB. The heading procedure 00065 C 1 0 may use global or static variables, and 00066 C 1 0 must be declared with the `asynchronous' 00067 C 1 0 attribute. 00068 C 1 0 PageSize - the number of lines desired per page. 00069 C 1 0 If you specify 0 for this parameter, the 00070 C 1 0 system default (see LIB$LP_LINES) (minus 00071 C 1 0 three lines for bottom margin) is used. 00072 C 1 0 00073 C 1 0 Implicit Inputs: None. 00074 C 1 0 00075 C 1 0 Implicit Outputs: Sets several fields in the LCB. 00076 C 1 0 00077 C 1 0 Completion status or returned value: None. 00078 C 1 0 00079 C 1 0 Side Effects: Opens the listing file. 00080 C 1 0 ---} 00081 1 1 begin 00082 1 1 if length(FileSpec) = 0 then { Check for null file spec. } 00083 1 1 lcb.NullFileFlag := TRUE 00084 1 2 else with lcb do begin 00085 1 2 open (OutFile, FileSpec, history := NEW, default := '.lis', 00086 1 2 record_length := MAX_WIDTH); { Open the file. } 00087 1 2 rewrite (OutFile); LISTINGS 3-Oct-1986 09:25:18 VAX Pascal V3.4-114 Page 3 V1.1 Source Listing 3-Oct-1986 09:25:10 ACE$DISK:[DECUS.LISTER]LISTINGS.PAS;16 (2) -LINE-IDC-PL-SL- 00088 1 2 if PageSize <= 0 then { Calc. page size. } 00089 1 2 PageLength := LIB$LP_LINES - FOOTING_LINES 00090 1 2 else 00091 1 2 PageLength := PageSize; 00092 1 2 CurrentLine := PageLength + 1; 00093 1 2 BufferPointer := 0; 00094 1 2 HeaderAddr := HeadingProcedureAddr; { save addr. of header rtn. } 00095 1 2 NullFileFlag := FALSE 00096 1 2 end 00097 0 0 end; { OpenListing } LISTINGS 3-Oct-1986 09:25:18 VAX Pascal V3.4-114 Page 4 V1.1 Source Listing 3-Oct-1986 09:25:10 ACE$DISK:[DECUS.LISTER]LISTINGS.PAS;16 (3) -LINE-IDC-PL-SL- 00099 1 0 [global] procedure FlushListing ( 00100 1 0 var lcb : aListingControlBlock 00101 1 0 ); 00102 1 0 var i : integer; 00103 1 0 arglist : integer; 00104 C 1 0 {+++ 00105 C 1 0 Functional Description: This procedure writes all of the text currently 00106 C 1 0 buffered to the listing file. 00107 C 1 0 00108 C 1 0 Calling Sequence: See above. 00109 C 1 0 00110 C 1 0 Formal Arguments: the LCB for this listing file. 00111 C 1 0 00112 C 1 0 Implicit Inputs: None. 00113 C 1 0 00114 C 1 0 Implicit Outputs: None. 00115 C 1 0 00116 C 1 0 Completion status or returned value: None. 00117 C 1 0 00118 C 1 0 Side Effects: Writes to the listing file. Will call user's 00119 C 1 0 page heading routine when necessary. 00120 C 1 0 ---} 00121 1 1 begin 00122 1 2 if not lcb.NullFileFlag then begin 00123 1 2 if (lcb.CurrentLine + lcb.BufferPointer) > lcb.PageLength then 00124 1 3 begin { Call header routine. } 00125 1 3 arglist := 0; 00126 1 3 lcb.CurrentLine := lib$callg (%ref arglist, %immed lcb.HeaderAddr) 00127 1 2 end; 00128 1 3 for i := 1 to lcb.BufferPointer do begin 00129 1 3 writeln (lcb.OutFile, lcb.Buffer[i]); 00130 1 3 lcb.CurrentLine := lcb.CurrentLine + 1 00131 1 2 end; 00132 1 2 lcb.BufferPointer := 0 00133 1 2 end 00134 0 0 end; { FlushListing } LISTINGS 3-Oct-1986 09:25:18 VAX Pascal V3.4-114 Page 5 V1.1 Source Listing 3-Oct-1986 09:25:10 ACE$DISK:[DECUS.LISTER]LISTINGS.PAS;16 (4) -LINE-IDC-PL-SL- 00136 1 0 [global] procedure WriteListing ( 00137 1 0 var lcb : aListingControlBlock; 00138 1 0 data : varying [a] of char 00139 1 0 ); 00140 C 1 0 {+++ 00141 C 1 0 Functional Description: This procedure adds a line of text to the buffer 00142 C 1 0 for the listing file specified. If there is no 00143 C 1 0 room in the buffer, it is flushed first. 00144 C 1 0 00145 C 1 0 Calling Sequence: See above. 00146 C 1 0 00147 C 1 0 Formal Arguments: lcb - The listing control block for this listing. 00148 C 1 0 data - a character string containing the line of 00149 C 1 0 data for this file. 00150 C 1 0 00151 C 1 0 Implicit Inputs: None. 00152 C 1 0 00153 C 1 0 Implicit Outputs: None. 00154 C 1 0 00155 C 1 0 Completion status or returned value: None. 00156 C 1 0 00157 C 1 0 Side Effects: May call FlushListing if necessary. 00158 C 1 0 ---} 00159 1 1 begin 00160 1 2 if not lcb.NullFileFlag then begin 00161 1 2 if (lcb.BufferPointer >= MAX_HELD_LINES) 00162 1 3 or (lcb.BufferPointer >= lcb.PageLength) then begin 00163 1 3 FlushListing (lcb); 00164 1 2 end; 00165 1 3 if length(data) > 0 then begin { If there's data... } 00166 1 4 if substr(data,1,1) = chr(12) then begin { ...and it starts with a ... } 00167 1 4 FlushListing (lcb); { start a new page } 00168 1 5 if length(data) > 1 then begin { and print data if any left. } 00169 1 5 lcb.BufferPointer := lcb.BufferPointer + 1; 00170 1 5 lcb.Buffer[lcb.BufferPointer] := substr(data,2,length(data)-1) 00171 1 5 end 00172 1 4 end 00173 1 4 else begin { did not have leading } 00174 1 4 lcb.BufferPointer := lcb.BufferPointer + 1; 00175 1 4 lcb.Buffer[lcb.BufferPointer] := data 00176 1 4 end 00177 1 3 end 00178 1 3 else begin { `data' is empty. } 00179 1 3 lcb.BufferPointer := lcb.BufferPointer + 1; 00180 1 3 lcb.Buffer[lcb.BufferPointer] := data 00181 1 3 end 00182 1 2 end 00183 0 0 end; { WriteListing } 00184 0 0 00185 0 0 end. LISTINGS 3-Oct-1986 09:25:18 VAX Pascal V3.4-114 Page 6 V1.1 Pascal Compilation Statistics 3-Oct-1986 09:25:10 ACE$DISK:[DECUS.LISTER]LISTINGS.PAS;16 (4) PSECT SUMMARY Name Bytes Attributes $CODE 953 NOVEC,NOWRT, RD, EXE, SHR, LCL, REL, CON, PIC,ALIGN(2) ENVIRONMENT STATISTICS -------- Symbols -------- File Total Loaded Percent SYS$COMMON:[SYSLIB]RTL.PEN;59 845 7 1 COMMAND QUALIFIERS PASCAL/LIST LISTINGS /CHECK=(BOUNDS,NOCASE_SELECTORS,NOOVERFLOW,NOPOINTERS,NOSUBRANGE) /DEBUG=(NOSYMBOLS,TRACEBACK) /SHOW=(DICTIONARY,INCLUDE,NOINLINE,HEADER,SOURCE,STATISTICS,TABLE_OF_CONTENTS) /OPTIMIZE /STANDARD=NONE /TERMINAL=(NOFILE_NAME,NOROUTINE_NAME,NOSTATISTICS) /USAGE=(NOUNUSED,UNINITIALIZED,NOUNCERTAIN) /ENVIRONMENT=ACE$DISK:[DECUS.LISTER]LISTINGS.PEN;14 /LIST=ACE$DISK:[DECUS.LISTER]LISTINGS.LIS;13 /OBJECT=ACE$DISK:[DECUS.LISTER]LISTINGS.OBJ;14 /NOCROSS_REFERENCE /ERROR_LIMIT=30 /NOG_FLOATING /NOMACHINE_CODE /NOOLD_VERSION /WARNINGS COMPILER INTERNAL TIMING Phase Faults CPU Time Elapsed Time Initialization 224 00:00.1 00:00.9 Source Analysis 304 00:00.2 00:00.7 Source Listing 13 00:00.1 00:00.8 Tree Construction 131 00:00.1 00:00.2 Flow Analysis 51 00:00.0 00:00.1 Value Propagation 11 00:00.0 00:00.0 Profit Analysis 29 00:00.1 00:00.1 Context Analysis 360 00:00.8 00:01.2 Name Packing 7 00:00.0 00:00.0 Code Selection 107 00:00.1 00:00.2 Final 109 00:00.2 00:00.8 TOTAL 1351 00:01.8 00:05.0 COMPILATION STATISTICS CPU Time: 00:01.8 (6343 Lines/Minute) Elapsed Time: 00:05.0 Page Faults: 1351 Pages Used: 906 Compilation Complete