home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Vectronix 2
/
VECTRONIX2.iso
/
FILES_01
/
X_PROLOG.LZH
/
X_PROLOG
/
SOURCES
/
BIIO.C
< prev
next >
Wrap
C/C++ Source or Header
|
1990-08-13
|
9KB
|
449 lines
/*
* X PROLOG Vers. 2.0
*
*
* Written by : Andreas Toenne
* CS Dept. , IRB
* University of Dortmund, W-Germany
* <at@unido.uucp>
* <....!seismo!unido!at>
* <at@unido.bitnet>
*
* Copyright : This software is copyrighted by Andreas Toenne.
* Permission is granted hereby to copy the entire
* package including this copyright notice without fee.
*
*/
#include <stdio.h>
#include <ctype.h>
#include "prolog.h"
#include "extern.h"
#include "error.h"
extern term *int_copy(); /* terms */
extern term *term_copy(); /* terms */
extern term *read_term(); /* reader */
extern void display(); /* reader */
extern long eval(); /* bimath */
/* SEE(stream) */
short bisee(args)
term *args[];
{
short i;
if (ISVAR(args[0])) /* no var arguments */
BIERROR(EBAD);
if (! ISATOM(args[0])) /* need an atomic argument */
BIERROR(EBAD);
for (i=0; i<MAXSTREAMS; i++)
if (!(streams[i].status & CLOSED)
&& FUNC(args[0]) == FUNC(streams[i].atom)
&& streams[i].status & INPUT)
break;
if (i == MAXSTREAMS) /* new stream */
{
for (i=0; i<MAXSTREAMS && !(streams[i].status & CLOSED); i++);
if (i == MAXSTREAMS) /* no slot left */
FILEERROR(EIO); /* signal an error */
in = (stream *)&(streams[i]);
in->atom = args[0];
if ((in->fp = fopen(NAME(args[0]), "r")) == NULL)
FILEERROR(EIO);
in->status = INPUT;
}
else
{
in = (stream *)&(streams[i]);
if (ISFOROUTPUT(in) && FUNC(in->atom) != USERFUNCTOR)
FILEERROR(EIO);
}
return(TRUE);
}
/* SEEING(stream) */
short biseeing(args)
term *args[];
{
if (ISVAR(args[0])) /* must bind stream with in */
{
BIND_VAR(args[0], in->atom);
return(TRUE);
}
else
{
if (! ISATOM(args[0]))
BIERROR(EBAD);
return(FUNC(args[0]) == FUNC(in->atom));
}
}
/* SEEN */
short biseen(/* args */)
/* term *args[]; */
{
if (ISCLOSED(in)) /* cannot close closed stream */
FILEERROR(EIO);
if (FUNC(in->atom) == USERFUNCTOR)/* cannot close the user stream */
return(FALSE);
else
{
if (fclose(in->fp) <0) /* error while closeing */
FILEERROR(EIO);
in->status |= CLOSED;
in = (stream *)(&(streams[0]));
}
return(TRUE);
}
/* TELL(stream) */
short bitell(args)
term *args[];
{
short i;
if (ISVAR(args[0])) /* no var arguments */
BIERROR(EBAD);
if (! ISATOM(args[0]))
BIERROR(EBAD);
for (i=0; i<MAXSTREAMS; i++)
if (!(streams[i].status & CLOSED)
&& FUNC(args[0]) == FUNC(streams[i].atom)
&& streams[i].status & OUTPUT)
break;
if (i == MAXSTREAMS) /* new stream */
{
for (i=0; i<MAXSTREAMS && !(streams[i].status & CLOSED); i++);
if (i == MAXSTREAMS) /* no slot left */
FILEERROR(EIO); /* signal an error */
out = (stream *)(&(streams[i]));
out->atom = args[0];
if ((out->fp = fopen(NAME(args[0]), "w")) == NULL)
FILEERROR(EIO);
out->status = OUTPUT;
}
else
{
out = (stream *)(&(streams[i]));
if (ISFORINPUT(out) && FUNC(out->atom) != USERFUNCTOR)
FILEERROR(EIO);
}
return(TRUE);
}
/* TELLING(stream) */
short bitelling(args)
term *args[];
{
if (ISVAR(args[0])) /* must bind stream with out */
{
BIND_VAR(args[0], out->atom);
return(TRUE);
}
else
{
if (! ISATOM(args[0]))
BIERROR(EBAD);
return(FUNC(args[0]) == FUNC(out->atom));
}
}
/* TOLD */
short bitold(/* args */)
/* term *args[]; */
{
if (ISCLOSED(out)) /* cannot close closed stream */
FILEERROR(EIO);
if (FUNC(out->atom) == USERFUNCTOR)/* cannot close the user stream */
return(FALSE);
else
{
if (fclose(out->fp) <0) /* error while closeing */
FILEERROR(EIO);
out->status = CLOSED;
out = (stream *)(&(streams[1]));
}
return(TRUE);
}
/* CLOSE(stream) */
biclose(args)
term *args[];
{
if (! ISATOM(args[0]))
BIERROR(EBAD);
if (FUNC(args[0]) == FUNC(in->atom))
return(biseen());
else
if (FUNC(args[0]) == FUNC(out->atom))
return(bitold());
else
FILEERROR(EIO);
}
/* FILEERRORS */
short bifileerrors(/* args */)
/* term *args[]; */
{
io_errors = 1;
return(TRUE);
}
/* NOFILERRORS */
short binofileerrors(/* args */)
/* term *args[]; */
{
io_errors = 0;
return(TRUE);
}
/* EXISTS(stream) */
short biexists(args)
term *args[];
{
if (! ISATOM(args[0]))
BIERROR(EBAD);
return(!access(NAME(args[0]), 0));
}
/* RENAME(old, new) */
short birename(args)
term *args[];
{
term *old;
term *new;
char string[255];
old = args[0];
new = args[1];
if (! ISATOM(old) || ! ISATOM(new))
BIERROR(EBAD);
if (FUNC(new) == NILFUNCTOR)
{
if (unlink(NAME(old)) < 0)
FILEERROR(EIO);
return(TRUE);
}
sprintf(string, "mv %s %s", NAME(old), NAME(new));
if (system(string))
FILEERROR(EIO);
return(TRUE);
}
/* NL */
short binl( /* args */ )
/* term *args[]; */
{
putc('\n', out->fp);
return(TRUE);
}
/* GET0( ORD ) */
short biget0(args)
term *args[];
{
term *t;
if (! ISVAR(args[0]) && ! ISINT(args[0]))
BIERROR(EBAD);
if (ISATEOF(in)) /* already at the end-of-file */
FILEERROR(EEOF);
if ((lastc = getc(in->fp)) == EOF) /* at EOF */
{
in->status |= SEOF;
t = EOFATOM;
}
else
t = int_copy((long)lastc);
if (ISVAR(args[0]))
{
BIND_VAR(args[0], t);
return(TRUE);
}
else
return(VALUE(args[0]) == VALUE(t));
}
/* GET( ORD ) */
short biget(args)
term *args[];
{
term *t;
if (! ISVAR(args[0]) && ! ISINT(args[0]))
BIERROR(EBAD);
if (ISATEOF(in)) /* already at the end-of-file */
FILEERROR(EEOF);
while ((lastc = getc(in->fp)) != EOF && lastc < ' ');
if (lastc == EOF) /* at EOF */
{
in->status |= SEOF;
t = EOFATOM;
}
else
t = int_copy((long)lastc);
if (ISVAR(args[0]))
{
BIND_VAR(args[0], t);
return(TRUE);
}
else
return(VALUE(args[0]) == VALUE(t));
}
/* SKIP ( ORD ) */
short biskip(args)
term *args[];
{
char c;
if (! ISINT(args[0])) /* not proper argument */
BIERROR(EBAD);
if (ISATEOF(in)) /* already at the end-of-file */
FILEERROR(EEOF);
while ((c = getc(in->fp)) != EOF && c != (char)VALUE(args[0]));
if (c == EOF) /* at EOF */
{
in->status |= SEOF;
return(FALSE);
}
return(TRUE);
}
/* PUT (ord) */
short biput(args)
term *args[];
{
short l;
l = (short)eval(args[0]);
if (c_errno)
return(FALSE);
putc(l, out->fp);
return(TRUE);
}
/* TAB (ord) */
short bitab(args)
term *args[];
{
short i;
i = (short)eval(args[0]);
if (c_errno)
return(FALSE);
while (i--)
putc(' ', out->fp);
return(TRUE);
}
/* OP ( prio, operator, name) */
short biop(args)
term *args[];
{
unsigned short pre;
if (!ISINT(args[0]))
BIERROR(EBAD);
if (!ISATOM(args[1]) || !ISATOM(args[2]))
BIERROR(EBAD);
pre = (unsigned short)VALUE(args[0]);
if (pre < 0 || pre > 255) /* preceedence out of range */
return(FALSE);
add_operator(NAME(args[2]), FUNC(args[1]), pre);
return(TRUE);
}
/* READ ( term ) */
short biread(args)
term *args[];
{
term *t;
if (FUNC(in->atom) == USERFUNCTOR)
{
clearerr(in->fp);
in->status = INPUT; /* clear errors */
}
if (ISATEOF(in)) /* already at the end-of-file */
FILEERROR(EEOF);
t = read_term(); /* read it */
if (c_errno == EEOF) /* we reached EOF */
{
t = EOFATOM;
c_errno = 0; /* reset the error */
}
if (!t || c_errno) /* something strange */
return(FALSE);
return(term_unify(args[0], Topenv, t, Topenv));
}
/* WRITE ( term ) */
short biwrite(args)
term *args[];
{
display(args[0], Topenv, 255, TRUE, FALSE);
return(TRUE);
}
/* WRITEQ ( term ) */
short biwriteq(args)
term *args[];
{
display(args[0], Topenv, 255, TRUE, TRUE);
return(TRUE);
}
/* DISPLAY ( term ) */
short bidisplay(args)
term *args[];
{
display(args[0], Topenv, 255, FALSE, FALSE);
return(TRUE);
}