home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / XSCHEME2.ZIP / os.c < prev    next >
Text File  |  1992-05-02  |  7KB  |  359 lines
  1. /* os.c - OS specific routines */
  2. /* modified for OS/2 under C Set/2 */
  3.  
  4. #include "xscheme.h"
  5. #define M_I386
  6.  
  7. #ifdef M_I386
  8. #include "conio.h"
  9. #include "signal.h"
  10. #endif
  11.  
  12. #define LBSIZE 200
  13.  
  14. #ifndef M_I386
  15. unsigned _stklen=16384;
  16. #endif
  17.  
  18. /* external variables */
  19. extern LVAL s_unbound,true;
  20. extern FILE *tfp;
  21. extern int errno;
  22.  
  23. /* local variables */
  24. static char lbuf[LBSIZE];
  25. static int lpos[LBSIZE];
  26. static int lindex;
  27. static int lcount;
  28. static int lposition;
  29. static long rseed = 1L;
  30.  
  31. /* osinit - initialize */
  32. osinit(banner)
  33.   char *banner;
  34. {
  35.     fputs(banner,stdout);
  36.     lposition = 0;
  37.     lindex = 0;
  38.     lcount = 0;
  39.  
  40. #ifdef M_I386
  41.   signal(SIGINT, SIG_IGN);  /* Disable Cntl-C from terminating this app.*/
  42. #endif
  43. }
  44.  
  45. /* osfinish - clean up before returning to the operating system */
  46. osfinish()
  47. {
  48. }
  49.  
  50. /* oserror - print an error message */
  51. oserror(msg)
  52.   char *msg;
  53. {
  54.     printf("error: %s\n",msg);
  55. }
  56.  
  57. /* osrand - return a random number between 0 and n-1 */
  58. int osrand(n)
  59.   int n;
  60. {
  61.     long k1;
  62.  
  63.     /* make sure we don't get stuck at zero */
  64.     if (rseed == 0L) rseed = 1L;
  65.  
  66.     /* algorithm taken from Dr. Dobbs Journal, November 1985, page 91 */
  67.     k1 = rseed / 127773L;
  68.     if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
  69.     rseed += 2147483647L;
  70.  
  71.     /* return a random number between 0 and n-1 */
  72.     return ((int)(rseed % (long)n));
  73. }
  74.  
  75. /* osaopen - open an ascii file */
  76. FILE *osaopen(name,mode)
  77.   char *name,*mode;
  78. {
  79.     return (fopen(name,mode));
  80. }
  81.  
  82. /* osbopen - open a binary file */
  83. FILE *osbopen(name,mode)
  84.   char *name,*mode;
  85. {
  86.     char bmode[10];
  87.     strcpy(bmode,mode); strcat(bmode,"b");
  88.     return (fopen(name,bmode));
  89. }
  90.  
  91. /* osclose - close a file */
  92. int osclose(fp)
  93.   FILE *fp;
  94. {
  95.     return (fclose(fp));
  96. }
  97.  
  98. /* ostell - get the current file position */
  99. long ostell(fp)
  100.   FILE *fp;
  101. {
  102.     return (ftell(fp));
  103. }
  104.  
  105. /* osseek - set the current file position */
  106. int osseek(fp,offset,whence)
  107.   FILE *fp; long offset; int whence;
  108. {
  109.     return (fseek(fp,offset,whence));
  110. }
  111.  
  112. /* osagetc - get a character from an ascii file */
  113. int osagetc(fp)
  114.   FILE *fp;
  115. {
  116.     return (getc(fp));
  117. }
  118.  
  119. /* osaputc - put a character to an ascii file */
  120. int osaputc(ch,fp)
  121.   int ch; FILE *fp;
  122. {
  123.     return (putc(ch,fp));
  124. }
  125.  
  126. /* osbgetc - get a character from a binary file */
  127. int osbgetc(fp)
  128.   FILE *fp;
  129. {
  130.     return (getc(fp));
  131. }
  132.  
  133. /* osbputc - put a character to a binary file */
  134. int osbputc(ch,fp)
  135.   int ch; FILE *fp;
  136. {
  137.     return (putc(ch,fp));
  138. }
  139.  
  140. /* ostgetc - get a character from the terminal */
  141. int ostgetc()
  142. {
  143.     int ch;
  144.  
  145.     /* check for a buffered character */
  146.     if (lcount--)
  147.     return (lbuf[lindex++]);
  148.  
  149.     /* get an input line */
  150.     for (lcount = 0; ; )
  151.     switch (ch = xgetc()) {
  152.     case '\r':
  153.         lbuf[lcount++] = '\n';
  154.         xputc('\r'); xputc('\n'); lposition = 0;
  155.         if (tfp)
  156.             for (lindex = 0; lindex < lcount; ++lindex)
  157.             osaputc(lbuf[lindex],tfp);
  158.         lindex = 0; lcount--;
  159.         return (lbuf[lindex++]);
  160.     case '\010':
  161.     case '\177':
  162.         if (lcount) {
  163.             lcount--;
  164.             while (lposition > lpos[lcount]) {
  165.             xputc('\010'); xputc(' '); xputc('\010');
  166.             lposition--;
  167.             }
  168.         }
  169.         break;
  170.     case '\032':
  171.         xflush();
  172.         return (EOF);
  173.     default:
  174.         if (ch == '\t' || (ch >= 0x20 && ch < 0x7F)) {
  175.             lbuf[lcount] = ch;
  176.             lpos[lcount] = lposition;
  177.             if (ch == '\t')
  178.             do {
  179.                 xputc(' ');
  180.             } while (++lposition & 7);
  181.             else {
  182.             xputc(ch); lposition++;
  183.             }
  184.             lcount++;
  185.         }
  186.         else {
  187.             xflush();
  188.             switch (ch) {
  189.             case '\003':    xltoplevel();    /* control-c */
  190.             case '\007':    xlcleanup();    /* control-g */
  191.             case '\020':    xlcontinue();    /* control-p */
  192.             case '\032':    return (EOF);    /* control-z */
  193.             default:        return (ch);
  194.             }
  195.         }
  196.     }
  197. }
  198.  
  199. /* ostputc - put a character to the terminal */
  200. ostputc(ch)
  201.   int ch;
  202. {
  203.     /* check for control characters */
  204.     oscheck();
  205.  
  206.     /* output the character */
  207.     if (ch == '\n') {
  208.     xputc('\r'); xputc('\n');
  209.     lposition = 0;
  210.     }
  211.     else {
  212.     xputc(ch);
  213.     lposition++;
  214.    }
  215.  
  216.    /* output the character to the transcript file */
  217.    if (tfp)
  218.     osaputc(ch,tfp);
  219. }
  220.  
  221. /* osflush - flush the terminal input buffer */
  222. osflush()
  223. {
  224.     lindex = lcount = lposition = 0;
  225. }
  226.  
  227. /* oscheck - check for control characters during execution */
  228. oscheck()
  229. {
  230.     int ch;
  231.     if (ch = xcheck())
  232.     switch (ch) {
  233.     case '\002':    /* control-b */
  234.         xflush();
  235.         xlbreak("BREAK",s_unbound);
  236.         break;
  237.     case '\003':    /* control-c */
  238.         xflush();
  239.         xltoplevel();
  240.         break;
  241.     case '\024':    /* control-t */
  242.         xinfo();
  243.         break;
  244.     case '\023':    /* control-s */
  245.         while (xcheck() != '\021')
  246.         ;
  247.         break;
  248.     }
  249. }
  250.  
  251. /* xinfo - show information on control-t */
  252. static xinfo()
  253. {
  254.  
  255.     extern int nfree,gccalls;
  256.     extern long total;
  257.     char buf[80];
  258.     sprintf(buf,"\n[ Free: %d, GC calls: %d, Total: %ld ]",
  259.         nfree,gccalls,total);
  260.     errputstr(buf);
  261.  
  262. }
  263.  
  264. /* xflush - flush the input line buffer and start a new line */
  265. static xflush()
  266. {
  267.     osflush();
  268.     ostputc('\n');
  269. }
  270.  
  271. /* xgetc - get a character from the terminal without echo */
  272. static int xgetc()
  273. {
  274. #ifdef M_I386
  275.     int i;
  276.  
  277.     i = getch();
  278.  
  279.     if (i == -1)
  280.       return (3);
  281.     else
  282.       return (i & 0x00FF);
  283. #else
  284.     return (bdos(7) & 0xFF);
  285. #endif
  286. }
  287.  
  288. /* xputc - put a character to the terminal */
  289. static xputc(ch)
  290.   int ch;
  291. {
  292. #ifdef M_I386
  293.     putch(ch);
  294. #else
  295.     bdos(6,ch,0);
  296. #endif
  297. }
  298.  
  299. /* xcheck - check for a character */
  300.  
  301. static int xcheck()
  302. {
  303. #ifdef M_I386
  304.     if (kbhit())
  305.       {
  306.       int i;
  307.  
  308.       i = getch();
  309.  
  310.       if (i == -1)
  311.     return (3);
  312.       else
  313.     return(i & 0x00FF);
  314.       }
  315.     else
  316.       return (0);
  317. #else
  318.     return (bdos(6,0xFF,0) & 0xFF);
  319. #endif
  320. }
  321.  
  322.  
  323. /* getnext - get the next fixnum from a list */
  324. static int getnext(plist)
  325.   LVAL *plist;
  326. {
  327.     LVAL val;
  328.     if (consp(*plist)) {
  329.         val = car(*plist);
  330.     *plist = cdr(*plist);
  331.     if (!fixp(val))
  332.         xlerror("expecting an integer",val);
  333.         return ((int)getfixnum(val));
  334.     }
  335.     return (0);
  336. }
  337.  
  338. /* xsystem - execute a system command */
  339. LVAL xsystem()
  340. {
  341.     char *cmd="COMMAND";
  342.     if (moreargs())
  343.     cmd = (char *)getstring(xlgastring());
  344.     xllastarg();
  345.     return (system(cmd) == 0 ? true : cvfixnum((FIXTYPE)errno));
  346. }
  347.  
  348. /* xgetkey - get a key from the keyboard */
  349. LVAL xgetkey()
  350. {
  351.     xllastarg();
  352.     return (cvfixnum((FIXTYPE)xgetc()));
  353. }
  354.  
  355. /* ossymbols - enter os specific symbols */
  356. ossymbols()
  357. {
  358. }
  359.