GHC@NIHKLMB.BITNET (Gerson H Cohen) (08/09/88)
I have been requested to post the FPRETTY program on the list, having already
sent out several copies directly. I hope all who want it do get it. There
are three parts to the distribution, as I cave cut it. GHC
...................... Cut between dotted lines and save .....................
.
$!..............................................................................
$! VAX/VMS archive file created by VMS_SHAR V-5.01 01-Oct-1987
$! which was written by Michael Bednarek (U3369429@ucsvc.dn.mu.oz.au)
$! To unpack, simply save and execute (@) this file.
$!
$! This archive was created by GHC
$! on Monday 8-AUG-1988 15:21:50.64
$!
$! ATTENTION: To keep each article below 15872 bytes, this program
$! has been transmitted in 3 parts.
$! You should concatenate ALL parts to ONE file and execute (@) that file.
$!
$! It contains the following 5 files:
$! FPRETTY.CLD FPRETTY.HLP FPRETTY3.FOR FPRETTY2.FOR FPRETTY1.FOR
$!==============================================================================
$ Set Symbol/Scope=(NoLocal,NoGlobal)
$ Version=F$GetSYI("VERSION") ! See what VMS version we have here:
$ If Version.ges."V4.4" then goto Version_OK
$ Write SYS$Output "Sorry, you are running VMS ",Version, -
", but this procedure requires V4.4 or higher."
$ Exit 44
$Version_OK: CR[0,8]=13
$ Pass_or_Failed="failed!,passed."
$ Goto Start
$Convert_File:
$ Read/Time_Out=0/Error=No_Error1/Prompt="creating ''File_is'" SYS$Command ddd
$No_Error1: Define/User_Mode SYS$Output NL:
$ Edit/TPU/NoSection/NoDisplay/Command=SYS$Input/Output='File_is' -
VMS_SHAR_DUMMY.DUMMY
f:=Get_Info(Command_Line,"File_Name");b:=Create_Buffer("",f);
o:=Get_Info(Command_Line,"Output_File");Set(Output_File,b,o);
Position(Beginning_of(b));Loop x:=Erase_Character(1);Loop ExitIf x<>"V";
Move_Vertical(1);x:=Erase_Character(1);Append_Line;
Move_Horizontal(-Current_Offset);EndLoop;Move_Vertical(1);
ExitIf Mark(None)=End_of(b) EndLoop;Position(Beginning_of(b));Loop
x:=Search("`",Forward,Exact);ExitIf x=0;Position(x);Erase_Character(1);
If Current_Character='`' then Move_Horizontal(1);else
Copy_Text(ASCII(INT(Erase_Character(3))));EndIf;EndLoop;Exit;
$ Delete VMS_SHAR_DUMMY.DUMMY;*
$ Checksum 'File_is
$ Success=F$Element(Check_Sum_is.eq.CHECKSUM$CHECKSUM,",",Pass_or_Failed)+CR
$ Read/Time_Out=0/Error=No_Error2/Prompt=" CHECKSUM ''Success'" SYS$Command ddd
$No_Error2: Return
$Start:
$ File_is="FPRETTY.CLD"
$ Check_Sum_is=1159419776
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
Xmodule fpretty
X
X! an individual user should type
X!`009SET COMMAND FPRETTY
X! the system manager can add to DCLTABLES by
X!`009SET COMMAND/TABLE=SYS$LIBRARY:DCLTABLES.EXE-
X!`009`009/OUTPUT=SYS$LIBRARY:DCLTABLES.EXE FPRETTY
X! see utilities reference manual (remember to reinstall DCLTABLES...)
X! and set UT to something appropriate (SYS$SYSTEM maybe)
X! `009Mark Paulk - SDC Huntsville
X! Modified for Fermilab Accelerator VAX by Frank J. Nagy, 03-Apr-83
X
Xdefine verb FPretty
X`009image sys$disk:[]Fpretty
X`009parameter p1, value(required), prompt="File"
X`009qualifier list, default
X`009qualifier comment_indent, default
X
$ GoSub Convert_File
$ File_is="FPRETTY.HLP"
$ Check_Sum_is=386293012
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
X1 FPRETTY_
X Invokes the FORTRAN "pretty printer" utility.
X
X FPRETTY accepts as input a FORTRAN program and can produce
X as output an indented listing, showing levels of nesting,
X or a compilable program, with structured indentation.
X
X The listing, generated by default, is a .LIS file.
X
X Format:
X
X FPRETTY file-spec
X
X2 Qualifiers
X/LIST
X
X /LIST (D)
X /NOLIST
X
X Controls whether a listing file (.LIS) is generated or a
X new version of the file (.FOR). The listing file provides
X "alignment" markers to indicate the nesting of control
X structures. The /NOLIST provides an indented, compilable
X version of the program.
X
X/COMMENT_INDENT
X
X /COMMENT_INDENT (D)
X /NOCOMMENT_INDENT
X
X Controls whether comments are indented along with the code.
$ GoSub Convert_File
$ File_is="FPRETTY3.FOR"
$ Check_Sum_is=1380075458
$ Copy SYS$Input VMS_SHAR_DUMMY.DUMMY
Xc
Xc Subroutine to find next nonblank character past a starting point.
Xc
X subroutine scan(start,last)
X integer start,last
Xc
Xc Function.
Xc
X logical space
Xc
Xc Common.
Xc
X common/line/linein,lineout,in_length,out_length
X character linein*132,lineout*132
X integer in_length,out_length
Xc
Xc Executable code.
Xc
Xd write(6,10000)
X10000 format(' in scan')
X if ((start+1).le.in_length) then
X i = start + 1
X do while (i.lt.in_length .and. space(linein(i:i)))
X i = i + 1
X end do
X last = i
X else
X last = in_length
X end if
X return
X end
Xc
Xc Function to determine if a character is a space.
Xc Either a blank or a tab is considered to be a space.
Xc
X logical function space(ch)
X character ch
Xc
X parameter bl = char(32)
X parameter tab = char(9)
Xc
Xc Executable code.
Xc
Xd write(6,10000)
X10000 format(' in space')
X space = ((ch .eq. bl) .or. (ch .eq. tab))
X return
X end
Xc
Xc Subroutine to find the end of the logical
Xc expression following an IF.
Xc
X subroutine log_expr(last)
X integer last
Xc
X integer start
Xc
Xc Function.
Xc
X logical space
Xc
Xc Commons.
Xc
X common/line/linein,lineout,in_length,out_length
X character linein*132,lineout*132
X integer in_length,out_length
Xc
X common/error/err_num,num_parens,quote_out
X integer err_num,num_parens
X logical quote_out
Xc
Xc Executable code.
Xc
Xd write(6,10000)
X10000 format(' in log_expr')
X if (err_num.eq.0) then
X quote_out = .true.
X num_parens = 0
X start = 9
X else
X if (err_num.eq.4) then
X last = 7
X err_num = 0
X return
X else
X start = 7
X end if
X end if
X last = in_length
X if (start.gt.in_length) return
X do i = start,in_length
X if (.not.space(linein(i:i))) then
X if (linein(i:i).eq.'''') quote_out = .not. quote_out
X if (quote_out) then
X if (linein(i:i).eq.'(') num_parens = num_parens + 1
X if (linein(i:i).eq.')') num_parens = num_parens - 1
X if (num_parens.eq.0) then
X if ((i+4).gt.in_length) then
X err_num = 4
X return
X else
X call scan(i,last)
X err_num = 0
X return
X end if
X end if
X end if
X end if
X end do
X err_num = 5
X return
X end
Xc
Xc Subroutine to determine where to split a line of
Xc FORTRAN code which extends beyond column 72.
Xc The second line will have an ampersand placed
Xc in column 6 as a continuation character.
Xc
X subroutine split(success)
Xc
X integer end
X logical success
Xc
Xc Functions.
Xc
X logical divider
X logical outside_quotes
Xc
Xc Commons.
Xc
X common/line/linein,lineout,in_length,out_length
X character linein*132,lineout*132
X integer in_length,out_length
Xc
X common/split/line_continue,continue_length,start
X character line_continue*132
X integer continue_length,start
Xc
Xc Executable code.
Xc
Xd write(6,10000)
X10000 format(' in split')
X success = .false.
Xc
Xc never split lines with embedded comments that begin before col 72
Xc if comment after nesting starts after col 72 then we can split
Xc there is a "gap" here. comment starts after col 72, valid
Xc code ends before will lead to an error. will let ann fix
Xc this to work better (if she cares to bother).
Xc MCP
Xc
X i = 1
X jj = 1
X do while (i.le.72 .and. jj.gt.0)
X jj = index(lineout(i:72),'!')
X if (jj.gt.0) then
X i = i + jj
X jj = outside_quotes(i-1)
X if (jj) return
X end if
X end do
Xc
Xc Find beginning of line (first nonblank past column 6).
Xc
X do i = 7,out_length
X if (lineout(i:i).ne.' ') goto 10
X end do
X write(6,10010)
X10010 format(' blank line - unresolved in split')
X return
X 10 start = i
X end = min(out_length,72)
X if (start.gt.end) then
X write(6,10020)
X10020 format(' indentation past 72 - unresolved in split')
X return
X end if
X do i = end,start,-1
X if (divider(lineout(i:i)) .and. outside_quotes(i)) goto 20
X end do
X write(6,10030)
X10030 format(' no place to split - unresolved in split')
X return
X 20 continue_length = out_length - i + 6
X line_continue(1:continue_length) =
X &' &'//lineout(i+1:out_length)
X out_length = i
X success = .true.
Xd write (6,10040) lineout(1:out_length)
X10040 format (' >',a,'<')
Xd write (6,10040) line_continue(1:continue_length)
X return
X end
Xc
Xc Function to determine if a character is a valid "divider"
Xc for splitting a line of FORTRAN code.
Xc
X logical function divider(char)
X character char
Xc
Xc Function.
Xc
X logical oper
Xc
Xc Executable code.
Xc
Xd write(6,10000)
X10000 format(' in divider')
X divider = ((char.eq.' ') .or. oper(char))
X return
X end
Xc
Xc Function to determine whether a "point"ed to
Xc character is inside or outside quotes.
Xc A line of FORTRAN code should not be split
Xc inside quotes.
Xc
Xc NOTE: This function will not perform properly
Xc if the user has split quotes across lines.
Xc
X logical function outside_quotes(point)
X integer point
Xc
Xc Commons.
Xc
X common/line/linein,lineout,in_length,out_length
X character linein*132,lineout*132
X integer in_length,out_length
Xc
X common/split/line_continue,continue_length,start
X character line_continue*132
X integer continue_length,start
Xc
Xc Data.
Xc
X character quote
X data quote/''''/
Xc
Xc Executable code.
Xc
Xd write(6,10000)
X10000 format(' in outside_quotes')
X outside_quotes = .true.
X do i = start,point
X if (lineout(i:i).eq.quote) outside_quotes =
X & .not.outside_quotes
X end do
X return
X end
Xc
Xc function to determine if a character is one of
Xc the following operators:`009+ - * /
Xc
X logical function oper(char)
X character char
Xc
Xc Data.
Xc
X character operator*4
X data operator/'+-*/'/
Xc
Xc Executable code.
Xc
Xd write(6,10000)
X10000 format(' in oper')
X oper = index(operator,char).gt.0
X return
X end
$ GoSub Convert_File
$ Goto Part2