#define vmr	vmr_		/* parameter for Name Translation is l_ */
#define ROUTINE int
/*++++++++++++++++++++++++  ISTIUE.FC +++++++++++++++++++++++++++++++++++++++
.LANGUAGE C
.IDENTIFICATION Module ISTIUE
.COMMENTS	DRAFT (No garantee)
.AUTHOR    	D.Ponz & C.Guirao.
.KEYWORDS       standard interfaces.
.ENVIRONMENT    FORTRAN and C standards
.VERSION  [1.00] 920410:  Master file.
.VERSION  [2.00]  940624:  Add disk access routines
-----------------------------------------------------------------------------*/
#include <ftoc.h>             /* FORTRAN to C definitions */
#include <filedef.h>
#include <computer.h>         /* computer dependant constants  */

#ifdef vms
#define osfphname(x,y)  OSY_TRNLOG(x,y,64,&n)
#endif

typedef  struct {
                  int            ifmt;   /* integer format          */
                  int            bos;   /* byte order for short    */
                } DFMT;

static  DFMT  cpu = { INTFMT, SWAPSHORT};

static  int           samei2;  /* same 2-byte integer format         */
static  int           samei4;  /* same 4-byte integer format         */
static  DFMT            efmt;  /* external data format definition    */
static  int  ls0,ls1,ls2,ls3;  /* int integer byte swap order       */
static  int  fs0,fs1,fs2,fs3;  /* 32-bit float byte swap order       */
static  int  ds0,ds1,ds2,ds3;  /* 64-bit double byte swap order      */
static  int  ds4,ds5,ds6,ds7;  /* 64-bit double byte swap order      */
/********************EBCDIC to ASCII conversion table ****************/
/* #define ____	0xff		/* No Translation	*/
#define ____	'.'		/* No Translation	*/

unsigned char ebc_to_asc[256] = {
   ' ',  01,  02,  03,____,0011,____,0177, /* 0. */
  ____,____,____,0013,0014,0015,0016,0017, /* 0. */
   020,0021,0022,0023,____,____,0010,____, /* 1. */
   030,0031,____,____,0034,0035,0036,0037, /* 1. */
  ____,____,____,____,____,0012,0027,0033, /* 2. */
  ____,____,____,____,____,0005,0006,0007, /* 2. */
  ____,____,0026,____,____,____,____,0004, /* 3. */
  ____,____,____,____,0024,0025,____,0032, /* 3. */
   ' ',____,____,____,____,____,____,____, /* 4. */
  ____,____, '[', '.', '<', '(', '+', '!', /* 4. */
   '&',____,____,____,____,____,____,____, /* 5. */
  ____,____, ']', '$', '*', ')', ';', '^', /* 5. */
   '-', '/',____,____,____,____,____,____, /* 6. */
  ____,____, '|', ',', '%', '_', '>', '?', /* 6. */ 
  ____,____,____,____,____,____,____,____, /* 7. */
  ____, '`', ':', '#', '@','\'', '=','\"', /* 7. */
  ____, 'a', 'b', 'c', 'd', 'e', 'f', 'g', /* 8. */
   'h', 'i',____,____,____,____,____,____, /* 8. */
  ____, 'j', 'k', 'l', 'm', 'n', 'o', 'p', /* 9. */
   'q', 'r',____,____,____,____,____,____, /* 9. */
  ____, '~', 's', 't', 'u', 'v', 'w', 'x', /* a. */ 
   'y', 'z',____,____,____,____,____,____, /* a. */
  ____,____,____,____,____,____,____,____, /* b. */
  ____,____,____,____,____,____,____,____, /* b. */
   '{', 'A', 'B', 'C', 'D', 'E', 'F', 'G', /* c. */
   'H', 'I',____,____,____,____,____,____, /* c. */
   '}', 'J', 'K', 'L', 'M', 'N', 'O', 'P', /* d. */
   'Q', 'R',____,____,____,____,____,____, /* d. */
  '\\',____, 'S', 'T', 'U', 'V', 'W', 'X', /* e. */
   'Y', 'Z',____,____,____,____,____,____, /* e. */
   '0', '1', '2', '3', '4', '5', '6', '7', /* f. */
   '8', '9',____,____,____,____,____,____  /* f. */
    };
/************************************************************/

char  istbyt[1024];
short isthwd[1600];

#if 0     /* ==== Original Code ==== */
SUBROUTINE ISTOPN(device,fd,status)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      open tape unit
.RETURN       error code: ok=0, error opening the tape=5
.ALGORITM     use the routine osuopen.
--------------------------------------------------------------------*/
CHARACTER   device;	/* IN: device name  */
fint2c *fd;		/* OUT: file descriptor */
fint2c *status;
#else     /* ==== Generated Code === */
#define ISTOPN	istopn_
ISTOPN(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */

    char name[64], tpname[64],  devn[5];
    char *pc;
    int n;  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */


    strcpy(name,STRIPPED_STRING(1,3,0));

    /* if name does not start with "tape" then it is a device */
    /* otherwise we believe is a logic name for a device */

    for (n=0; n<4; n++)
      devn[n] = (('A'<=name[n]) && (name[n]<='Z')) ? name[n]+'a'-'A' : name[n];
    devn[n] = '\0';

    if (strncmp(devn,"tape",4)) { 
        *PARAM(2,3,1,fint2c *) = osuopen(name,READ,0);
        *PARAM(3,3,1,fint2c *) = (*PARAM(2,3,1,fint2c *) == -1) ? 5 : 0 ;
	ftoc_free(FORmark); /* <forif> */return 0;
    }
    else {
      	pc = name;
	while (*pc) { if (('A'<=*pc) && (*pc<='Z')) *pc += 'a'-'A'; pc++; }
	if (osfphname(name,tpname)) {  /* get physical name of device */
            pc = name;
            while (*pc) { if (('a'<=*pc) && (*pc<='z')) *pc += 'A'-'a'; pc++; }
            if (osfphname(name,tpname)) {
		printf("Error: device not defined\n");
		*PARAM(3,3,1,fint2c *)=5;
		ftoc_free(FORmark); /* <forif> */return 0;
             }
	 }
        *PARAM(2,3,1,fint2c *) = osuopen(tpname,READ,0);
        *PARAM(3,3,1,fint2c *) = (*PARAM(2,3,1,fint2c *) == -1) ? 5 : 0 ;
	ftoc_free(FORmark); /* <forif> */return 0;
    }
}

#define ISTSKP	istskp_
ROUTINE ISTSKP(fd,num,status) 
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      initiate data conversion routines
.RETURN       error code: ok=0, 1=unknown format
.ALGORITM     Analyze internal and external data format definitions
              and setup static varibles to define conversion needed.
--------------------------------------------------------------------*/
fint2c *fd;		/* IN: file descriptor */
fint2c *num;		/* IN: number of EOF to skip forward */
fint2c *status;
{
    *status = (osufseek(*fd, *num, FILE_CURRENT) == -1) ? 6 : 0;
}

#define ISTWTM	istwtm_
ROUTINE ISTWTM(fd,status) 
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      close the tape unit
.RETURN       error code: ok=0, 7=error on tape unit
.ALGORITM     use osufclose
--------------------------------------------------------------------*/
fint2c *fd;		/* IN: file descriptor */
fint2c *status;
{
    *status = (osufclose(*fd) == -1) ? 7 : 0;
}

#define ISTREW	istrew_
ROUTINE ISTREW(fd,status) 
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      rewind the tape
.RETURN       error code: ok=0, 8=error on tape
.ALGORITM     use osufseek
--------------------------------------------------------------------*/
fint2c *fd;		/* IN: file descriptor */
fint2c *status;
{
    *status = (osufseek(*fd, 0, FILE_START) == -1) ? 8 : 0;
}

#define ISTRBY	istrby_
ROUTINE ISTRBY(fd,buffer,size,length,status)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      read record from tape. The routine converts each byte
              into integer format.
.RETURN       error code: ok=0, 3=error on reading the tape
.ALGORITM     use osuread
--------------------------------------------------------------------*/
fint2c *fd;		/* IN: file descriptor */
fint2c *buffer;		/* OUT: Ptr first element */
fint2c *size;		/* IN: number of bytes to read */
fint2c *length;		/* OUT: number of bytes actually read */
fint2c *status;
{
int i;

    *length = osuread(*fd, istbyt, *size);
    if ( *length == 0 ) *status = 1;
    else *status = (*length == -1) ? 3 : 0 ;
    
    for (i=0; i< *size; i++) buffer[i] = istbyt[i]; 
}

#define ISTRB1	istrb1_
ROUTINE ISTRB1(fd,buffer,size,length,status)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      read record from tape without conversion.
.RETURN       error code: ok=0, 3=error on reading the tape
.ALGORITM     use osuread
--------------------------------------------------------------------*/

/* read pixels in byte format - output is byte */

fint2c *fd;		/* IN: file descriptor */
char *buffer;		/* OUT: Ptr first element */
fint2c *size;		/* IN: number of bytes to read */
fint2c *length;		/* OUT: number of bytes actually read */
fint2c *status;
{
    *length = osuread(*fd, buffer, *size);
    if ( *length == 0 ) *status = 1;
    else *status = (*length == -1) ? 3 : 0 ;
}

#define ISTRHW	istrhw_
ROUTINE ISTRHW(fd,buffer,size,length,status)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      read record from tape. Pixels on tape are short integer format.
              Pixels are converted to int after byte swap if required.
.RETURN       error code: ok=0, 3=error on reading the tape
.ALGORITM     use osuread
--------------------------------------------------------------------*/

/* read pixels in integer*2 - output is integer*4 with optional byte swap */

fint2c *fd;		/* IN: file descriptor */
fint2c *buffer;		/* OUT: Ptr first element */
fint2c *size;		/* IN: number of bytes to read */
fint2c *length;		/* OUT: number of bytes actually read */
fint2c *status;
{
int j, i;

    *length = osuread(*fd, isthwd, *size);
    if ( *length == 0 ) *status = 1;
    else *status = (*length == -1) ? 3 : 0 ;

    j = *size/2;
    istcvh(isthwd,j,0);
    for (i=0; i< j; i++) buffer[i] = isthwd[i]; 

}

#define ISTRH1	istrh1_
ROUTINE ISTRH1(fd,buffer,size,length,status)

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      read record from tape. Pixels on tape are short integer format.
              The routine performs byte swap if required.
.RETURN       error code: ok=0, 3=error on reading the tape
.ALGORITM     use osuread
--------------------------------------------------------------------*/

fint2c *fd;		/* IN: file descriptor */
short *buffer;		/* OUT: Ptr first element */
fint2c *size;		/* IN: number of bytes to read */
fint2c *length;		/* OUT: number of bytes actually read */
fint2c *status;


{
int j, i;

    *length = osuread(*fd, isthwd, *size);
    if ( *length == 0 ) *status = 1;
    else *status = (*length == -1) ? 3 : 0 ;

    j = *size/2;
    istcvh(isthwd,j,0);
    for (i=0; i< j; i++) buffer[i] = isthwd[i]; 

}

#if 0     /* ==== Original Code ==== */
SUBROUTINE ISTREC(fd,buffer,size,length,status)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      read record from tape. Each record contains character
              information in EBCDIC format. Characters are converted to ASCII.
.RETURN       error code: ok=0, 3=error on reading the tape
.ALGORITM     use osuread and osctr
--------------------------------------------------------------------*/
fint2c *fd;		/* IN: file descriptor */
CHARACTER buffer;	/* OUT: ASCII converted string */
fint2c *size;		/* IN: number of bytes to read */
fint2c *length;		/* OUT: number of bytes actually read */
fint2c *status;
#else     /* ==== Generated Code === */
#define ISTREC	istrec_
ISTREC(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */

    *PARAM(4,5,1,fint2c *) = osuread(*PARAM(1,5,0,fint2c *), istbyt, *PARAM(3,5,1,fint2c *));
    if ( *PARAM(4,5,1,fint2c *) == 0 ) *PARAM(5,5,1,fint2c *) = 1;
    else *PARAM(5,5,1,fint2c *) = (*PARAM(4,5,1,fint2c *) == -1) ? 3 : 0 ;

    osctr(istbyt,istbyt,*PARAM(3,5,1,fint2c *),ebc_to_asc); /* converts from EBCDIC to ASCII  */
    STRFCOPY(2,5,0,istbyt);                /* copy the string */
  ftoc_free(FORmark);    /* <forif> */
}

#if 0     /* ==== Original Code ==== */
SUBROUTINE ISDOPN(device,fd,status)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      open disk
.RETURN       error code: ok=0, error opening the tape=5
.ALGORITM     use the routine osdopen.
--------------------------------------------------------------------*/
CHARACTER   device;	/* IN: device name  */
fint2c *fd;		/* OUT: file descriptor */
fint2c *status;
#else     /* ==== Generated Code === */
#define ISDOPN	isdopn_
ISDOPN(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */

    char name[64], tpname[64],  devn[5];
    char *pc;
    int n;  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */

    strcpy(name,STRIPPED_STRING(1,3,0));
    *PARAM(2,3,1,fint2c *) = osdopen(name,READ);
    *PARAM(3,3,1,fint2c *) = (*PARAM(2,3,1,fint2c *) == -1) ? 5 : 0 ;
    ftoc_free(FORmark); /* <forif> */return 0;
}

#define ISDREW	isdrew_
ROUTINE ISDREW(fd,status) 
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      position b.o.f.
.RETURN       error code: ok=0, 8=error on tape
.ALGORITM     use osdseek
--------------------------------------------------------------------*/
fint2c *fd;		/* IN: file descriptor */
fint2c *status;
{
    *status = (osdseek(*fd, 0, FILE_START) == -1) ? 8 : 0;
}

#define ISDRBY	isdrby_
ROUTINE ISDRBY(fd,buffer,size,length,ioff,status)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      read record. The routine converts each byte into integer format.
.RETURN       error code: ok=0, 3=error 
.ALGORITM     use osdread
--------------------------------------------------------------------*/
fint2c *fd;		/* IN: file descriptor */
fint2c *buffer;		/* OUT: Ptr first element */
fint2c *size;		/* IN: number of bytes to read */
fint2c *length;		/* OUT: number of bytes actually read */
fint2c *ioff;             /* IN:  byte offset */
fint2c *status;
{
int i, isize;

    isize = *size+*ioff;
    *length = osdread(*fd, istbyt, isize);
    if ( *length == 0 ) *status = 1;
    else *status = (*length == -1) ? 3 : 0 ;
    
    for (i=0; i< *size; i++) buffer[i] = istbyt[i+*ioff]; 
}

#define ISDRB1	isdrb1_
ROUTINE ISDRB1(fd,buffer,size,length,ioff,status)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      read record without conversion.
.RETURN       error code: ok=0, 3=error on reading file
.ALGORITM     use osdread
--------------------------------------------------------------------*/

/* read pixels in byte format - output is byte */

fint2c *fd;		/* IN: file descriptor */
char *buffer;		/* OUT: Ptr first element */
fint2c *size;		/* IN: number of bytes to read */
fint2c *length;		/* OUT: number of bytes actually read */
fint2c *ioff;
fint2c *status;
{int isize, i;
    isize = *size + *ioff;
    *length = osdread(*fd, istbyt, isize);
    if ( *length == 0 ) *status = 1;
    else *status = (*length == -1) ? 3 : 0 ;
    for (i=0; i< *size; i++) buffer[i] = istbyt[i+*ioff]; 
}

#define ISDRHW	isdrhw_
ROUTINE ISDRHW(fd,buffer,size,length,ioff,status)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      read record. Pixels on tape are short integer format.
              Pixels are converted to int after byte swap if required.
.RETURN       error code: ok=0, 3=error on reading the record
.ALGORITM     use osdread
--------------------------------------------------------------------*/

/* read pixels in integer*2 - output is integer*4 with optional byte swap */

fint2c *fd;		/* IN: file descriptor */
fint2c *buffer;		/* OUT: Ptr first element */
fint2c *size;		/* IN: number of bytes to read */
fint2c *length;		/* OUT: number of bytes actually read */
fint2c *ioff;
fint2c *status;
{
int j, i, ioff2;


    *length = osdread(*fd, isthwd, *size+*ioff);
    if ( *length == 0 ) *status = 1;
    else *status = (*length == -1) ? 3 : 0 ;

    j = *size/2; ioff2 = (*ioff)/2;
    istcvh(isthwd,j+ioff2,0);
    for (i=0; i< j; i++) buffer[i] = isthwd[i+ioff2]; 

}

#define ISDRH1	isdrh1_
ROUTINE ISDRH1(fd,buffer,size,length,ioff,status)

/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      read record. Pixels on tape are short integer format.
              The routine performs byte swap if required.
.RETURN       error code: ok=0, 3=error on reading the record
.ALGORITM     use osdread
--------------------------------------------------------------------*/

fint2c *fd;		/* IN: file descriptor */
short *buffer;		/* OUT: Ptr first element */
fint2c *size;		/* IN: number of bytes to read */
fint2c *length;		/* OUT: number of bytes actually read */
fint2c *ioff;
fint2c *status;


{
int j, i, ioff2;

    *length = osdread(*fd, isthwd, *size+*ioff);
    if ( *length == 0 ) *status = 1;
    else *status = (*length == -1) ? 3 : 0 ;

    j = *size/2; ioff2 = (*ioff)/2;
    istcvh(isthwd,j+ioff2,0);
    for (i=0; i< j; i++) buffer[i] = isthwd[i+ioff2]; 

}

#if 0     /* ==== Original Code ==== */
SUBROUTINE ISDREC(fd,buffer,size,length,ioff,status)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      read record. Each record contains character
              information in EBCDIC format. Characters are converted to ASCII.
.RETURN       error code: ok=0, 3=error on reading the record
.ALGORITM     use osdread and osctr
--------------------------------------------------------------------*/
fint2c *fd;		/* IN: file descriptor */
CHARACTER buffer;	/* OUT: ASCII converted string */
fint2c *size;		/* IN: number of bytes to read */
fint2c *length;		/* OUT: number of bytes actually read */
fint2c *ioff;
fint2c *status;
#else     /* ==== Generated Code === */
#define ISDREC	isdrec_
ISDREC(va_alist) va_dcl 
{ va_list Cargs;
#endif    /* ======================= */
  int FORmark;           /* <forif> */
int isize, i;  va_start(Cargs);       /* <forif> */
  FORmark = ftoc_mark(); /* <forif> */


    isize = *PARAM(3,6,1,fint2c *)+*PARAM(5,6,1,fint2c *);
    *PARAM(4,6,1,fint2c *) = osdread(*PARAM(1,6,0,fint2c *), istbyt, isize);
    if ( *PARAM(4,6,1,fint2c *) == 0 ) *PARAM(6,6,1,fint2c *) = 1;
    else *PARAM(6,6,1,fint2c *) = (*PARAM(4,6,1,fint2c *) == -1) ? 3 : 0 ;

    osctr(istbyt,istbyt,isize,ebc_to_asc); /* converts from EBCDIC to ASCII  */

    STRFCOPY(2,6,0,&istbyt[*PARAM(5,6,1,fint2c *)]);                /* copy the string */
  ftoc_free(FORmark);    /* <forif> */
}

#define ISTCVI	istcvi_
ROUTINE ISTCVI()
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      initiate data conversion routines
.RETURN       error code: ok=0, 1=unknown format
.ALGORITM     Analyze internal and external data format definitions
              and setup static varibles to define conversion needed.
--------------------------------------------------------------------*/
{
  int   i, lbo[8], xbo[8], sa[8];
  int  n;

    efmt.ifmt = TWOS_COMP;
    efmt.bos = 12;
    samei2 = (cpu.ifmt == efmt.ifmt) && (cpu.bos == efmt.bos);

    return 0;
}

typedef union {                             /* union for conversion  */
		unsigned char   c[2];       /* bytes                 */
		short              s;       /* 2 byte integer        */
              } VI2;

int istcvh(pbuf,no,to)
/*++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
.PURPOSE      convert 2 byte integer array between different computers
.RETURN       error code: ok=0, 1=cannot convert
.ALGORITM     swap bytes between VAX - nonVAX machines
---------------------------------------------------------------------*/
      VI2      *pbuf;                  /* pointer to data array      */
      int         no;                  /* no. of values to convert   */
      int         to;                  /* true if convert to ext.fmt */
{
  register  unsigned char  byte;
  register  int               n;
  register  VI2             *pv;

  if (no<1 || samei2) return 0;        /* check if conversion needed */

  if (cpu.ifmt!=efmt.ifmt) return 1;      /* no format conversion    */

  if (cpu.bos!=efmt.bos) {                /* byte swap needed !      */
     n = no; pv = pbuf;
     while (n--) {                        /* loop through data array */
       byte = pv->c[0]; pv->c[0] = pv->c[1]; pv->c[1] = byte;
       pv++;
     }
  }

  return 0;
}