mirror of
https://github.com/cookiengineer/audacity
synced 2025-10-21 06:01:13 +02:00
Move library tree where it belongs
This commit is contained in:
ra
242
lib-src/libnyquist/nyquist/xlisp/xlio.c
Normal file
242
lib-src/libnyquist/nyquist/xlisp/xlio.c
Normal file
@@ -0,0 +1,242 @@
|
||||
/* xlio - xlisp i/o routines */
|
||||
/* Copyright (c) 1985, by David Michael Betz
|
||||
All Rights Reserved
|
||||
Permission is granted for unrestricted non-commercial use */
|
||||
|
||||
/* CHANGE LOG
|
||||
* --------------------------------------------------------------------
|
||||
* 28Apr03 dm eliminate some compiler warnings
|
||||
*/
|
||||
|
||||
#include "xlisp.h"
|
||||
|
||||
/* external variables */
|
||||
extern LVAL s_stdin,s_stdout,s_stderr,s_debugio,s_traceout,s_unbound;
|
||||
extern int xlfsize;
|
||||
|
||||
#ifdef DEBUG_INPUT
|
||||
extern FILE *read_by_xlisp;
|
||||
#endif
|
||||
|
||||
/* xlgetc - get a character from a file or stream */
|
||||
int xlgetc(LVAL fptr)
|
||||
{
|
||||
LVAL lptr, cptr=NULL;
|
||||
FILE *fp;
|
||||
int ch;
|
||||
|
||||
/* check for input from nil */
|
||||
if (fptr == NIL)
|
||||
ch = EOF;
|
||||
|
||||
/* otherwise, check for input from a stream */
|
||||
else if (ustreamp(fptr)) {
|
||||
if ((lptr = gethead(fptr)) == NIL)
|
||||
ch = EOF;
|
||||
else {
|
||||
if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
|
||||
xlfail("bad stream");
|
||||
sethead(fptr,lptr = cdr(lptr));
|
||||
if (lptr == NIL)
|
||||
settail(fptr,NIL);
|
||||
ch = getchcode(cptr);
|
||||
}
|
||||
}
|
||||
|
||||
/* otherwise, check for a buffered character */
|
||||
else if ((ch = getsavech(fptr)))
|
||||
setsavech(fptr,'\0');
|
||||
|
||||
/* otherwise, check for terminal input or file input */
|
||||
else {
|
||||
fp = getfile(fptr);
|
||||
if (fp == stdin || fp == STDERR)
|
||||
ch = ostgetc();
|
||||
else
|
||||
ch = osagetc(fp);
|
||||
#ifdef DEBUG_INPUT
|
||||
if (read_by_xlisp && ch != -1) {
|
||||
putc(ch, read_by_xlisp);
|
||||
}
|
||||
#endif
|
||||
}
|
||||
|
||||
/* return the character */
|
||||
return (ch);
|
||||
}
|
||||
|
||||
/* xlungetc - unget a character */
|
||||
void xlungetc(LVAL fptr, int ch)
|
||||
{
|
||||
LVAL lptr;
|
||||
|
||||
/* check for ungetc from nil */
|
||||
if (fptr == NIL)
|
||||
;
|
||||
|
||||
/* otherwise, check for ungetc to a stream */
|
||||
if (ustreamp(fptr)) {
|
||||
if (ch != EOF) {
|
||||
lptr = cons(cvchar(ch),gethead(fptr));
|
||||
if (gethead(fptr) == NIL)
|
||||
settail(fptr,lptr);
|
||||
sethead(fptr,lptr);
|
||||
}
|
||||
}
|
||||
|
||||
/* otherwise, it must be a file */
|
||||
else
|
||||
setsavech(fptr,ch);
|
||||
}
|
||||
|
||||
/* xlpeek - peek at a character from a file or stream */
|
||||
int xlpeek(LVAL fptr)
|
||||
{
|
||||
LVAL lptr, cptr=NULL;
|
||||
int ch;
|
||||
|
||||
/* check for input from nil */
|
||||
if (fptr == NIL)
|
||||
ch = EOF;
|
||||
|
||||
/* otherwise, check for input from a stream */
|
||||
else if (ustreamp(fptr)) {
|
||||
if ((lptr = gethead(fptr)) == NIL)
|
||||
ch = EOF;
|
||||
else {
|
||||
if (!consp(lptr) || (cptr = car(lptr)) == NIL || !charp(cptr))
|
||||
xlfail("bad stream");
|
||||
ch = getchcode(cptr);
|
||||
}
|
||||
}
|
||||
|
||||
/* otherwise, get the next file character and save it */
|
||||
else {
|
||||
ch = xlgetc(fptr);
|
||||
setsavech(fptr,ch);
|
||||
}
|
||||
|
||||
/* return the character */
|
||||
return (ch);
|
||||
}
|
||||
|
||||
/* xlputc - put a character to a file or stream */
|
||||
void xlputc(LVAL fptr, int ch)
|
||||
{
|
||||
LVAL lptr;
|
||||
FILE *fp;
|
||||
|
||||
/* count the character */
|
||||
++xlfsize;
|
||||
|
||||
/* check for output to nil */
|
||||
if (fptr == NIL)
|
||||
;
|
||||
|
||||
/* otherwise, check for output to an unnamed stream */
|
||||
else if (ustreamp(fptr)) {
|
||||
lptr = consa(cvchar(ch));
|
||||
if (gettail(fptr))
|
||||
rplacd(gettail(fptr),lptr);
|
||||
else
|
||||
sethead(fptr,lptr);
|
||||
settail(fptr,lptr);
|
||||
}
|
||||
|
||||
/* otherwise, check for terminal output or file output */
|
||||
else {
|
||||
fp = getfile(fptr);
|
||||
if (!fp)
|
||||
xlfail("file not open");
|
||||
else if (fp == stdout || fp == STDERR)
|
||||
ostputc(ch);
|
||||
else
|
||||
osaputc(ch,fp);
|
||||
}
|
||||
}
|
||||
|
||||
/* xloutflush -- flush output buffer */
|
||||
void xloutflush(LVAL fptr)
|
||||
{
|
||||
FILE *fp;
|
||||
|
||||
/* check for output to nil or unnamed stream */
|
||||
if (fptr == NIL || ustreamp(fptr))
|
||||
;
|
||||
|
||||
/* otherwise, check for terminal output or file output */
|
||||
else {
|
||||
fp = getfile(fptr);
|
||||
if (!fp)
|
||||
xlfail("file not open");
|
||||
else if (fp == stdout || fp == STDERR)
|
||||
ostoutflush();
|
||||
else
|
||||
osoutflush(fp);
|
||||
}
|
||||
}
|
||||
|
||||
/* xlflush - flush the input buffer */
|
||||
void xlflush(void)
|
||||
{
|
||||
osflush();
|
||||
}
|
||||
|
||||
/* stdprint - print to *standard-output* */
|
||||
void stdprint(LVAL expr)
|
||||
{
|
||||
xlprint(getvalue(s_stdout),expr,TRUE);
|
||||
xlterpri(getvalue(s_stdout));
|
||||
}
|
||||
|
||||
/* stdputstr - print a string to *standard-output* */
|
||||
void stdputstr(char *str)
|
||||
{
|
||||
xlputstr(getvalue(s_stdout),str);
|
||||
}
|
||||
|
||||
/* stdflush - flush the *standard-output* buffer */
|
||||
void stdflush()
|
||||
{
|
||||
xloutflush(getvalue(s_stdout));
|
||||
}
|
||||
|
||||
/* errprint - print to *error-output* */
|
||||
void errprint(LVAL expr)
|
||||
{
|
||||
xlprint(getvalue(s_stderr),expr,TRUE);
|
||||
xlterpri(getvalue(s_stderr));
|
||||
}
|
||||
|
||||
/* errputstr - print a string to *error-output* */
|
||||
void errputstr(char *str)
|
||||
{
|
||||
xlputstr(getvalue(s_stderr),str);
|
||||
}
|
||||
|
||||
/* dbgprint - print to *debug-io* */
|
||||
void dbgprint(LVAL expr)
|
||||
{
|
||||
xlprint(getvalue(s_debugio),expr,TRUE);
|
||||
xlterpri(getvalue(s_debugio));
|
||||
}
|
||||
|
||||
/* dbgputstr - print a string to *debug-io* */
|
||||
void dbgputstr(char *str)
|
||||
{
|
||||
xlputstr(getvalue(s_debugio),str);
|
||||
}
|
||||
|
||||
/* trcprin1 - print to *trace-output* */
|
||||
void trcprin1(LVAL expr)
|
||||
{
|
||||
xlprint(getvalue(s_traceout),expr,TRUE);
|
||||
}
|
||||
|
||||
/* trcputstr - print a string to *trace-output* */
|
||||
void trcputstr(char *str)
|
||||
{
|
||||
xlputstr(getvalue(s_traceout),str);
|
||||
}
|
||||
|
||||
|
||||
Reference in New Issue
Block a user