Since a typical program consisted of 50 to 100 or more modules and its structure chart spanned 5 to 10 pages, updating a structure chart was always put off as long as you could get away with it. Not being particularly adept at drawing any type of diagram, I cast around for an easier way to document the structure of my programs. The result was STRUCHART, a tool that automatically constructs the calling tree for a program.
MAIN
INITIALIZE
PROCESS
GET_DATA
TRANSFORM_DATA
PUT_DATA
TERMINATE
The STRUCHART program is compiled and linked using a DCL
command procedure, BUILDSC.COM (not shown):
$ @BUILDSC.COM
After building the executable, you must then add STRUCHART to your
process command table using the VMS Command Definition Utility (CDU). This
is conveniently done in your LOGIN.COM file:
$ SET COMMAND STRUCHART.CLD
where STRUCHART.CLD is the Command
Language Definition file for the structure chart generator. To make it more
readily available to all users, your system manager can add STRUCHART
to the system-wide DCL command table:
$ SET COMMAND/TABLE=SYS$LIBRARY:DCLTABLES
/OUTPUT=SYS$LIBRARY:DCLTABLES STRUCHART.CLD
Once entered into a command table, STRUCHART is invoked by:
$ STRUCHART [/[NO]DOLLARS] [/MAIN=(name[,...])]
[/OUTPUT[=output_file]] [input_file_spec[,...]]
The /[NO]DOLLARS option controls the inclusion of module names
with embedded dollar signs (generally indicative of system
routines). NODOLLARS excludes all module names with embedded
dollar signs; DOLLARS includes all module names with embedded
dollar signs. If neither is specified, STRUCHART excludes names
according to its default list of module name prefixes (FOR$,
MTH$, OTS$, and STR$).
Normally, STRUCHART prints out a structure chart for each
module which is not called by any other, i.e., the module is the
main routine of a program. If the /MAIN option is used,
STRUCHART only prints out structure charts whose roots are the
specified module names.
STRUCHART's default output device is your terminal
(SYS$OUTPUT). Specifying
/OUTPUT=output_file on the command line redirects
STRUCHART's output to a file. Specifying /OUTPUT
without a file name causes STRUCHART to create a new output file,
module.SCO, for each struchart chart generated,
where module assumes the name of the main module in each
structure chart.
Each input_file_spec can be a single file or a wildcard file
specification; wildcards are expanded into the matching set of files.
STRUCHART handles three types of input file: object files, object
libraries, and intermediate files. Object files are the standard
.OBJ files generated by VMS compilers and assemblers. Object
libraries (.OLB files) collect object modules from multiple
object files into a single library file; these object modules are scanned
and treated as if separate object files were specified. STRUCHART
intermediate files (.SCI files) are read as text files
containing module calling relations. All other input file names have their
file extension replaced by .OBJ; e.g., you can say
*.FOR and STRUCHART will pick up the corresponding
.OBJ object files.
As an example, suppose you're in the STRUCHART directory.
The following command builds the structure chart for STRUCHART
and writes it to STRUCHART.SCO:
$ STRUCHART/OUTPUT *.OBJ
"Sticky defaults" are applied to input file specifications, so
$ STRUCHART *.FOR,ALEX$LIB:*.OLB,*.OBJ
reads, in succession, FORTRAN-generated object files in your current
directory, .OLB object libraries in ALEX$LIB, and
.OBJ files in ALEX$LIB.
STRUCHART is composed of 12 modules: a main program and 11
subprograms. The main program parses the
command line arguments and calls the other functions. The complete source
code for STRUCHART can be downloaded from ARIS; two subroutines of
interest, GET_SYMBOLS and DFS_PRINT, are described
and listed below.
.LIS files) for the information
needed to build a call tree. Two passes were made over each list file.
The first pass located the Functions and Subroutines Referenced
section found near the end of a listing and extracted the routine names
from that section. The second pass tried to sort the names into their
order of reference within the program text. As you can imagine, the code
to accomplish all this was not a pretty sight. Major revisions were
required whenever a new compiler release introduced drastic changes into
the list file format.
Surprisingly, reading list files was not unduly slow; the time-consuming aspect of generating structure charts in this manner was recompiling all the modules to produce the list files, which, to conserve disk space, were normally not kept around. The major disadvantage of the original STRUCHART was not its speed, but that it was limited to FORTRAN programs.
.OBJ files instead of .LIS files. Since the
formats of object modules in object files and object libraries are
identical, the capability of reading object libraries was easily added in a
later upgrade of STRUCHART.
Subroutines READ_OBJ and READ_OLB read object
module records from object files and object libraries, respectively. Each
record is passed to GET_SYMBOLS for
processing. When a module header record is input, GET_SYMBOLS
extracts and saves the module name. When a Text Information and Relocation
(TIR) record is read, each global symbol is extracted and a
module-calls-symbol relation is stored in STRUCHART's internal
data structures. References to low-level system routines (e.g.,
FOR$xxx, MTH$xxx,
OTS$xxx, etc.) are discarded at this point.
The contents of the TIR records are essentially a tokenized instruction
stream that the Linker reads and interprets to build an executable image.
The DATA_LENGTH table in
GET_SYMBOLS tells GET_SYMBOLS how to increment
its "program counter" through the instructions in a record. TIR records
were chosen over the Global Symbol Definition (GSD) records as the source
of external references since the symbols' order of occurrence in the TIR
records more closely approximates the order of their occurrence in the
program text.
Since our VAX had a limited number of languages available,
STRUCHART was tested primarily on FORTRAN and MACRO object
modules. Some Pascal software supplied by another company was
also subjected to STRUCHART, but the results were not examined
closely. STRUCHART's module-based tree derivation can cause
problems with object files generated by other compilers. C
language object files, for instance, contain a single module per
file: the module's name is the name of the source file and the
functions defined in the source file are treated as entry points
within that one object module. Therefore, if you restrict
yourself to one function per source file, STRUCHART should prove
useful with C language object files, too. Running STRUCHART on
an Ada library (and ANALYZE/OBJECT on an object file extracted
from the library) produced no useful information.
STRUCHART intermediate files are normal VMS text files; the intermediate file for the example program given in Figure 1 might look as follows:
Routine GET_DATA Calls
Routine INITIALIZE Calls
Routine MAIN Calls
INITIALIZE
PROCESS
TERMINATE
Routine PROCESS Calls
GET_DATA
TRANSFORM_DATA
PUT_DATA
Routine PUT_DATA Calls
Routine TERMINATE Calls
Routine TRANSFORM_DATA Calls
A calls routine B in the program is
represented in the graph by two vertices, A and
B, connected by an edge from A to B.
Recursion and utility functions called by multiple routines prevent us from
using strict trees.
The call graph, constructed as the input files are read, is represented
using adjacency lists. A routine table contains the names of all the
modules in the program. Attached to each routine X in the table
are two adjacency lists: a list of those routines that X calls
(the CALLS array) and a list of those routines by whom
X is called (the CALLED_BY array). Figure 2 shows
the graph constructed for the example program in Figure 1.
After the graph is built, STRUCHART steps through each name
in the routine table. If an entry in the table has an empty
CALLED_BY list (i.e., no other routines call this one), the
routine is assumed to be the main module of a program and the
root of a call tree; therefore, a structure chart for it is
generated. STRUCHART keeps track of where each routine is
defined, so that unreferenced library routines don't generate
spurious structure charts.
If object modules from several programs are mixed together
in an object file specification, a single invocation of STRUCHART
will produce several structure charts. The /MAIN command line
option can be used to selectively print the structure charts.
Generation of an output structure chart is based on a simple, depth-first search (DFS) algorithm that recursively visits each vertex in the call graph:
PROC dfs (x)
IF visited[x] THEN RETURN
visited[x] = true
DO for each routine y that x calls
CALL dfs (y)
ENDDO
ENDPROC
While the algorithm above is sufficient to perform a basic graph
traversal, the structures of real programs usually introduce
cycles and multiple paths into the graph, the presence of which
would be usefully noted in the output structure chart.
Cycles are caused by recursive procedure calls (see Figure 3a) and are easily detected by locking a routine while its subtree is searched. The locked routines at any particular instant are those routines which lie on the current search path: the sequence of calls from the main routine down to the current routine. Visiting a locked routine (i.e., one which also appears earlier in the search path) is the sign of a recursive call and STRUCHART outputs an explicit message saying so.
In graph terminology, the number of edges entering a vertex
is known as the in-degree of the vertex. In STRUCHART, a
module's in-degree equals the length of its CALLED_BY list and is
the number of different routines that directly call the module.
Multiple paths to a particular vertex, indicated by an in-degree
greater than one, are characteristic of utility routines called
from different modules in your program (see Figure 3b). Utility
routines are flagged with an asterisk (*) in the output; a
utility routine's subtree is only expanded on the first visit to
the routine during the graph traversal.
An enhanced DFS algorithm handles recursive calls
and utility routines. Subroutine
DFS_PRINT, an iterative, FORTRAN
implementation of this algorithm, traverses the graph and prints out the
structure chart.
Some more extraordinary applications of STRUCHART have taken advantage of its intermediate file. Although the separation of the object file scan from the building of the call graph, as was done in earlier versions of STRUCHART, seems to have added an unneccesary processing step, the ability to input the calling information from an arbitrary intermediate file served to free STRUCHART from the VAX sphere of influence. In one case, fancy footwork with a text editor enabled me to hack some PL/M-86 source files (stored on our VAX before being downloaded to an Intel development system) into a STRUCHART intermediate file that generated a usable structure chart for our non-VAX, embedded, real-time software.
More recently, I was handed a PDP-11 magnetic tape containing nearly 600 undocumented, FORTRAN source files (plus 100 INCLUDE files and 50 MACRO files) from an old satellite control center. I was able to read the tape on a Data General computer and transfer the files over a network to our Sun workstation, but where could I go from there? Hmmm ... STRUCHART ...
A couple of hours sufficed to write a C program that scanned the FORTRAN programs for subroutine declarations and calls and output a STRUCHART-readable intermediate file. The C program also picked up function declarations, but the small number of functions in the FORTRAN code did not warrant the complexity required to recognize function calls.
Porting STRUCHART to the Sun system was a real headache because the available FORTRAN compiler implemented a primitive version of FORTRAN-77 (to maintain compatibility with some third-party software, we were running an older version of Sun's operating system). After a few hours of work, however, I had STRUCHART up and running, minus object file processing and many of the amenities of VMS. A short while later, I had 700 routines divided up among structure charts for 120 programs. Not bad for a full day's work; now, if I could just figure out what all those 6-character variable names mean!
The list of prefixes used by STRUCHART to filter out the names of
frequently-called system routines (e.g., FOR$xxx,
etc.) is hard-coded in subroutine GET_SYMBOLS and was tailored
to our FORTRAN/MACRO programming environment. Other shops might wish to
modify this list as their needs require. An attractive alternative to
hard-coding the list is to set it up at run-time using command line options
or an initialization file.
Although I like STRUCHART's 8-space indentation of call
levels, I frequently get lost in deeply-nested, multi-page
structure charts. It's a simple matter, however, to edit the
output file and add some type of level indicator. For example,
the EDT command S / /. / WHOLE (replace 8 spaces
by a dot and 7 spaces throughout the file) adds a vertical line
of dots for each call level. STRUCHART's own structure chart
looks as follows after this treatment:
STRUCHART
. FPARSE *
. TRIM *
. SCAN_OLB
. . READ_OLB
. . . TRIM *
. . . GET_SYMBOLS *
. . . . ADD_ROUTINE *
. . . . ADD_NODE *
. . TRIM *
. READ_SCI
. . TRIM *
. . GETWORD
. . ADD_ROUTINE *
. . ADD_NODE *
. READ_OBJ
. . FPARSE *
. . TRIM *
. . GET_SYMBOLS *
. DFS_PRINT
. . TRIM *
STRUCHART was written when the author worked for General Electric's Space Division (Lanham, MD); the program was ported to UNIX in the author's current position with Integral Systems, Inc. (Lanham, MD). Acknowledgement is due Andrew Measday of CAE-Link (Silver Spring, MD) for his assistance in testing STRUCHART.
!**************************************************************************
!
! Command Language Definition file for the Structure Chart Generator.
!
! NOTE: Set the IMAGE argument to point to your copy of the
! STRUCHART executable.
!
!**************************************************************************
DEFINE VERB STRUCHART
IMAGE "disk:[directory]struchart.exe"
QUALIFIER DOLLARS, NEGATABLE
QUALIFIER MAIN, VALUE (LIST,REQUIRED)
QUALIFIER OUTPUT, VALUE (TYPE=$FILE)
PARAMETER P1, VALUE (LIST,TYPE=$FILE,DEFAULT="*.obj")
C**************************************************************************
PROGRAM STRUCHART
C**************************************************************************
C
C STRUCHART is an automatic structure chart generator. It reads the
C VAX/VMS object modules making up a program (or multiple programs),
C extracts the global symbols defined in each object module, and builds
C the structure chart(s) defined by that symbol information.
C
C**************************************************************************
IMPLICIT NONE
C... Parameters, global variables, and external definitions.
INCLUDE 'struchart.inc' ! STRUCHART definitions.
PARAMETER P_SCO_LUN = 9 ! Logical unit number for output file.
EXTERNAL CLI$_ABSENT, CLI$_NEGATED, CLI$_PRESENT
INTEGER*4 fparse, trim ! External functions.
INTEGER*4 CLI$GET_VALUE, CLI$PRESENT, LIB$FIND_FILE
C... Local variables.
CHARACTER extension*4, main*32, message*128
CHARACTER output_file*128, source_file*128
CHARACTER sticky_defaults*128, wildcard_spec*128
INTEGER*4 context, i, length, status
LOGICAL name_from_module
C... Set flags based on command line options.
status = CLI$PRESENT ('DOLLARS')
IF (status .EQ. %LOC(CLI$_PRESENT)) THEN
exclude_flag = P_NONE ! /DOLLARS - includes all $-routines.
ELSEIF (status .EQ. %LOC(CLI$_NEGATED)) THEN
exclude_flag = P_DOLLARS ! /NODOLLARS - excludes all $-routines.
ELSE
exclude_flag = P_DEFAULTS ! Otherwise, exclude default list only.
ENDIF
C... Initialize the adjacency list and the routine table to empty.
NUM_ADJ = 0
NUM_ROUTINES = 0
C... Get the input file specifications from the command line.
C Read each file and build the caller-callee data structure.
sticky_defaults = ' '
DO WHILE (CLI$GET_VALUE ('P1', wildcard_spec) .NE.
+ %LOC(CLI$_ABSENT))
IF (fparse (wildcard_spec, %DESCR(';'), sticky_defaults, , ,
+ source_file)) THEN
wildcard_spec = source_file
ENDIF
context = 0
DO WHILE (LIB$FIND_FILE (wildcard_spec, source_file, context))
WRITE (6,*) source_file(1:trim(source_file))
CALL fparse (source_file, , , %DESCR('TYPE'), , extension)
IF (extension .EQ. '.OLB') THEN
CALL scan_olb (source_file) ! Object library.
ELSEIF (extension .EQ. '.SCI') THEN
CALL read_sci (source_file) ! Intermediate file.
ELSE
CALL read_obj (source_file) ! Object file.
ENDIF
ENDDO
sticky_defaults = wildcard_spec
ENDDO
C... Open up the output file. If "/OUTPUT" was specified, base
C the output file name on the main module name. If "/OUTPUT=filename"
C was specified, open filename for output. If neither was specified,
C write the structure charts out to SYS$OUTPUT.
status = CLI$PRESENT ('OUTPUT')
IF (status .EQ. %LOC(CLI$_PRESENT)) THEN
status = CLI$GET_VALUE ('OUTPUT', output_file)
IF (status .EQ. %LOC(CLI$_ABSENT)) THEN
name_from_module = .TRUE. ! "/OUTPUT"
ELSE
name_from_module = .FALSE. ! "/OUTPUT=filename"
OPEN (UNIT=P_SCO_LUN, NAME=output_file, TYPE='NEW',
+ CARRIAGECONTROL='LIST', IOSTAT=status, ERR=90)
ENDIF
ELSE
name_from_module = .FALSE. ! Option not specified.
output_file = 'SYS$OUTPUT'
OPEN (UNIT=P_SCO_LUN, NAME=output_file, TYPE='NEW',
+ CARRIAGECONTROL='LIST', IOSTAT=status, ERR=90)
ENDIF
C... If the names of one or more main modules was specified on the
C command line, generate a structure chart for each of the programs.
C For each of the main routines, traverse that routine's subtree and
C output its structure chart. If the output file names are to be
C based on the main module names, open a new output file for each
C main routine.
IF (CLI$PRESENT ('MAIN') .NE. %LOC(CLI$_ABSENT)) THEN
DO WHILE (CLI$GET_VALUE ('MAIN', main) .NE. %LOC(CLI$_ABSENT))
DO i = 1, num_routines
IF (routine_name(i) .EQ. main) THEN
IF (name_from_module) THEN
CALL fparse (routine_name(i), %DESCR('.SCO'),
+ , , , output_file)
OPEN (UNIT=P_SCO_LUN, NAME=output_file,
+ TYPE='NEW', CARRIAGECONTROL='LIST',
+ IOSTAT=status, ERR=90)
ENDIF
CALL dfs_print (i, P_SCO_LUN)
IF (name_from_module) CLOSE (UNIT=P_SCO_LUN)
ENDIF
ENDDO
ENDDO
ELSE
C... If no main modules were specified on the command line, generate
C structure charts for all possible programs. For each "root" (a node
C called by no other node) in the graph, traverse the tree below the
C root and display that root's structure chart. If the output file
C names are to be based on the main module names, open a new output
C file for each root.
DO i = 1, num_routines
IF ((called_by(i) .EQ. NULL) .AND. ! A root node?
+ (defined_in(i) .NE. 'OLB')) THEN ! Not a library routine?
IF (name_from_module) THEN
CALL fparse (routine_name(i), %DESCR('.SCO'),
+ , , , output_file)
OPEN (UNIT=P_SCO_LUN, NAME=output_file,
+ TYPE='NEW', CARRIAGECONTROL='LIST',
+ IOSTAT=status, ERR=90)
ENDIF
CALL dfs_print (i, P_SCO_LUN)
IF (name_from_module) CLOSE (UNIT=P_SCO_LUN)
ENDIF
ENDDO
ENDIF
C... If there was an error opening up the output file, display
C an error message.
status = 0 ! No errors.
90 IF (status .NE. 0) THEN
CALL ERRSNS ( , , , , status)
WRITE (6,*) 'Error opening output file: "',
+ output_file(1:trim(output_file)), '"'
CALL LIB$SYS_GETMSG (status, length, message, , )
WRITE (6,*) message(1:length)
CALL EXIT
ENDIF
END
C**************************************************************************
SUBROUTINE GET_SYMBOLS (current_module, file_type,
+ rec, record_length)
C**************************************************************************
C
C Subroutine GET_SYMBOLS extracts calling hierarchy information from
C a VMS object record. GET_SYMBOLS handles two types of VMS object
C records: (i) main module header records and (ii) text information
C and relocation records. Other record types are ignored.
C
C If a main module header (MHD) record is encountered, GET_SYMBOLS
C extracts the module name, adds it to the routine table, and updates
C the CURRENT_MODULE argument.
C
C If a text information and relocation (TIR) record is encountered,
C GET_SYMBOLS scans the Linker instructions in the record, looking
C for references to global symbols. For each reference found,
C GET_SYMBOLS adds a "currentModule calls globalSymbol"
C relation to the call graph.
C
C NOTE: GET_SYMBOLS is dependent upon the VMS object file format,
C which is described in the VAX/VMS Linker Manual. Changes in
C the file format might require changes in GET_SYMBOLS.
C
C
C Example Usage (in Pseudo-Code):
C
C Open the object file
C current_module = ' '
C DO WHILE (NOT EOF)
C Read an object record from the object file
C CALL get_symbols (current_module, 'OBJ',
C object_record, length)
C ENDDO
C
C
C Arguments:
C
C CURRENT_MODULE (Character)
C is the name of the current module. Initially this should
C be spaced out (' '). As GET_SYMBOLS processes main module
C header records, it will pull out the module name and store
C it in this argument.
C FILE_TYPE (Character)
C is the type of the file from which the object record
C was read: 'OBJ' for a ".OBJ" object file, and 'OLB' for
C a ".OLB" object library. (See the DEFINED_IN field of
C the routine table in the STRUCHART.INC include file.)
C REC (Object record structure)
C is the object record GET_SYMBOLS will scan.
C RECORD_LENGTH (Integer)
C is the length of the object record.
C
C**************************************************************************
IMPLICIT NONE
C... Parameters, global variables, and external definitions.
INCLUDE '($MHDEF)' ! Module header record definition.
INCLUDE '($OBJRECDEF)' ! Object language record definition.
INCLUDE '($TIRDEF)' ! Text information and relocation record.
INCLUDE 'struchart.inc' ! STRUCHART definitions.
INTEGER*4 add_routine ! External function.
C... Subroutine arguments.
CHARACTER*(*) current_module
CHARACTER*(*) file_type ! 'OBJ' or 'OLB'.
STRUCTURE /OBJECT_RECORD/
UNION
MAP
CHARACTER text*(OBJ$C_MAXRECSIZ)
END MAP
MAP
BYTE buffer(OBJ$C_MAXRECSIZ)
END MAP
MAP
RECORD /MHDEF/ mhd ! Module header record.
END MAP
MAP
RECORD /OBJRECDEF/ obj ! Object file record.
END MAP
MAP
RECORD /TIRDEF/ tir ! Text info/reloc record.
END MAP
END UNION
END STRUCTURE
RECORD /OBJECT_RECORD/ rec
INTEGER*4 record_length
C... Local variables.
CHARACTER*32 symbol
INTEGER*4 calling_routine, command, i, length, ptr
C**************************************************************************
C
C Data Length Table:
C
C The Data Length Table defines the lengths of the data fields
C for the various Text Information and Relocation commands recognized
C by the VMS Linker. Subroutine GET_SYMBOLS uses these lengths to
C step through the command stream in a TIR record. Certain types of
C commands which have variable length data fields are flagged with
C a negative length in the table:
C
C -1 : Standard name (first byte = # of characters that follow)
C -2 : Standard name + byte + argument descriptor
C -3 : Word + standard name
C -4 : Like standard name (first byte = # of bytes that follow)
C
C**************************************************************************
INTEGER*4 data_length(0:127)
DATA data_length(TIR$C_STA_GBL) /-1/
DATA data_length(TIR$C_STA_SB) / 1/
DATA data_length(TIR$C_STA_SW) / 2/
DATA data_length(TIR$C_STA_LW) / 4/
DATA data_length(TIR$C_STA_PB) / 2/
DATA data_length(TIR$C_STA_PW) / 3/
DATA data_length(TIR$C_STA_PL) / 5/
DATA data_length(TIR$C_STA_UB) / 1/
DATA data_length(TIR$C_STA_UW) / 2/
DATA data_length(TIR$C_STA_BFI) / 0/
DATA data_length(TIR$C_STA_WFI) / 0/
DATA data_length(TIR$C_STA_LFI) / 0/
! Entry point mask from GSD$C_EPM subrecord?
DATA data_length(TIR$C_STA_EPM) /-1/
DATA data_length(TIR$C_STA_CKARG) /-2/
DATA data_length(TIR$C_STA_WPB) / 3/
DATA data_length(TIR$C_STA_WPW) / 4/
DATA data_length(TIR$C_STA_WPL) / 6/
DATA data_length(TIR$C_STA_LSY) /-3/
DATA data_length(TIR$C_STA_LIT) / 1/
! Entry point mask from GSD$C_LEPM record?
DATA data_length(TIR$C_STA_LEPM) /-3/
DATA data_length(TIR$C_STO_SB) / 0/
DATA data_length(TIR$C_STO_SW) / 0/
DATA data_length(TIR$C_STO_L) / 0/ ! TIR$C_STO_LW
DATA data_length(TIR$C_STO_BD) / 0/
DATA data_length(TIR$C_STO_WD) / 0/
DATA data_length(TIR$C_STO_LD) / 0/
DATA data_length(TIR$C_STO_LI) / 0/
DATA data_length(TIR$C_STO_PIDR) / 0/
DATA data_length(TIR$C_STO_PICR) / 0/
DATA data_length(TIR$C_STO_RSB) / 0/
DATA data_length(TIR$C_STO_RSW) / 0/
DATA data_length(TIR$C_STO_RL) / 0/
DATA data_length(TIR$C_STO_VPS) / 2/
DATA data_length(TIR$C_STO_USB) / 0/
DATA data_length(TIR$C_STO_USW) / 0/
DATA data_length(TIR$C_STO_RUB) / 0/
DATA data_length(TIR$C_STO_RUW) / 0/
DATA data_length(TIR$C_STO_B) / 0/
DATA data_length(TIR$C_STO_W) / 0/
DATA data_length(TIR$C_STO_RB) / 0/
DATA data_length(TIR$C_STO_RW) / 0/
DATA data_length(TIR$C_STO_RIVB) /-4/
DATA data_length(TIR$C_STO_PIRR) / 0/
DATA data_length(TIR$C_OPR_NOP) / 0/
DATA data_length(TIR$C_OPR_ADD) / 0/
DATA data_length(TIR$C_OPR_SUB) / 0/
DATA data_length(TIR$C_OPR_MUL) / 0/
DATA data_length(TIR$C_OPR_DIV) / 0/
DATA data_length(TIR$C_OPR_AND) / 0/
DATA data_length(TIR$C_OPR_IOR) / 0/
DATA data_length(TIR$C_OPR_EOR) / 0/
DATA data_length(TIR$C_OPR_NEG) / 0/
DATA data_length(TIR$C_OPR_COM) / 0/
DATA data_length(TIR$C_OPR_INSV) / 2/
DATA data_length(TIR$C_OPR_ASH) / 0/
DATA data_length(TIR$C_OPR_USH) / 0/
DATA data_length(TIR$C_OPR_ROT) / 0/
DATA data_length(TIR$C_OPR_SEL) / 0/
DATA data_length(TIR$C_OPR_REDEF) /-1/
DATA data_length(TIR$C_OPR_DFLIT) / 1/
DATA data_length(TIR$C_CTL_SETRB) / 0/
DATA data_length(TIR$C_CTL_AUGRB) / 4/
DATA data_length(TIR$C_CTL_DFLOC) / 0/
DATA data_length(TIR$C_CTL_STLOC) / 0/
DATA data_length(TIR$C_CTL_STKDL) / 0/
C... Lookup the current module name in the routine table and
C save its index.
IF (current_module .NE. ' ') THEN
calling_routine = add_routine (current_module, ' ')
ENDIF
C... Main module header record. Extract the module name and
C enter it in the routine table.
IF ((rec.obj.OBJ$B_RECTYP .EQ. OBJ$C_HDR) .AND.
+ (rec.obj.OBJ$B_SUBTYP .EQ. MHD$C_MHD)) THEN
length = ZEXT (rec.mhd.MHD$B_NAMLNG)
current_module = rec.mhd.MHD$T_NAME(1:length)
calling_routine = add_routine (current_module, file_type)
C... Text information and relocation record. Extract the global
C symbols referenced in the record.
ELSEIF (rec.obj.OBJ$B_RECTYP .EQ. OBJ$C_TIR) THEN
i = 2
DO WHILE (i .LE. record_length)
command = rec.buffer(I)
i = i + 1 ! Skip command byte.
C... Extract the global symbol and add the module-calls-symbol
C relation to the call graph.
IF (command .EQ. TIR$C_STA_GBL) THEN
length = ZEXT (rec.buffer(i))
symbol = rec.text(i+1:i+length)
IF (exclude_flag .EQ. P_DEFAULTS) THEN
IF (symbol(1:4) .EQ. 'FOR$') symbol = ' '
IF (symbol(1:4) .EQ. 'MTH$') symbol = ' '
IF (symbol(1:4) .EQ. 'OTS$') symbol = ' '
IF (symbol(1:4) .EQ. 'STR$') symbol = ' '
ELSEIF (exclude_flag .EQ. P_DOLLARS) THEN
IF (INDEX (symbol, '$') .GT. 0) symbol = ' '
ENDIF
IF (symbol .NE. ' ') THEN ! Not excluded?
ptr = add_routine (symbol, ' ')
CALL add_node (calling_routine, ptr)
ENDIF
ENDIF
C... Step over the TIR command's operands to the next command.
IF (command .LT. 0) THEN ! Store immediate command?
i = i + ABS (command)
ELSE
length = data_length(command)
IF (length .EQ. -1) THEN
length = ZEXT (rec.buffer(i))
i = i + 1 + length
ELSEIF (length .EQ. -2) THEN
length = ZEXT (rec.buffer(i))
i = i + 1 + length + 1 + 1
length = ZEXT (rec.buffer(i))
i = i + 1 + length
ELSEIF (length .EQ. -3) THEN
i = i + 2 ! Skip word.
length = ZEXT (rec.buffer(i))
i = i + 1 + length
ELSEIF (length .EQ. -4) THEN
length = ZEXT (rec.buffer(i))
i = i + 1 + length
ELSE
i = i + length
ENDIF
ENDIF ! If not a Store Immediate command.
ENDDO ! Until the contents of the record are exhausted.
ENDIF ! If a TIR record.
RETURN
END
Initially, for all routines x:
visited[x] = false
locked[x] = false
PROC dfs (x, level)
LOCAL y ;
IF locked[x] THEN
Indent (level) ; Print "Routine <x> is recursively called." ;
ELSE
IF visited[x] THEN
Indent (level) ; Print "<x> *" ;
The subtree below x was expanded on the first visit -
do not expand it on subsequent visits ;
ELSE
IF in-degree[x] > 1 THEN
Indent (level) ; Print "<x> *" ;
ELSE
Indent (level) ; Print "<x>" ;
ENDIF
visited[x] = true ;
locked[x] = true ;
DO for each routine y that x calls
CALL dfs (y, level+1) ;
ENDDO
locked[x] = false ;
ENDIF
ENDIF
ENDPROC
C**************************************************************************
SUBROUTINE dfs_print (root, lun)
C**************************************************************************
C
C Subroutine DFS_PRINT is the iterative implementation of a
C recursive, depth-first search algorithm that visits and
C prints out the nodes in a call graph.
C
C
C Arguments:
C
C ROOT (Integer)
C is the index in the routine table of the main module
C at which the call tree traversal is to start.
C LUN (Integer)
C is the FORTRAN logical unit number to which the output
C structure chart is to be written.
C
C**************************************************************************
IMPLICIT NONE
C... Parameters, global variables, and external definitions.
INCLUDE 'struchart.inc' ! STRUCHART definitions.
INTEGER*4 trim ! External function.
C... Subroutine arguments.
INTEGER*4 root
INTEGER*4 lun
C... Local variables.
INTEGER*4 length, level, ptr, routine
C... Initialize the graph structure attributes.
DO routine = 1, num_routines
locked(routine) = .FALSE.
visited(routine) = .FALSE.
ENDDO
C... Beginning at the main routine (the root of the tree),
C traverse the graph, printing out the calling structure of
C the program.
length = trim (routine_name(root))
WRITE (lun,500) routine_name(root)(1:length)
500 FORMAT (//A, /<length>('-'), /)
routine = root
stack_pointer = 0
DO WHILE (routine .GT. 0)
length = trim (routine_name(routine))
level = (stack_pointer/2) + 1
ptr = NULL
C... If the routine is locked (i.e., it also appears earlier in the
C current search path), then a recursive call was made. Note that
C fact in the output and "return".
IF (locked(routine)) THEN
WRITE (lun,510) routine_name(routine)(1:length) //
+ ' is recursively called.'
510 FORMAT (<(level-1)*8>X, A)
ELSE
C... If the routine has already been visited (i.e., it's a
C utility-type function), then mark it in the output with an
C asterisk and "return". The routine's subtree was expanded
C on the first visit.
IF (visited(routine)) THEN
WRITE (lun,510) routine_name(routine)(1:length) //
+ ' *'
ELSE
C... On the first visit to a routine, print out its name and perform
C a depth-first search of its subtree.
IF (in_degree(routine) .GT. 1) THEN
WRITE (lun,510) routine_name(routine)(1:length)
+ // ' *'
ELSE
WRITE (lun,510) routine_name(routine)(1:length)
ENDIF
visited(routine) = .TRUE.
ptr = calls(routine)
ENDIF ! Visited?
ENDIF ! Locked?
C... If a routine has no subtree or the subtree does not need
C to be expanded (both conditions indicated by PTR = NULL),
C then "return". If the expansion of the subtree of a routine
C popped off the stack is complete, unlock the routine (i.e.,
C it's no longer on the current search path) and "return" again.
DO WHILE ((ptr .EQ. NULL) .AND. (stack_pointer .GT. 0))
ptr = stack(stack_pointer) ! Pop (Routine, Ptr)
stack_pointer = stack_pointer - 1
routine = stack(stack_pointer)
stack_pointer = stack_pointer - 1
ptr = adj_link(ptr)
IF (ptr .EQ. NULL) locked(routine) = .FALSE.
ENDDO
C... For each routine Y that X calls, lock X (i.e., X is on the
C current search path), push X on the stack, and process Y.
IF (ptr .EQ. NULL) THEN
routine = -1
ELSE
locked(routine) = .TRUE.
stack_pointer = stack_pointer + 1 ! Push (Routine, Ptr)
stack(stack_pointer) = routine
stack_pointer = stack_pointer + 1
stack(stack_pointer) = ptr
routine = adj_info(ptr)
ENDIF
ENDDO ! Until stack empty and no node.
RETURN
END