Article 143146 of comp.os.vms:
Path: nntpd.lkg.dec.com!pa.dec.com!decwrl!elroy.jpl.nasa.gov!swrinde!ihnp4.ucsd.edu!mvb.saic.com!info-vax
From: "Richard B. Gilbert [VAX]" <76702.1567@compuserve.com>
Newsgroups: comp.os.vms
Subject: Fortran EOF
Message-ID: <960323181341_76702.1567_CHN45-1@CompuServe.COM>
Date: 23 Mar 96 13:13:42 EST
Organization: Info-Vax<==>Comp.Os.Vms Gateway
X-Gateway-Source-Info: Mailing List
Lines: 98

	dwmorsb@ids2.idsonline.com (David Morsberger) writes:
>
>I need a way to determine the EOF location of a disk file in FORTRAN.  The 
>problem is when I read the file with QIOWs it returns SS$_ENDOFFILE in 
>IOSB(1) when the last extended block is read with the number of bytes up 
>to the end of the extended block in  IOSB(2).   I need to know the EOF 
>location down to the last byte.  I am opening the file with a useropen so 
>FABs, RABs, and XABs are accesible.  I have noticed EOF VBN and next byte 
>value in the XABFHC structure but I am having a difficult time accessing 
>it.  My questions are: 
>    
>1) Is there an easier way of accessing the EOF info in FORTRAN without 
>using XABs?  (I do not want to call a DCL routine to do it.) 
>    
>2) How do I access the XABFHC structure?  I know there is a link list off 
>the FAB$M_XAB element but what order are the XABs in or how do I set the 
>order? 
>

	You find the XABFHC by traversing the linked list until you find the
right XAB.  Here is some code that obtains information similar to that which
you require.  It should be quite easy to modify it to obtain the position of 
the EOF in the last block.  I will leave that as an exercise for the student!


      INTEGER FUNCTION SIZE_OPEN (FAB, RAB, LUN)
C
C         This is a useropen routine.  It will determine the address of
C     the first XAB connected to the FAB, pass the address of that XAB
C     to another integer function which in turn will return the address
C     of the next XAB in the XAB chain.
C
      IMPLICIT INTEGER (A-Z)
      INCLUDE '($FABDEF)'   ! File access block definitions.
      INCLUDE '($RABDEF)'   ! Record access block definitions.
      RECORD  /FABDEF/ FAB
      RECORD  /RABDEF/ RAB
      SIZE_OPEN = SYS$OPEN(FAB)		! Open the file.
      SIZE_OPEN = SYS$CONNECT(RAB)	! Connect the RAB to the FAB.
C
C     Now, lets look at the XAB.  Note that it is necessary to pass
C     FAB.FAB$L_XAB by value in order to pass the address it contains
C     rather than the useless address of the address.
C
      STATUS = XABACCESS(%VAL(FAB.FAB$L_XAB), NEXT_XAB)
            ! Pass the address of the first XAB to XABACCESS.
      DO WHILE(STATUS)
            ! STATUS will be set when all XABs have been processed.
          THIS_XAB = NEXT_XAB
          STATUS = XABACCESS(%VAL(THIS_XAB), NEXT_XAB)
            ! Pass the address of the next XAB to XABACCESS.
          END DO
      RETURN
      END
      INTEGER FUNCTION XABACCESS (FHCXAB, NEXT_XAB)
C
C         This function maps a XAB to a record defining a File Header
C     Characteristics XAB.  Because each XAB begins with XABDEF, the
C     type of XAB may be determined.  If this is the FHC XAB the
C     function stores the blocks used and the blocks allocated in COMMON
C     and returns zero as the function value.
C
      IMPLICIT INTEGER (A-Z)
      COMMON /SIZE/ FILESIZE, FILEALLO
      EXTERNAL SS$_CONTINUE
      INCLUDE  '($XABDEF)'	! XAB definitions common to all XABs.
      INCLUDE  '($XABFHCDEF)'	! XAB definitions for a FHC XAB.
      STRUCTURE /FHC_XAB/
         UNION
           MAP
             RECORD /XABDEF/    XABDEF_RECORD
           END MAP
           MAP
             RECORD /XABFHCDEF/ FHC_RECORD
           END MAP
         END UNION
      END STRUCTURE
      RECORD /FHC_XAB/ FHCXAB
      IF(FHCXAB.XABDEF_RECORD.XAB$B_COD .EQ. XAB$C_FHC) THEN
              FILESIZE = FHCXAB.FHC_RECORD.XAB$L_EBK
              FILEALLO = FHCXAB.FHC_RECORD.XAB$L_HBK
              XABACCESS = 0
          ELSE
              NEXT_XAB = FHCXAB.XABDEF_RECORD.XAB$L_NXT
                    ! Address of the next XAB in the XAB chain.
              XABACCESS = %LOC(SS$_CONTINUE)
          END IF
       RETURN
       END

--
*************************************************************************
*                        Here, there be dragons!                        *
*                       DRAGON@CIS.CompuServe.Com                       *
*                                                                       *
*                                                Richard B. Gilbert     *
*************************************************************************



