Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!uunet!husc6!mit-eddie!ll-xn!ames!ucbcad!ucbvax!vaxb.rhbnc.ac.UK!CHAA006
From: CHAA006@vaxb.rhbnc.ac.UK
Newsgroups: comp.os.vms
Subject: Re: I/O redirection & Lib${Get_Input|Put_Output}
Message-ID: <8708192135.AA27040@ucbvax.Berkeley.EDU>
Date: Wed, 19-Aug-87 17:36:09 EDT
Article-I.D.: ucbvax.8708192135.AA27040
Posted: Wed Aug 19 17:36:09 1987
Date-Received: Sat, 22-Aug-87 04:34:46 EDT
Sender: daemon@ucbvax.BERKELEY.EDU
Distribution: world
Organization: The ARPA Internet
Lines: 53

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