Re: public domain program to convert f77 code to lower case





On Nov 1, 4:42pm, "David Flower" <DavJFlo...@xxxxxxx> wrote:
On Nov 1, 1:11?pm, mec...@xxxxxxxxx wrote:



Lynn McGuire wrote:
We have a 550,000 line program that is mostly written in upper case.
Does anyone have experience with a public domain program to
convert all the code into lower case ? ?Of course, comments, formats
and data statements would need to be skipped.

Thanks,
LynnHere is the source of lower.for, of unknown authorship, acquired from
the Internet years ago:

c Converted to lower case 91-10-28
c ?WARNING--DO NO UPSHIFT THIS PROGRAM SOURCE*************
c --SPECIFICALLY ROUTINES GETNXT & WORK***********
c
c ? ? UPPER CASE FORTRAN TO lower case converter
c ? ? Convert a fortran source file:
c ? ? downshift non-comments,non-strings,non-holleriths
c ?Vers 0.00 - converted from UPPER source
c ?Vers 0.1 ?- Fix same comment bug that was in UPPER
c ?COnverted to VP2200. Deleted ALTER, UPALL.
C ?.21 - Lines starting with # are treated as comments.
C ? ? ? ?They cannot be continued.
c
? ? ? implicit none
? ? ? integer smax ,nstore
? ? ? parameter (smax=5000)
? ? ? character*1 ctue(100)
? ? ? character*2000 cline,qline,zline
? ? ? character*80 store(smax),cbuf,fname,oname
? ? ? character dates*8,vers*4
? ? ? logical end,have,decl
? ? ? integer i,lcount,len,qlen,lines,comm(smax),tabs
c
? ? ? vers='0.21'
? ? ? write(0,40) vers
? ?40 format(' Lower ',a,' Converts FORTRAN source to lower CASE.',/
? ? ?& ' Will not shift inside strings comments or ',
? ? ?& ? ? ? 'Holleriths.')
? ? ? call getopts(fname,oname)
? ? ? call openf(fname,oname)
? ? ? call fdate(dates)
? ? ? write(2,42) dates
? ?42 format('c Converted to lower case ',a8)
c
? ? ? ? call init(ctue)
? ? ? ? lcount=0
c ? ? ? READ FIRST LINE INTO TEMPORARY BUFFER
? ? ? ? read(1,43,end=9999) cbuf
? ?43 format(a80)
c ?USED TO INDICATE THAT WE ALREADY HAVE NEXT LINE READ INTO BUF
? ? ? ? have=.true.
c ?LCOUNT indicates how many lines processed.
? ? ? ? lcount=1
c
c ?Read next line, concatenating continuation lines.
c ?Comments are written out immediately or if between ctuation
c ?lines are stored (yuk).
c
? ?50 ? call getnxt(cline,len,cbuf,have,end,lines,lcount,
? ? ?& ? ? ? ? ? ? ?ctue,store,nstore,comm)
? ? ? ? if(end) goto 999
? ? ? ? tabs=0
? ? ? ? call dotab(cline,qline,len,qlen,tabs)
? ? ? ? call sqze(qline,zline,qlen)
? ? ? ? call clssfy(zline,decl)
? ? ? ? if(decl) then
? ? ? ? ? call low(qline,1,len)
? ? ? ? else
? ? ? ? ? call work(qline,len,lcount)
? ? ? ? endif
? ? ? ? call output(qlen,qline,ctue,store,nstore,comm)
? ? ? ? goto 50
c==============
? 999 continue
? ? ? write(0,80)lcount
? ?80 format(1x,i6,' LINES CONVERTED')
? ? ? stop
?9999 write(0,*)'UNEXPECTED END OF FILE on unit 1'
? ? ? stop
? ? ? end
c
? ? ? subroutine getnxt(cline,len,cbuf,have,end,lines,lcount
? ? ?& ? ? ? ? ? ,ctue,store,nstore,comm)
c ?GET NEXT LINE. OUTPUT COMMENTS IMMEDIATELY if possible.
c
? ? ? implicit none
? ? ? integer smax ,nstore
? ? ? parameter (smax=5000)
? ? ? character*2000 cline
? ? ? character*80 ? cbuf,store(smax)
? ? ? character*1 ctue(100),c
? ? ? integer len,lines,lcount,comm(smax),ll,lastnb,l
? ? ? logical end,have,first
c
c ?if no lines in buf then already reached EOF
? ? ? if(.not.have) goto 999
? ?10 c=cbuf(1:1)
? ? ? if(c.eq.'C'.or.c.eq.'c'.or.c.eq.'*'.or.c.eq.'#') then
? ? ? ? if(c.eq.'C') cbuf(1:1)='c'
c
? ? ? ? ll=lastnb(cbuf,1,80)
? ? ? ? ? write(2,40) cbuf(1:ll)
? ?40 ? ? format(a)
c
? ? ? ? read(1,40,end=999) cbuf
? ? ? ? lcount=lcount+1
? ? ? ? have=.true.
? ? ? ? goto 10
? ? ? endif
c
c ?BUF IS NOT A COMMENT. transfer into cline
c
? ? ? cline(1:72)=cbuf(1:72)
? ? ? len=72
? ? ? lines=1
? ? ? nstore=0
? ? ? l=1
? ? ? first=.true.
c
c ?SEE IF NEXT LINE IS A CONTINUATION; if so concatenate & read again
c
? ?20 read(1,40,end=99) cbuf
? ? ? lcount=lcount+1
? ? ? l=l+1
? ? ? have=.true.
? ? ? c=cbuf(1:1)
? ? ? if(c.eq.'C'.or.c.eq.'c'.or.c.eq.'*'.or.c.eq.'#') then
c ?Is a comment. Store it.
? ? ? ? if(c.eq.'C') cbuf(1:1)='c'
c
? ? ? ? if(nstore.lt.smax) then
? ? ? ? ? nstore=nstore+1
? ? ? ? ? store(nstore)=cbuf
? ? ? ? ? comm(nstore)=l
? ? ? ? else if(first) then
? ? ? ? ? write(0,*)'More than ',smax,' consecutive comments'
? ? ? ? ? write(0,*)'**** REMAINDER WILL BE SKIPPED ********'
? ? ? ? ? first=.false.
? ? ? ? endif
? ? ? ? goto 20
? ? ? endif
c
? ? ? if(cbuf(6:6).eq.' ') return
c The ugly tab again... next line not actually a continuation.
? ? ? if(ichar(cbuf(1:1)).eq.9) return
? ? ? if(ichar(cbuf(2:2)).eq.9) return
? ? ? if(ichar(cbuf(3:3)).eq.9) return
? ? ? if(ichar(cbuf(4:4)).eq.9) return
? ? ? if(ichar(cbuf(5:5)).eq.9) return
? ? ? if(ichar(cbuf(6:6)).eq.9) return
? ? ? if(lines.gt.100) stop ' ERROR IN GETNXT. TOO MANY CTUATION LINES'
c ?STORE CONTINUATION CHARACTER SEPARATELY
? ? ? call lower(cbuf(6:6))
? ? ? ctue(lines)=cbuf(6:6)
? ? ? cline(1+len:66+len)=cbuf(7:72)
? ? ? len=len+66
? ? ? if(len.gt.2000) stop 'LEN ERROR IN GETNXT'
? ? ? lines=lines+1
? ? ? goto 20
c ?EOF.
c ?Haven't any lines in BUF, but have a line in cline to be upshifted
? ?99 have=.false.
? ? ? return
? 999 len=0
? ? ? have=.false.
? ? ? end=.true.
? ? ? return
? ? ? end
c
? ? ? subroutine work(cline,len,lcount)
c
c ? ? Process the line: upshift non-comments,non-strings,non-holleriths
c
? ? ? implicit none
? ? ? character cline*2000,c*1,q*1
? ? ? integer class,case,value,count,lcount,len,i,n
? ? ? common /ctable/nonpr,l_alpha,u_alpha
? ? ?& ? ? ? ,specl,czero,nznum,ignore,quote
? ? ?& ? ? ? ,lookup(0:255)
? ? ? integer nonpr,l_alpha,u_alpha
? ? ?& ? ? ? ,specl,czero,nznum,ignore,quote,lookup,kchar
c
? ? ? case=0
? ? ? q=' '
? ? ? do 100 i=7,len
? ? ? ? c=cline(i:i)
c ? ? ? Determine class of character c
? ? ? ? kchar=ichar(c)
? ? ? ? class=lookup(kchar)
? ? ? ? if(class.eq.nonpr) then
? ? ? ? ? write(0,*)'UNPRINTABLE CHARACTER AT COLUMN ',i,' LINE ',
? ? ?& ? ?lcount,' ASCII VALUE ',ichar(c)
? ? ? ? else if(kchar.eq.9) then
? ? ? ? ? write(0,*)'TAB CHARACTER AT COLUMN ',i, 'LINE ', lcount
? ? ? ? endif
c ? ? ? IF(C.NE.' ')WRITE(6,*)'I ',I,'C',C,' CLASS',CLASS,' CASE ',CASE
c
? ? ? ? if(case.eq.1) then
c ? ? ? ? in string,looking for terminal quote
c ? ? ? ? end of string
? ? ? ? ? if(c.eq.q) case=5
? ? ? ? else if(case.eq.2) then
c ? ? ? ? Have just encountered a special. Look for 1-9
? ? ? ? ? if(class.eq.nznum) then
? ? ? ? ? ? case=3
c ? ? ? ? ? Start accumulating value of holler. qual.
? ? ? ? ? ? n=value(c)
? ? ? ? ? else if(class.eq.quote) then
c ? ? ? ? ? ?Not holler qual - is start of a string. eg ('
? ? ? ? ? ? case=1
? ? ? ? ? ? q=c
? ? ? ? ? else if(class.eq.l_alpha.or.class.eq.u_alpha.or.
? ? ?& ? ? ? ? ? ?class.eq.czero) then
? ? ? ? ? ? case=0
? ? ? ? ? else if(class.eq.specl.or.class.eq.ignore) then
c ? ? ? ? ? another special but not '. CASE stays 2
? ? ? ? ? ? case=2
? ? ? ? ? else
? ? ? ? ? ? case=0
? ? ? ? ? endif
? ? ? ? else if(case.eq.3) then
c ? ? ? ? look for rest of probable Holler. qualifier
? ? ? ? ? if(class.eq.nznum.or.class.eq.czero) then
? ? ? ? ? ? n=10*n+value(c)
? ? ? ? ? else if(c.eq.'H'.or.c.eq.'h') then
c ? ? ? ? A HOLLERITH!
? ? ? ? ? ? case=4
? ? ? ? ? ? count=0
? ? ? ? ? ? cline(i:i)='h'
? ? ? ? ? else if(class.eq.quote) then
c ? ? ? ? ? Wasn't a Holler. Is a string
? ? ? ? ? ? case=1
? ? ? ? ? ? q=c
c ? ? ? ? ? Not a 'string', not Holler.
? ? ? ? ? else if(class.eq.specl) then
? ? ? ? ? ? case=2
? ? ? ? ? else if(class.eq.l_alpha.or.class.eq.u_alpha) then
? ? ? ? ? ? case=0
? ? ? ? ? endif
? ? ? ? else if(case.eq.4) then
c ? ? ? ? we are in a hollerith. Skip n charactes
? ? ? ? ? count=count+1
c ? ? ? ? last hollerith char
? ? ? ? ? if(count.gt.n) case=0
? ? ? ? endif
c
? ? ? ? if(case.eq.0) then
? ? ? ? ? if(class.eq.quote) then
c ? ? ? ? ? Start string
? ? ? ? ? ? case=1
? ? ? ? ? ? q=c
c
? ? ? ? ? else if(class.eq.specl) then
? ? ? ? ? ? case=2
? ? ? ? ? else
? ? ? ? ? ? if(class.eq.u_alpha) then
? ? ? ? ? ? ? cline(i:i)=char(kchar+32)
? ? ? ? ? ? endif
? ? ? ? ? endif
? ? ? ? else if(case.eq.5) then
? ? ? ? ? case=0
? ? ? ? endif
? 100 continue
c
? ? ? return
? ? ? end
c
? ? ? subroutine dotab(cline,q,len,qlen,tabs)
? ? ? implicit none
? ? ? character cline*2000,q*500,c*1,qfound*1
? ? ? logical instr
? ? ? integer i,len,qlen,j,tabs,kchar,class,lastnb
? ? ? common /ctable/nonpr,l_alpha,u_alpha,
? ? ?& ? ? ? ?specl,czero,nznum,ignore,quote,lookup(0:255)
? ? ? integer nonpr,l_alpha,u_alpha
? ? ?& ? ? ? ,specl,czero,nznum,ignore,quote,lookup
? ? ? j=0
? ? ? lastnb=0
? ? ? instr=.false.
? ? ? do 2 i=1,len
? ? ? ? c=cline(i:i)
? ? ? ? class=lookup(ichar(c))
? ? ? ? kchar=ichar(c)
c Is this an ascii tab ?
? ? ? ? ? if(.not.instr.and.(class.eq.quote)) then
? ? ? ? ? ? instr=.true.
? ? ? ? ? ? qfound=c
? ? ? ? ? else if(instr.and.c.eq.qfound) then
? ? ? ? ? ? instr=.false.
? ? ? ? ? endif
? ? ? ? if(.not.instr) then
? ? ? ? ? if(j.gt.5.and.kchar.eq.9) then
? ? ? ? ? ? j=j+1
? ? ? ? ? ? q(j:j)=' '
? ? ? ? ? ? lastnb=lastnb+1
? ? ? ? ? else if(kchar.ne.9) then
? ? ? ? ? ? j=j+1
? ? ? ? ? ? q(j:j)=c
? ? ? ? ? ? if(class.ne.ignore) lastnb=j
c ?Replace first tab by 5-j spaces.
? ? ? ? ? else if(j.le.5) then
? ? ? ? ? ? tabs=tabs+1
? ? ? ? ? ? q(j+1:6)=' '
? ? ? ? ? ? j=6
? ? ? ? ? ? if(class.ne.ignore) lastnb=j
? ? ? ? ? endif
? ? ? ? else
? ? ? ? ? ? j=j+1
? ? ? ? ? ? q(j:j)=c
? ? ? ? ? ? lastnb=lastnb+1
? ? ? ? endif
? ? 2 continue
c ? ? write(6,*)'j=',j,' len=',len,' lastnb=',lastnb
? ? ? j=lastnb
? ? ? qlen=len
c Line length now len+j-6
c Check that line- Hide quoted text -- Show quoted text -...

read more

Well, I found another bug: the variable 'end' is never initialised,
with somewhat catastrophic results.

I fixed that, and tried a seven-line, 'difficult' test program.

Conclusions:

1) The program down-cases not only keywords, but:
i) Variable names
ii) Continuation characters
iii) The 'H' in Hollerith specifiers
iv) Trailing comments as indicated by '!'

2) I conclude that you do not need to eat all the egg to determine that
it is bad, and cannot recomment the program

Dave Flower

.