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