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