From:	CRDGW2::CRDGW2::MRGATE::"SMTP::CLIPR.COLORADO.EDU::JWBARBOUR" 18-JUL-1989 15:31
To:	MRGATE::"ARISIA::EVERHART"
Subj:	No Subject

Message-Id:  <8907181902.AA03582@crdgw1.ge.com>
Date: 18 Jul 89 12:59:00 MDT
From: "Jim Barbour" <jwbarbour@clipr.colorado.edu>
To: "buhle" <buhle@xrt.upenn.edu>
Cc: "everhart" <everhart@arisia.decnet>, "grs" <grs@cics.wustl.edu>,
        "tjenht" <tjenht@nusdiscs.bitnet>,
        "wilsonjl" <wilsonjl%hsdp1.decnet@hqhsd.brooks.af.mil>,
        "kodak!cygnus!haskins" <kodak!cygnus!haskins@cs.rochester.edu>,
        "mcvax!simulog!eagles" <mcvax!simulog!eagles@uunet.uu.net>

Hello,

	My apologies for getting this out so late.  I've been busy with
several other projects and on vacation.

	this is the fortran version of more.  It contains

	1.  a command definition (.CLD file)
	2.  a help module (.HLP file)
	3.  The fortran source code.

The advantage of this program is that it is not terminal dependent.  It
should run on any CRT display and (with some minor problems) on a hardcopy
display.  The disadvantage is that it does not support regular expression
searches (grep).  If you want this, my TPU more does support regexps.

I would suggest that you proceed as follows:

1.  Divide the more file (after these comments) into the 3 separate files.
    The beginning and end of each file is denoted like this:
-------- Beginning of more.hlp --------
...
-------- End of more.hlp --------

    these lines should be removed.

2.  Insert more.hlp into your local help library.  If you don't have
    permission to do this, or if you don't have a local help library,
    you may do the following:
    $ library/create/help more more ! this will create more.hlb in your dir.
    $ assign 'f$env("default")'more hlp$library
    $! this should be done in a login.com file or sysstartup.com file.
    $! It will tell more that more.hlb is available for people to look at.

3.  Compile the source as follows:
    $ fortran/extend more
    $ link more

4.  Put the .EXE and .CLD files where you want them to live.

5.  Edit MORE.CLD and change the IMAGE line to specify the full file-spec
    of MORE.EXE

6.  type $ set command more
    This should be done in a login.com file.  if you have permissions you can
    also add it to the default system command tables.  I've never done this,
    so I'm not sure how.

7.  look at the help topic more more_editor.  if you wish, assign an editor
    to MORE_EDITOR.

More should now work.  If you have any problems, let me know.

Jim Barbour (JWBARBOUR@CLIPR)
-------- Beginning of MORE.CLD --------
define verb more
	image disk$user0:[jwbarbour.src.more]more

	parameter p1,
		label=file,
		value(required,type=$file,list),
		prompt="File"

	qualifier start,default,nonnegatable,placement=positional,
		  value(default=1,type=$number)
-------- End of MORE.CLD --------
-------- Beginning of MORE.HLP --------
1 MORE
       Prints out a file one page at a time allowing for forward and 
       backward motion by line, page, half page or search.

  Format:
       $ more [/start=n] file-spec[/start=n][,file-spec[/start=n]...]
2 /START=n  (D=1)

       Specifies the first line in the file to be printed.  Note that you
       can specify a default start before any files are listed and then
       specify /start= immidiately after individual files.
2 COMMANDS
Most commands can optionally be preceded by an integer argument k.
Default values are indicated by brackets []. A star (*) indicates that the
argument becomes the new default.  All commands may be entered in upper
or lower case.
---------------------------------------------------------------------------
   <space>            Display next k lines of text [current screen size]
   <return>           Display next k lines of text [1]*.  Default is
                      Changed only if k is explicitly set.
   ^L                 Reprint the last screenfull of output.
   0                  Goto beginning of file.
   =                  Display current line number and file name.
   ? or /string       Search for next occurrence of string.
                      ? searches backwards.  An empty string means search
                      again for the last string search for.
   B or -             Back up k screenfulls of text [1]
   D                  Display next k/2 screenfuls of text. [1] (1/2 screen)
   E                  Start up editor in logical MORE_EDITOR [EDT]
   F                  Skip forward k screenfuls of text [1]
   H                  Display this message
   N                  start at beginning of next file.
   Q                  Exit from more
   S                  Scroll continueously forward until any key is pressed.
   Z                  Pause more.
2 MORE_EDITOR

       You can define which editor more uses with the e command.  You do 
       this by assign a value to the logical name MORE_EDITOR.
3 CALLABLE_EDITORS
    You can specify that more use either callable EDT or TPU.  To do this
    you assign either the value EDT or TPU to the logical name
    MORE_EDITOR.

    Callable EDT and TPU work exactly the same as the EDT and TPU you use
    from the command line.  However, if you have defined a symbol
    to execute EDT or TPU with a command file
    (i.e. EDT :== EDIT/EDT/COMMAND=MYCOMS)
    your commands will not get executed.  Instead, you should do the 
    following: $ ASSIGN MYCOMS EDTINI   for EDT
    or
               $ ASSIGN MYCOMS TPU$COMMANDS  for TPU
               $ ASSIGN MYCOMS EVE$INIT      if file contains eve commands.
4 BUGS
  Callable EDT with crath and take more with it if EDT can not create a
  journal file.  Therefore, to use more with the callable EDT
  interface, you MUST be in a directory you can write to.  Note that 
  pausing more and sd'ing to a writable directory WILL NOT WORK.  You
  must exit more and sd to a writable directory and then start up more.
3 EXTERNAL_EDITORS
  You can specify any editor as a VMS command line.  Note that this
  is slower then using callable editors because more spawns a process
  to run these editors.  To do this, simply assign the command line to
  MORE_EDITOR.  For example, 

  $ ASSIGN "emacs /startfile=mlisp:startup" MORE_EDITOR
       
  More will take the command and concat a space and the filename to it.
  It then passes this as a command to spawn.
-------- End of MORE.HLP --------
-------- Beginning of MORE.FOR --------
******************************************************************************
** MORE v 2.5 Copyright 1989, By The University of Colorado.		    **
** 									    **
**        Written By: James W Barbour (jwbarbour.Colorado.EDU)		    **
** 									    **
** This is a VMS more utility similar (yet saverely stripped down) to the   **
** more standard on UNIX operating systems.			            **
** 								            **
** $ more [/start=n] file-spec[/start=n] [,...]				    **
******************************************************************************
	
	program more
	implicit none
	
	include '(lib$routines)'
	include '($ssdef)'
	include '($rmsdef)'
	include '($lnmdef)'
	include '($dvidef)'
	include '($jpidef)'
	
	character * 1   ch
	character * 255 line
	character * 100 fname,wild_fname
	character * 80  search_string,search_string_old
	
	character * 137 erase_line
	character * 67 backspace
	
	integer	index,	     ! General index and looping variable.
	1	start,	     ! Starting line of file. more +start
	1	context,     ! Used in $find_file.
	1	flen,	     ! length of file name.
	1	strlen,      ! length of each line read.
	1	linelen,     ! length of line with tabs expanded.
	1	line_counter,! counts number of line read from file
	1	prefix,	     ! Prefix entered before scrolling commands.
	1	display_next,! Number of lines to read from file on next read.
	1	s_index,     ! String indexing variable.
	1	stat,	     ! Status variable for all I/O and rtl calls.
	1	screen_size, ! Number of rows on CRT.
	1	page_size    ! default number of lines to output

	logical prefix_was_set,forward
** Declare item lists for the $trnlnm call.
	integer*4 item_list(4)
	integer*2 item_list_(2)
	equivalence(item_list,item_list_)
	
** Declare functions.
	character * 1 getch_upper

	integer*4 cli$get_value, ! Used to get cli command line values.
	1	  ichar,     ! Fortran function to return ascii values of char
	1	  sys$trnlnm,! Translate logical names for editor.
	1	  sys$assign,! Assigns an I/O channel to a device (terminal)
	1	  str$case_blind_compare,
	1	  edt$edit,  ! used to edit files in EDT.
	1	  tpu$tpu,   ! Used to edit files in TPU.
	1	  leng	     ! length of unpadded string.

	logical   cli$present! Used to determine the presence of a qualifier.

c Declare I/O channel for terminal.  This is shared with the getch_upper
c function which gets one character at a time.
	integer*2 chan
	common /io/ chan

** Set up I/O channel and find out how many rows are on a screen.

	stat=lib$getjpi(jpi$_master_pid,,,strlen,,)
	if (.not. stat) call my_exit(stat)
	stat=lib$getjpi(jpi$_terminal,strlen,,,fname,flen)
	if (.not. stat) call my_exit(stat)
	stat=sys$assign(fname(1:flen),chan,,)
	if(.not.stat)call my_exit(stat)
	stat=lib$getdvi(dvi$_tt_page,chan,,screen_size)
	if (.not. stat) call my_exit(stat)

** Define a string of backspaces.  This is used in printing messages.
** Note that the recl of sys$output is 133 bytes.
	do stat=1,67
	   backspace(stat:stat) = char(8)
	end do

** Define a format statement which will overprint the current line with
** spaces.  This too is used in printing messages.
	erase_line='(''+'
	erase_line(69:135) = backspace
	erase_line(136:137) = ''')'
	
	page_size=screen_size - 1 ! To begin with, a "page" is the who screen.
	search_string_old = ' '   ! No default search string.

** Outer loop.  bring files off the list.  (See top of program.)
	do while (cli$get_value('FILE',wild_fname))
	   stat = cli$get_value('START',search_string,index)
	   if (.not. stat) call my_exit(stat)
	   read (search_string(:index),'(i<index>)',iostat=stat)start
** There should never be any formatting errors because the cli should 
** catch them all, But...
	   if (stat .ne. 0) then
	      call pforerror(stat,'Error parsing starting number.',1)
	      call exit(1)
	   endif
** Next loop, If its a wildcarded file, loop until all matches are found.
	   context = 0
	   stat = lib$find_file(wild_fname,fname,context)
	   do while (stat)
	      open(unit=3,file=fname,status='old',readonly,shared)
	      flen = leng(fname)
	      print *,fname(1:flen)
	      print *,' '
** Find start of file.
	      do stat = 1,start - 1
		 read (3,'(a)',end=999)line
	      end do
	      display_next = page_size - 1
	      line_counter = start - 1
** Main read loop. The read kicks us out of loop.
	      do while(.true.)
** Get the next set of lines, however many that is.
		 if (display_next .gt. 0) then
		    read(3,'(q,a)',end=999)strlen,line
** Erase the <--MORE... prompt and print next line in file.
		    print erase_line
		    if (strlen .gt. 0) print '(''+'',a)',line(:strlen)
		    linelen = 0
** Find out how long a line will be when tabs are expanded.
		    do index=1,strlen
		       if (line(index:index) .eq. char(9)) then
			  linelen = linelen + 1
		          do while (jmod(linelen,8) .ne. 0)
			     linelen = linelen + 1
			  end do
		       else
			  linelen = linelen + 1
		       endif
		    end do
** Loop through printing as many lines as were asked for.  Note that a
** line is a screen line, not a file record.
		    index = (linelen/80) + 1
		    do while (index .lt. display_next)
		       read(3,'(q,a)',end=999)strlen,line
** Find out how long a line will be when tabs are expanded.
		       linelen = 0
		       do s_index=1,strlen
		          if (line(s_index:s_index) .eq. char(9)) then
			     linelen = linelen + 1
		             do while (jmod(linelen,8) .ne. 0)
			        linelen = linelen + 1
			     end do
		          else
			     linelen = linelen + 1
		          endif
		       end do
		       if (index + (linelen/80) + 1 .gt. display_next) then
			  backspace(3)
		       else if (linelen .gt. 0) then
			  print *,line(:strlen)
		       else
		          print '('' '')'
		       endif
		       index = index + (linelen/80) + 1
		    end do
** Print the more prompt.  Make sure cursor ends up in col # 1.
		    print '(''$<--MORE H=HELP-->'',a17)',backspace(:17)
		 endif
		 line_counter = line_counter + display_next
		 display_next = page_size
		 prefix = 1
		 prefix_was_set = .false.
666		 ch = getch_upper(0)
** If user enters a number, accept it for prefix and get command.
		 if ((ch .ge. '1') .and. (ch .le. '9')) then
		    prefix_was_set = .true.
		    prefix = 0
		    print erase_line
		    print '(''+<BS> and <DEL> cancels prefix  '',$)'
		    stat = 0
		    do while (((ch .ge. '0') .and. (ch .le. '9')) .or.
	1		      (ch .eq. char(127)) .or. (ch .eq. char(8)))
		       if ((ch .eq. char(127)) .or. (ch .eq. char(8))) then
			  print '(''+'',a,$)',backspace(1:stat+32)
		          print erase_line
			 print '(''+<--MORE H=HELP-->'',a17,$)',backspace(:17)
			  goto 666
		       else if (prefix .gt. 10000) then
			  print '($,''+'',a)',char(7)
		       else
		          print '(''+'',a1,$)',ch
		          prefix = prefix * 10
		          prefix = prefix + (ichar(ch) - 48)
			  stat = stat + 1
		       endif
		       ch = getch_upper(0)
		    end do
		    if (prefix .eq. 0) prefix = 1
		 end if
** Precess character read.
		 if (ch .eq. 'Q') call exit(1)
** restart at beginning of file.
		 if (ch .eq. '0') then
		    rewind(3)
		    line_counter = 0
		 else if (ch .eq. char(12)) then
		    do stat = 1,screen_size - 1
		       backspace(3)
		    end do
		    display_next = screen_size - 1
		 else if (ch .eq. '=') then
		    print erase_line
		    stat = jmax0(flen - 59,1)
		    print '(''+'',i6,1x,a,$)',line_counter,
	1	          fname(stat:flen)// backspace(1:9 + (flen - stat))
		    display_next = 0
** Back up a page.
		 else if (ch .eq. 'B' .or. ch .eq. '-') then
		    print erase_line
		    print '(''+Backing up '',i4,'' lines...'')',prefix*page_size
		    print '('' '')'
		    do index = 1,(prefix * page_size) + page_size
		       backspace(3)
		    end do
		    line_counter = jidim(line_counter,(prefix * page_size)+page_size)
** Skip X number of pages
		 else if (ch .eq. 'F') then
		    print erase_line
		    print '(''+Skipping '',i4,'' lines...'')',prefix*page_size
		    print '('' '')'
		    do index = 1,prefix * page_size
		       read(3,'(a)',end=999)line
		    end do
		    line_counter = line_counter + (prefix * page_size)
** Search for string.
		 else if ((ch .eq. '/') .or. (ch .eq. '?')) then
		    if (ch .eq. '/') forward = .true.
		    if (ch .eq. '?') forward = .false.
		    search_string = ' '
		    print erase_line
		    call lib$get_input(search_string,'Search: ',s_index)
		    if((s_index.eq.0).and.(search_string_old .eq. ' ')) then
		       print erase_line
		       print '(''+No previous string.'',a,$)',backspace(:19)
		       display_next = 0
		    else
		       if (s_index .eq. 0)then
		          search_string = search_string_old
			  s_index = leng(search_string)
		       else
		          search_string_old = search_string
		       endif
		       call search(3,search_string(:s_index),forward,index,screen_size)
		       if (index .eq. 0) then
			  print erase_line
			  print '(''+String not found.'',a,$)',backspace(:19)
			  rewind(3)
			  do index = 1,line_counter
			     read (3,'(a)')line
			  end do
			  display_next = 0
		       else if (forward) then
			  print '(''+Skipping...'')'
			  line_counter = line_counter + index
		       else
			  print '(''+Backing...'')'
			  line_counter = jidim(line_counter,index)
		       endif
		    endif
** Jump into editor.
		 else if (ch .eq. 'E') then
		    close(3)
		    item_list_(1) = 255
		    item_list_(2) = lnm$_string
		    item_list(2) = %loc(line)
		    item_list(3) = %loc(strlen)
		    item_list(4) = 0
		    stat=sys$trnlnm(,'LNM$DCL_LOGICAL','MORE_EDITOR',,item_list)
		    if (stat .eq. ss$_nolognam) then
		       line = 'EDT'
		    else if (.not. stat) then
		       call my_exit(stat)
		    endif
111		    if (str$case_blind_compare(line(:strlen),'EDT').eq.0) then
		       stat = edt$edit(fname(:flen))
		       if (.not. stat) then
		          call psyserror(1,
	1		     'Error editing file using callable EDT.',1)
		          stat=lib$get_input(search_string,
	1			    'Press <RETURN>: ',s_index)
		       endif
		    else if(str$case_blind_compare(line(:strlen),'TPU').eq.0) then
		       stat = tpu$tpu('tpu '//fname(:flen))
		       if (.not. stat) then
		          call psyserror(1,'Error editing file using callable TPU.',1)
		          stat=lib$get_input(search_string,
	1			   'Press <RETURN>: ',s_index)
		       endif
		    else
		     stat=lib$spawn(line(:strlen)//' '//fname(:flen))
		       if (.not. stat) then
		          call psyserror(stat,
	1		   'Error running personal editor -- Will use EDT.',1)
		          stat=lib$get_input(search_string,
	1			   'Press <RETURN>: ',s_index)
			  goto 111
		       endif
		    endif
		    open(3,file=fname,status='old',readonly,shared)
		    print '(''Restarting at beginning.'')'
		 else if (ch .eq. 'H') then
		    print erase_line
		    call print_help
		    print '(''$<--MORE H=HELP-->'',a17)',backspace(:17)
		    display_next=0
		 else if (ch .eq. char(13)) then
		    if (prefix_was_set) page_size = prefix
		    display_next = prefix
		 else if (ch .eq. 'D') then
		    display_next = prefix * (page_size / 2)
		 else if (ch .eq. 'S') then
		    read(3,'(q,a)',end=999)strlen,line
** Erase the <--MORE... prompt and print next line in file.
		    print erase_line
		    if (strlen .gt. 0) print '(''+'',a)',line(:strlen)
** Loop through printing lines until stopped by a keystroke.
		    ch = getch_upper(-1)
		    do while (ch .eq. char(0))
		       read(3,'(q,a)',end=999)strlen,line
		       if (strlen .gt. 0) then
			  print '('' '',a)',line(:strlen)
		       else
		          print '('' '')'
		       endif
		       ch = getch_upper(-1)
		    end do
** Print the more prompt.  Make sure cursor ends up in col # 1.
		    print '(''$<--MORE H=HELP-->'',a17)',backspace(:17)
		    display_next = 0
		 else if (ch .eq. ' ') then
		    do stat = 1, (prefix - 1) * (screen_size - 1)
		       read(3,'(a)',end=999)line
		    end do
		    display_next = page_size
** Symulate reading end-of-file, use goto.
		 else if (ch .eq. 'N') then
		    goto 999
		 else if (ch .eq. 'Z') then
		    print '(''+Type LOGOUT to return to more.'')'
		    stat = lib$spawn()
		    if (.not. stat) call my_exit(stat)
		    do stat = 1,screen_size - 1
		       backspace(3)
		    end do
		    line_counter = jidim(line_counter,(screen_size - 1))
		    display_next = screen_size - 1
		 else
		    print '($,''+'',a)',char(7)
  		    display_next = 0
	  	 end if
	      end do
999	      continue
	      close(3)
	      stat = lib$find_file(wild_fname,fname,context)
	   end do
	   if (stat .ne. rms$_nmf) call psyserror(stat,
	1 'Error opening '//wild_fname(:leng(wild_fname))//' as input',1)
	end do
	end
	
	subroutine print_help
	implicit none
	character * 20 fmt
	fmt='('' || '',a,t78,'' ||'')'
	print fmt,'Most commands can optionally be preceded by an integer argument k.'
	print fmt,'Default values are indicated by brackets []. A star (*) indicates that the'
	print fmt,'argument becomes the new default.  All commands may be entered in upper'
	print fmt,'or lower case.'
	print *,'-------------------------------------------------------------------------------'
	print fmt,'<space>            Display next k lines of text [current screen size]'
	print fmt,'<return>           Display next k lines of text [1]*.  Default is'
	print fmt,'                   Changed only if k is explicitly set.'
	print fmt,'^L                 Reprint the last screenfull of output.'
	print fmt,'0                  Goto beginning of file.'
	print fmt,'=                  Display current line number and file name.'
	print fmt,'? or /string       Search for next occurrence of string.'
	print fmt,'                   ? searches backwards.  An empty string means search'
	print fmt,'                   again for the last string search for.'
	print fmt,'B or -             Back up k screenfulls of text [1]'
	print fmt,'D                  Display next k/2 screenfuls of text. [1] (1/2 screen)'
	print fmt,'E                  Start up editor in logical MORE_EDITOR [EDT]'
	print fmt,'F                  Skip forward k screenfuls of text [1]'
	print fmt,'H                  Display this message'
	print fmt,'N                  start at beginning of next file.'
	print fmt,'Q                  Exit from more'
	print fmt,'S                  Scroll continueously forward until any key is pressed.'
	print fmt,'Z                  Pause more.'
	end

	subroutine search(unit,string,forward,offset,screen_size)
	implicit none
	character *(*) string
	integer unit,offset
	logical forward
	integer*4 screen_size
**	local variables
	character * 250 line
	integer*4 index,i,leng,abs
	
	offset = 0
	if (.not. forward) then
	   do i = 1,screen_size - 1
	      backspace(unit)
	   end do
	   offset = offset - screen_size
	end if
	read(unit,'(a)',end=99)line
	offset = offset + 1
	
	do while(index(line(:leng(line)),string) .eq. 0)
	   if (.not. forward) then
	      do i = 1,2
		 backspace(unit)
		 offset = offset - 1
	      end do
	   end if
	   read(unit,'(a)',end=99)line
	   offset = offset + 1
	end do
	backspace(unit) 
**  position unit so first line read is the line searched for.
	offset = abs(offset)
	return
99	continue
	offset = 0
	return
	end

	subroutine pforerror(forstat,error_message,content)
	implicit none
	character *(*) error_message
	integer*4 forstat,content
	integer*4 rmsstat,rmscomp,vaxstat,len,istat,lib$sys_getmsg
	character * 132 message
	
	rmsstat = 0
	rmscomp = 0
	vaxstat = 0
	if (forstat.eq.0) return
	call errsns(forstat,rmsstat,rmscomp,,vaxstat)
	if (rmsstat .eq. 0) then
	   rmsstat = vaxstat
	   rmscomp = 1
	endif
	goto 100
	
	entry psyserror(forstat,error_message,content)
	rmscomp = 1
	rmsstat = forstat
100	if (.not. rmsstat) then
	   istat = lib$sys_getmsg(rmsstat,len,message,content)
	   if (.not. istat) call exit(istat)
	   print *,error_message
	   print *,message(:len)
	endif
	if (.not. rmscomp) then
	   istat = lib$sys_getmsg(rmscomp,len,message,content)
	   print *,message(:len)
	endif
	end

** read a single character and retuurn it.  Ignore arrow keys, etc.
c========================================
	character*1 function getch(timeout)
	implicit none
	integer*4 timeout
c
c  get a single character from the given I/O channel
c
c----------
	include '($ttdef)'
	include '($iodef)'
	include '($syssrvnam)'
	integer*4 istat
	character*1 ch,getch_upper
c
	integer*4 term_stat(2),cbuf(2),funct,t
	integer*2 chan
	common /io/ chan
c
c  set up function code
c
	funct=ior(io$_readvblk,io$m_noecho)
	goto 100

	entry getch_upper(timeout)
	funct=ior(ior(io$_readvblk,io$m_noecho),io$m_cvtlow)

100	if(timeout.ne.0) funct=ior(funct,io$m_timed)
	t = timeout
	if (t .lt. 0) t = 0
c
c Get current terminal characteristics.
c
	istat = sys$qiow(,%val(chan),%val(io$_sensemode),,,,term_stat,,,,,)
	if( .not. istat) call my_exit(istat)
c
c Set passthr bit.
c
	cbuf(1) = term_stat(1)
	cbuf(2) = term_stat(2)
	
	cbuf(2) = ior( ior(cbuf(2),%loc(tt$m_passall) ),%loc(tt$m_noecho))
	istat = sys$qiow(,%val(chan),%val(io$_setmode),,,,cbuf,,,,,)
c
c clear ichar & do single character read
c
	ch=char(0)
	istat=sys$qiow(,%val(chan),%val(funct),,,,
	1		%ref(getch),%val(1),%val(t),,,)
	if(.not.istat)call exit(istat)
	istat = sys$qiow(,%val(chan),%val(io$_setmode),,,,term_stat,,,,,)
	if(.not.istat)call exit(istat)
	end

c length of string (prior to padded blanks) is returned
	integer*4 function leng(string)	
	implicit none
	character*(*) string

** paramaters
	integer*4 status,len,index
	if (string .eq. ' ') then
	  leng = 1
	else
	   index = len(string)
	   do while(index .gt. 1 .and. string(index:index) .eq. ' ')
	      index = index - 1
	   end do
	   leng = index
	endif
	return
	end

	subroutine my_exit(stat)
	implicit none
	integer*4 stat
d	call lib$stop(%val(stat))
	call exit(stat)
	end
-------- End of MORE.FOR --------

