home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / languages / scheme / xscheme028 / c / unixstuff < prev    next >
Encoding:
Text File  |  1991-12-05  |  4.3 KB  |  236 lines
  1. /* unixstuff.c - unix specific routines */
  2.  
  3. #include "xscheme.h"
  4. #include <time.h>
  5.  
  6. #define LBSIZE 200
  7.  
  8. /* external variables */
  9. extern LVAL s_unbound;
  10. LVAL true_lval=TRUE;
  11. extern FILE *tfp;
  12. extern int errno;
  13.  
  14. /* local variables */
  15. static char lbuf[LBSIZE];
  16. /* static int lpos[LBSIZE]; */
  17. static int lindex;
  18. static int lcount;
  19. static long rseed = 1L;
  20.  
  21. /* osinit - initialize */
  22. osinit(banner)
  23.   char *banner;
  24. {
  25.     printf("%s\n",banner);
  26.     lindex = 0;
  27.     lcount = 0;
  28. /*     osinterrupts (-1);   SB Mod for RISC OS */
  29. }
  30.  
  31. /* osfinish - clean up before returning to the operating system */
  32. osfinish()
  33. {
  34. }
  35.  
  36. /* oserror - print an error message */
  37. oserror(msg)
  38.   char *msg;
  39. {
  40.     printf("xscheme error: %s\n",msg);
  41. }
  42.  
  43. /* osrand - return a random number between 0 and n-1 */
  44. int osrand(n)
  45.   int n;
  46. {
  47.     long k1;
  48.  
  49.     if (n <= 0)
  50.       xlerror("RANDOM: argument must be >= 1", cvfixnum(n));
  51.  
  52.     /* make sure we don't get stuck at zero */
  53.     if (rseed == 0L) rseed = 1L;
  54.  
  55.     /* algorithm taken from Dr. Dobbs Journal, November 1985, page 91 */
  56.     k1 = rseed / 127773L;
  57.     if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
  58.         rseed += 2147483647L;
  59.  
  60.     /* return a random number between 0 and n-1 */
  61.     return ((int)(rseed % (long)n));
  62. }
  63.  
  64. /* osaopen - open an ascii file */
  65. FILE *osaopen(name,mode)
  66.   char *name,*mode;
  67. {
  68.     return (fopen(name,mode));
  69. }
  70.  
  71. /* osbopen - open a binary file */
  72. FILE *osbopen(name,mode)
  73.   char *name,*mode;
  74. {
  75.     return (fopen(name,mode));
  76. }
  77.  
  78. /* osclose - close a file */
  79. int osclose(fp)
  80.   FILE *fp;
  81. {
  82.     return (fclose(fp));
  83. }
  84.  
  85. /* ostell - get the current file position */
  86. long ostell(fp)
  87.   FILE *fp;
  88. {
  89.     return (ftell(fp));
  90. }
  91.  
  92. /* osseek - set the current file position */
  93. int osseek(fp,offset,whence)
  94.   FILE *fp; long offset; int whence;
  95. {
  96.     return (fseek(fp,offset,whence));
  97. }
  98.  
  99. /* osagetc - get a character from an ascii file */
  100. int osagetc(fp)
  101.   FILE *fp;
  102. {
  103.     return (getc(fp));
  104. }
  105.  
  106. /* osaputc - put a character to an ascii file */
  107. int osaputc(ch,fp)
  108.   int ch; FILE *fp;
  109. {
  110.     return (putc(ch,fp));
  111. }
  112.  
  113. /* osbgetc - get a character from a binary file */
  114. int osbgetc(fp)
  115.   FILE *fp;
  116. {
  117.     return (getc(fp));
  118. }
  119.  
  120. /* osbputc - put a character to a binary file */
  121. int osbputc(ch,fp)
  122.   int ch; FILE *fp;
  123. {
  124.     return (putc(ch,fp));
  125. }
  126. #include <errno.h>
  127.  
  128. /* ostgetc - get a character from the terminal */
  129. int ostgetc()
  130. {
  131.     /* int ch; */
  132.  
  133.     /* check for a buffered character */
  134.     if (lcount--)
  135.         return (lbuf[lindex++]);
  136.  
  137.     /* get an input line */
  138. #ifdef IRIS4D
  139.     do {
  140.       errno = 0;
  141.       if (fgets(lbuf,LBSIZE,stdin) == NULL)
  142.         {
  143.           osflush ();
  144.           return EOF;
  145.         }
  146.     } while (((lcount = strlen(lbuf)) == 0) || (errno == EINTR));
  147. #else
  148.     do {
  149.         fgets(lbuf,LBSIZE,stdin);
  150.     } while ((lcount = strlen(lbuf)) == 0);
  151. #endif
  152.  
  153.     /* write it to the transcript file */
  154.     if (tfp)
  155.         for (lindex = 0; lindex < lcount; ++lindex)
  156.             osaputc(lbuf[lindex],tfp);
  157.     lindex = 0; lcount--;
  158.  
  159.     /* return the first character */
  160.     return (lbuf[lindex++]);
  161. }
  162.  
  163. /* ostputc - put a character to the terminal */
  164. ostputc(ch)
  165.   int ch;
  166. {
  167.     /* check for control characters */
  168.     oscheck();
  169.  
  170.     /* output the character */
  171.     putchar(ch);
  172.  
  173.     /* output the character to the transcript file */
  174.     if (tfp)
  175.         osaputc(ch,tfp);
  176. }
  177.  
  178. /* ostputs - output a string to the terminal */
  179. void ostputs(str)
  180.   char *str;
  181. {
  182.     while (*str != '\0')
  183.     ostputc(*str++);
  184. }
  185.  
  186. /* osflush - flush the terminal input buffer */
  187. osflush()
  188. {
  189.     lindex = lcount = 0;
  190. }
  191.  
  192. /* oscheck - check for control characters during execution */
  193. oscheck()
  194. {
  195. }
  196.  
  197. /* xsystem - execute a system command */
  198. LVAL xsystem()
  199. {
  200.     char *cmd="gos";
  201.     if (moreargs())
  202.         cmd = (char *)getstring(xlgastring());
  203.     xllastarg();
  204.     return (system(cmd) == 0 ? true_lval : cvfixnum((FIXTYPE)errno));
  205. }
  206.  
  207. /* ossymbols - enter os specific symbols */
  208. ossymbols()
  209. {
  210. }
  211.  
  212. /* xtime - get the current time */
  213. LVAL xtime()
  214. {
  215.     xllastarg();
  216.     return (cvfixnum((FIXTYPE)time((time_t)0)));
  217. }
  218.  
  219. /* xdifftime - get the difference between two time values */
  220. LVAL xdifftime()
  221. {
  222.     time_t t1,t2;
  223.     LVAL val;
  224.     val = xlgafixnum(); t1 = (time_t)getfixnum(val);
  225.     val = xlgafixnum(); t2 = (time_t)getfixnum(val);
  226.     xllastarg();
  227.     return (cvflonum((FLOTYPE)difftime(t1,t2)));
  228. }
  229.  
  230. /* main - the main routine */
  231. void main(argc,argv)
  232.   int argc; char *argv[];
  233. {
  234.     xlmain(argc,argv);
  235. }
  236.