[INHERIT('sys$library:starlet',
	 'sys$library:pascal$lib_routines')]

PROGRAM RFA_Read (INPUT, OUTPUT);

{++}
{
{	This is an example of using RMS RFA access 
{	in a VAX PASCAL program.
{
{	This program reads a file, then prints it
{	backwards.  This is done by saving the RFAs as
{	the file is read sequentially, then using RFAs
{	to step through the file backwards.
{
{	With RFAs, the file can be positioned to any
{	known record, then read sequentially or accessed
{	randomly.
{
{	The procedures shown here are for files of type
{	FILE OF VARYING OF CHAR.
{
{	Assumptions/Restrictions:
{	    File is <= 1000 records long.
{	    Records are truncated to 132 characters.
{
{--}

CONST
    Max_Records = 1000;
 
TYPE
    File_Type	    = FILE OF VARYING [132] OF CHAR;
    File_Name_Type  = VARYING [255] OF CHAR;
    Ptr_to_FAB	    = ^FAB$Type;
    Ptr_to_RAB	    = ^RAB$Type;
    RFA_Type	    = RECORD
			  RFA0 : [LONG] UNSIGNED;
			  RFA4 : [WORD] 0..65535;
		      END;

[EXTERNAL] 
FUNCTION PAS$RAB
    (VAR F : [UNSAFE] File_Type) : Ptr_to_RAB; EXTERNAL;
 
FUNCTION Position_of 
    (VAR F : File_Type) : RFA_Type;
 
    {+}
    {
    {	This function returns the current position, i.e. the 
    {	RFA, of the pascal file variable parameter.
    {
    {-}

    VAR
	RAB : Ptr_to_RAB;
	RFA : RFA_Type;
     
    BEGIN
    RAB := PAS$RAB( F );
    RFA.RFA0 := RAB^.RAB$L_RFA0;
    RFA.RFA4 := RAB^.RAB$W_RFA4;
    Position_of := RFA;
    END;

PROCEDURE Position_to
    (VAR F	: File_Type;
     VAR RFA	: RFA_Type);
 
    {+}
    {
    {	This procedure positions a pascal-file-variable
    {	to a given RFA.  It is straight forward except
    {	for the RESET, which is needed to "reset" the
    {	PASRTL internal structures when EOF is true.
    {
    {-}

    VAR
	RAB	: Ptr_to_RAB;
	Status	: INTEGER;

    BEGIN
    IF EOF( F )
    THEN
	RESET( F );			{ reset EOF status }

    RAB := PAS$RAB( F );
    RAB^.RAB$L_RFA0 := RFA.RFA0;	{ put RFA into RAB }
    RAB^.RAB$W_RFA4 := RFA.RFA4;
    RAB^.RAB$B_RAC  := RAB$C_RFA;	{ set for RFA access }

    Status := $get( RAB^ );		{ do the RMS $get }
    IF NOT ODD( Status )
    THEN
	LIB$Stop( Status );

    RAB^.RAB$B_RAC  := RAB$C_SEQ;	{ restore to sequential access }

    F^.length := RAB^.RAB$W_RSZ;	{ update length of VARYING string }
					{   usually done by PASRTL }
    END;

FUNCTION User_Open
    (VAR FAB : FAB$Type;
     VAR RAB : RAB$Type;
     VAR F   : File_Type) : INTEGER;

    {+}
    {
    {	This user-action routine modifies the FOP fields
    {	to allow non-sequential access to the file.
    {
    {-}

    VAR
	Status : INTEGER;

    BEGIN
    FAB.FAB$V_SQO := FALSE;		{ allow non-sequential access }

    Status := $open( FAB );		{ open file and connect RAB }
    IF ODD( Status )
    THEN
	Status := $connect( RAB );

    User_Open := Status;		{ return $open or $connect status }
    END;
 

VAR
    F		: FILE OF VARYING [132] OF CHAR;
    File_Name	: File_Name_Type;
    I, Line_Num	: INTEGER;
    RFA_Array	: ARRAY [1..Max_Records] OF RFA_Type;

BEGIN
WRITE( 'file-name> ' );
IF NOT EOF
THEN
    BEGIN
    {+}
    {
    {	Get file-name and prepare for reading.
    {
    {-}
    READLN( file_name );

    OPEN( File_Variable     := F,
	  File_Name         := File_Name,
	  History           := Readonly,
	  User_Action	    := User_Open );
    RESET( F );

    {+}
    {
    {	Read file saving RFAs in rfa_array.  Remember
    {	that the RESET has already caused first
    {	record to be read into file buffer variable.
    {
    {-}
    Line_Num := 0;
    WHILE NOT EOF( F ) DO
	BEGIN
	Line_Num := Line_Num + 1;
	RFA_Array[Line_Num] := Position_of( F );
	GET( F );
	END;

    {+}
    {
    {	Print file backwards.
    {
    {-}
    FOR I := Line_Num DOWNTO 1 DO
	BEGIN
	Position_to( F, RFA_Array[I]);
	WRITELN( F^ );
	END;

    END;
END.