home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / drdobbs / 1991 / 08 / xscheme / msstuff.c < prev    next >
Text File  |  1991-06-04  |  10KB  |  449 lines
  1. /* msstuff.c - ms-dos specific routines */
  2.  
  3. #ifdef NOTDEF
  4. #include <dos.h>
  5. #endif
  6. #include <time.h>
  7. #include "xscheme.h"
  8.  
  9. #define LBSIZE 200
  10.  
  11. unsigned _stklen=16384;
  12.  
  13. /* external variables */
  14. extern LVAL s_unbound,true;
  15. extern FILE *tfp;
  16. #ifdef CODEBLDR
  17. #include <errno.h>
  18. #else
  19. extern int errno;
  20. #endif
  21.  
  22. /* local variables */
  23. static char lbuf[LBSIZE];
  24. static int lpos[LBSIZE];
  25. static int lindex;
  26. static int lcount;
  27. static int lposition;
  28. static long rseed = 1L;
  29.  
  30. #ifdef __STDC__
  31. static void xinfo(void);
  32. static void xflush(void);
  33. static int xgetc(void);
  34. static void xputc(int ch);
  35. static int xcheck(void);
  36. #endif
  37.  
  38. /* main - the main routine */
  39. void main(argc,argv)
  40.   int argc; char *argv[];
  41. {
  42.     xlmain(argc,argv);
  43. }
  44.  
  45. /* osinit - initialize */
  46. void osinit(banner)
  47.   char *banner;
  48. {
  49.     ostputs(banner);
  50.     ostputc('\n');
  51.     lposition = 0;
  52.     lindex = 0;
  53.     lcount = 0;
  54. }
  55.  
  56. /* osfinish - clean up before returning to the operating system */
  57. void osfinish()
  58. {
  59. }
  60.  
  61. /* oserror - print an error message */
  62. void oserror(msg)
  63.   char *msg;
  64. {
  65.     ostputs("error: ");
  66.     ostputs(msg);
  67.     ostputc('\n');
  68. }
  69.  
  70. /* osrand - return a random number between 0 and n-1 */
  71. int osrand(n)
  72.   int n;
  73. {
  74.     long k1;
  75.  
  76.     /* make sure we don't get stuck at zero */
  77.     if (rseed == 0L) rseed = 1L;
  78.  
  79.     /* algorithm taken from Dr. Dobbs Journal, November 1985, page 91 */
  80.     k1 = rseed / 127773L;
  81.     if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
  82.     rseed += 2147483647L;
  83.  
  84.     /* return a random number between 0 and n-1 */
  85.     return ((int)(rseed % (long)n));
  86. }
  87.  
  88. /* osaopen - open an ascii file */
  89. FILE *osaopen(name,mode)
  90.   char *name,*mode;
  91. {
  92.     return (fopen(name,mode));
  93. }
  94.  
  95. /* osbopen - open a binary file */
  96. FILE *osbopen(name,mode)
  97.   char *name,*mode;
  98. {
  99.     char bmode[10];
  100.     strcpy(bmode,mode); strcat(bmode,"b");
  101.     return (fopen(name,bmode));
  102. }
  103.  
  104. /* osclose - close a file */
  105. int osclose(fp)
  106.   FILE *fp;
  107. {
  108.     return (fclose(fp));
  109. }
  110.  
  111. /* ostell - get the current file position */
  112. long ostell(fp)
  113.   FILE *fp;
  114. {
  115.     return (ftell(fp));
  116. }
  117.  
  118. /* osseek - set the current file position */
  119. int osseek(fp,offset,whence)
  120.   FILE *fp; long offset; int whence;
  121. {
  122.     return (fseek(fp,offset,whence));
  123. }
  124.  
  125. /* osagetc - get a character from an ascii file */
  126. int osagetc(fp)
  127.   FILE *fp;
  128. {
  129.     return (getc(fp));
  130. }
  131.  
  132. /* osaputc - put a character to an ascii file */
  133. int osaputc(ch,fp)
  134.   int ch; FILE *fp;
  135. {
  136.     return (putc(ch,fp));
  137. }
  138.  
  139. /* osbgetc - get a character from a binary file */
  140. int osbgetc(fp)
  141.   FILE *fp;
  142. {
  143.     return (getc(fp));
  144. }
  145.  
  146. /* osbputc - put a character to a binary file */
  147. int osbputc(ch,fp)
  148.   int ch; FILE *fp;
  149. {
  150.     return (putc(ch,fp));
  151. }
  152.  
  153. /* ostgetc - get a character from the terminal */
  154. int ostgetc()
  155. {
  156.     int ch;
  157.  
  158.     /* check for a buffered character */
  159.     if (lcount--)
  160.     return (lbuf[lindex++]);
  161.  
  162.     /* get an input line */
  163.     for (lcount = 0; ; )
  164.     switch (ch = xgetc()) {
  165.     case '\r':
  166.         lbuf[lcount++] = '\n';
  167.         xputc('\r'); xputc('\n'); lposition = 0;
  168.         if (tfp)
  169.             for (lindex = 0; lindex < lcount; ++lindex)
  170.             osaputc(lbuf[lindex],tfp);
  171.         lindex = 0; lcount--;
  172.         return (lbuf[lindex++]);
  173.     case '\010':
  174.     case '\177':
  175.         if (lcount) {
  176.             lcount--;
  177.             while (lposition > lpos[lcount]) {
  178.             xputc('\010'); xputc(' '); xputc('\010');
  179.             lposition--;
  180.             }
  181.         }
  182.         break;
  183.     case '\032':
  184.         xflush();
  185.         return (EOF);
  186.     default:
  187.         if (ch == '\t' || (ch >= 0x20 && ch < 0x7F)) {
  188.             lbuf[lcount] = ch;
  189.             lpos[lcount] = lposition;
  190.             if (ch == '\t')
  191.             do {
  192.                 xputc(' ');
  193.             } while (++lposition & 7);
  194.             else {
  195.             xputc(ch); lposition++;
  196.             }
  197.             lcount++;
  198.         }
  199.         else {
  200.             xflush();
  201.             switch (ch) {
  202.             case '\003':    xltoplevel();    /* control-c */
  203.             case '\007':    xlcleanup();    /* control-g */
  204.             case '\020':    xlcontinue();    /* control-p */
  205.             case '\032':    return (EOF);    /* control-z */
  206.             case '\034':    xlwrapup();    /* control-\ */
  207.             default:        return (ch);
  208.             }
  209.         }
  210.     }
  211. }
  212.  
  213. /* ostputc - put a character to the terminal */
  214. void ostputc(ch)
  215.   int ch;
  216. {
  217.     /* check for control characters */
  218.     oscheck();
  219.  
  220.     /* output the character */
  221.     if (ch == '\n') {
  222.     xputc('\r'); xputc('\n');
  223.     lposition = 0;
  224.     }
  225.     else {
  226.     xputc(ch);
  227.     lposition++;
  228.    }
  229.  
  230.    /* output the character to the transcript file */
  231.    if (tfp)
  232.     osaputc(ch,tfp);
  233. }
  234.  
  235. /* ostputs - output a string to the terminal */
  236. void ostputs(str)
  237.   char *str;
  238. {
  239.     while (*str != '\0')
  240.     ostputc(*str++);
  241. }
  242.  
  243. /* osflush - flush the terminal input buffer */
  244. void osflush()
  245. {
  246.     lindex = lcount = lposition = 0;
  247. }
  248.  
  249. /* oscheck - check for control characters during execution */
  250. void oscheck()
  251. {
  252.     switch (xcheck()) {
  253.     case '\002':    /* control-b */
  254.     xflush();
  255.     xlbreak();
  256.     break;
  257.     case '\003':    /* control-c */
  258.     xflush();
  259.     xltoplevel();
  260.     break;
  261.     case '\024':    /* control-t */
  262.     xinfo();
  263.     break;
  264.     case '\023':    /* control-s */
  265.     while (xcheck() != '\021')
  266.         ;
  267.     break;
  268.     case '\034':    /* control-\ */
  269.     xlwrapup();
  270.     break;
  271.     }
  272. }
  273.  
  274. /* xinfo - show information on control-t */
  275. static void xinfo()
  276. {
  277. /*
  278.     extern int nfree,gccalls;
  279.     extern long total;
  280.     char buf[80];
  281.     sprintf(buf,"\n[ Free: %d, GC calls: %d, Total: %ld ]",
  282.         nfree,gccalls,total);
  283.     errputstr(buf);
  284. */
  285. }
  286.  
  287. /* xflush - flush the input line buffer and start a new line */
  288. static void xflush()
  289. {
  290.     osflush();
  291.     ostputc('\n');
  292. }
  293.  
  294. /* xgetc - get a character from the terminal without echo */
  295. static int xgetc()
  296. {
  297.     return (bdos(7,0,0) & 0xFF);
  298. }
  299.  
  300. /* xputc - put a character to the terminal */
  301. static void xputc(ch)
  302.   int ch;
  303. {
  304.     bdos(6,ch,0);
  305. }
  306.  
  307. /* xcheck - check for a character */
  308. static int xcheck()
  309. {
  310.     return (bdos(6,0xFF,0) & 0xFF);
  311. }
  312.  
  313. #ifdef NOTDEF
  314. /* xinbyte - read a byte from an input port */
  315. LVAL xinbyte()
  316. {
  317.     int portno;
  318.     LVAL val;
  319.     val = xlgafixnum(); portno = (int)getfixnum(val);
  320.     xllastarg();
  321.     return (cvfixnum((FIXTYPE)inp(portno)));
  322. }
  323.  
  324. /* xoutbyte - write a byte to an output port */
  325. LVAL xoutbyte()
  326. {
  327.     int portno,byte;
  328.     LVAL val;
  329.     val = xlgafixnum(); portno = (int)getfixnum(val);
  330.     val = xlgafixnum(); byte = (int)getfixnum(val);
  331.     xllastarg();
  332.     outp(portno,byte);
  333.     return (NIL);
  334. }
  335.  
  336. /* xint86 - invoke a system interrupt */
  337. LVAL xint86()
  338. {
  339.     union REGS inregs,outregs;
  340.     struct SREGS sregs;
  341.     LVAL inv,outv,val;
  342.     int intno;
  343.  
  344.     /* get the interrupt number and the list of register values */
  345.     val = xlgafixnum(); intno = (int)getfixnum(val);
  346.     inv = xlgavector();
  347.     outv = xlgavector();
  348.     xllastarg();
  349.  
  350.     /* check the vector lengths */
  351.     if (getsize(inv) != 9)
  352.         xlerror("incorrect vector length",inv);
  353.     if (getsize(outv) != 9)
  354.     xlerror("incorrect vector length",outv);
  355.  
  356.     /* load each register from the input vector */
  357.     val = getelement(inv,0);
  358.     inregs.x.ax = (fixp(val) ? (int)getfixnum(val) : 0);
  359.     val = getelement(inv,1);
  360.     inregs.x.bx = (fixp(val) ? (int)getfixnum(val) : 0);
  361.     val = getelement(inv,2);
  362.     inregs.x.cx = (fixp(val) ? (int)getfixnum(val) : 0);
  363.     val = getelement(inv,3);
  364.     inregs.x.dx = (fixp(val) ? (int)getfixnum(val) : 0);
  365.     val = getelement(inv,4);
  366.     inregs.x.si = (fixp(val) ? (int)getfixnum(val) : 0);
  367.     val = getelement(inv,5);
  368.     inregs.x.di = (fixp(val) ? (int)getfixnum(val) : 0);
  369.     val = getelement(inv,6);
  370.     sregs.es = (fixp(val) ? (int)getfixnum(val) : 0);
  371.     val = getelement(inv,7);
  372.     sregs.ds = (fixp(val) ? (int)getfixnum(val) : 0);
  373.     val = getelement(inv,8);
  374.     inregs.x.cflag = (fixp(val) ? (int)getfixnum(val) : 0);
  375.  
  376.     /* do the system interrupt */
  377.     int86x(intno,&inregs,&outregs,&sregs);
  378.  
  379.     /* store the results in the output vector */
  380.     setelement(outv,0,cvfixnum((FIXTYPE)outregs.x.ax));
  381.     setelement(outv,1,cvfixnum((FIXTYPE)outregs.x.bx));
  382.     setelement(outv,2,cvfixnum((FIXTYPE)outregs.x.cx));
  383.     setelement(outv,3,cvfixnum((FIXTYPE)outregs.x.dx));
  384.     setelement(outv,4,cvfixnum((FIXTYPE)outregs.x.si));
  385.     setelement(outv,5,cvfixnum((FIXTYPE)outregs.x.di));
  386.     setelement(outv,6,cvfixnum((FIXTYPE)sregs.es));
  387.     setelement(outv,7,cvfixnum((FIXTYPE)sregs.ds));
  388.     setelement(outv,8,cvfixnum((FIXTYPE)outregs.x.cflag));
  389.     
  390.     /* return the result list */
  391.     return (outv);
  392. }
  393.  
  394. /* getnext - get the next fixnum from a list */
  395. static int getnext(plist)
  396.   LVAL *plist;
  397. {
  398.     LVAL val;
  399.     if (consp(*plist)) {
  400.         val = car(*plist);
  401.     *plist = cdr(*plist);
  402.     if (!fixp(val))
  403.         xlerror("expecting an integer",val);
  404.         return ((int)getfixnum(val));
  405.     }
  406.     return (0);
  407. }
  408. #endif
  409.  
  410. /* xtime - get the current time */
  411. LVAL xtime()
  412. {
  413.     xllastarg();
  414.     return (cvfixnum((FIXTYPE)time((time_t)0)));
  415. }
  416.  
  417. /* xdifftime - get the difference between two time values */
  418. LVAL xdifftime()
  419. {
  420.     time_t t1,t2;
  421.     LVAL val;
  422.     val = xlgafixnum(); t1 = (time_t)getfixnum(val);
  423.     val = xlgafixnum(); t2 = (time_t)getfixnum(val);
  424.     xllastarg();
  425.     return (cvflonum((FLOTYPE)difftime(t1,t2)));
  426. }
  427.  
  428. /* xsystem - execute a system command */
  429. LVAL xsystem()
  430. {
  431.     char *cmd="COMMAND";
  432.     if (moreargs())
  433.     cmd = (char *)getstring(xlgastring());
  434.     xllastarg();
  435.     return (system(cmd) == 0 ? true : cvfixnum((FIXTYPE)errno));
  436. }
  437.  
  438. /* xgetkey - get a key from the keyboard */
  439. LVAL xgetkey()
  440. {
  441.     xllastarg();
  442.     return (cvfixnum((FIXTYPE)xgetc()));
  443. }
  444.  
  445. /* ossymbols - enter os specific symbols */
  446. void ossymbols()
  447. {
  448. }
  449.