From:	CSBVAX::MRGATE!@KL.SRI.Com:CHAA006%vaxb.rhbnc.ac.uk@Cs.Ucl.AC.UK@SMTP 19-AUG-1987 12:41
To:	EVERHART
Subj:		Re: I/O redirection & Lib${Get_Input|Put_Output}

Received: from Cs.Ucl.AC.UK (TUNNEL.CS.UCL.AC.UK.#Internet) by KL.SRI.COM with TCP; Wed 19 Aug 87 08:23:32-PDT
Received: from vaxb.rhbnc.ac.uk by nss.Cs.Ucl.AC.UK   via Janet with NIFTP
           id aa06467; 19 Aug 87 14:10 BST
Date:		19-AUG-1987 14:10:02
From:		CHAA006%vaxb.rhbnc.ac.uk@Cs.Ucl.AC.UK
To:		INFO-VAX <@Cs.Ucl.AC.UK:INFO-VAX@kl.sri.com>
Subject:	Re: I/O redirection & Lib${Get_Input|Put_Output}
X-Sender: P.Taylor (RHBNC, U. of London) <CHAA006%VAXB.RHBNC.AC.UK@CS.UCL.AC.UK>

Well, I thought that Ralph's approach of patching the image was going
a bit far, so I tried the following approach ... it does generate
"Multiply defined symbol" warnings at link time, but uses the user's
supplied Lib$Put_Output routine in preference to the LIBRTL one, so
all should be well.  Of course, I haven't coded in the test for
a re-defined SYS$OUTPUT - it was the technique I was interested in,
not the application.  ** Phil.

Philip Taylor (Royal Holloway & Bedford New College;  University of London; U.K)

       Janet	    :	chaa006@uk.ac.rhbnc.vaxa (or) chaa006@uk.ac.rhbnc.vaxb
			([+Janet.000005181000] or [+Janet.000005181100])

       Arpa	    :	chaa006%vaxa.rhbnc.ac.uk@cs.ucl.ac.uk
       (or) 	    :	chaa006%vaxb.rhbnc.ac.uk@cs.ucl.ac.uk

Bitnet/NetNorth/Earn:	chaa006@vaxa.rhbnc.ac.uk (or) chaa006%rhbnc.vaxa@ac.uk
       (or)	    :	chaa006@vaxb.rhbnc.ac.uk (or) chaa006%rhbnc.vaxb@ac.uk

============================== I/O REDIRECTION ==============================

	program test
	implicit none
	call lib$put_output ('Line 1')
	call lib$put_output ('Line 2')
	end

	subroutine lib$put_output (text)
	implicit none
	character * (*) text
	integer address, lib$find_image_symbol
	write (6, *) 'In simulated "Lib$Put_Output" routine ...'
	call function 
     &		(lib$find_image_symbol 
     &			('librtl', 'lib$put_output', address))
	call procedure (%val (address), text)
	return
	end

	subroutine procedure (address, text)
	implicit none
	integer address
	character * (*) text
	call address (text)
	return
	end

	subroutine function (status)
	implicit none
	integer status
	if (.not. status) call lib$signal (%val (status))
	return
	end	
