home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 3 / PDCD_3.iso / languages / lisp / xlisp / xlsp21_src / sources / c / unixstuf < prev    next >
Encoding:
Text File  |  1992-04-25  |  15.8 KB  |  680 lines
  1. /*I doubt that standard input and output can be redirected with this version*/
  2. /* -*-C-*-
  3. ********************************************************************************
  4. *
  5. * File:         unixstuff.c
  6. * Description:  UNIX-Specific interfaces for XLISP
  7. * Author:       David Michael Betz; Niels Mayer
  8. *
  9. * WINTERP 1.0 Copyright 1989 Hewlett-Packard Company (by Niels Mayer).
  10. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  11. *
  12. * Modified again by Tom Almy
  13. * some SYSV modifications by Dave Rivers (rivers@ponds.uucp)
  14. * some bugs fixed by Hume Smith (850347s@aucs.acadiau.ca)
  15. * yet another fix by Tom Almy
  16. ********************************************************************************
  17. */
  18.  
  19. /*****************************************************************************
  20. *               edit history
  21. *
  22. * 92Jan29 CrT.  Edit history.  Reversed SysV gtty/stty #defs fixed.
  23. *****************************************************************************/
  24. #include <signal.h>
  25. #include <sys/types.h>
  26. #include <sys/times.h>
  27.  
  28. #ifdef BSD
  29. #include <sys/ioctl.h>
  30. struct sgttyb savetty;
  31. struct sgttyb newtty;
  32. #define gtty(fd,arg)    (ioctl(fd, TIOCGETP, arg))
  33. #define stty(fd,arg)    (ioctl(fd, TIOCSETP, arg))
  34. #else
  35. #include <termio.h>
  36. struct termio savetty;
  37. struct termio newtty;
  38. #define gtty(fd,arg)    (ioctl(fd, TCGETA, arg))
  39. #define stty(fd,arg)    (ioctl(fd, TCSETAF, arg))
  40. #endif
  41.  
  42. #include "xlisp.h"
  43.  
  44. #define LBSIZE  200
  45. #ifndef HZ
  46. #define HZ 60
  47. #endif
  48.  
  49. /* -- external variables */
  50. extern  FILEP tfp;
  51. extern long times();
  52. extern LVAL xlenv, xlfenv, xldenv;
  53.  
  54. /* -- local variables */
  55. static  char    lbuf[LBSIZE];
  56. static  int     lpos[LBSIZE];
  57. int     lposition;  /* export this */
  58. static  int     lindex;
  59. static  int     lcount;
  60.  
  61. char *xfgets();
  62. char read_keybd();
  63.  
  64.  
  65. /******************************************************************************
  66.  * xsystem - run a process, sending output (if any) to stdout/stderr
  67.  *
  68.  * syntax: (system <command line>)
  69.  *                 <command line> is a string to be sent to the subshell (sh).
  70.  *
  71.  * Returns T if the command executed succesfully, otherwise returns the
  72.  * integer shell exit status for the command.
  73.  *
  74.  * Added to XLISP by Niels Mayer
  75.  * didn't spawn a shell with null string HCLS
  76.  * didn't reset terminal for interaction HCLS
  77.  ******************************************************************************/
  78. LVAL
  79. xsystem()
  80. {
  81.     char *          getenv();
  82.     extern LVAL     true;
  83.     char           *comstr;
  84.     LVAL            command;
  85.     int             result;
  86.     char            temptext[1024];
  87.  
  88.     /* get shell command */
  89.     command = xlgastring();
  90.     xllastarg();
  91.  
  92.     comstr = (char *) getstring(command);
  93.     if (*comstr) {
  94.             /* restore the terminal */
  95.         stty(0, &savetty);
  96.         /* run the process */
  97.         result = system(comstr);
  98.         /* restore the terminal */
  99.         stty(0, &newtty);
  100.                 
  101.         if (result == -1) {     /* if a system error has occured */
  102.             xlfail("error in system call");
  103.         }
  104.     } else {
  105.         /*
  106.          * We were given a null string.  We'll try to find out what
  107.          * shell the user uses and spawn it.
  108.          */
  109.         if (comstr = getenv("SHELL")) {
  110.             int  pid;
  111.             /*
  112.              * we could just system(comstr), but that would get
  113.              * two shells running...
  114.              */
  115.             /* restore the terminal */
  116.             stty(0, &savetty);
  117.             pid = fork();
  118.             if (pid == 0) {
  119.                     extern int errno;
  120.                 execl(comstr, comstr, 0);
  121.                 exit(errno);
  122.             }
  123.             if (pid == -1) {
  124.                 xlfail("error in system call");
  125.             }
  126.             while (pid != wait(&result));
  127.             stty(0, &newtty);
  128.             result >>= 8;
  129.         } else {
  130.             /* SHELL is expected (environ(5)) */
  131.             xlfail("can't find SHELL variable");
  132.         }
  133.     }
  134.     /*
  135.      * return T if success (exit status 0), else return exit status
  136.      */
  137.     return (result ? cvfixnum(result) : true);
  138. }
  139.  
  140.  
  141. /******************************************************************************/
  142. /* -- Written by dbetz for XLISP 2.0 */
  143.  
  144.  
  145. /* -- osinit - initialize */
  146. VOID osinit(banner)
  147. char       *banner;
  148. {
  149.         fprintf(stderr,"%s\nUNIX version\n", banner );
  150.         init_tty();
  151.         lindex  = 0;
  152.         lcount  = 0;
  153. }
  154.  
  155. /* -- osfinish - clean up before returning to the operating system */
  156. VOID osfinish()
  157. {
  158.         stty(0, &savetty);
  159. }
  160.  
  161.  
  162. /* -- xoserror - print an error message */
  163. VOID xoserror(msg)
  164. char         *msg;
  165. {
  166.         printf( "error: %s\n", msg );
  167. }
  168.  
  169.  
  170. /* osrand - return next random number in sequence */
  171. long osrand(rseed)
  172.   long rseed;
  173. {
  174.     long k1;
  175.  
  176.     /* make sure we don't get stuck at zero */
  177.     if (rseed == 0L) rseed = 1L;
  178.  
  179.     /* algorithm taken from Dr. Dobbs Journal, November 1985, page 91 */
  180.     k1 = rseed / 127773L;
  181.     if ((rseed = 16807L * (rseed - k1 * 127773L) - k1 * 2836L) < 0L)
  182.         rseed += 2147483647L;
  183.  
  184.     /* return a random number between 0 and MAXFIX */
  185.     return rseed;
  186. }
  187. #ifdef FILETABLE
  188. extern VOID gc();
  189.  
  190. int truename(name, rname)
  191. char        *name,*rname;
  192. {
  193.     int i;
  194.     char *cp;
  195.     char pathbuf[FNAMEMAX+1];   /* copy of path part of name */
  196.     char curdir[FNAMEMAX+1];    /* current directory */
  197.     char *fname;        /* pointer to file name part of name */
  198.     
  199.     /* parse any drive specifier */
  200.  
  201.     /* check for absolute path (good news!) */
  202.     
  203.     if (*name == '/') {
  204.         strcpy(rname, name);
  205.     }
  206.     else {
  207.         strcpy(pathbuf, name);
  208.         if ((cp = strrchr(pathbuf, '/')) != NULL) { /* path present */
  209.             cp[1] = 0;
  210.             fname = strrchr(name, '/') + 1;
  211.         }
  212.         else {
  213.             pathbuf[0] = 0;
  214.             fname = name;
  215.         }
  216.  
  217.         /* get the current directory of the selected drive */
  218.         
  219.         getcwd(curdir, FNAMEMAX);
  220.  
  221.         /* peel off "../"s */
  222.         while (strncmp(pathbuf, "../", 3) == 0) {
  223.             if (*curdir == 0) return FALSE;     /* already at root */
  224.             strcpy(pathbuf, pathbuf+3);
  225.             if ((cp=strrchr(curdir+1, '/')) != NULL)
  226.                 *cp = 0;    /* peel one depth of directories */
  227.             else
  228.                 *curdir = 0;    /* peeled back to root */
  229.         }
  230.         
  231.         /* allow for a "./" */
  232.         if (strncmp(pathbuf, "./", 2) == 0)
  233.             strcpy(pathbuf, pathbuf+2);
  234.         
  235.         /* final name is /curdir/pathbuf/fname */
  236.  
  237.         if (strlen(pathbuf)+strlen(curdir)+strlen(fname)+4 > FNAMEMAX) 
  238.             return FALSE;
  239.         
  240.         if (*curdir)
  241.             sprintf(rname, "%s/%s%s", curdir, pathbuf, fname);
  242.         else
  243.             sprintf(rname, "/%s%s", pathbuf, fname);
  244.     }
  245.     
  246.     return TRUE;
  247. }
  248.  
  249. int getslot()
  250. {
  251.     int i=0;
  252.     
  253.     for (; i < FTABSIZE; i++)   /* look for available slot */
  254.         if (filetab[i].fp == NULL) return i;
  255.     
  256.     gc();   /* is this safe??????? */
  257.  
  258.     for (; i < FTABSIZE; i++) /* try again -- maybe one has been freed */
  259.         if (filetab[i].fp == NULL) return i;
  260.  
  261.     xlfail("too many open files");
  262.     
  263.     return 0;   /* never returns */
  264. }
  265.  
  266.  
  267. FILEP osopen(name, mode)
  268.   char *name, *mode;
  269. {
  270.     int i=getslot();
  271.     char namebuf[FNAMEMAX+1];
  272.     FILE *fp;
  273.     
  274.     if (!truename((char *)name, namebuf))
  275.         strcpy(namebuf, name);  /* should not happen */
  276.  
  277.     if ((filetab[i].tname = (char *)malloc(strlen(namebuf)+1)) == NULL) {
  278.         free(filetab[i].tname);
  279.         xlfail("insufficient memory");
  280.     }
  281.     
  282.     
  283.     if ((fp = fopen(name,mode)) == NULL) {
  284.         free(filetab[i].tname);
  285.         return CLOSED;
  286.     }
  287.  
  288.     filetab[i].fp = fp;
  289.  
  290.     strcpy(filetab[i].tname, namebuf);
  291.  
  292.     return i;
  293. }
  294.     
  295. void osclose(f)
  296.   FILEP f;
  297. {
  298.     fclose(filetab[f].fp);
  299.     free(filetab[f].tname);
  300.     filetab[f].tname = NULL;
  301.     filetab[f].fp = NULL;
  302. }
  303.     
  304. #endif
  305.  
  306. #ifdef PATHNAMES
  307. /* ospopen - open using a search path */
  308. FILEP ospopen(name, ascii)
  309. char *name;
  310. int ascii;  /* value not used in UNIX */
  311. {
  312.     char *getenv();
  313.     FILEP fp;
  314.     char *path = getenv(PATHNAMES);
  315.     char *newnamep;
  316.     char ch;
  317.     char newname[256];
  318.  
  319.     /* don't do a thing if user specifies explicit path */
  320.     if (strchr(name,'/') != NULL || path == NULL)
  321.         return OSAOPEN(name, "r");
  322.  
  323.     do {
  324.         if (*path == '\0')  /* no more paths to check */
  325.             /* check current directory just in case */
  326.             return OSAOPEN(name, "r");
  327.  
  328.         newnamep = newname;
  329.         while ((ch = *path++) != '\0' && ch != ':' && ch != ' ')
  330.             *newnamep++ = ch;
  331.  
  332.     if (ch == '\0') path--;
  333.  
  334.         if (*(newnamep-1) != '/')
  335.             *newnamep++ = '/';  /* final path separator needed */
  336.         *newnamep = '\0';
  337.  
  338.         strcat(newname, name);
  339.         fp = OSAOPEN(newname, "r");
  340.     } while (fp == CLOSED); /* not yet found */
  341.  
  342.     return fp;
  343. }
  344. #endif
  345.  
  346. /* rename argument file as backup, return success name */
  347. /* For new systems -- if cannot do it, just return TRUE! */
  348.  
  349. int renamebackup(filename)
  350.   char *filename;
  351. {
  352.     char *bufp, ch=0;
  353.  
  354.     strcpy(buf, filename);  /* make copy with .bak extension */
  355.  
  356.     bufp = &buf[strlen(buf)];   /* point to terminator */
  357.     while (bufp > buf && (ch = *--bufp) != '.' && ch != '/') ;
  358.  
  359.  
  360.     if (ch == '.') strcpy(bufp, ".bak");
  361.     else strcat(buf, ".bak");
  362.  
  363.     unlink(buf);
  364.  
  365.     return !rename(filename, buf);
  366. }
  367.  
  368.  
  369. /* -- ostgetc - get a character from the terminal */
  370. int     ostgetc()
  371. {
  372.         while(--lcount < 0 )
  373.                 {
  374.                 if ( xfgets(lbuf,LBSIZE,stdin) == NULL )
  375.                         return( EOF );
  376.  
  377.                 lcount = strlen( lbuf );
  378.                 if (tfp!=CLOSED) OSWRITE(lbuf,1,lcount,tfp);
  379.  
  380.                 lindex = 0;
  381.                 lposition = 0;
  382.                 }
  383.  
  384.         return( lbuf[lindex++] );
  385. }
  386.  
  387.  
  388. /* -- ostputc - put a character to the terminal */
  389. VOID ostputc( ch )
  390. int     ch;
  391. {
  392.         char buf[1];
  393.  
  394.         buf[0] = ch;
  395.  
  396.         if (ch == '\n') lposition = 0;
  397.         else lposition++;
  398.  
  399.         /* -- output the character */
  400. /*        putchar( ch ); */
  401.         write(1,buf,1);
  402.  
  403.         /* -- output the char to the transcript file */
  404.         if ( tfp != CLOSED )
  405.                 OSPUTC( ch, tfp );
  406. }
  407.  
  408.  
  409.  
  410.  
  411. /* -- osflush - flush the terminal input buffer */
  412. VOID osflush()
  413. {
  414.         lindex = lcount = lposition = 0;
  415. }
  416.  
  417. void oscheck()
  418. {
  419. }
  420.  
  421. osx_check(ch)
  422. char ch;
  423. {
  424.      switch (ch) {
  425.         case '\003':
  426.           xltoplevel(); /* control-c */
  427.         case '\007':
  428.           xlcleanup();  /* control-g */
  429.         case '\020':
  430.           xlcontinue(); /* control-p */
  431.         case '\024':    /* control-t */
  432.           xinfo();
  433.           printf("\n ");
  434.      }
  435. }
  436.  
  437.  
  438. /* -- ossymbols - enter os-specific symbols */
  439. VOID ossymbols()
  440. {
  441. }
  442.  
  443.  
  444. /* xinfo - show information on control-t */
  445. static xinfo()
  446. {
  447.   extern int nfree, gccalls;
  448.   extern long total;
  449.   char tymebuf[100];
  450.   time_t tyme;
  451.   char buf[500];
  452.  
  453.   time(&tyme);
  454.   strcpy(tymebuf, ctime(&tyme));
  455.   tymebuf[19] = '\0';
  456.   sprintf(buf,"\n[ %s Free: %d, GC calls: %d, Total: %ld ]",
  457.     tymebuf, nfree,gccalls,total);
  458.   errputstr(buf);
  459. }
  460.  
  461. /* xflush - flush the input line buffer and start a new line */
  462. static xflush()
  463. {
  464.   osflush();
  465.   ostputc('\n');
  466. }
  467.  
  468.  
  469. char read_keybd()
  470. {
  471.    int nrd;
  472.    char buf[2];
  473.  
  474.    nrd = read(0, buf, 1);
  475.    buf[nrd] = 0;
  476.    if (buf[0] != 127 && buf[0] != 8)
  477.       stdputstr(buf);
  478.  
  479.    return(buf[0]);
  480. }
  481.  
  482. #ifndef BSD
  483. /* SYS V requires reseting of SIGINT */
  484. VOID xlresetint()
  485. {
  486.     signal(SIGINT, xlresetint);
  487.     xltoplevel();
  488. }
  489. #endif
  490.  
  491. init_tty()
  492. {
  493.         /* extern sigcatch(); */
  494.     extern onsusp();
  495.  
  496.  
  497. #ifdef BSD
  498.     signal(SIGINT, xltoplevel);
  499. #else
  500.     signal(SIGINT, xlresetint);
  501. #endif
  502.     signal(SIGQUIT, SIG_IGN);
  503.  
  504. #ifdef SIGTSTP
  505.     if (signal(SIGTSTP, onsusp) == SIG_DFL) {
  506.         signal(SIGTSTP, onsusp);
  507.     }
  508. #endif
  509.  
  510.  
  511.     if (gtty(0, &savetty) == -1) {
  512.         printf("ioctl failed: not a tty\n");
  513.         exit();
  514.     }
  515.  
  516.     newtty = savetty;
  517.  
  518.     
  519. #ifdef BSD
  520.     newtty.sg_flags |= CBREAK;      /* turn off canonical mode */
  521.                                     /* i.e., turn on cbreak mode */
  522.     newtty.sg_flags &= ~ECHO;       /* turn off character echo */
  523. #else
  524.     newtty.c_lflag &= ~ICANON;  /* SYS 5 */
  525.     newtty.c_lflag &= ~ECHO;
  526.     newtty.c_cc[VMIN] = 1;
  527.     newtty.c_cc[VTIME] = 1;
  528. #endif
  529.     /*
  530.      * You can't request that it try to give you at least
  531.      * 5 characters, nor set the timeout to 10 seconds,
  532.      * as you can in the S5 example.  If characters come
  533.      * in fast enough, though, you may get more than one.
  534.      */
  535.     if (stty(0, &newtty) == -1) {
  536.         printf("cannot put tty into cbreak mode\n");
  537.         exit();
  538.     }
  539. }
  540.  
  541. onsusp()
  542. {
  543. #ifdef SIGSTP
  544.     /* ignore SIGTTOU so we dont get stopped if csh grabs the tty */
  545.     signal(SIGTTOU, SIG_IGN);
  546.     stty(0, &savetty);
  547.     xflush();
  548.     signal(SIGTTOU,SIG_DFL);
  549.  
  550.     /* send the TSTP signal to suspend our process group */
  551.     signal(SIGTSTP, SIG_DFL);
  552.     sigsetmask(0);
  553.     kill(0, SIGTSTP);
  554.     /* pause for station break */
  555.  
  556.     /* we re back */
  557.     signal(SIGTSTP, onsusp);
  558.     stty(0, &newtty);
  559. #endif
  560. }
  561.  
  562.  
  563.  
  564. char *xfgets(s, n, iop)
  565. char *s;
  566. register FILE *iop;
  567. {
  568.         register c;
  569.         register char *cs;
  570.  
  571.         cs = s;
  572.         while (--n>0 && (c = read_keybd()) != EOF) {
  573.              switch(c) {
  574.                   case '\002' :                 /* CTRL-b */
  575.                   case '\003' :                 /* CTRL-c */
  576.                   case '\007' :                 /* CTRL-g */
  577.                   case '\020' :                 /* CTRL-p */
  578.                   case '\024' : osx_check(c);   /* CTRL-t */
  579.                                 n++;
  580.                                 break;
  581.  
  582.                   case 8      :
  583.                   case 127    : if (cs==s) break;   /* not before beginning */
  584.  
  585.                               if (c == 127) {   /* perform erase */
  586.                                   stdputstr("\010");
  587.                                   stdputstr(" ");
  588.                               }
  589.                               stdputstr("\010"); /* BACKSPACE */
  590.  
  591.                                 n+=2;           
  592.                                 cs--;
  593.                                 break;
  594.  
  595.                   default     : *cs++ = c;      /* character */
  596.                 }
  597.                 if (c=='\n') break;
  598.         }
  599.         if (c == EOF && cs==s) return(NULL);
  600.         *cs++ = '\0';
  601.         return(s);
  602. }
  603.  
  604. #ifdef TIMES
  605. /***********************************************************************/
  606. /**                                                                   **/
  607. /**                  Time and Environment Functions                   **/
  608. /**                                                                   **/
  609. /***********************************************************************/
  610.  
  611. unsigned long ticks_per_second() { return((unsigned long) HZ); }
  612.  
  613. unsigned long run_tick_count()
  614. {
  615.   struct tms tm;
  616.  
  617.   times(&tm);
  618.   return((unsigned long) tm.tms_utime + tm.tms_stime );
  619. }
  620.  
  621. unsigned long real_tick_count()
  622. {                                  /* Real time */
  623.   return((unsigned long) (60 * (time((unsigned long *) NULL))));
  624. }
  625.  
  626.  
  627. LVAL xtime()
  628. {
  629.   LVAL expr, result;
  630.   unsigned long tm, rtm;
  631.   double dtm, rdtm;
  632.  
  633. /* get the expression to evaluate */
  634.   expr = xlgetarg();
  635.   xllastarg();
  636.  
  637.   tm = run_tick_count();
  638.   rtm = real_tick_count();
  639.   result = xleval(expr);
  640.   tm = run_tick_count() - tm;
  641.   rtm = real_tick_count() - rtm;
  642.   dtm = (tm > 0) ? tm : -tm;
  643.   rdtm = (rtm > 0) ? rtm : -rtm;
  644.   sprintf(buf, "CPU %.2f sec., Real %.2f sec.\n", dtm / ticks_per_second(),
  645.                                             rdtm / ticks_per_second());
  646.   trcputstr(buf);
  647.   return(result);
  648. }
  649.  
  650. LVAL xruntime() {
  651.     xllastarg();
  652.     return(cvfixnum((FIXTYPE) run_tick_count()));
  653. }
  654.  
  655. LVAL xrealtime() {
  656.     xllastarg();
  657.     return(cvfixnum((FIXTYPE) real_tick_count()));
  658. }
  659. #endif
  660.  
  661.  
  662. #ifndef BSD
  663. #if 0
  664. /*
  665.  * substitute for BSD/SVR3 rename() system call, from
  666.  * Janet Walz, walz@mimsy.umd.edu & Rich Salz, rsalz@pineapple.bbn.com
  667.  */
  668.  
  669. int 
  670. rename(oldname,newname)
  671. char *oldname,*newname;
  672. {
  673.     (void)unlink(newname);
  674.     if(link(oldname,newname))
  675.         return(-1);
  676.     return(unlink(oldname));
  677. }
  678. #endif
  679. #endif
  680.