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