Google
 

Trailing-Edge - PDP-10 Archives - BB-K818A-BM_1981 - sources/openf.for
There are 2 other files named openf.for in the archive. Click here to see a list.
C  openf - open a file by name
C  Copyright (C) 1980, by Digital Equipment Corporation, Maynard, Mass.
C  copyright notice
C 
C 
C   			C O P Y R I G H T
C 
C 
C   		Copyright (C) 1980 by
C   		Digital Equipment Corporation, Maynard, Mass.
C 
C 
C   	This software is furnished under a license and may be used and
C   	copied  only  in accordance with the terms of such license and
C   	with the  inclusion  of  the  above  copyright  notice.   This
C   	software  or  any  other copies thereof may not be provided or
C   	otherwise made available to any other person.  No title to and
C   	ownership of the software is hereby transferred.
C 
C   	The information in this software is subject to change  without
C   	notice  and should not be construed as a commitment by Digital
C   	Equipment Corporation.
C 
C   	DIGITAL assumes no responsibility for the use  or  reliability
C   	of its software on equipment that is not supplied by DIGITAL.
C 
C ========== Ratfor character definitions ==========
C 	 9-FEB-79
C 	12-MAY-80
C  ampersand
C  exclamation mark
C  ASCIZ strings as used by SYSLIB
C  max element count in packed char array
C  input record size
C  must be 2 more than MAXRECORD
C  alternative to YES, NO
C  a linefeed
C  for OPENF calls
C 	"
C 	"
C 	"
C  char i/o format:  "r1" for TOPS-20; "a1" otherwise
C  quoted string version of above
C  first char for single space with LIST carriagecontrol:
C 	' ' for RSTS, nothing for VMS
C  ascii numeric value corresponding to LISTSS, above
C  if "#", omit packed string code for this machine
C  5 for TOPS-20, 1 otherwise
C  if "#", omit TOPS20 code
      logical function openf ( lun , upname , modes )
      implicit integer ( a - z )
      integer lun , modes
      integer upname ( 1 ) , inname ( 40 ) , fname ( 20 )
C  fname is packed version of input name
      integer dsknam ( 5 ) , colntk ( 2 )
      data dsknam / 68 , 83 , 75 , 58 , 0 / , colntk / 58 , 0 /
      openf = . true .
      call scopyl ( upname , inname , 40 )
C  make internal copy of name
      if(.not.( indexx ( inname , colntk , 1 ) .lt. 1 ))goto 23000
C  is explicit device?
      call splice ( inname , dsknam , 1 )
C  if not, add "DSK:"
23000 continue
      call pack ( inname , fname )
C  convert to packed ascii
      if(.not.( ( modes .and. 2 ) .ne. 0 ))goto 23002
      open ( unit = lun , dialog = fname , access ='SEQIN' , mode ='ASCI
     *I' , err = 5000 )
      goto 23003
23002 continue
      if(.not.( modes .eq. 0 ))goto 23004
C  old, list
      open ( unit = lun , dialog = fname , access ='SEQIN' , mode ='ASCI
     *I' , err = 5000 )
      goto 23005
23004 continue
      if(.not.( modes .eq. 4 ))goto 23006
C  old
      open ( unit = lun , dialog = fname , access ='SEQIN' , mode ='ASCI
     *I' , err = 5000 )
      goto 23007
23006 continue
      if(.not.( modes .eq. 4 + 1 ))goto 23008
      open ( unit = lun , dialog = fname , access ='SEQOUT' , mode ='ASC
     *II' , err = 5000 )
      goto 23009
23008 continue
      if(.not.( modes .eq. 1 ))goto 23010
      open ( unit = lun , dialog = fname , access ='SEQOUT' , mode ='ASC
     *II' , err = 5000 )
      goto 23011
23010 continue
      openf = . false .
C  illegal mode
23011 continue
23009 continue
23007 continue
23005 continue
23003 continue
      return
5000  openf = . false .
      return
C  error return
      end