      SUBROUTINE SHODIR( Dirspec, Flags)

C  Print a directory listing of the files specified in Dirspec.  Wild cards
C  are acceptable, including [...]*.*;* type entries.  A null or empty string
C  will default to all files in the current directory.  
C
C  Flags is an integer interpreted as a binary value.  Each bit represents
C  a parameter as shown below:
C     BIT 0:  SIZE       - Include SIZE of file in directory listing.
C     BIT 1:  DATE       - Include DATE of file in directory listing.
C     BIT 2:  OWNER      (Not yet availabe)
C     BIT 3:  PROTECTION (Not yet availabe)
C
C  Example:
C     CALL SHODIR('*.FOR', 3)
C  The above fortran example will display all files of type .FOR in the
C  current default directory, along with the file size and file date.
C
C  BUILDING:
C    Required files:
C       SHODIR.FOR
C       FILATR.MAR
C    Compiling:
C       $ FORTRAN SHODIR
C       $ MACRO FILATR
C       $ LINK {main_program},SHODIR,SHODIRMSG,FILATR
C
C     David Deley.  January, 1987
C     David Deley.  September, 1987
C     David Deley.  October 13, 1987  Revised

      IMPLICIT INTEGER (A-Z)
      INCLUDE '($RMSDEF)'
      INCLUDE '($STSDEF)'
      INCLUDE '($FSCNDEF)'

      PARAMETER GET_SIZE = '00000001'X
      PARAMETER GET_DATE = '00000002'X
      PARAMETER MAX_FILITMS = 2

      LOGICAL first_time

      CHARACTER*(*) Dirspec
      CHARACTER*255 Filespec, resultspec, related, root
      CHARACTER*17  Filedate
      CHARACTER*80  Outline, Errmsg

C     ITEM_LIST SECTION
      ! Define item list structure

      STRUCTURE /item_list_2/
        union
          map
            integer*2 complen, itmcode
            integer*4 compadr
          end map
          map
            integer*4 end_list
          end map
        end union
      END STRUCTURE

	STRUCTURE	/item_list_3/
	  union
	    map
	      integer*2 buflen,itmcod
	      integer*4 bufadr, retadr
	    end map
	    map
	      integer*4 end_list
	    end map
	  end union
	END STRUCTURE

C     DECLARE STRUCTURED VARIABLES
      record /item_list_2/ filescan_itmlst(6)
      record /item_list_3/ filatr_itmlst(max_filitms+1)

12    FORMAT (1x,a)
14    FORMAT (1x,'Directory ',a)
15    FORMAT (1x, ' ')
21    FORMAT (1x,I7)
22    FORMAT (1x,a17)
C-----------------------------------------------------------------------
C      .ENTRY
      ! INITIALIZE VARIABLES
      first_time = .true.
      out_len = 1
      col = 1
      outline = ' '
      root = ' '

C     INITIALIZE ITEM LISTS
      filescan_itmlst(1).itmcode = fscn$_name
      filescan_itmlst(2).itmcode = fscn$_type
      filescan_itmlst(3).itmcode = fscn$_version
      filescan_itmlst(4).itmcode = fscn$_device
      filescan_itmlst(5).itmcode = fscn$_directory
      filescan_itmlst(6).end_list = 0

C     BUILD ITEM LIST FOR FILATR DEPENDING ON FLAGS
      I = 0
      If ((FLAGS .and. GET_SIZE) .NE. 0) then
         I = I + 1
         filatr_itmlst(I).buflen = 4		   !One longword for size
         filatr_itmlst(I).itmcod = GET_SIZE	   !Get size
         filatr_itmlst(I).bufadr = %loc(filesize)  !Address of filesize memory location
         filatr_itmlst(I).retadr = 0
      Endif
      If ((FLAGS .and. GET_DATE) .NE. 0) then
         I = I + 1
         filatr_itmlst(I).buflen = 17		   !17 characters for date
         filatr_itmlst(I).itmcod = GET_DATE	   !Get date
         filatr_itmlst(I).bufadr = %loc(filedate)  !Address of filedate memory location
         filatr_itmlst(I).retadr = 0
      Endif
      I = I + 1
      filatr_itmlst(I).end_list = 0  		   !End item list

C     INITIALIZE DIRECTORY/FILE SPECIFICATION
      Call Str$trim( Filespec, Dirspec, Dirspec_len)        
      If (Dirspec_len .eq. 0) Filespec = '*'
C
C-----------------------------------------------------------------------
C
C  ENTER MAIN LOOP
      DO WHILE (.TRUE.)
      Findstatus = LIB$FIND_FILE( filespec,resultspec,context,'*.*;*')
      IF (findstatus.NE.rms$_normal .AND.
     *    findstatus.NE.rms$_fnf    .AND.
     *    findstatus.NE.rms$_nmf)   THEN
            Call Sys$getmsg( %val(Findstatus), msglen, Errmsg, , )
            Write(6,12) Errmsg(1:msglen)
            Call Lib$find_file_end( context )
            Return
      ENDIF

C  SCAN RESULTSPEC FOR FILE NAME, TYPE, VERSION#, DEVICE AND DIRECTORY name.
      scanstatus = SYS$FILESCAN( resultspec, filescan_itmlst,)	
      if (.not. scanstatus) call lib$signal(%VAL(scanstatus))

      fname_len = 0		!file name length	(Zero integer*4 variables first,
      ftype_len = 0		!file type length	then equate to integer*2 values.)
      fversion_len = 0		!file version length
      fdevice_len = 0		!file device length
      fdirectory_len = 0	!file directory length

      fname_len = filescan_itmlst(1).complen
      ftype_len = filescan_itmlst(2).complen 
      fversion_len = filescan_itmlst(3).complen 
      fdevice_len = filescan_itmlst(4).complen
      fdirectory_len = filescan_itmlst(5).complen

      fntv_offset = filescan_itmlst(1).compadr-%loc(resultspec)+1	!file name.type;version offset
      fntv_len = fname_len + ftype_len + fversion_len			!file name.type;version length
      fntv_end = fntv_offset + fntv_len - 1				!file name.type;version end

      fdd_offset = filescan_itmlst(4).compadr - %loc(resultspec) + 1	!file device&directory offset
      fdd_len = fdevice_len + fdirectory_len				!file device$directory length
      fdd_end = fdd_offset + fdd_len - 1				!file device&directory end

C  PRINT NEW DIRECTORY HEADING IF NEEDED.
      IF ( root(1:fdd_len) .ne. resultspec(fdd_offset:fdd_end) ) then
           If (.not. first_time) then
                write(6,12) outline(1:out_len)
                outline = ' '
                out_len = 1
                col = 1
                write(6,15)
                write(6,15)
           Endif
           first_time = .false.
           root = resultspec(fdd_offset:fdd_end)
           write(6,14) root(1:fdd_len)
           write(6,15)
      ENDIF

C  PRINT OUT THE DIRECTORY
      IF (findstatus .eq. rms$_fnf) then
           Call Sys$getmsg( %val(Findstatus), msglen, Errmsg, , )
           Write(6,12) Errmsg(1:msglen)
           Call Lib$find_file_end( context )
           Return
      ELSEIF (findstatus .eq. rms$_nmf) then
           If (FLAGS .eq. 0) write(6,12) outline(1:out_len)
           Call Lib$find_file_end( context )
           Return
      ELSEIF(FLAGS .eq. 0) then
C          No qualifiers (like /SIZE or /DATE).  Print file names in rows.
           If (fntv_len.ge.80-col) then
                write(6,12) outline(1:out_len)
                outline = ' '
                out_len = 1
                col = 1
           Endif
           outline(col:) = resultspec(fntv_offset:fntv_end)
           out_len = col + fntv_len - 1
           col = col + 20
           if (fntv_len.ge.20) col = col + 20
           if (fntv_len.ge.40) col = col + 20
           if (fntv_len.ge.60) col = col + 20
           If (col.ge.80) then
                write(6,12) outline(1:out_len)
                outline = ' '
                out_len = 1
                col = 1
           Endif
      ELSE    !QUALIFIERS EXIST.  PRINT FILES ONE LINE AT A TIME.
           Status = Filatr( resultspec, filatr_itmlst)
           If (fntv_len .lt. 19) then
                outline = resultspec(fntv_offset:fntv_end)
           Else
                write(6,12) resultspec(fntv_offset:fntv_end)
                outline = ' '
           Endif
           If (.not. Status) then
                Call Sys$getmsg(%val(Status),,outline(20:),%val(1),) 
           Else
                If ((FLAGS .and. GET_SIZE) .NE. 0) Then
                    write(outline(20:),21) filesize	!internal write
                Endif
                If ((FLAGS .and. GET_DATE) .NE. 0) Then
                    write(outline(29:),22) filedate	!internal write
                Endif
           Endif
           Call Str$trim( Outline, Outline, Out_len)
           write(6,12) Outline(1:Out_len)
      ENDIF
      ENDDO

      END

