/* OSCPM.H : #include me in (your-op-sys) version of CPM.c */
/* I am the Operating-system dependant part of CPM.c */

/* Decus C RSX version */

/*	EDIT HISTORY
pf01	6Aug84	osget() only returns `\n` at line end
		change so it flags to return `\r` then `\n`
pf02	15dec84	add osbcreate() osafbcreate() ossecput() to do binary
		output so we can import cp/m binary files
pf03	24dec84	use mode "Uw" for fopen of files-11 binary file in -b
		import of binary file. "w" is subtly dangerous: every
		so often it thinks it will improve your '\n's. "uw"
		is the only mode to trust in DECUS C binarys.
pf04	27Jan85	invent binbuf[BINSIZ] binlen binptr osbget() wilbmake()
		wilbnext() xwildmake() so I could output binary files
		from o/s to CPM
pf05	24mar85	invent cleanname(), name[]. make sure that any file names we try to
		read or write to files-11 are legal. add "static" liberally.
pf06	29jun85	Check that we have a SINGLE density floppy. Bomb if we don't.
		This protects user from terrors of DEC special electromagnetic
		vandalism, and their software's "compensation" of same.
*/

/*	B U G S

	The qsort() is in fact a bubble sort. Either fix using DECUS qsort or 
	do a real qsort. Not fixed yet because speed is no bother in this (f)utility.
*/

extern int $$ferr;

#define ERROR -1
#define LUN 7
#define EFN 7

static	FILE	*iptr;		/* input file */
static	FILE	*optr;		/* output file */
static	int	prl[6];		/* QIO parameter block */
static	int	isb[2];		/* I/O status block */
static	int	dsw;		/* directive status word */
#define 	BINSIZ 1024	/* maximum binary record size */		/*pf04*/
static	char	binbuf[BINSIZ];	/* binary record from o/s */			/*pf04*/
static	unsigned binlen;	/* size of binary record in binbuf */		/*pf04*/
static	char *	binptr;		/* next char of binbuf to send to caller */	/*pf04*/
static char	name[45];	/* holds files-11 compatible file name */	/*pf05*/

/* these are the basis for the rest of CPM.c */

cbegin()
BEGIN
int	devnam;
int	devunt;

	devnam = 'DY';
	devunt = 0;
	dsw = alun(LUN,devnam,devunt);
	IF	(dsw!=IS_SUC)
	THEN	error("Can't attach device! dsw=%oo devnam=%oo devunt=%oo",dsw,devnam,devunt);
	FI
	dsw = qiow(IO_ATT,LUN,EFN,isb,0,prl);
	IF	(dsw!=IS_SUC||(isb[0]&0xFF)!=IS_SUC)
	THEN	error("dsw=%oo isb[0]=%oo isb[1]=%oo \7IO_ATT",dsw,isb[0],isb[1]);
	FI
/*+pf06*/
	dsw = qiow(IO_SEC,LUN,EFN,isb,0,prl);
	IF	(dsw!=IS_SUC||(isb[0]&0xFF)!=IS_SUC)
	THEN	error("dsw=%oo isb=%oo%oo\7 IO_SEC",dsw,isb[0],isb[1]);
	FI
#define DENS (04000)	/* DENS in u.cw2 of DY: UCB for RSX-11 */
	IF	(isb[1]&DENS)
	THEN	error("\7diskette is double density. DEC says you lose.");
	FI
/*-pf06*/
#ifdef iosmd
	prl[0] = 0;	/* RX01 density: 3740 standard */
	dsw = qiow(IO_SMD,LUN,EFN,isb,0,prl);
	IF	(dsw!=IS_SUC||(isb[0]&0xFF)!=IS_SUC)
	THEN	error("dsw=%oo isb[0]=%oo isb[1]=%oo \7IO_SMD",dsw,isb[0],isb[1]);
	FI
#endif
END

cend()
BEGIN
END

cgetsec(secnum,sector)	/* read a sector */
int	secnum;		/* 0-org sector number
			   0th sector is the 1st director sector
			   i.e. skip boot tracks */
char	sector[128];
BEGIN
int	sect;		/* sector within track: 0:25 */
int	cylinder;	/* track */
#ifdef debug
int	i;
#endif

	sect = cxlate(secnum%26);
	cylinder = secnum/26 + 2;
	prl[0] = sector;
	prl[1] = 128;
	prl[4] = cylinder*26+sect;
#ifdef debug
	printf("\nsector number = %d.",prl[4]);
#endif
	dsw = qiow(IO_RPB,LUN,EFN,isb,0,prl);
	IF	(dsw!=IS_SUC||(isb[0]&0xFF)!=IS_SUC)
	THEN	error("dsw=%oo isb[0]=%oo isb[1]=%oo \7IO_RPB",dsw,isb[0],isb[1]);
	FI
#ifdef debug
	FOR	(i=0;	i<128;	i++)
	DO	IF	(!(i&0x1F))
		THEN	putchar('\n');
		FI
		printf("%2x",0xFF&sector[i]);
	OD
#endif
END

cputsec(secnum,sector)	/* write a sector */
int	secnum;		/* 0-org sector number
			   0th sector is the 1st director sector
			   i.e. skip boot tracks */
char	sector[128];
BEGIN
int	sect;		/* sector within track: 0:25 */
int	cylinder;	/* track */

	sect = cxlate(secnum%26);
	cylinder = secnum/26 + 2;
	prl[0] = sector;
	prl[1] = 128;
	prl[4] = cylinder*26+sect;
	dsw = qiow(IO_WPB,LUN,EFN,isb,0,prl);
	IF	(dsw!=IS_SUC||(isb[0]&0xFF)!=IS_SUC)
	THEN	error("dsw=%oo isb[0]=%oo isb[1]=%oo \7IO_WPB",dsw,isb[0],isb[1]);
	FI
END


int	oscreate(fname)		/* TRUE if OK */
char	*fname;
BEGIN
#ifdef debug
	printf("OSCREATE: fname=\"%s\"\n",fname);
#endif
	cleanname(fname);			/*pf05*/
	return	( optr = fopen(name,"w") );
END

int	osbcreate(fname)	/* TRUE if OK */
char	*fname;
BEGIN
	cleanname(fname);			/*pf05*/
	return	( optr = fopen(name,"uw") );	/* pf03 */
END

ossecput(sect)			/* output 1 CP/M sector */
char	sect[128];
BEGIN
	fput(sect,128,optr);
	IF	(ferror(optr))
	THEN	fprintf(stderr,"\7sector output failed: $$ferr=%oo\n",$$ferr);
	FI;
END

osput(c)			/* output 1 char */
char		c;
BEGIN
	IF	(c!='\r')
	THEN
	IF	(putc(c,optr)==EOF)
	THEN	error("osput failed: $$ferr=%oo c=%oo",$$ferr,c);
	FI
	FI
END

osafbcreate()
BEGIN
	osafcreate();
END

osafcreate()
BEGIN
	IF	(fclose(optr))
	THEN	error("osafopen: $$ferr=%oo",$$ferr);
	FI
END

int	osopen(fname)		/* TRUE if OK */
char	*fname;
BEGIN
	cleanname(fname);			/*pf05*/
	return	( iptr=fopen(name,"r"));
END

/*+pf05*/

cleanname(fname)
char *	fname;
BEGIN
char	c;
char *	p;

	FOR	(p=name;	c=*fname;	fname++,p++)
	DO	IF	( ! strchr("abcdefghijklmnopqrstuvwxyz0123456789$.",tolower(c)))
		THEN	c = 'q';	/* substitute q for any illegal char */
		FI
		*p = c;
	OD
	*p = EOS;
#ifdef debug
	printf("%s\n",name);
#endif
END
/*-pf05*/
				/*+pf01*/
static	BOOL	lineend;	/* TRUE: we have seen a `\n`
					 we have sent a `\r`
					 we must send a `\n` next time
					 osget() is called
				*/
				/*-pf01*/

int	osget()			/* input 1 char */
BEGIN
int	c;

				/*+pf01*/
	IF	(lineend)
	THEN	c='\n';
		lineend=FALSE;
	ELSE	c = getc(iptr);
		IF	(c==EOF)
		THEN	c = -1;
		ELSE	c = c & 0xFF;
			IF	(c=='\n')
			THEN	c = '\r';
				lineend = TRUE;
			FI
		FI
	FI
				/*-pf01*/
#ifdef debug
printf("c=%xx\n");
#endif
	return(c);
END

osafopen()
BEGIN
	IF	(fclose(iptr))
	THEN	error("osafopen: $$ferr=%oo",$$ferr);
	FI
END

/*+pf04*/
int	osbget()	/* call wilbmake() wilbnext() before using
			in:	iptr	input file opened on this
				binbuf
				binlen
				binptr
			out:	either -1 or a 8-bit character
			*/
BEGIN
	IF	(binptr>=binbuf+binlen)
	THEN	binlen = 0;
		WHILE	(!feof(iptr) && !binlen)
		DO	binlen = fget(binbuf,BINSIZ,iptr);
			IF	(ferror(iptr))
			THEN	error("read fail $$ferr=%oo\7",$$ferr);
			FI
		OD
		/* here with binary record of at least one char length
		   or end-of-file (binlen=0) */
		binptr = binbuf;
	FI
	IF	(binlen<=0)
	THEN	return(-1);
	ELSE	return(*binptr++ & 0xFF);
	FI
END
/*-pf04*/

/*  OH NO! not the WILD CARDS! */

wildmake()
BEGIN
	xwildmake("r");		/* let DECUS C diddle '\r's */		/*pf04*/
END

wilbmake()			/* like wildmake() but for binaries */
BEGIN									/*pf04*/
	xwildmake("ur");	/* binary image - no 'corrections' of '\r' */
END

xwildmake(openmode)	/* in:	wname
				openmode				  pf04
			   do:	set up for wild carding
			   out: nothing
			   kill:wname
			*/
char *	openmode;	/* typically "r" or "ur" */			/*pf04*/
BEGIN
char		*p;
char		*q;
char		wspec[40];
char		*dotp;

	FOR	(p=wspec,q=wname;	q<wname+8&&*q!=' ';	p++,q++)
	DO	*p = *q ? *q : '?' ;
	OD
	*p = 0;
	IF	(!strcmp(wspec,"????????"))
	THEN	strcpy(wspec,"*");
		p = wspec+1;
	FI
	dotp = p;
	*p ++ = '.';
	FOR	(q=wname+8;	q<wname+11 && *q!=' ';	p++,q++)
	DO	*p = *q ? *q : '?' ;
	OD
	*p++ = 0;
	IF	(!strcmp(dotp,".???"))
	THEN	strcpy(dotp,".*");
	FI
#ifdef debug
printf("wspec=\"%s\"\n",wspec);
#endif
	IF	(!(iptr=fwild(wspec,openmode)))				/*pf04*/
	THEN	error("Can't fwild \"%s\" - bad name",wspec);
	FI
END

int	wilbnext()							/*pf04*/
BEGIN									/*pf04*/
	binptr = binbuf + 2;						/*pf04*/
	binlen = 1;							/*pf04*/
	return(wildnext());						/*pf04*/
END									/*pf04*/

int	wildnext()	/* in:	
			   do:	find next wild-carded file
			   out:	infilnam	print name of file
				wname		FCB name of file
						i.e. trail spaces in name,type
			   ret:	TRUE if we got another file
			*/
BEGIN
char		*w;	/* wname */
int		retval;	/* returned value */
char		*p;
char		*q;

	IF	(retval=fnext(iptr))
	THEN	fgetname(iptr,infilnam);
		IF	(p=strrchr(infilnam,':'))
		THEN	p++;
		ELSE	p = infilnam;
		FI
		IF	(q=strrchr(p,']'))
		THEN	p = q+1;
		FI
		FOR	(w=wname;	w<wname+8;	w++)
		DO	IF	(isdigit(*p) || isalpha(*p))
			THEN	*w = toupper(*p++);
			ELSE	*w = ' ';
			FI
		OD
		IF	(*p=='.')
		THEN	p++;
		FI
		FOR	(	;	w<wname+11;	w++)
		DO	IF	(isdigit(*p) || isalpha(*p))
			THEN	*w = toupper(*p++);
			ELSE	*w = ' ';
			FI
		OD
					/*+pf01*/
		lineend = FALSE;	/* new file - reset state of osget() */
					/*-pf01*/
	FI
#ifdef	debug
printf("retval=%xx infilnam=\"%s\"\n",retval,infilnam);
#endif
	return(retval);
END


/* pashunfingaz quicksort routine: he does not trust DECUS C */

qsort(array,nlm,esize,compare)
char	*array;
int	nlm;
int	esize;
int	(*compare)();
BEGIN
char	*end,*base,*roam,*p,*q,*ebase;
char	c;

	end = array + nlm*esize;
	FOR	(base=array;	base<end;	base+=esize)
	DO	FOR	(roam=base;	roam<end;	roam+=esize)
		DO	IF	((*compare)(base,roam)>0)
			THEN	ebase = base + esize;
				FOR	(p=base,q=roam;	p<ebase;	p++,q++)
				DO	c=*p;
					*p=*q;
					*q=c;
				OD
			FI
		OD
	OD
END
#undef debug
