d 	PROGRAM XTOC !! {<}Infile {>Outfile} {-Call -Index -List}
È c.		An Index and Listing program
,c.
c. Reads a source program, and identifies its 'module's via:
ôc.	'PROGRAM', 'SUBROUTINE', 'FUNCTION'.
Xc.
¼c. The 'module' Name, Type, and Lead Comment can be listed. (options)
 c.	1) The calling parameters are to be shown also, and/or
„c.	2) The Source is to be listed, with Line NOs, and with
èc.		page ejects between each 'module'.
Lc.
°c. Parameters
c.	-C	Show the calling parameters.
xc.	-F	Show the file name
Üc.	-N	Suppress the Line numbers {Only listing}
@c.	-L	Show only the listing
¤c.	-I	Show only the Index of programs
c.	-*	Loop until ^Z
lc-------------------------------------------------------end.of.info
Ðc. 05/16/81	.. Use JJUCMD
4c. 06/19/81 .. add page numbers
˜c.
ü	common /JJU_SWI/ JJUS(256)
`		character*40 Infile,outfile
Ä	c.
(
	character*132 upcmd, cmd
Œ
	character*60 discr
ð
	character*9 name
T	character*4 ntyp
¸	character*10 chday, chtime
	character*10 mode(0:1)
€	data mode/'LISTed','INDEXed'/
ä	byte ff
H	data ff/12/
¬c.
41	format(132a)
t49	format(q,132a)
Ø51	format(i6,': ',132a )
<c.
 	call jjctc(1)
	call date( chday )
h	call time( chtime )
Ìc.
0c/// get the command Line
”c.
ø1000	continue
\	close(unit=6)
À	open(6,type='new',carriagecontrol='list')
$	upcmd = char(0)
ˆ	cmd = '$XTOC {<}Infile {>Outfile} {-CFNLI*}'
ìc.
P	ntot = 0
´	call jjctc(0)
	do while( jjucmd( upcmd, cmd ) .gt.0 )
|	enddo
àc.
D	if( jjctc(0).gt.0 ) goto 9000
¨	if( JJUS(ichar('=')).lt.0 ) goto 9000
	ifinx = 1
p	iflis = 1
Ô	if( jjuswi('I').lt.0 ) iflis = 0
8	if( jjuswi('L').lt.0 .or. jjuswi('N').lt.0 ) ifinx = 0
œ	ntot = 0
 	ifst = 0
d	nmodule = 0
Èc.
,c/// Now process the INDEX and LISTING
c.
ô2000	continue
X	if( JJUOPI( infile ) .le. 0 ) then	!! No more inputs
¼c.
 c... End of one pass
„c.
è	  if( ntot.eq.0 ) goto 1000
L	  type 41,' '
°	  type 2100,ntot,'Records ',mode(ifinx), nmodule,' Modules'
	  ntot = 0
x2100	  format( i7,': ',2a, i7, ' ',a )
Ü	  if( ifinx.gt.0 ) then			!!Index
@	    if( iflis.eq.0 .and. JJUSWI('*').ge.0 ) goto 9000
¤	    if( iflis.eq.0 ) goto 1000
 	    ifinx = 0
l 	    upcmd = char(1)
Ð 	    cmd = '*'
4!	    do while( jjucmd( upcmd,cmd ).gt.0 )
˜!	    enddo
ü!	    nmodule = 0
`"	    goto 2000
Ä"	  endif
(#	  if( JJUSWI('*').ge.0 ) goto 9000
Œ#	  goto 1000
ð#	endif
T$c.
¸$c... Start of new file
%c.
€%	if( ifst.eq.0 ) then
ä%	  ifst = 1
H&	  call JJUOPO( infile, outfile )
¬&	  write(6,41) chday, chtime(1:5),'   ',infile(1:jjlen(infile))
'	  write(6,41) ' '
t'	endif
Ø'	npag = 1
<(	irec = 0
 (c...	ntot = 0
)c.
h)c/// read the next file record
Ì)c.
0*5000	continue
”*	if( jjctc(0).gt.0 ) goto 1000
ø*	read(1, 49, end=2000 ) nchar, cmd
\+	if( cmd.eq.char(12) ) then		!!New Page
À+	  npag = npag+1
$,	  irec = 0
ˆ,	  goto 5000
ì,	endif
P-	ntot = ntot+1
´-	irec = irec+1
.	inx = 1
|.	if(  mlatom( ifst, inx, cmd, ' ' ) .ne. 0 ) goto 5000
à.	upcmd = cmd(ifst:inx-1)
D/	CALL jjupp( upcmd )
¨/c.
0c/// Process the File line
p0c.
Ô0	if( upcmd.eq.'PROGRAM' .or. upcmd.eq.'SUBROUTINE'
81	1       .or. upcmd.eq.'FUNCTION' ) then
œ1c.
 2c//// Process a Program ...
d2c.
È2	  nmodule = nmodule+1
,3	  ntyp = upcmd
3	  if( ntyp.ne.'PROG' ) then
©3	    call jjlow( ntyp )
µ3	  else
Â3	    call jjlow( ntyp(2:) )
Î3	  endif
ô3	  CALL mlatom( ifst, inx, cmd, '(' )
X4	  name = cmd(ifst:inx-1)
¼4	  CALL jjupp( name )
 5	  if( ifinx.gt.0 ) then			!! Index
„5	    nrec = irec
è5	    nflag = 1
L6	    if( JJUSWI('F').lt.0 ) then			!! File
°6	      write(6,5400) nrec, npag, ntyp, name
7	1	,infile(1:jjlen(infile))
x7	    else if( jjus(ichar('C')) .lt. 0 ) then	!!2 Line/Mod
Ü7	      do while( inx.lt.nchar )
@8	        if( cmd(inx:inx).gt.' ' ) goto 5200
¤8	        inx = inx+1
9	      enddo
l95200	      continue
Ð9	      if( nchar.lt.inx ) nchar = inx
4:	      write(6,5400) nrec, npag, ntyp, name, cmd(inx:nchar)
˜:5400	      format( i6,'/',i3.3,' ',a,' ',a,' -- ', a )
ü:	    endif
`;	  else					!!Listing
Ä;	    if( ntot.gt.1 .and. JJUSWI('N').lt.0 ) then
(<	      write(6,41) ff
Œ<	    else
ð<	      write(6,41) ' '
T=	      write(6,41)ff
¸=c///	      write(6,5500) ntyp, name, irec, npag
ê=c///	1       , infile(1:jjlen(infile))
>	      write(6,5400) irec, npag, ntyp, name
>	1       , infile(1:jjlen(infile))
>5500	      format( a,'  ',a,i6,'/',i3.3,'  ',a )
€>	      write(6,41)'------:'
ä>	      inxlin = 1
H?	    endif
¬?	    goto 6000
@	  endif
t@	else if( ifinx.le.0 ) then		!!Listing
Ø@c.
<A6000	  continue
 A	  if( JJUSWI('N').lt.0 ) then		!!No Numbers
B	    write(6,41) cmd(1:nchar)
hB	  else
ÌB	    if( inxlin .gt. 50 ) then
0C	      write(6,41)ff
”Cc///	      write(6,5500) ntyp, name, irec, npag
µC	      write(6,5400) irec, npag, ntyp, name
ÖC	1       , infile(1:jjlen(infile))
øC	      write(6,41)'------:'
\D	      inxlin = 1
ÀD	    endif
$E	    write(6,51) irec,cmd(1:nchar)
ˆE	    inxlin = inxlin+1
ìE	  endif
PF	else if( jjlen(cmd).gt.2 .and. cmd(1:1).gt.' ') then
´F	  CALL mlatom( ifst, inx, cmd, ' ' )
G	  if( ifst.lt.nchar .and. nflag.gt.0 ) then !!Sec module cmd
|G	    if( jjus(ichar('C')).lt.0 ) then
àG	      write(6,6100) name, cmd(ifst:nchar)
DH6100	      format( 16x, a, ' -> ', a )
¨H	    else
I	      if( jjuswi('F').ge.0 ) then
pI	        write(6,5400) nrec, npag, ntyp, name, cmd(ifst:nchar)
ÔI	      endif
8J	    endif
œJ	    nflag = 0
 K	  endif
dK	endif
ÈK	goto 5000
,Lc.	----
Lc.
ôLc.. output source also
XMc.
¼M9000	continue
 Nc.
„N		end