home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / languages / lisp / xlisp / xlsp21_src / sources / c / metastuf < prev    next >
Encoding:
Text File  |  1992-04-25  |  23.7 KB  |  1,058 lines
  1. /* metastuf.c - Metaware High-C specific routines */
  2. /* modified to allow standard i/o redirection TAA */
  3.  
  4. #include "xlisp.h"
  5. #include "osdefs.h"
  6. #include <io.h>
  7. #ifdef TIMES
  8. #include <time.h>
  9. #endif
  10.  
  11. /* This is a kludgey, old interface, but the more Microsoft C-like calls
  12.    are bulkier */
  13.  
  14. #include <implement.cf>
  15. #include <language.cf>
  16.  
  17. #pragma Global_aliasing_convention(_Private_routine_prefix "%r");
  18.  
  19.    pragma data(common,_Private_prefix "dosregs");
  20.    typedef union {
  21.          struct {char L,H;} LH;   /* Lower & Upper portions of register. */
  22.          unsigned R;              /* Entire register. */
  23.          } Register;
  24.    typedef struct {
  25.       Register AX,BX,CX,DX,SI,DI,DS,ES;
  26.       unsigned Flags;
  27.       } DOS_communication;
  28.  
  29.    DOS_communication Registers;
  30.    pragma data;
  31.  
  32. #pragma Calling_convention(PASCAL);
  33.    /* Use this for your own direct communication with MS-DOS. */
  34.    extern void calldos();
  35.    extern void callint(int interrupt);
  36.  
  37. #pragma Global_aliasing_convention();
  38. #pragma Calling_convention(_DEFAULT_CALLING_CONVENTION);
  39.  
  40.  
  41. #define LBSIZE 200
  42.  
  43. /* external variables */
  44. extern LVAL s_unbound,s_dosinput,true;
  45. extern FILEP tfp;
  46.  
  47. /* external functions -- in SYSTEM.ASM file */
  48. extern int ssystem(char *cmd, char *tail);
  49. extern void setdrawmode(int mode);
  50. extern void unsetdrawmode(void);
  51.  
  52. /* exported variables */
  53. int lposition;
  54.  
  55. /* local variables */
  56. static char lbuf[LBSIZE];
  57. static int lpos[LBSIZE];
  58. static int lindex;
  59. static int lcount;
  60.  
  61. /* forward declarations */
  62. void xinfo(void);
  63. void xflush(void);
  64. void xputc(int ch);
  65. void setraw(void);
  66. void unsetraw(void);
  67. int  xgetc(void);
  68.  
  69. #define CHBSIZE 256         /* We have to do our own buffering */
  70. static char outbuf[CHBSIZE];
  71. static char *outbufp = &outbuf[0];
  72.  
  73. void flushbuf(void)
  74. {
  75.     if (outbufp != &outbuf[0]) {
  76.         Registers.AX.R = 0x4000;
  77.         Registers.BX.R = 2; /* write to stderr */
  78.         Registers.CX.R = outbufp - &outbuf[0];
  79.         Registers.DX.R = (unsigned int) &outbuf[0];
  80.         calldos();
  81.         outbufp = &outbuf[0];
  82.     }
  83. }
  84.  
  85. long myftell(FILE *fp)  /* metaware's is broken */
  86. {
  87.     long pos;
  88.  
  89.     Registers.AX.R = 0x4201;
  90.     Registers.BX.R = (unsigned int) fp->_fd;
  91.     Registers.CX.R = 0;
  92.     Registers.DX.R = 0;
  93.     calldos();
  94.  
  95.     pos = (Registers.DX.R << 16) + ((Registers.AX.R) & 0xffff);
  96.  
  97.     if ((fp->_flag & _UNINITIALIZED) ||
  98.         (fp->_cnt < 0))
  99.             return pos;
  100.  
  101.     if (fp->_flag & _WROTE_LAST) {
  102.         pos += BUFSIZ - fp->_cnt;
  103.     }
  104.     else {
  105.         pos -= fp->_cnt;
  106.     }
  107.     return pos;
  108. }
  109.  
  110. /* osinit - initialize */
  111. VOID osinit(banner)
  112.   char *banner;
  113. {
  114.     redirectout = !isatty(fileno(stdout));
  115.     redirectin = !isatty(fileno(stdin));
  116.  
  117.     fprintf(stderr,"%s\n",banner);
  118.     lposition = 0;
  119.     lindex = 0;
  120.     lcount = 0;
  121.     setraw();
  122. }
  123.  
  124. /* osfinish - clean up before returning to the operating system */
  125. VOID osfinish(void)
  126. {
  127.  
  128.     flushbuf();
  129.     unsetraw();
  130. }
  131.  
  132. /* xoserror - print an error message */
  133. VOID xoserror(msg)
  134.   char *msg;
  135. {
  136.     fprintf(stderr, "error: %s\n", msg);
  137. }
  138.  
  139. /* osrand - return next random number in sequence */
  140. long osrand(rseed)
  141.   long rseed;
  142. {
  143.     long k1;
  144.  
  145.     /* make sure we don't get stuck at zero */
  146.     if (rseed == 0L) rseed = 1L;
  147.  
  148.     /* algorithm taken from Dr. Dobbs Journal, November 1985, page 91 */
  149.     k1 = rseed / 127773L;
  150.     if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
  151.         rseed += 2147483647L;
  152.  
  153.     /* return a random number between 0 and MAXFIX */
  154.     return rseed;
  155. }
  156.  
  157. #ifdef FILETABLE
  158.  
  159. int truename(char *name, char *rname)
  160. {
  161.     int i;
  162.     char *cp;
  163.     int drive;          /* drive letter */
  164.     char pathbuf[FNAMEMAX+1];   /* copy of path part of name */
  165.     char curdir[FNAMEMAX+1];    /* current directory of drive */
  166.     char *fname;        /* pointer to file name part of name */
  167.     
  168.     /* use backslashes consistantly */
  169.     
  170.     for (cp = name; (cp = strchr(cp, '/')) != NULL; *cp = '\\') ;
  171.     
  172.     /* parse any drive specifier */
  173.  
  174.     if ((cp = strrchr(name, ':')) != NULL) {
  175.         if (cp != name+1 || !isalpha(*name)) return FALSE;
  176.         drive = toupper(*name);
  177.         name = cp+1;            /* name now excludes drivespec */
  178.     }
  179.     else {
  180.         Registers.AX.LH.H = 0x19;   /* get current disk */
  181.         calldos();
  182.         drive = Registers.AX.LH.L + 'A';
  183.     }
  184.     
  185.     /* check for absolute path (good news!) */
  186.     
  187.     if (*name == '\\') {
  188.         sprintf(rname,"%c:%s",drive,name);
  189.     }
  190.     else {
  191.         strcpy(pathbuf, name);
  192.         if ((cp = strrchr(pathbuf, '\\')) != NULL) {    /* path present */
  193.             cp[1] = 0;
  194.             fname = strrchr(name, '\\') + 1;
  195.         }
  196.         else {
  197.             pathbuf[0] = 0;
  198.             fname = name;
  199.         }
  200.  
  201.         /* get the current directory of the selected drive */
  202.         
  203.         Registers.AX.LH.H = 0x47;
  204.         Registers.DX.LH.L = drive + 1 - 'A';
  205.         Registers.SI.R = (unsigned) curdir;
  206.         calldos();
  207.  
  208.         if ((Registers.Flags&1) != 0) return FALSE; /* invalid drive */
  209.     
  210.         /* peel off "..\"s */
  211.         while (strncmp(pathbuf, "..\\", 3) == 0) {
  212.             if (*curdir == 0) return FALSE;     /* already at root */
  213.             strcpy(pathbuf, pathbuf+3);
  214.             if ((cp=strrchr(curdir, '\\')) != NULL)
  215.                 *cp = 0;    /* peel one depth of directories */
  216.             else
  217.                 *curdir = 0;    /* peeled back to root */
  218.         }
  219.         
  220.         /* allow for a ".\" */
  221.         if (strncmp(pathbuf, ".\\", 2) == 0)
  222.             strcpy(pathbuf, pathbuf+2);
  223.         
  224.         /* final name is drive:\curdir\pathbuf\fname */
  225.  
  226.         if (strlen(pathbuf)+strlen(curdir)+strlen(fname)+4 > FNAMEMAX) 
  227.             return FALSE;
  228.         
  229.         if (*curdir)
  230.             sprintf(rname, "%c:\\%s\\%s%s", drive, curdir, pathbuf, fname);
  231.         else
  232.             sprintf(rname, "%c:\\%s%s", drive, pathbuf, fname);
  233.     }
  234.     
  235.     /* lowercase the whole string */
  236.  
  237.     for (cp = rname; (i = *cp) != 0; cp++) {
  238.         if (isupper(i)) *cp = tolower(i);
  239.     }
  240.     
  241.     return TRUE;
  242. }
  243.  
  244. extern void gc(void);
  245.  
  246. LOCAL int NEAR getslot(VOID)
  247. {
  248.     int i=0;
  249.  
  250.     for (; i < FTABSIZE; i++)   /* look for available slot */
  251.         if (filetab[i].fp == NULL) return i;
  252.  
  253.     gc();   /* is this safe??????? */
  254.  
  255.     for (i=0; i < FTABSIZE; i++) /* try again -- maybe one has been freed */
  256.         if (filetab[i].fp == NULL) return i;
  257.  
  258.     xlfail("too many open files");
  259.  
  260.     return 0;   /* never returns */
  261. }
  262.  
  263.  
  264. FILEP osaopen(const char *name, const char *mode)
  265. {
  266.     int i=getslot();
  267.     char namebuf[FNAMEMAX+1];
  268.     FILE *fp;
  269.  
  270.     if (!truename((char *)name, namebuf))
  271.         strcpy(namebuf, name);  /* should not happen */
  272.  
  273.     if ((filetab[i].tname = malloc(strlen(namebuf)+1)) == NULL) {
  274.         free(filetab[i].tname);
  275.         xlfail("insufficient memory");
  276.     }
  277.     
  278.     
  279.     if ((fp = fopen(name,mode)) == NULL) {
  280.         free(filetab[i].tname);
  281.         return CLOSED;
  282.     }
  283.  
  284.     filetab[i].fp = fp;
  285.  
  286.     strcpy(filetab[i].tname, namebuf);
  287.  
  288.     return i;
  289. }
  290.  
  291.  
  292. FILEP osbopen(const char *name, const char *mode)
  293. {
  294.     char bmode[10];
  295.  
  296.     strcpy(bmode,mode); strcat(bmode,"b");
  297.  
  298.     return osaopen(name, bmode);
  299. }
  300.  
  301. VOID osclose(FILEP f)
  302. {
  303.     fclose(filetab[f].fp);
  304.     filetab[f].fp = NULL;
  305. }
  306.  
  307. #else
  308.  
  309. /* osbopen - open a binary file */
  310. FILE *osbopen(const char *name, const char *mode)
  311. {
  312.     char bmode[10];
  313.     strcpy(bmode,mode); strcat(bmode,"b");
  314.     return (fopen(name,bmode));
  315. }
  316. #endif
  317.  
  318. #ifdef PATHNAMES
  319. /* ospopen - open for reading using a search path */
  320. FILEP ospopen(char *name, int ascii)
  321. {
  322.     FILEP fp;
  323.     char *path = getenv(PATHNAMES);
  324.     char *newnamep;
  325.     char ch;
  326.     char newname[256];
  327.  
  328.     /* don't do a thing if user specifies explicit path */
  329.     if (strchr(name,'/') != NULL && strchr(name, '\\') != NULL)
  330. #ifdef FILETABLE
  331.         return (ascii? osaopen: osbopen)(name,"r");
  332. #else
  333.         return fopen(name,(ascii? "r": "rb"));
  334. #endif
  335.  
  336.     do {
  337.         if (*path == '\0')  /* no more paths to check */
  338.             /* check current directory just in case */
  339. #ifdef FILETABLE
  340.             return (ascii? osaopen: osbopen)(name,"r");
  341. #else
  342.             return fopen(name,(ascii? "r": "rb"));
  343. #endif
  344.  
  345.         newnamep = newname;
  346.         while ((ch=*path++) != '\0' && ch != ';' && ch != ' ')
  347.             *newnamep++ = ch;
  348.  
  349.         if (ch == '\0') path--;
  350.  
  351.         if (newnamep != newname &&
  352.             *(newnamep-1) != '/' && *(newnamep-1) != '\\')
  353.             *newnamep++ = '/';  /* final path separator needed */
  354.         *newnamep = '\0';
  355.  
  356.         strcat(newname, name);
  357. #ifdef FILETABLE
  358.         fp = (ascii? osaopen: osbopen)(newname,"r");
  359. #else
  360.         fp = fopen(newname, ascii? "r": "rb");
  361. #endif
  362.     } while (fp == CLOSED); /* not yet found */
  363.  
  364.     return fp;
  365. }
  366. #endif
  367.  
  368. /* rename argument file as backup, return success name */
  369. /* For new systems -- if cannot do it, just return TRUE! */
  370.  
  371. int renamebackup(char *filename) {
  372.     char *bufp, ch=0;
  373.  
  374.     strcpy(buf, filename);  /* make copy with .bak extension */
  375.  
  376.     bufp = &buf[strlen(buf)];   /* point to terminator */
  377.     while (bufp > buf && (ch = *--bufp) != '.' && ch != '/' && ch != '\\') ;
  378.  
  379.  
  380.     if (ch == '.') strcpy(bufp, ".bak");
  381.     else strcat(buf, ".bak");
  382.  
  383.     remove(buf);
  384.  
  385.     return !rename(filename, buf);
  386. }
  387.  
  388.  
  389. /* ostgetc - get a character from the terminal */
  390. int ostgetc()
  391. {
  392.     int ch;
  393.  
  394.     /* check for a buffered character */
  395.     if (lcount-- > 0)
  396.         return (lbuf[lindex++]);
  397.  
  398.     /* get an input line */
  399.     if (getvalue(s_dosinput) != NIL && !redirectin && !redirectout) {
  400.         flushbuf();
  401.         lindex = 2;
  402.         lbuf[0] = LBSIZE - 2;
  403.         Registers.AX.R = 0x0A00;
  404.         Registers.DX.R = (unsigned int) lbuf;
  405.         calldos();
  406.         putchar('\n');
  407.         lcount = lbuf[1];
  408.         lbuf[lcount+2] = '\n';
  409.         if (tfp!=CLOSED) OSWRITE(&lbuf[2],1,lcount+1,tfp);
  410.         lposition = 0;
  411.         return (lbuf[lindex++]);
  412.     }
  413.     else {
  414.     for (lcount = 0; ; )
  415.         switch (ch = xgetc()) {
  416.         case '\r':
  417.         case '\n':
  418.                 lbuf[lcount++] = '\n';
  419.                 xputc('\r'); xputc('\n'); lposition = 0;
  420.                 if (tfp!=CLOSED) OSWRITE(lbuf,1,lcount,tfp);
  421.                 lindex = 0; lcount--;
  422.                 return (lbuf[lindex++]);
  423.         case '\010':
  424.         case '\177':
  425.                 if (lcount) {
  426.                     lcount--;
  427.                     while (lposition > lpos[lcount]) {
  428.                         xputc('\010'); xputc(' '); xputc('\010');
  429.                         lposition--;
  430.                     }
  431.                 }
  432.                 break;
  433.         case '\032':
  434.                 xflush();
  435.                 return (EOF);
  436.         default:
  437.                 if (ch == '\t' || (ch >= 0x20 && ch < 0x7F)) {
  438.                     lbuf[lcount] = ch;
  439.                     lpos[lcount] = lposition;
  440.                     if (ch == '\t')
  441.                         do {
  442.                             xputc(' ');
  443.                         } while (++lposition & 7);
  444.                     else {
  445.                         xputc(ch); lposition++;
  446.                     }
  447.                     lcount++;
  448.                 }
  449.                 else {
  450.                     xflush();
  451.                     switch (ch) {
  452.                     case '\003':    xltoplevel();   /* control-c */
  453.                     case '\007':    xlcleanup();    /* control-g */
  454.                     case '\020':    xlcontinue();   /* control-p */
  455.                     case '\032':    return (EOF);   /* control-z */
  456.                     case '\024':    xinfo();        /* control-t */
  457.                                     return ostgetc();
  458.                     default:        return (ch);
  459.                     }
  460.                 }
  461.         }}
  462. }
  463.  
  464. /* ostputc - put a character to the terminal */
  465. VOID ostputc(ch)
  466.   int ch;
  467. {
  468.     /* check for control characters */
  469.     oscheck();
  470.  
  471.     /* output the character */
  472.     if (ch == '\n') {
  473.         xputc('\r'); xputc('\n');
  474.         lposition = 0;
  475.     }
  476.     else if (ch == '\t')
  477.         do { xputc(' '); } while (++lposition & 7);
  478.     else {
  479.         xputc(ch);
  480.         lposition++;
  481.    }
  482.  
  483.    /* output the character to the transcript file */
  484.    if (tfp!=CLOSED)
  485.         OSPUTC(ch,tfp);
  486. }
  487.  
  488. /* osflush - flush the terminal input buffer */
  489. VOID osflush()
  490. {
  491.     lindex = lcount = lposition = 0;
  492. }
  493.  
  494. /* oscheck - check for control characters during execution */
  495. VOID oscheck()
  496. {
  497.     if (redirectin) return; /* if input redirected, don't check */
  498.     Registers.AX.R = 0x0600;
  499.     Registers.DX.LH.L = 0xff;
  500.     calldos();
  501.     if (Registers.AX.LH.L == 0) return;     /* no characters */
  502.  
  503.     switch (Registers.AX.LH.L) {
  504.         case '\002':    /* control-b */
  505.             xflush();
  506.             xlbreak("BREAK",s_unbound);
  507.             break;
  508.         case '\003':    /* control-c */
  509.             xflush();
  510.             xltoplevel();
  511.             break;
  512.         case '\023':    /* control-s */
  513.             xgetc();    /* paused -- get character and toss */
  514.             break;
  515.         case '\024':    /* control-t */
  516.             xinfo();
  517.             break;
  518.         }
  519. }
  520.  
  521. /* xinfo - show information on control-t */
  522. static VOID xinfo()
  523. {
  524.     extern int nfree,gccalls;
  525.     extern long total;
  526.     sprintf(buf,"\n[ Free: %d, GC calls: %d, Total: %ld ]",
  527.             nfree,gccalls,total);
  528.     errputstr(buf);
  529.     flushbuf();
  530. }
  531.  
  532. /* xflush - flush the input line buffer and start a new line */
  533. static VOID xflush()
  534. {
  535.     osflush();
  536.     ostputc('\n');
  537. }
  538.  
  539. /* xgetc - get a character from the terminal without echo */
  540. static int xgetc()
  541. {
  542.  
  543.     flushbuf();
  544.  
  545.     if (redirectin) {
  546.         unsigned char chbuf[1];
  547.         Registers.AX.R = 0x3f00;
  548.         Registers.BX.R = 2;
  549.         Registers.CX.R = 1;
  550.         Registers.DX.R = (unsigned int) &chbuf;
  551.         calldos();
  552.         return chbuf[0];
  553.     }
  554.     else {
  555.         Registers.AX.LH.H = 0x7;
  556.         calldos();
  557.         return Registers.AX.LH.L;
  558.     }
  559. }
  560.  
  561. /* xputc - put a character to the terminal */
  562. static void xputc(ch)
  563.   int ch;
  564. {
  565.     *outbufp++ = ch;
  566.     if (ch == '\n' || outbufp == &outbuf[CHBSIZE]) flushbuf();
  567. }
  568.  
  569. static unsigned savestate;
  570. static unsigned char savebrk;
  571. #ifdef GRAPHICS
  572. static unsigned char origmode;
  573. static unsigned ourmode1=0, ourmode2=0;
  574.  
  575. static VOID setmode(ax,bx)
  576. int ax,bx;
  577. {
  578.     Registers.AX.R = ax;
  579.     Registers.BX.R = bx;
  580.     callint(0x10);
  581. }
  582.  
  583. #endif
  584.  
  585. /* setraw -- set raw mode */
  586. static VOID setraw()
  587. {
  588.     Registers.AX.R = 0x4400;        /* get device status */
  589.     Registers.BX.R = 1;
  590.     calldos();
  591.     Registers.DX.LH.H = 0;
  592.     savestate = Registers.DX.R;
  593.     Registers.AX.R = 0x4401;
  594.     Registers.DX.LH.L |= 0x20;
  595.     calldos();
  596.  
  597.     Registers.AX.R = 0x3300; /* get ctrl-break status */
  598.     calldos();
  599.     savebrk = Registers.DX.LH.L;
  600.     Registers.AX.R = 0x3301;
  601.     Registers.DX.LH.L = 0;
  602.     calldos();
  603.  
  604. #ifdef GRAPHICS
  605.     Registers.AX.R = 0x0f00;        /* get mode */
  606.     callint(0x10);
  607.     origmode = Registers.AX.LH.L;
  608.     if (ourmode1 != 0)      /* mode was changed -- use it */
  609.         setmode(ourmode1,ourmode2);
  610. #endif
  611. }
  612.  
  613. /* unsetraw -- restore original mode */
  614. static VOID unsetraw()
  615. {
  616.     Registers.AX.R = 0x4401;
  617.     Registers.BX.R = 1;
  618.     Registers.DX.R = savestate;
  619.     calldos();
  620.     Registers.AX.R = 0x3301;
  621.     Registers.DX.LH.L = savebrk;
  622.     calldos();
  623.  
  624. #ifdef GRAPHICS
  625.     if ((ourmode1 !=0) && (ourmode2 != origmode))
  626.         setmode(origmode,0);
  627. #endif
  628. }
  629.  
  630.  
  631. /* xsystem - execute a system command */
  632. LVAL xsystem()
  633. {
  634.     char commandtail[128],*s;
  635.     int Err;
  636.  
  637.     if (moreargs()) {
  638.         strcpy(commandtail," /c ");
  639.         s = getstring(xlgastring());
  640.         strcat(commandtail,s);
  641.         strcat(commandtail,"\r");
  642.         commandtail[0] = strlen(commandtail) - 2;
  643.         xllastarg();
  644.     }
  645.     else
  646.         strcpy(commandtail,"\001 \r");
  647.  
  648.     unsetraw();
  649.     Err = ssystem(getenv("COMSPEC"),commandtail);
  650.     setraw();
  651.     return ( Err == 0 ? true : cvfixnum((FIXTYPE)Err));
  652. }
  653.  
  654. /* xgetkey - get a key from the keyboard */
  655. LVAL xgetkey()
  656. {
  657.     xllastarg();
  658.     return (cvfixnum((FIXTYPE)xgetc()));
  659. }
  660.  
  661. /* ossymbols - enter os specific symbols */
  662. VOID ossymbols()
  663. {
  664. }
  665.  
  666.  
  667. #ifdef GRAPHICS
  668.  
  669. static int xpos=0, ypos=0;
  670. static int Xmax = -1, Ymax=-1;
  671. extern int bytesperline;
  672. static unsigned char drawvalue=15;
  673.  
  674. extern void setpixel();
  675.  
  676. struct overlay{int offset; short seg;}; /* trick to set far pointers */
  677.  
  678. /* function goto-xy which set/obtains cursor position */
  679. LVAL xgotoxy()
  680. {
  681.     FIXTYPE x, y;
  682.     LVAL oldpos;
  683.     _far unsigned char *basemem;
  684.  
  685.     ((struct overlay *)&basemem)->seg = 0x34;   /* 1 meg linear address */
  686.     ((struct overlay *)&basemem)->offset = 0;
  687.  
  688.     flushbuf();
  689.  
  690.     Registers.AX.R = 0x300; /* get old position */
  691.     Registers.BX.R = 0;
  692.     callint(0x10);
  693.     oldpos = cons(cvfixnum((FIXTYPE)Registers.DX.LH.L),
  694.                   cons(cvfixnum((FIXTYPE)Registers.DX.LH.H),NIL));
  695.  
  696.     if (moreargs()) {
  697.         x = getfixnum(xlgafixnum());
  698.         y = getfixnum(xlgafixnum());
  699.         xllastarg();
  700.         if (x < 0) x = 0;   /* check for in bounds */
  701.         else if (x >= *(_far unsigned int *) &basemem[0x44a])
  702.             x = *(_far unsigned int *)&basemem[0x44a] - 1;
  703.         if (y < 0) y = 0;
  704.         else if (basemem[0x484]!=0) {
  705.             if (y > basemem[0x484])
  706.                 y = basemem[0x484];
  707.         }
  708.         else if (y > 24) y = 24;
  709.  
  710.         Registers.AX.R = 0x200; /* set new position */
  711.         Registers.DX.LH.L = x;
  712.         Registers.DX.LH.H = y;
  713.         Registers.BX.R = 0;
  714.  
  715.         callint(0x10);
  716.         lposition = x;
  717.     }
  718.  
  719.     return oldpos;
  720. }
  721.  
  722. LVAL xcls() /* clear the screen */
  723. {
  724.     int xsize, ysize, attrib;
  725.     _far unsigned char *basemem;
  726.  
  727.     ((struct overlay *)&basemem)->seg = 0x34;   /* 1 meg linear address */
  728.     ((struct overlay *)&basemem)->offset = 0;
  729.  
  730.     flushbuf();
  731.     lposition = 0;
  732.  
  733.     xsize = *(_far unsigned int *) &basemem[0x44a];
  734.     ysize = (basemem[0x484]!=0 ? basemem[0x484] : 24);
  735.     attrib = (ourmode1 > 3 ? 0 : basemem[0xb8001]);
  736.  
  737.     Registers.AX.R = 0x0600;
  738.     Registers.BX.LH.H = attrib;
  739.     Registers.CX.R = 0;
  740.     Registers.DX.LH.H = ysize;
  741.     Registers.DX.LH.L = xsize;
  742.     callint(0x10);
  743.     Registers.AX.R =0x200;              /* home cursor */
  744.     Registers.DX.R = 0;
  745.     Registers.BX.R = 0;
  746.     callint(0x10);
  747.     return NIL;
  748. }
  749.  
  750. LVAL xcleol()   /* clear to end of line */
  751. {
  752.     _far unsigned char *basemem;
  753.  
  754.     ((struct overlay *)&basemem)->seg = 0x34;   /* 1 meg linear address */
  755.     ((struct overlay *)&basemem)->offset = 0;
  756.  
  757.     flushbuf();
  758.  
  759.     Registers.AX.R = 0x300; /* get old position */
  760.     Registers.BX.R = 0;
  761.     callint(0x10);  /* x position in dl, y in dh */
  762.     lposition = Registers.DX.LH.L;      /* just to be sure */
  763.     Registers.CX.R = Registers.DX.R;
  764.     Registers.DX.LH.L = *(_far unsigned int *)&basemem[0x44a] -1; /* x size */
  765.     Registers.AX.R = 0x0600;            /* scroll region */
  766.     Registers.BX.LH.H = (ourmode1 > 3 ? 0 : basemem[0xb8001]); /* atrrib*/
  767.     callint(0x10);
  768.     return NIL;
  769. }
  770.  
  771. static LVAL draw(int x, int y, int x2, int y2)
  772.  
  773. {
  774.     int xStep,yStep,xDist,yDist;
  775.     int i, t8, t9, t10;
  776.  
  777.     flushbuf();
  778.  
  779.     if ((x < 0) | (x > Xmax) | (y < 0) | (y > Ymax) |
  780.         (x2 < 0)| (x2 > Xmax)  | (y2 < 0) | (y2 > Ymax))
  781.             return (NIL);
  782.  
  783.     x -= x2;     /* cvt to distance and screen coordiate (right hand) */
  784.     y2 = Ymax - y2;
  785.     y = (Ymax - y) - y2;
  786.  
  787.     if (x < 0) {    /* calculate motion */
  788.         xStep = -1;
  789.         xDist = -x;
  790.     }
  791.     else {
  792.         xStep = 1;
  793.         xDist = x;
  794.     }
  795.     if (y < 0) {
  796.         yStep = -1;
  797.         yDist = -y;
  798.     }
  799.     else {
  800.         yStep = 1;
  801.         yDist = y;
  802.     }
  803.  
  804.     setdrawmode(drawvalue);
  805.     setpixel(x2,y2);
  806.  
  807.     if (yDist == 0) {
  808.         i = xDist;
  809.         while (i--) {
  810.             x2 += xStep;
  811.             setpixel(x2,y2);
  812.         }
  813.     }
  814.     else if (xDist == yDist) {
  815.         i = xDist;
  816.         while (i--) {
  817.             x2 += xStep;
  818.             y2 += yStep;
  819.             setpixel(x2,y2);
  820.         }
  821.     }
  822.     else if (xDist == 0) {
  823.         i = yDist;
  824.         while (i--) {
  825.             y2 += yStep;
  826.             setpixel(x2,y2);
  827.         }
  828.     }
  829.     else if (xDist > yDist) {
  830.         t8 = 2*yDist;
  831.         t10 = 2*yDist - xDist;
  832.         t9 = 2*(yDist - xDist);
  833.         i = xDist;
  834.         while (i--) {
  835.             x2 += xStep;
  836.             if (t10 < 0) {
  837.                 t10 += t8;
  838.             }
  839.             else {
  840.                 y2 += yStep;
  841.                 t10 += t9;
  842.             }
  843.             setpixel(x2,y2);
  844.         }
  845.     }
  846.     else {
  847.         t8 = 2*xDist;
  848.         t10 = 2*xDist - yDist;
  849.         t9 = 2*(xDist - yDist);
  850.         i = yDist;
  851.         while (i--) {
  852.             y2 += yStep;
  853.             if (t10 < 0) {
  854.                 t10 += t8;
  855.             }
  856.             else {
  857.                 x2 += xStep;
  858.                 t10 += t9;
  859.             }
  860.             setpixel(x2,y2);
  861.         }
  862.     }
  863.     unsetdrawmode();
  864.     return (true);
  865. }
  866.  
  867. /* xmode -- set display mode */
  868. /* called with either ax contents, or ax,bx,xsize,ysize */
  869. LVAL xmode()
  870. {
  871.     LVAL arg;
  872.     int nmode1, nmode2;
  873.  
  874.     arg = xlgafixnum();
  875.     nmode1 = (int) getfixnum(arg);
  876.  
  877.     if (moreargs()) {
  878.         arg = xlgafixnum();
  879.         nmode2 = (int) getfixnum(arg);
  880.         arg = xlgafixnum();
  881.         Xmax = (int) getfixnum(arg) - 1;    /* max x coordinate */
  882.         arg = xlgafixnum();
  883.         Ymax = (int) getfixnum(arg) - 1;    /* max y coordinate */
  884.         xllastarg();
  885.     }
  886.     else {
  887.         nmode2 = 0;
  888.         switch (nmode1) {
  889.         case 0:
  890.         case 1:
  891.         case 2:
  892.         case 3:
  893.             Xmax = Ymax = -1; /* not a graphic mode */
  894.             break;
  895.  
  896.         case 13: Xmax = 319;
  897.                  Ymax = 199;
  898.                  break;
  899.         case 14: Xmax = 639;
  900.                  Ymax = 199;
  901.                  break;
  902.         case 16: Xmax = 639;
  903.                  Ymax = 349;
  904.                  break;
  905.         case 18: Xmax = 639;    /* added VGA mode */
  906.                  Ymax = 479;
  907.                  break;
  908.         default: return NIL;    /* invalid mode */
  909.         }
  910.     }
  911.  
  912.     ourmode1 = nmode1;
  913.     ourmode2 = nmode2;
  914.     setmode(ourmode1,ourmode2); /* set mode */
  915.     bytesperline = (Xmax + 1) / 8;
  916.  
  917.  
  918.     return (true);
  919. }
  920.  
  921. /* xcolor -- set color */
  922.  
  923. LVAL xcolor()
  924. {
  925.     LVAL arg;
  926.  
  927.     arg = xlgafixnum();
  928.     xllastarg();
  929.  
  930.     drawvalue = (char) getfixnum(arg);
  931.  
  932.     return (arg);
  933. }
  934.  
  935. /* xdraw -- absolute draw */
  936.  
  937. LVAL xdraw()
  938. {
  939.     LVAL arg = true;
  940.     int newx, newy;
  941.  
  942.     while (moreargs()) {
  943.         arg = xlgafixnum();
  944.         newx = (int) getfixnum(arg);
  945.  
  946.         arg = xlgafixnum();
  947.         newy = (int) getfixnum(arg);
  948.  
  949.         arg = draw(xpos,ypos,newx,newy);
  950.  
  951.         xpos = newx;
  952.         ypos = newy;
  953.     }
  954.     return (arg);
  955. }
  956.  
  957. /* xdrawrel -- absolute draw */
  958.  
  959. LVAL xdrawrel()
  960. {
  961.     LVAL arg = true;
  962.     int newx, newy;
  963.  
  964.     while (moreargs()) {
  965.         arg = xlgafixnum();
  966.         newx = xpos + (int) getfixnum(arg);
  967.  
  968.         arg = xlgafixnum();
  969.         newy = ypos + (int) getfixnum(arg);
  970.  
  971.         arg = draw(xpos,ypos,newx,newy);
  972.  
  973.         xpos = newx;
  974.         ypos = newy;
  975.     }
  976.     return (arg);
  977. }
  978.  
  979. /* xmove -- absolute move, then draw */
  980.  
  981. LVAL xmove()
  982. {
  983.     LVAL arg;
  984.  
  985.     arg = xlgafixnum();
  986.     xpos = (int) getfixnum(arg);
  987.  
  988.     arg = xlgafixnum();
  989.     ypos = (int) getfixnum(arg);
  990.  
  991.     return (xdraw());
  992. }
  993.  
  994. /* xmoverel -- relative move */
  995.  
  996. LVAL xmoverel()
  997. {
  998.     LVAL arg;
  999.  
  1000.     arg = xlgafixnum();
  1001.     xpos += (int) getfixnum(arg);
  1002.  
  1003.     arg = xlgafixnum();
  1004.     ypos += (int) getfixnum(arg);
  1005.  
  1006.     return (xdrawrel());
  1007. }
  1008.  
  1009. #endif
  1010.  
  1011. #ifdef TIMES
  1012.  
  1013. unsigned long ticks_per_second() { return((unsigned long) CLK_TCK); }
  1014.  
  1015. unsigned long run_tick_count()
  1016. {
  1017.   return((unsigned long) clock()); /* Real time in MSDOS */
  1018. }
  1019.  
  1020. unsigned long real_tick_count()
  1021. {                                  /* Real time */
  1022.   return((unsigned long) clock());
  1023. }
  1024.  
  1025.  
  1026. LVAL xtime()
  1027. {
  1028.     LVAL expr,result;
  1029.     unsigned long tm;
  1030.  
  1031.     /* get the expression to evaluate */
  1032.     expr = xlgetarg();
  1033.     xllastarg();
  1034.  
  1035.     tm = run_tick_count();
  1036.     result = xleval(expr);
  1037.     tm = run_tick_count() - tm;
  1038.     sprintf(buf, "The evaluation took %.2f seconds.\n",
  1039.             ((double)tm) / ticks_per_second());
  1040.     trcputstr(buf);
  1041.  
  1042.     flushbuf();
  1043.  
  1044.     return(result);
  1045. }
  1046.  
  1047. LVAL xruntime() {
  1048.     xllastarg();
  1049.     return(cvfixnum((FIXTYPE) run_tick_count()));
  1050. }
  1051.  
  1052. LVAL xrealtime() {
  1053.     xllastarg();
  1054.     return(cvfixnum((FIXTYPE) real_tick_count()));
  1055. }
  1056.  
  1057. #endif
  1058.