/* @(#)osfvms.c	17.1.1.1 (ES0-DMD) 01/25/02 17:35:25 */
/*===========================================================================
  Copyright (C) 1995 European Southern Observatory (ESO)
 
  This program is free software; you can redistribute it and/or 
  modify it under the terms of the GNU General Public License as 
  published by the Free Software Foundation; either version 2 of 
  the License, or (at your option) any later version.
 
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
 
  You should have received a copy of the GNU General Public 
  License along with this program; if not, write to the Free 
  Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
  MA 02139, USA.
 
  Corresponding concerning ESO-MIDAS should be addressed as follows:
	Internet e-mail: midas@eso.org
	Postal address: European Southern Observatory
			Data Management Division 
			Karl-Schwarzschild-Strasse 2
			D 85748 Garching bei Muenchen 
			GERMANY
===========================================================================*/

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.TYPE        Module
.NAME        osfvms.c
.LANGUAGE    C
.AUTHOR      Francois Ochsenbein [IPG-ESO]
.CATEGORY    VMS-Specific File Definitions for osa / osd / osf routines.
.ENVIRONMENT	VAX / VMS
.COMMENTS    Only VMS-specific code common to
		osf / osa / osd routines.
		This module keeps thearray of opened files.

.VERSION 1.0 	08-Oct-1988
.VERSION 1.1 	08-Jan-1990: Added parameters U (undefined)
.VERSION 1.2 	08-Feb-1990: Check ^Z that describes the EOF
.VERSION 1.3 	24-Aug-1990: Add more parameters to osfop function.
.VERSION 1.4    09-Dec-1991: Add no attribute to fixed length record files
------------------------------------------------------------*/

#define DEBUG	0

#define _NFILE_ 	32	/* Max. number of opened files	*/

#include <atype.h>	/* Character classification	*/
#include <osdefos.h>
#include <osfile.h>
#include <macrogen.h>
#include <errno.h>	/* System	*/
#include <iodef.h>	/* System	*/
#include <ssdef.h>	/* System	*/
#	define	 dsc$w_length	len			/* Simplify names... */
#	define	 dsc$a_pointer	s
#include <descrip.h>	/* System	*/
#	define fab$l_fna		name
#	define fab$b_fns		lname
#	define fab$l_ctx		file_no
#	define TheSector(n)		(n-1)
#	define FileSector(n)		(n+1)
#include <rms.h>	/* System	*/
#include <ssdef.h>	/* System	*/
#include <devdef.h>	/* System	*/

MID_EXTERN int vmserror;		/* VMS-specific error code */
MID_EXTERN int oserror;
MID_EXTERN char *oserrmsg;

				/* Define Default File Organisation	*/
#define RECORD_LENGTH	512
#define OPEN_FMT 	FAB$C_STMLF
#define OPEN_ORG 	FAB$C_SEQ
#define OPEN_RAT 	FAB$M_CR
#define OPEN_BKS 	0

#define	FINISH		goto FIN

struct IOSB {		/* IO control Block	*/
	unsigned short iostatus;
	unsigned short length;
	unsigned long info;
  };
				/* Define the default files	*/
static char *perm_files[3] = {"SYS$INPUT", "SYS$OUTPUT", "SYS$ERROR"};
static int   perm_open[3]  = {READ, WRITE, WRITE};

				/* Define local structure prototypes	*/
static struct FAB     fax, *fap;
static struct RAB     rab;
static struct XABFHC  fhc,*fhp; /* File Header Characteristics  */
static struct XABPRO  pro;	/* Protections			*/
static struct XABRDT  rdt;	/* Revision Date & Time 	*/
static struct NAM     nam;	/* Name block			*/

static struct IOSB iosb;	/* The i/o status block		*/

				/* Character descriptor		*/
static struct dsc$descriptor_s dev_des = 
		{ 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};

				/* Array of Opened Files	*/
static 	struct RAB *fp,
	*Files[_NFILE_] = {0,0,0,0,0,0,0,0};
static int    nf = 2;

				/* Open Options (set by osfop)	*/
static unsigned short	open_len = RECORD_LENGTH;
static char	open_fmt = OPEN_FMT ;
static char	open_org = OPEN_ORG ;
static char	open_rat = OPEN_RAT ;
static char    	open_bks = OPEN_BKS ;	/* Bucket Size	*/

char *osmmget();

/*======================================================================*/
int osfop(fmt, len)
/*++++++++
.PURPOSE Initializes the Format for the next Open / Create
.RETURNS 0 (understood) / -1 (wrong)
.REMARKS Only for VMS (useless in Unix context). Values are
	=> File organisation Q (sequential)/ Y (relative) / X (indexed) / H (hashed)
	=> Relative bucket size (Z)
	=> Record organisation U (undefined) / F (fixed) / V (variable) / 
		C (variable with control) / S (stream CR+LF) / 
		L (Stream-LF) / R (stream-CR)
	=> Record carriage     1 (Fortran) / 2 (CR) / 4 (print)
	=> Block span  (8)
------------------------------------------------------------*/
	int fmt;		/* IN : 'f' for Fixed, 'v' for Variable\
					'u' for undefined, 't' for Text(PCs) */
	int  len;		/* IN : Length of longest record	*/
{
  switch(toupper(fmt)) {
    case 'F':
        open_rat = 0;
  	open_fmt = FAB$C_FIX; open_len = len; break;	/* Fixed	*/
    case 'V':
    	open_fmt = FAB$C_VAR; open_len = len; break;	/* Variable	*/
    case 'U':
    	open_fmt = FAB$C_UDF; open_len = len; break;	/* Undefined	*/
    case 'S': case 'T':
    	open_fmt = FAB$C_STM; open_len = len; break;	/* Text CR+LF	*/
    case 'L': 
        open_fmt = FAB$C_STMLF; open_len = len; break;	/* Stream-LF	*/
    case 'C':
        open_fmt = FAB$C_VFC; open_len = len; break;	/* var with ctrl*/
    case 'R':
        open_fmt = FAB$C_STMCR; open_len = len;break;	/* stream-CR	*/

    case 'Q':
    	open_org = FAB$C_SEQ;		break;		/* Sequential	*/
    case 'Y':
    	open_org = FAB$C_REL;		break;		/* Relative	*/
    case 'X':
    	open_org = FAB$C_IDX;		break;		/* Indexed	*/
    case 'H':
    	open_org = FAB$C_HSH;		break;		/* Hashed	*/
    
    case '1':
    	open_rat = FAB$M_FTN;		break;		/* Fortran CR	*/
    case '2':
    	open_rat = FAB$M_CR;		break;		/* LF carriage	*/
    case '4':
    	open_rat = FAB$M_PRN;		break;		/* Printfile CR	*/
    case '8':
    	open_rat |= FAB$M_BLK;		break;		/* No block span*/

    case 'Z':
       	open_bks = len;			break;		/* bucket size */

    default:	return(-1);
  }
  
  return(0)  ;
}

/*======================================================================*/
struct RAB *vmsinit (phname)
/*++++++++
.PURPOSE Initializes one RMS structure, with what was specified in osfop
.RETURNS Pointer to filled RAB structure (which includes links to other)
------------------------------------------------------------*/
	char *phname;		/* IN : physical filename */
{
  vmserror = 0;

  rab = cc$rms_rab; 
  fax = cc$rms_fab; 
  fhc = cc$rms_xabfhc;
  rdt = cc$rms_xabrdt;
  pro = cc$rms_xabpro;
  nam = cc$rms_nam;	

  rab.rab$l_fab = &fax;
  rab.rab$l_ctx = 0;
  
  fax.fab$b_fac = FAB$M_BRO|FAB$M_PUT;
  fax.fab$b_shr = FAB$M_NIL;
  fax.fab$b_org = open_org;	
  fax.fab$b_rfm = open_fmt;	
  fax.fab$w_mrs = open_len;	
  fax.fab$b_rat = open_rat;
  fax.fab$b_bks = open_bks;
  
  fax.fab$l_nam = &nam;			/* NAM block address */
  fax.fab$l_xab = (char *)&fhc;		/* File Header Characteristics 	*/

  fhc.xab$l_nxt = (char *)&pro;		/* Next block = protection	*/

  pro.xab$l_nxt = (char *)&rdt;		/* Next block = date/time	*/

  if (phname){				/* Add name of file		*/
   	fax.fab$b_fns = strlen(phname);	/* sets length of file_name 	*/
	fax.fab$l_fna = phname;
  }

  open_len = RECORD_LENGTH;		/* Reset variables to default	*/
  open_fmt = FAB$C_STMLF;
  open_org = OPEN_ORG ;
  open_rat = OPEN_RAT ;
  open_bks = OPEN_BKS ;	

  return(&rab);
}

/*======================================================================*/
static int vmsop1(phname, mode)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE Interface to $OPEN / $CREATE
         The variable mode defines the way of opening the file as READ,
         WRITE, READ_WRITE and APPEND. (see osfile.h).
	 Option NOATTR available.
.RETURNS Upon successful completion a file descriptor is returned. -1 is
         returned on error.
.REMARKS The rab$l_ctx takes values -1 for QIO access
------------------------------------------------------------*/
	char *phname;			/* IN : physical filename */
	int  mode;			/* IN : open mode */
{
	register int i;
	register long pos;
	register char *trname;

  vmsinit(phname);

  fax.fab$b_fac = FAB$M_GET | FAB$M_BRO;
  fax.fab$b_shr = FAB$M_NIL;

  i = 0;		/* No creation		*/

  switch (mode&3) {
    case READ :  	/* open for read only 	*/
	fax.fab$b_shr = FAB$M_SHRGET;
	break;
    case WRITE :  	/* open for write only 	*/
	fax.fab$b_fac |= FAB$M_UPD|FAB$M_PUT|FAB$M_TRN;
	/* fax.fab$l_fop |= FAB$M_CIF; */
	fax.fab$l_fop |= FAB$M_TEF; 
	if(mode&NOATTR)	fax.fab$b_rat = 0;
	fax.fab$b_fsz = 2;
	i = 1;		/* CREATE utillity	*/
	break;
    case APPEND:
	fax.fab$b_fac |= FAB$M_PUT|FAB$M_UPD;
	rab.rab$l_rop |= RAB$M_EOF;
	fax.fab$l_fop |= FAB$M_TEF; 
	break;
    default:
	fax.fab$b_fac |= FAB$M_UPD|FAB$M_PUT;
	fax.fab$l_fop |= FAB$M_TEF; 
	break;
  }

  vmserror = i ? SYS$CREATE(&fax) : SYS$OPEN(&fax);
  if (!(vmserror&1)) 	FINISH;
			
	/* It's not a file when the file-id is zero in NAM block.
	  In this case, set rab$l_ctx to -1, which means that
	  logical QIO's must be used for access		  	*/

  if ((nam.nam$w_fid[0] == 0) && (nam.nam$w_fid[1] == 0)) {
	dev_des.len = nam.nam$t_dvi[0];
	dev_des.s   = &nam.nam$t_dvi[1];
    	vmserror    = SYS$ASSIGN(&dev_des,&(rab.rab$w_isi),0,0); 
        rab.rab$l_ctx = 0xffffffff;
  }

					/* Find a free slot	*/
  for (i=3; (i < _NFILE_) && (Files[i]); i++) {}
  if (i >= _NFILE_) {
  	oserror = EMFILE;		/* Too many opened files */
	FINISH;
  }
  if (rab.rab$l_ctx != 0)	FINISH;		/* Device	*/
  
	/* For non-sequential organisation, the only access provided
	   here is via QIOs. 
	   If the file has such an organisation, close it,
	   reopen with option UFO which only allows QIO's
	*/
				

  vmserror = SYS$CONNECT(&rab);	
  if (!(vmserror&1)) 	{ oserror = EIO; FINISH; }

  if ((mode&3) == APPEND){
  	pos = (fhc.xab$l_ebk-1)*fax.fab$w_bls;
	if (pos%fax.fab$w_bls)	(rab.rab$l_bkt)++;
	*(long *)(rab.rab$w_rfa) = 1 + pos/fax.fab$w_bls;
	rab.rab$w_rfa[2] = pos % fax.fab$w_bls;
  }

  FIN:
  if (!(vmserror&1))
  {	oserror = ENOENT;
  	i = -1;
  }
  fax.file_no = i;
#if DEBUG
  printf("Internal File Idenfier=%d\n", fax.fab$w_ifi);
  printf("Status                =%d\n", fax.fab$l_stv);
  printf("Lst block             =%d\n", fhc.xab$l_ebk);
  printf("last byte in block    =%d\n", fhc.xab$w_ffb);
  printf("rfm=%d, rat=%d\n", fax.fab$b_rfm,fax.fab$b_rat);
  printf("File Identifier is    =%d\n", fax.file_no);
#endif

  return(i);
}

/*==========================================================================*/
static struct RAB *falloc(name)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE Copy structures in newly allocated pieces of memory.
.RETURNS Address of allocated structures, NULL in case of error
.REMARKS For internal use only.
------------------------------------------------------------*/
	char *name;		/* IN: Name of File	*/
{
	register struct RAB *fp;
	register char *p, *q;

  fp 	= (struct RAB *)osmmget(sizeof(struct RAB) + sizeof(struct FAB) 
		+ sizeof(fhc) + fax.lname + 1);
  if (oserror)		FINISH;
  *fp   = rab;
  fap  	= (struct FAB *) (fp+1);
  *fap	= fax;
  fhp  	= (struct XABFHC *) (fap+1);
  *fhp	= fhc;
  fhp->xab$l_nxt = 0;			/* No link to other extensions 	*/
  p	= (char *) (fhp + 1);
  fap->fab$l_fna = p;			/* File Name			*/
  fp->rab$l_fab  = fap;
  fap->fab$l_xab = (char *)fhp;		/* File Header Characteristics	*/
  fap->fab$l_nam = (struct NAM *)0;	/* No NAM block address 	*/

  for (q = name; *q; )	*(p++) = *(q++);
  *p = EOS;

  FIN:
  return(oserror ? NULL_PTR(struct RAB) : fp);
}

/*==========================================================================*/
struct RAB *vmsrab(fid)
/*++++++++
.PURPOSE Retrieve the "file pointer" from file identifier.
.RETURNS Upon successful completion the pointer.
         Else , NULL is returned and the system error code is set into
         oserror.
.REMARKS The permanent files (stdin, stdout, stderr) are implicitely opened.
	For internal use only.
------------------------------------------------------------*/
	int   fid;			/* IN : file identifier */
{
	register struct RAB *fp;

  oserror  = 0, vmserror = 0;

#if DEBUG
  printf("vmsrab: File Number is: %d\n", fid);
#endif
  if ( (fid < 0)||(fid > nf) )		{ oserror = EBADF; FINISH; }
  else  if ( (Files[fid] == 0) && (fid < 3)) {	/* Permanent Files */
  	if (vmsop1(perm_files[fid], perm_open[fid]) < 0)	FINISH;
	fax.file_no = fid;
	fp = falloc(perm_files[fid]);
	if (oserror)	FINISH;
	Files[fid] = fp;
  }

  fp = Files[fid];
  if (!fp)	oserror = EBADF;

  FIN:
  return ( oserror ? NULL_PTR(struct RAB) : fp );
}

/*======================================================================*/
int osfunix(phname)
/*++++++++
.PURPOSE Check if a file is Unix-compatible (STMLF)
.RETURNS 1 if STMLF format, 0 otherwise, -1 if error
.REMARKS 
------------------------------------------------------------*/
	char *phname;		/* IN : Name of the file	*/
{
	int	i;
	
  vmsinit(phname);

  fax.fab$b_fac = FAB$M_GET | FAB$M_BRO;
  fax.fab$b_shr = FAB$M_SHRGET;

  vmserror = SYS$OPEN(&fax);
  if (!(vmserror&1)) 	FINISH;

  vmserror = SYS$CONNECT(&rab);	
  if (!(vmserror&1)) 	FINISH;
  i = (fax.fab$b_rfm == FAB$C_STMLF) && (fax.fab$b_org = FAB$C_SEQ);
  SYS$CLOSE(&fax);	
  
  FIN:
  if (!(vmserror&1))	oserror = ENOENT, i = -1;
  return(i);
}

/*==========================================================================*/
int vmsopen(phname, mode)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE Opens RMS file for read or write. The variable mode
         defines the way of opening the file as READ,
         WRITE (the file is created), 
	READ_WRITE and APPEND. (see osfile.h).
	SHARE option to be implemented ?
.RETURNS Upon successful completion a file descriptor is returned. -1 is
         returned on error; oserror specifies the error.
.REMARKS Special case phname = -1 to reopen file in UFO mode.
------------------------------------------------------------*/
	char *phname;			/* IN : physical filename */
	int  mode;			/* IN : open mode */
{
	register int i;
    
  oserror = 0;
  if (phname == (char *)(-1)) {		/* Non-sequential file. Reopen */
  	SYS$CLOSE(&fax);	
	fax.fab$l_fop = FAB$M_NAM | FAB$M_UFO;
  	vmserror = SYS$OPEN(&fax);
  	if (!(vmserror&1))	{ oserror = EIO; FINISH; }
    	i = fax.fab$l_stv;	/* IO channel	*/
    	FINISH;
  }
  fp = 0;

  i = vmsop1(phname, mode);	/* Call system-dependent part */
  if (i<0)			FINISH;	

  nf = MAX(i, nf);
  fp = falloc(phname);		/* Copy file pointers to new area */

  Files[i] = fp; 		/* Store in table the file pointer */

  FIN:
#if DEBUG
    printf("vmsopen %d: ", i); 
    if (fp) printf ("fab$w_bls=%d, rab$l_bkt=%d\n\n", 
                fap->fab$w_bls,fp->rab$l_bkt);
#endif
  return(oserror ? -1 : i);
}

/*==========================================================================*/
int vmsclose(fid)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE Closes a disk file.
         The argument fid is the file identification obtained from osbopen.
.RETURNS 0 (success) / -1 (failure)
------------------------------------------------------------*/
	int   fid;			/* IN : file identifier */
{

  if (!(fp = vmsrab(fid)))  		FINISH;

  if (fp->rab$l_ctx == 0xffffffff)	/* Special Device	*/
  	vmserror = SYS$DASSGN(fp->rab$w_isi);
  else	vmserror = SYS$CLOSE(fp->rab$l_fab);

  if (!(vmserror&1))		oserror = EIO;

  osmmfree(Files[fid]);
  Files[fid] = NULL_PTR(struct RAB);

  FIN: 
  return(oserror ? -1 : 0);
}

/*======================================================================*/
long vmsize(fid)
/*++++++++++++++++++++++++++++
.PURPOSE Returns the size of an opened a file
.RETURNS Upon successful completion the total size in bytes (-1 on error)
.REMARKS 
-------------------------------*/
	int   fid;			/* IN : file identifier */
{
	register long pos;

  if (!(fp = vmsrab(fid)))  		FINISH;

  fap = fp->rab$l_fab;
  fhp = (struct XABFHC *) fap->fab$l_xab;
  
  if ((fap->fab$b_org == FAB$C_SEQ) && (fap->fab$b_fac & FAB$M_PUT)) {
  					/* Update the File Header */
  	vmserror = SYS$FLUSH(fp);
	if (!(vmserror&1))	 	oserror = EIO;
	SYS$DISPLAY(fap);		/* ... and retrieve it	  */
  }
  else	vmserror = RMS$_NORMAL;

  if (fhp->xab$l_ebk > 0)	
  	pos = (fhp->xab$l_ebk-1)*fap->fab$w_bls + fhp->xab$w_ffb; 
  else	pos = 0;

  FIN: 
  return(oserror ? -1 : pos);
}

/*======================================================================*/
int vmsqio (chan, op, buffer, length, blkno)
/*+++++++++++++ 
.PURPOSE Interface to SYS$QIOW, with test of 2 returned codes
.RETURNS Length / -1 if error
.REMARK	
--------------*/
	int	chan;		/* IN: The channel for QIO	*/
	int	op;		/* IN: The operation to perform	*/
	char	*buffer;	/* OUT: Buffer address		*/
	int	length;		/* IN: Buffer length		*/
	int	blkno;		/* IN: Block number		*/
{
	register int l;
	
  oserror = 0;
  iosb.iostatus = 0, iosb.length = 0;

  vmserror = SYS$QIOW (0,chan,op,&iosb,0,0,buffer,length,blkno,0,0,0);
  l = iosb.length;
  if (!(vmserror & 1))	{ oserror = EIO; FINISH;}

  if (oserror == 0) {
  	switch(iosb.iostatus)
	{ case SS$_NORMAL: 	
		break;

	  case SS$_DATAOVERUN:	break;

	  case SS$_ENDOFVOLUME:
	  case SS$_ENDOFFILE:	l = -1; break;	/* No error */

	  case SS$_ENDOFTAPE:	oserrmsg = "Physical End reached";
	  			oserror = -1;
				break; 

	  default:		oserror = EIO;
	  			vmserror = iosb.iostatus;
				break; 
	}
  }
  FIN: 
  return(oserror ? -1 : l);
}

/*======================================================================*/
int vmsrlb(channel, buffer, length)
/*+++++++++++++ 
.PURPOSE Interface to SYS$QIOW, reading a logical block
.RETURNS Bytes read over channel / -1 if error
.REMARK	 Test the ending ^Z on devices.
--------------*/
	int channel;		/* IN: Channel id 	*/
	char *buffer;		/* OUT: Buffer to read	*/
	int  length;		/* IN: Size of buffer	*/
{
	int	stat;		/* Returned status	*/

  buffer[0] = 0;
  stat = vmsqio(channel, IO$_READLBLK, buffer, length, 0);

				/* Check ^Z	*/
  if ((stat == 0) && (buffer[0]) == 26)	stat = -1;
  
  return(stat);
}

#if 0		/* The following functions may just be skipped. */
/*======================================================================*/
int vmswlb(channel, buffer, length)
/*+++++++++++++ 
.PURPOSE	Interface to SYS$QIOW, writing a logical block
.RETURNS	Length / -1 if error
.REMARK	
--------------*/
	unsigned short channel;	/* IN: Channel id	*/
	char *buffer;		/* IN: Buffer to write 	*/
	int  length;		/* IN: Number of bytes to write	*/
{
  return(vmsqio(channel, IO$_WRITELBLK, buffer, length, 0));
}

/*======================================================================*/
int vmsrvb(channel, buffer, length)
/*+++++++++++++ 
.PURPOSE Interface to SYS$QIOW, reading a virtual block
.RETURNS Bytes read over channel / -1 if error
--------------*/
	int channel;		/* IN: Channel id 	*/
	char *buffer;		/* OUT: Buffer to read	*/
	int  length;		/* IN: Size of buffer	*/
{
  return (vmsqio(channel, IO$_READVBLK, buffer, length, 0));
}

/*======================================================================*/
int vmswvb(channel, buffer, length)
/*+++++++++++++ 
.PURPOSE Interface to SYS$QIOW, writing a virtual block
.RETURNS Length / -1 if error
--------------*/
	iont channel;		/* IN: Channel id	*/
	char *buffer;		/* IN: Buffer to write 	*/
	int  length;		/* IN: Number of bytes to write	*/
{
  return(vmsqio(channel, IO$_WRITEVBLK, buffer, length, 0));
}
#endif