ardai@bass.bu.edu (Michael Ardai) (04/14/90)
Here is an os-specific module that I hacked together for VMS. It runs
under both 4.7 and 5.
/mike
/* vmsstuff.c - VMS specific routines */
#include "xlisp.h"
#include <descrip.h>
#include <iodef.h>
#include <ttdef.h>
#include <tt2def.h>
#define LBSIZE 200
static int tty_channel;
/* external variables */
extern LVAL s_unbound,true;
extern FILE *tfp;
extern int errno;
/* make sure we get a large stack */
int _stklen = 32766;
/* local variables */
static char lbuf[LBSIZE];
static int lpos[LBSIZE];
static int lindex;
static int lcount;
static int lposition;
static long rseed = 1L;
static char terminal_mode[12];
/* osinit - initialize */
osinit(banner)
char *banner;
{
char newmode[12];
short status_blk[4];
struct dsc$descriptor_s ttydesc = { 3, DSC$K_DTYPE_T, DSC$K_CLASS_S, "TT:" };
int *tmp;
printf("%s\n",banner);
printf("VMS version\n");
lposition = 0;
lindex = 0;
lcount = 0;
/* Read TTY mode and set to passthru so VMS won't trap control characters */
SYS$ASSIGN(&ttydesc, &tty_channel, 0, 0);
SYS$QIOW(0, tty_channel, IO$_SENSEMODE,
&status_blk[0], 0, 0, terminal_mode, 12, 0, 0, 0, 0);
memcpy(newmode, terminal_mode, 12);
tmp = &(newmode[8]);
*tmp |= TT2$M_PASTHRU;
tmp = &(newmode[4]);
*tmp |= TT$M_TTSYNC; /* So ^s/^q will work */
SYS$QIOW(0, tty_channel, IO$_SETMODE,
&status_blk[0], 0, 0, newmode, 12, 0, 0, 0, 0);
}
/* osfinish - clean up before returning to the operating system */
osfinish()
{
short status_blk[4];
/* Set terminal to how we found it */
SYS$QIOW(0, tty_channel, IO$_SETMODE,
&status_blk[0], 0, 0, terminal_mode, 12, 0, 0, 0, 0);
SYS$DASSGN(tty_channel);
}
/* oserror - print an error message */
oserror(msg)
char *msg;
{
printf("error: %s\n",msg);
}
/* osrand - return a random number between 0 and n-1 */
int osrand(n)
int n;
{
long k1;
/* make sure we don't get stuck at zero */
if (rseed == 0L) rseed = 1L;
/* algorithm taken from Dr. Dobbs Journal, November 1985, page 91 */
k1 = rseed / 127773L;
if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
rseed += 2147483647L;
/* return a random number between 0 and n-1 */
return ((int)(rseed % (long)n));
}
/* osaopen - open an ascii file */
FILE *osaopen(name,mode)
char *name,*mode;
{
return (fopen(name,mode));
}
/* osbopen - open a binary file */
FILE *osbopen(name,mode)
char *name,*mode;
{
return (fopen(name,mode));
}
/* osclose - close a file */
int osclose(fp)
FILE *fp;
{
return (fclose(fp));
}
/* osagetc - get a character from an ascii file */
int osagetc(fp)
FILE *fp;
{
return (getc(fp));
}
/* osaputc - put a character to an ascii file */
int osaputc(ch,fp)
int ch;
FILE *fp;
{
return (putc(ch,fp));
}
/* osbgetc - get a character from a binary file */
int osbgetc(fp)
FILE *fp;
{
return (getc(fp));
}
/* osbputc - put a character to a binary file */
int osbputc(ch,fp)
int ch;
FILE *fp;
{
return (putc(ch,fp));
}
/* ostgetc - get a character from the terminal */
int ostgetc()
{
int ch;
/* check for a buffered character */
if (lcount--)
return (lbuf[lindex++]);
/* get an input line */
for (lcount = 0; ; )
switch (ch = xgetc()) {
case '\r':
lbuf[lcount++] = '\n';
xputc('\r');
xputc('\n');
lposition = 0;
if (tfp)
for (lindex = 0; lindex < lcount; ++lindex)
osaputc(lbuf[lindex],tfp);
lindex = 0;
lcount--;
return (lbuf[lindex++]);
case '\010':
case '\177':
if (lcount) {
lcount--;
while (lposition > lpos[lcount]) {
xputc('\010');
xputc(' ');
xputc('\010');
lposition--;
}
}
break;
case '\032':
xflush();
return (EOF);
case '\024': /* control-t */
xinfo();
printf("\n ");
break;
default:
if (ch == '\t' || (ch >= 0x20 && ch < 0x7F)) {
lbuf[lcount] = ch;
lpos[lcount] = lposition;
if (ch == '\t')
do {
xputc(' ');
}
while (++lposition & 7);
else {
xputc(ch);
lposition++;
}
lcount++;
}
else {
xflush();
switch (ch) {
case '\003':
xltoplevel(); /* control-c */
case '\007':
xlcleanup(); /* control-g */
case '\020':
xlcontinue(); /* control-p */
case '\032':
return (EOF); /* control-z */
default:
return (ch);
}
}
}
}
/* ostputc - put a character to the terminal */
ostputc(ch)
int ch;
{
/* check for control characters */
oscheck();
/* output the character */
if (ch == '\n') {
xputc('\r');
xputc('\n');
lposition = 0;
}
else {
xputc(ch);
lposition++;
}
/* output the character to the transcript file */
if (tfp)
osaputc(ch,tfp);
}
/* osflush - flush the terminal input buffer */
osflush()
{
lindex = lcount = lposition = 0;
}
/* oscheck - check for control characters during execution */
oscheck()
{
int ch;
if (ch = xcheck())
switch (ch) {
case '\002': /* control-b */
xflush();
xlbreak("BREAK",s_unbound);
break;
case '\003': /* control-c */
xflush();
xltoplevel();
break;
case '\024': /* control-t */
xinfo();
break;
}
}
/* xinfo - show information on control-t */
static xinfo()
{
extern int nfree,gccalls;
extern long total;
char buf[80], tymebuf[20];
int tyme;
tyme = time(0);
strcpy(tymebuf, ctime(&tyme));
tymebuf[19] = '\0';
sprintf(buf,"\n[ %s Free: %d, GC calls: %d, Total: %ld ]",
tymebuf, nfree,gccalls,total);
errputstr(buf);
}
/* xflush - flush the input line buffer and start a new line */
static xflush()
{
osflush();
ostputc('\n');
}
/* xgetc - get a character from the terminal without echo */
static int xgetc()
{
short status_blk[4];
char ch;
SYS$QIOW(0, tty_channel, IO$M_NOECHO|IO$_READVBLK|IO$_READLBLK|IO$M_NOFILTR,
&status_blk[0], 0, 0, &ch, 1, 0, 0, 0, 0);
return(ch);
}
/* xputc - put a character to the terminal */
static xputc(ch)
int ch;
{
putchar(ch);
}
/* xcheck - check for a character */
static int xcheck()
{
short status_blk[4];
char blk[8], ch;
SYS$QIOW(0, tty_channel, IO$_SENSEMODE | IO$M_TYPEAHDCNT,
&status_blk[0], 0, 0, blk, 8, 0, 0, 0, 0);
if (blk[0] == 0) return(0);
return(xgetc());
}
/* xsystem - execute a system command */
LVAL xsystem()
{
char *cmd="";
if (moreargs())
cmd = (char *)getstring(xlgastring());
else
errputstr("\nSpawning. Type 'logout' to return to XLISP\n");
xllastarg();
return (system(cmd) == 0 ? true : cvfixnum((FIXTYPE)errno));
}
/* xgetkey - get a key from the keyboard */
LVAL xgetkey()
{
xllastarg();
return (cvfixnum((FIXTYPE)xgetc()));
}
/* ossymbols - enter os specific symbols */
ossymbols()
{
}
\|/ Michael L. Ardai ardai@bu-pub.bu.edu
--- ---------------------------------------------------------------
/|\ ...!sun!teda!maven.dnet!ardai (preferred)