The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "longptr.h"
#include "mpefile.h"
#include <mpe.h>
#include <limits.h>
/* #include <stdio.h>   /* STDIO for testing only */
#define MAXPARMS 41

/* static FILE *dbg; /* For testing  only */

static int mpestatus;
static int maxwaitreclen;
static int lastwaitfilenum;

#define ARRAYLIMIT 100
static int reclens[ARRAYLIMIT];
HV *hashreclen;

static void
setreclen(int file, int reclen)
{
  if (file >= 0 && file < ARRAYLIMIT) {
      reclens[file] = reclen;
  } else {
    SV *sreclen = newSViv(reclen);
    int hashkey=0;
    if (!hashreclen)
      hashreclen = newHV();
    hv_store(hashreclen, (char*)&file, sizeof(file), sreclen, hashkey);
  }
}



static void
seterrmpe(int status)
{
   int create=1;
   SV *exterr;
   char buffer[256];
   int buflength;
   short len;
   exterr = get_sv("MPE::File::MPE_error", create);
   if (status >= 0 && status <=65535) {
      short fserrorcode=status;
      FERRMSG(&fserrorcode, buffer, &len);
      buffer[len] = '\0';
   } else {
      int status1;
      len = sizeof(buffer) - 1;
      HPERRMSG(7, 3, 0, 0, status,
	                  buffer, &len, &status1);
      buffer[len] = '\0';
   }
   sv_setpvn(exterr, buffer, len);
   sv_setiv(exterr, status);
   SvPOK_on(exterr);
}

static int
getreclen(int file)
{
  int result=0;
  if (file >= 0 && file < ARRAYLIMIT) {
      result = reclens[file];
  } else {
    SV **val=NULL;
    if (hashreclen)
      val = hv_fetch(hashreclen, (char*)&file, sizeof(file), 0);
    if (val)
      result = SvIV(*val);
  }
  return result;
}

static void
savestats(int file)
{
  aoptions aopts;
  short shortreclen;
  int   reclen;
  int access;
  int chompout;
  int rectype;

  FFILEINFO(file, 3, &aopts, 4, &shortreclen, 67, &reclen,
	  90,&rectype,0, NULL);
  if (ccode() == CCE) {
    if (rectype == 9) {
       reclen = LINE_MAX;
    } else if (shortreclen) {
      if (shortreclen<0)
	reclen = - shortreclen;
      else
	reclen = 2 * shortreclen;
    }
    if (aopts.as.no_wait) {
      int access= aopts.as.access;
      if (access<1 || access > 3) {
	if (reclen > maxwaitreclen)
	  maxwaitreclen = reclen;
      }
    }
    setreclen(file, reclen);
  } else {
    /* who knows ? */
  }
}


MODULE = MPE::File		PACKAGE = MPE::File		
short
mpefopen(name, fopt, aopt)
    char *name
    short fopt
    short aopt
  PROTOTYPE: $$$
  CODE:
    RETVAL = FOPEN(name, fopt, aopt,0,0,0,0,0,0,0,0,0,0);
    if (ccode() != CCE) {
      short shorterr;
      FCHECK(RETVAL, &shorterr,0,0,0);
      seterrmpe(shorterr);
    } else {
      savestats(RETVAL);
    }
  OUTPUT:
    RETVAL
    

int
mpehpfopen(...)
   PROTOTYPE: $$;@
   PREINIT:
       int  extraitems;
       int  parm[MAXPARMS];
       char *parmval[MAXPARMS];
       char isalloced[MAXPARMS];
       int  intparms[MAXPARMS];
       int nparms;
       int itemsin;
       int i;
       int dummylen;
       int intfilenum;
       STRLEN len;
       SV *svparmval;
   CODE:
       itemsin = 0;
       intfilenum = 0;
       mpestatus = 0;
       
       for (nparms=0; nparms<MAXPARMS && itemsin<items; nparms++, itemsin+=2) {
	 parm[nparms] = sv_iv(ST(itemsin));
         svparmval = ST(itemsin+1);
	 switch (parm[nparms]) {
	   case  2:
	   case  8:
	   case 22:
	   case 23:
	   case 25:
	   case 26:
	   case 28:
	   case 31:
	   case 32:
	   case 42:
	   case 52:
	     isalloced[nparms] = 1;
	     New(413, parmval[nparms], 2+SvCUR(svparmval),char);
	     sprintf(parmval[nparms], "%c%s", 0, SvPVX(svparmval));
	     break;

	   case 43: /* UFID */
	   case 45: /* fill char */
	   case 51: /* Pascal string */
	   case 54: /* KSAM parm */
	     isalloced[nparms] = 0;
	     parmval[nparms] = SvPVX(svparmval);

	     break;


	   case 64:
	     isalloced[nparms] = 0;
	     parmval[nparms] = SvPVX(svparmval);
	     if (parmval[nparms][SvCUR(svparmval)] != '\r') {
	       isalloced[nparms] = 1;
	       New(413, parmval[nparms], 2+SvCUR(svparmval),char);
	       sprintf(parmval[nparms], "%s\r", SvPVX(svparmval));
	     } 
	     break;

	   case 18:
	   default:
	       isalloced[nparms] = 0;
	       parmval[nparms] = (char *)&intparms[nparms];
	       intparms[nparms] = SvIV(svparmval);

	 }
       }
       if (nparms < MAXPARMS) {
         parm[nparms] = 0;
       }
       HPFOPEN(2+2*nparms,
	    &intfilenum, &mpestatus,
	    parm[0],	parmval[0],
	    parm[1],	parmval[1],
	    parm[2],	parmval[2],
	    parm[3],	parmval[3],
	    parm[4],	parmval[4],
	    parm[5],	parmval[5],
	    parm[6],	parmval[6],
	    parm[7],	parmval[7],
	    parm[8],	parmval[8],
	    parm[9],	parmval[9],
	    parm[10],	parmval[10],
	    parm[11],	parmval[11],
	    parm[12],	parmval[12],
	    parm[13],	parmval[13],
	    parm[14],	parmval[14],
	    parm[15],	parmval[15],
	    parm[16],	parmval[16],
	    parm[17],	parmval[17],
	    parm[18],	parmval[18],
	    parm[19],	parmval[19],
	    parm[20],	parmval[20],
	    parm[21],	parmval[21],
	    parm[22],	parmval[22],
	    parm[23],	parmval[23],
	    parm[24],	parmval[24],
	    parm[25],	parmval[25],
	    parm[26],	parmval[26],
	    parm[27],	parmval[27],
	    parm[28],	parmval[28],
	    parm[29],	parmval[29],
	    parm[30],	parmval[30],
	    parm[31],	parmval[31],
	    parm[32],	parmval[32],
	    parm[33],	parmval[33],
	    parm[34],	parmval[34],
	    parm[35],	parmval[35],
	    parm[36],	parmval[36],
	    parm[37],	parmval[37],
	    parm[38],	parmval[38],
	    parm[39],	parmval[39],
	    parm[40],	parmval[40],
	    parm[41],	parmval[41]);

	  
	  /* freeing Memory */
	  for (i=0; i<nparms; i++) {
	    if (isalloced[i]) {
	      Safefree(parmval[i]);
	    }
	  }

	 /*
	  sv_setiv(filenum, intfilenum);
	  sv_setiv(status, mpestatus);
	  */
	  if (mpestatus) {
	    seterrmpe(mpestatus);
	  }

	  if (intfilenum) {
	    savestats(intfilenum);
	  }

	RETVAL = intfilenum;
   OUTPUT:
     RETVAL

int
mpeffileinfo(filenum, item1, item1o, item2, item2o, item3, item3o, item4, item4o, item5, item5o)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
    short item1
    char *item1o
    short item2
    char *item2o
    short item3
    char *item3o
    short item4
    char *item4o
    short item5
    char *item5o
  CODE:
      FFILEINFO(filenum, item1, item1o, item2, item2o, item3, item3o, item4, item4o, item5, item5o);
     RETVAL = (ccode() == CCE);
     if (!RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
       mpestatus = shorterr;
     }
  OUTPUT:
    RETVAL

int
mpeflabelinfo(name, mode, items, itemsout, itemerror)
    char *name
    short mode
    char *items
    char *itemsout
    char *itemerror
  CODE:
  {
    short fserr=0;
    FLABELINFO(name, mode, &fserr, items, itemsout, itemerror);
    if (fserr) {
      seterrmpe(fserr);
    }
    RETVAL = !fserr;
  }
  OUTPUT:
     RETVAL


int
mpe_fileno(filenum)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
  CODE:
    RETVAL = filenum;
  OUTPUT:
    RETVAL

SV *
readrec(filenum)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
  CODE:
  {
    short reclen = getreclen(filenum);
    char *buf = alloca(reclen);
    reclen = FREAD(filenum, longaddr(buf), -reclen);
    if (ccode() == CCE) {
      buf[reclen] = '\0';
      RETVAL = newSVpvn(buf, reclen);
    } else {
      short shorterr;
      FCHECK(filenum, &shorterr,0,0,0);
      seterrmpe(shorterr);
      RETVAL = &PL_sv_undef;
    }
  }
  OUTPUT:
    RETVAL

int
writerec(filenum, buffer, ...)
      short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
      SV *buffer
  CODE:
  {
     short cctl=0;
     int reclen;
     char *bufptr;
     if (items>2)
         cctl=SvIV(ST(2));
     bufptr = SvPV(buffer, reclen);
     if (reclen > 32767) {
       reclen /= 2;
     } else {
       reclen = -reclen;
     }
     FWRITE(filenum, longaddr(bufptr), (short)reclen, cctl);
     RETVAL = (ccode() == CCE);
     if (!RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
       mpestatus = shorterr;
     }
  }
  OUTPUT:
    RETVAL



int
hperrmsg(displaycode,...)
    int displaycode
   PROTOTYPE: $;@
   CODE:
   {
      int depth=0;
      int errornum=0;
      SV *buffer=NULL;
      char *pbuf;
      short buflength=0;
      int status=0;
      int parm_ct;
      if (items>1) {
	depth = SvIV(ST(1));

	if (items > 3) {
	  errornum = SvIV(ST(3));
	  if (items > 4) {
	    buffer = ST(4);
	    if (items == 5) {
	      buflength = 256;
	    } else {
	      buflength = SvIV(ST(5));
	    }
	  }
	}
      }

       if (buffer == NULL || SvREADONLY(buffer)) {
         pbuf = NULL;
       } else {
         int dummylen;
	 SvPV_force(buffer, dummylen);
	 pbuf = SvGROW(buffer, buflength+1);
       }

	parm_ct = items;

   	HPERRMSG(parm_ct, displaycode, depth, 0, errornum,
	                  pbuf, &buflength, &status);
	if (buflength) {
	  pbuf[buflength] = '\0';  
	  SvPOK_on(buffer);
	  SvCUR_set(buffer, buflength);
	}
	if (items==7) {
	  sv_setiv(ST(6), status);
	}
	if (status) {
	  seterrmpe(status);
	}
	RETVAL = !status;
   }
   OUTPUT:
     RETVAL

int
fread(filenum, buffer, bufsize)
       short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
       SV *buffer
       short bufsize
   PROTOTYPE: $$$
   CODE:
   {
     int tmplen;
     longpointer lpbuf;
     int dummylen;
     if (bufsize < 0)
       tmplen = -bufsize;
     else
       tmplen = 2 * bufsize;
     SvPV_force(buffer, dummylen);
     SvGROW(buffer, tmplen);
     lpbuf = longaddr(SvPVX(buffer));

     RETVAL = FREAD(filenum, lpbuf, bufsize);
     if (ccode() != CCE) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
     }
     SvCUR_set(buffer, RETVAL);
  }
  OUTPUT:
       RETVAL

int
ccode()

 
int
fcheck(...)
  CODE:
  {
    short filenum=0;
    short fserrorcode;
    short translog;
    int   blocknum;
    short numrecs;

    if (items > 0) {
      filenum = SvIV(SvROK(ST(0))?SvRV(ST(0)):ST(0));
    }
    FCHECK(filenum,&fserrorcode,&translog,&blocknum,&numrecs);
    RETVAL = (ccode() == CCE);

    if (items>1) {
      if (!SvREADONLY(ST(1)))
	  sv_setiv(ST(1), fserrorcode);
      if (items>2) {
	if (!SvREADONLY(ST(2)))
	    sv_setiv(ST(2), translog);
	if (items>3) {
	  if (!SvREADONLY(ST(3)))
	      sv_setiv(ST(3), blocknum);
	  if (items>4) {
	    if (!SvREADONLY(ST(4)))
		sv_setiv(ST(4), numrecs);
	  }
	}
      }
    }
  }
  OUTPUT:
    RETVAL

int
fwrite(filenum, buffer, length, controlcode)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
    char  *buffer
    short length
    short controlcode
  PROTOTYPE: $$$$
  CODE:
    FWRITE(filenum, longaddr(buffer), length, controlcode);
    RETVAL = (ccode() == CCE);
    if (!RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
    }
  OUTPUT:
       RETVAL


int
mpeprint(buffer, ...)
    SV  *buffer
  PROTOTYPE: $;$$
  CODE:
    int length;
    short cctl=0;
    char *bufptr=SvPV(buffer, length);

    if (items>1 && SvIOK(ST(1))) {
      length=SvIV(ST(1));
    } else {
      length = -length;
    }
    if (items>2 && SvIOK(ST(2))) {
      cctl=SvIV(ST(2));
    }
    PRINT(longaddr(bufptr), (short)length, cctl);
    RETVAL = (ccode() == CCE);
    if (!RETVAL) {
       short shorterr;
       FCHECK(0, &shorterr,0,0,0);
       seterrmpe(shorterr);
    }
  OUTPUT:
       RETVAL


SV *
printopreply (buffer)
    SV  *buffer
  PROTOTYPE: $
  CODE: 
  {
    int length;
    char *bufptr=SvPV(buffer, length);
    char reply[32];
    short lenread;

    memset(reply, 0, sizeof reply);

    lenread=PRINTOPREPLY(bufptr, -(short)length, 0, reply, 31);
    if (ccode() != CCE) {
       short shorterr;
       FCHECK(0, &shorterr,0,0,0);
       seterrmpe(shorterr);
	RETVAL = &PL_sv_undef;
    } else {
      reply[lenread] = '\0';
      RETVAL = newSVpvn(reply, lenread);
    }
  }
  OUTPUT:
    RETVAL

int
printop(buffer, ...)
    SV  *buffer
  PROTOTYPE: $;$$
  CODE:
    int length;
    short cctl=0;
    char *bufptr=SvPV(buffer, length);

    if (items>1 && SvIOK(ST(1))) {
      length=SvIV(ST(1));
    } else {
      length = -length;
    }
    if (items>2 && SvIOK(ST(2))) {
      cctl=SvIV(ST(2));
    }
    PRINTOP(bufptr, (short)length, cctl);
    RETVAL = (ccode() == CCE);
    if (!RETVAL) {
       short shorterr;
       FCHECK(0, &shorterr,0,0,0);
       seterrmpe(shorterr);
    }
  OUTPUT:
       RETVAL



int
fclose(filenum, disposition, securitycode)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
    short disposition
    short securitycode
  PROTOTYPE: $$$
  CODE:
    FCLOSE(filenum, disposition, securitycode);
    RETVAL = (ccode() == CCE);
    if (RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
    }
  OUTPUT:
       RETVAL


int
flock(filenum, lockflag)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
    unsigned short lockflag
  PROTOTYPE: $$
  CODE:
    FLOCK(filenum, lockflag);
    RETVAL = (ccode() == CCE);
    if (RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
    }
  OUTPUT:
       RETVAL

int
funlock(filenum)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
  PROTOTYPE: $
  CODE:
    FUNLOCK(filenum);
    RETVAL = (ccode() == CCE);
    if (RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
    }
  OUTPUT:
       RETVAL

int
fpoint(filenum,lrecnum)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
    int lrecnum
  PROTOTYPE: $$
  CODE:
    FPOINT(filenum, lrecnum);
    RETVAL = (ccode() == CCE);
    if (RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
    }
  OUTPUT:
       RETVAL


int
fcontrol(filenum,itemnum,item)
  short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
  short itemnum
  SV  *item
  PROTOTYPE: $$$
  CODE:
  {
    unsigned short sitem=SvIV(item);
    FCONTROL(filenum,itemnum,longaddr(&sitem));
    RETVAL = (ccode() == CCE);
    if (RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
    }
    if (sitem != SvIV(item))
      sv_setiv(item, sitem);
  }
  OUTPUT:
    RETVAL

int
fdelete(filenum, ...)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
  PROTOTYPE: $;@
  CODE:
  {
     long lrecnum=-1;
     if (items>1)
         lrecnum=SvIV(ST(1));
     FDELETE(filenum, lrecnum);
     RETVAL = (ccode() == CCE);
     if (RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
     }
  }
  OUTPUT:
    RETVAL



SV *
ferrmsg(fserrorcode)
    int fserrorcode
  PROTOTYPE: $
  CODE:
    if (fserrorcode >= 0 && fserrorcode <=65535) {
      short shorterr=fserrorcode;
      char buffer[74];
      short len;
      FERRMSG(&shorterr, buffer, &len);
      buffer[len] = '\0';
      RETVAL = newSVpvn(buffer, len);
    } else {
      char buffer[256];
      short  buflength = sizeof(buffer) - 1;
      int status;
      HPERRMSG(7, 3, 0, 0, fserrorcode,
	                  buffer, &buflength, &status);
      buffer[buflength] = '\0';  
      RETVAL = newSVpvn(buffer, buflength);
    }
  OUTPUT:
    RETVAL


void
printfileinfo(filenum)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
  PROTOTYPE: $
  CODE:
    PRINTFILEINFO(filenum);


SV *
iowait(filenum)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
  CODE:
  {
     short reclen;
     char *buf;
     if (filenum == 0) {
        reclen = maxwaitreclen;
     } else {
       reclen = getreclen(filenum);
     }
     buf = alloca(reclen);
     lastwaitfilenum = IOWAIT(filenum, longaddr(buf), &reclen, 0);
     if (ccode() == CCE) {
       RETVAL = newSVpvn(buf, reclen);
     } else {
      short shorterr;
      FCHECK(lastwaitfilenum, &shorterr,0,0,0);
      seterrmpe(shorterr);
      RETVAL = &PL_sv_undef;
    }
  }
  OUTPUT:
    RETVAL
 
SV *
iodontwait(filenum)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
  CODE:
  {
     short reclen;
     char *buf;
     if (filenum == 0) {
        reclen = maxwaitreclen;
     } else {
       reclen = getreclen(filenum);
     }
     buf = alloca(reclen);
     lastwaitfilenum = IODONTWAIT(filenum, longaddr(buf), &reclen, 0);
     if (ccode() == CCE) {
       RETVAL = newSVpvn(buf, reclen);
     } else {
      short shorterr;
      FCHECK(lastwaitfilenum, &shorterr,0,0,0);
      seterrmpe(shorterr);
      RETVAL = &PL_sv_undef;
    }
  }
  OUTPUT:
    RETVAL
 
int
mpe_iowait(filenum,buffer,length,cstation)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
    SV *buffer
    SV *length
    SV *cstation
  PROTOTYPE: $$$$
  CODE:
  {
    longpointer lpbuf = longaddr(SvPVX(buffer));
    short _length;
    short _cstation;
    IOWAIT(filenum, lpbuf, &_length, &_cstation);
    RETVAL = (ccode() == CCE);
    if (!RETVAL) {
      short shorterr;
      FCHECK(filenum, &shorterr,0,0,0);
      seterrmpe(shorterr);
    }
    SvCUR_set(buffer, _length);
    sv_setiv(length, _length);
    sv_setiv(cstation, _cstation);
  }
  OUTPUT:
    RETVAL

int
mpe_iodontwait(filenum,buffer,length,cstation)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
    SV *buffer
    SV *length
    SV *cstation
  PROTOTYPE: $$$$
  CODE:
  {
    longpointer lpbuf = longaddr(SvPVX(buffer));
    short _length;
    short _cstation;
    IODONTWAIT(filenum, lpbuf, &_length, &_cstation);
    RETVAL = (ccode() == CCE);
    if (!RETVAL) {
      short shorterr;
      FCHECK(filenum, &shorterr,0,0,0);
      seterrmpe(shorterr);
    }
    SvCUR_set(buffer, _length);
    sv_setiv(length, _length);
    sv_setiv(cstation, _cstation);
  }
  OUTPUT:
    RETVAL



int
ffindbykey( filenum,value,location,length,relop)
       short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
       char *value
       short location
       short length
       short relop
   CODE:
     FFINDBYKEY(filenum, longaddr(value), location, length, relop);
     RETVAL = (ccode() == CCE);
     if (!RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
       mpestatus = shorterr;
     }
   OUTPUT:
     RETVAL



int
fgetkeyinfo(filenum, param, control)
       short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
       SV *param
       SV *control
    CODE:
    {
      int dummylen;
      SvPV_force(param, dummylen);
      SvGROW(param, 162);
      SvPV_force(control, dummylen);
      SvGROW(control, 256);
      FGETKEYINFO(filenum, SvPVX(param), SvPVX(control));
     RETVAL = (ccode() == CCE);
     if (!RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
       mpestatus = shorterr;
     }
    }
   OUTPUT:
     RETVAL


SV *
freaddir(filenum, lrecnum)
     short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
     int lrecnum
  CODE:
  {
    short reclen = getreclen(filenum);
    char *buf = alloca(reclen);
    FREADDIR(filenum, longaddr(buf), -reclen, lrecnum);
    if (ccode() == CCE) {
      buf[reclen] = '\0';
      RETVAL = newSVpvn(buf, reclen);
    } else {
      short shorterr;
      FCHECK(filenum, &shorterr,0,0,0);
      seterrmpe(shorterr);
      RETVAL = &PL_sv_undef;
    }
  }
  OUTPUT:
    RETVAL


SV *
freadlabel(filenum, ...)
     short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
  CODE:
  {
    short labelid;
    char *buf = alloca(257);
    FREADLABEL(filenum, longaddr(buf), 128, labelid);
    if (items>2)
	 labelid=SvIV(ST(2));
    if (ccode() == CCE) {
      buf[256] = '\0';
      RETVAL = newSVpvn(buf, 256);
    } else {
      short shorterr;
      FCHECK(filenum, &shorterr,0,0,0);
      seterrmpe(shorterr);
      RETVAL = &PL_sv_undef;
    }
  }
  OUTPUT:
    RETVAL


int
fremove(filenum)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
  CODE:
     FREMOVE(filenum);
     RETVAL = (ccode() == CCE);
     if (!RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
       mpestatus = shorterr;
     }
  OUTPUT:
    RETVAL


int
fsetmode(filenum, modeflags)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
    unsigned short modeflags;
  CODE:
     FSETMODE(filenum, modeflags);
     RETVAL = (ccode() == CCE);
     if (!RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
       mpestatus = shorterr;
     }
  OUTPUT:
    RETVAL


int
fwritedir(filenum, buffer, lrecnum)
      short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
      SV *buffer
      int lrecnum
  CODE:
  {
     short cctl=0;
     short reclen;
     if (SvCUR(buffer) > 32767) {
       reclen = SvCUR(buffer)/2;
     } else {
       reclen = -SvCUR(buffer);
     }
     FWRITEDIR(filenum, longaddr(SvPVX(buffer)), reclen, lrecnum);
     RETVAL = (ccode() == CCE);
     if (!RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
       mpestatus = shorterr;
     }
  }
  OUTPUT:
    RETVAL



int
fupdate(filenum, buffer)
      short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
      SV *buffer
  CODE:
  {
     short cctl=0;
     short reclen;
     if (SvCUR(buffer) > 32767) {
       reclen = SvCUR(buffer)/2;
     } else {
       reclen = -SvCUR(buffer);
     }
     FUPDATE(filenum, longaddr(SvPVX(buffer)), reclen);
     RETVAL = (ccode() == CCE);
     if (!RETVAL) {
       short shorterr;
       FCHECK(filenum, &shorterr,0,0,0);
       seterrmpe(shorterr);
       mpestatus = shorterr;
     }
  }
  OUTPUT:
    RETVAL


SV *
freadbykey(filenum, key, keyloc)
     short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
     char *key
     short keyloc
  CODE:
  {
    short reclen = getreclen(filenum);
    char *buf = alloca(reclen);
    reclen = FREADBYKEY(filenum, longaddr(buf), -reclen, 
	               longaddr(key), keyloc);
    if (ccode() == CCE) {
      buf[reclen] = '\0';
      RETVAL = newSVpvn(buf, reclen);
    } else {
      short shorterr;
      FCHECK(filenum, &shorterr,0,0,0);
      seterrmpe(shorterr);
      RETVAL = &PL_sv_undef;
    }
  }
  OUTPUT:
    RETVAL


SV *
freadc(filenum)
    short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
  CODE:
  {
    short reclen = getreclen(filenum);
    char *buf = alloca(reclen);
    reclen = FREAD(filenum, longaddr(buf), -reclen);
    if (ccode() == CCE) {
      buf[reclen] = '\0';
      RETVAL = newSVpvn(buf, reclen);
    } else {
      short shorterr;
      FCHECK(filenum, &shorterr,0,0,0);
      seterrmpe(shorterr);
      RETVAL = &PL_sv_undef;
    }
  }
  OUTPUT:
    RETVAL

int
lastwaitfilenum()
  CODE:
    RETVAL = lastwaitfilenum;
  OUTPUT:
    RETVAL

int
fwritelabel(filenum, svbuf, ...)
      short filenum = SvIV(SvROK($arg)?SvRV($arg):$arg);
      SV *svbuf
    CODE:
    {
      int len;
      short labelid=0;
      char *buf = SvPV(svbuf, len);
      if (items>2)
	   labelid=SvIV(ST(2));
      if (len>256) {
	len = 128;
      } else {
	len = (1+len)/2;
      }
      FWRITELABEL(filenum, longaddr(buf), len, labelid);
      RETVAL = (ccode() == CCE);
      if (!RETVAL) {
        short shorterr;
        FCHECK(filenum, &shorterr,0,0,0);
        seterrmpe(shorterr);
        mpestatus = shorterr;
      }
    }
  OUTPUT:
    RETVAL