CHAA006@vaxb.rhbnc.ac.UK (08/20/87)
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