home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / src / runtime / fsys.r < prev    next >
Text File  |  2002-01-18  |  34KB  |  1,517 lines
  1. /*
  2.  * File: fsys.r
  3.  *  Contents: close, chdir, exit, getenv, open, read, reads, remove, rename,
  4.  *  [save], seek, stop, system, where, write, writes, [getch, getche, kbhit]
  5.  */
  6.  
  7. #if MICROSOFT
  8. #define BadCode
  9. #endif                    /* MICROSOFT */
  10.  
  11. /*
  12.  * The following code is operating-system dependent [@fsys.01]. Include
  13.  *  system-dependent files and declarations.
  14.  */
  15.  
  16. #if PORT
  17.    /* nothing to do */
  18. Deliberate Syntax Error
  19. #endif                    /* PORT */
  20.  
  21. #if AMIGA
  22. #if __SASC
  23.    /* Undefine macros from fcntl.h and stdlib.h that collide with
  24.       function names in this module. */
  25. #passthru #undef close
  26. #passthru #undef open
  27. #passthru #undef read
  28. #passthru #undef write
  29. #passthru #undef getenv
  30. #endif __SASC                           /* __SASC */
  31. extern FILE *popen(const char *, const char *);
  32. extern int pclose(FILE *);
  33. #endif AMIGA                            /* AMIGA */
  34.  
  35. #if MSDOS || OS2 || UNIX || VMS
  36.    /* nothing to do */
  37. #endif                    /* MSDOS ... */
  38.  
  39. #if MACINTOSH && MPW
  40. extern int MPWFlush(FILE *f);
  41. #define fflush(f) MPWFlush(f)
  42. #endif                    /* MACINTOSH && MPW*/
  43.  
  44. /*
  45.  * End of operating-system specific code.
  46.  */
  47.  
  48.  
  49. #ifdef MSWindows
  50. #ifdef FAttrib
  51.  
  52. "fattrib(str, att) - get the attribute of a file "
  53.  
  54. function{*} fattrib (fname, att[argc])
  55.  
  56.    if !cnv:C_string(fname) then
  57.         runerr(103, fname)
  58.  
  59.    abstract {
  60.       return string ++ integer
  61.       }
  62.  
  63.    body {
  64.       tended char *s;
  65.       struct stat fs;
  66. #if UNIX
  67.       struct passwd *pwnam;
  68.       struct group  *grnam;
  69. #endif                    /* UNIX */
  70. #if NT
  71.       HFILE hf;
  72.       OFSTRUCT of;
  73.       FILETIME ft1,ft2,ft3;
  74.       SYSTEMTIME st;
  75. #endif                    /* NT */
  76.       int fd, i;
  77.       char *retval;
  78.       char *temp;
  79.       long l;
  80.  
  81.          if ( stat(fname, &fs) == -1 )
  82.             fail;
  83.      for(i=0; i<argc; i++) {
  84.         if (!cnv:C_string(att[i], s)) {
  85.            runerr(103, att[i]);
  86.            }
  87.          if ( !strcasecmp("size", s) ) {
  88.             suspend C_integer(fs.st_size);
  89.             }
  90.          else if ( !strcasecmp("status", s) ) {
  91.             temp = make_mode (fs.st_mode);
  92.         l = strlen(temp);
  93.             Protect(retval = alcstr(temp,l), runerr(0));
  94.         free(temp);
  95.             suspend string(l, retval);
  96.             }
  97. #if UNIX
  98.          else if ( !strcasecmp("owner", s) ) {
  99.             pwnam = getpwuid (fs.st_uid);
  100.         temp = pwnam->pw_name;
  101.         l = strlen(temp);
  102.         Protect(temp = alcstr(temp, l), runerr(0));
  103.             suspend string (l, temp);
  104.             }
  105.          else if ( !strcasecmp("group", s) ) {
  106.             grnam = getgrgid (fs.st_gid);
  107.         temp = grnam->gr_name;
  108.         l = strlen(temp);
  109.         Protect(temp = alcstr(temp, l), runerr(0));
  110.             suspend string (l, temp);
  111.             }
  112. #endif                    /* UNIX */
  113.          else if ( !strcasecmp("m_time", s) ) {
  114.         temp = ctime(&(fs.st_mtime));
  115.         l = strlen(temp);
  116.         if (temp[l-1] == '\n') l--;
  117.         Protect(temp = alcstr(temp, l), runerr(0));
  118.             suspend string(l, temp);
  119.             }
  120.          else if ( !strcasecmp("a_time", s) ) {
  121.         temp = ctime(&(fs.st_atime));
  122.         l = strlen(temp);
  123.         if (temp[l-1] == '\n') l--;
  124.         Protect(temp = alcstr(temp, l), runerr(0));
  125.             suspend string(l, temp);
  126.             }
  127.          else if ( !strcasecmp("c_time", s) ) {
  128.         temp = ctime(&(fs.st_ctime));
  129.         l = strlen(temp);
  130.         if (temp[l-1] == '\n') l--;
  131.         Protect(temp = alcstr(temp, l), runerr(0));
  132.             suspend string(l, temp);
  133.             }
  134.          else {
  135.             runerr(160);
  136.             }
  137.       }
  138.       fail;
  139.    }
  140. end
  141. #endif                    /* FAttrib */
  142. #endif                    /* MSWindows */
  143.  
  144. "close(f) - close file f."
  145.  
  146. function{1} close(f)
  147.  
  148.    if !is:file(f) then
  149.       runerr(105, f)
  150.  
  151.    abstract {
  152.       return file ++ integer
  153.       }
  154.  
  155.    body {
  156.       FILE *fp;
  157.       int status;
  158.  
  159.       fp = BlkLoc(f)->file.fd;
  160.       status = BlkLoc(f)->file.status;
  161.       if ((status & (Fs_Read | Fs_Write)) == 0)
  162.      return f;            /* if already closed */
  163.  
  164.       /*
  165.        * Close f, using fclose, pclose, or wclose as appropriate.
  166.        */
  167.  
  168. #ifdef Graphics
  169.       /*
  170.        * Close window if windows are supported.
  171.        */
  172.  
  173.       pollctr >>= 1;
  174.       pollctr++;
  175.       if (BlkLoc(f)->file.status & Fs_Window) {
  176.      if (BlkLoc(f)->file.status != Fs_Window) { /* not already closed? */
  177.         BlkLoc(f)->file.status = Fs_Window;
  178.         SETCLOSED((wbp) fp);
  179.         wclose((wbp) fp);
  180.         }
  181.      return f;
  182.      }
  183.       else
  184. #endif                    /* Graphics */
  185.  
  186. #ifdef ReadDirectory
  187.       if (BlkLoc(f)->file.status & Fs_Directory)
  188.          closedir((DIR*) fp);
  189.       else
  190. #endif                    /* ReadDirectory */
  191.  
  192. #if AMIGA || ARM || OS2 || UNIX || VMS
  193.       /*
  194.        * Close pipe if pipes are supported.
  195.        */
  196.  
  197.       if (BlkLoc(f)->file.status & Fs_Pipe) {
  198.      BlkLoc(f)->file.status = 0;
  199.      return C_integer((pclose(fp) >> 8) & 0377);
  200.      }
  201.       else
  202. #endif                    /* AMIGA || ARM || OS2 || ... */
  203.  
  204.       fclose(fp);
  205.       BlkLoc(f)->file.status = 0;
  206.  
  207.       /*
  208.        * Return the closed file.
  209.        */
  210.       return f;
  211.       }
  212. end
  213.  
  214. #undef exit
  215. #passthru #undef exit
  216.  
  217. "exit(i) - exit process with status i, which defaults to 0."
  218.  
  219. function{} exit(status)
  220.    if !def:C_integer(status, EXIT_SUCCESS) then
  221.       runerr(101, status)
  222.    inline {
  223.       c_exit((int)status);
  224.       }
  225. end
  226.  
  227.  
  228. "getenv(s) - return contents of environment variable s."
  229.  
  230. function{0,1} getenv(s)
  231.  
  232.    /*
  233.     * Make a C-style string out of s
  234.     */
  235.    if !cnv:C_string(s) then
  236.       runerr(103,s)
  237.    abstract {
  238.       return string
  239.       }
  240.  
  241.    inline {
  242.       register char *p;
  243.       long l;
  244.  
  245.       if ((p = getenv(s)) != NULL) {    /* get environment variable */
  246.      l = strlen(p);
  247.      Protect(p = alcstr(p,l),runerr(0));
  248.      return string(l,p);
  249.      }
  250.       else                /* fail if not in environment */
  251.      fail;
  252.  
  253.       }
  254. end
  255.  
  256.  
  257. #ifdef Graphics
  258. "open(s1, s2, ...) - open file named s1 with options s2"
  259. " and attributes given in trailing arguments."
  260. function{0,1} open(fname, spec, attr[n])
  261. #else                        /* Graphics */
  262. "open(fname, spec) - open file fname with specification spec."
  263. function{0,1} open(fname, spec)
  264. #endif                        /* Graphics */
  265.    declare {
  266.       tended struct descrip filename;
  267.       }
  268.  
  269.    /*
  270.     * fopen and popen require a C string, but it looks terrible in
  271.     *  error messages, so convert it to a string here and use a local
  272.     *  variable (fnamestr) to store the C string.
  273.     */
  274.    if !cnv:string(fname) then
  275.       runerr(103, fname)
  276.  
  277.    /*
  278.     * spec defaults to "r".
  279.     */
  280.    if !def:tmp_string(spec, letr) then
  281.       runerr(103, spec)
  282.  
  283.    abstract {
  284.       return file
  285.       }
  286.  
  287.    body {
  288.       tended char *fnamestr;
  289.       register word slen;
  290.       register int i;
  291.       register char *s;
  292.       int status;
  293.       char mode[4];
  294.       extern FILE *fopen();
  295.       FILE *f;
  296.       struct b_file *fl;
  297.  
  298. #ifdef Graphics
  299.       int j, err_index = -1;
  300.       tended struct b_list *hp;
  301.       tended struct b_lelem *bp;
  302. #endif                    /* Graphics */
  303.  
  304. /*
  305.  * The following code is operating-system dependent [@fsys.02].  Make
  306.  *  declarations as needed for opening files.
  307.  */
  308.  
  309. #if PORT
  310. Deliberate Syntax Error
  311. #endif                    /* PORT */
  312.  
  313. #if AMIGA || MACINTOSH || MSDOS || OS2
  314.    /* nothing is needed */
  315. #endif                    /* AMIGA || ... */
  316.  
  317. #if ARM
  318.       extern FILE *popen(const char *, const char *);
  319.       extern int pclose(FILE *);
  320. #endif                    /* ARM */
  321.  
  322. #if OS2 || UNIX || VMS
  323.       extern FILE *popen();
  324. #endif                    /* OS2 || UNIX || VMS */
  325.  
  326. /*
  327.  * End of operating-system specific code.
  328.  */
  329.  
  330.       /*
  331.        * get a C string for the file name
  332.        */
  333.       if (!cnv:C_string(fname, fnamestr))
  334.      runerr(103,fname);
  335.  
  336.       status = 0;
  337.  
  338.       /*
  339.        * Scan spec, setting appropriate bits in status.  Produce a
  340.        *  run-time error if an unknown character is encountered.
  341.        */
  342.       s = StrLoc(spec);
  343.       slen = StrLen(spec);
  344.       for (i = 0; i < slen; i++) {
  345.      switch (*s++) {
  346.         case 'a':
  347.         case 'A':
  348.            status |= Fs_Write|Fs_Append;
  349.            continue;
  350.         case 'b':
  351.         case 'B':
  352.            status |= Fs_Read|Fs_Write;
  353.            continue;
  354.         case 'c':
  355.         case 'C':
  356.            status |= Fs_Create|Fs_Write;
  357.            continue;
  358.         case 'r':
  359.         case 'R':
  360.            status |= Fs_Read;
  361.            continue;
  362.         case 'w':
  363.         case 'W':
  364.            status |= Fs_Write;
  365.            continue;
  366.         case 't':
  367.         case 'T':
  368.            status &= ~Fs_Untrans;
  369.            continue;
  370.         case 'u':
  371.         case 'U':
  372.            status |= Fs_Untrans;
  373.            continue;
  374.  
  375. #if AMIGA || ARM || OS2 || UNIX || VMS
  376.         case 'p':
  377.         case 'P':
  378.            status |= Fs_Pipe;
  379.            continue;
  380. #endif                    /* AMIGA || ARM || OS2 || UNIX || VMS */
  381.  
  382.         case 'x':
  383.         case 'X':
  384.         case 'g':
  385.         case 'G':
  386. #ifdef Graphics
  387.            status |= Fs_Window | Fs_Read | Fs_Write;
  388.            continue;
  389. #else                    /* Graphics */
  390.            fail;
  391. #endif                    /* Graphics */
  392.  
  393.         default:
  394.            runerr(209, spec);
  395.         }
  396.      }
  397.  
  398.       /*
  399.        * Construct a mode field for fopen/popen.
  400.        */
  401.       mode[0] = '\0';
  402.       mode[1] = '\0';
  403.       mode[2] = '\0';
  404.       mode[3] = '\0';
  405.  
  406.       if ((status & (Fs_Read|Fs_Write)) == 0)    /* default: read only */
  407.      status |= Fs_Read;
  408.       if (status & Fs_Create)
  409.      mode[0] = 'w';
  410.       else if (status & Fs_Append)
  411.      mode[0] = 'a';
  412.       else if (status & Fs_Read)
  413.      mode[0] = 'r';
  414.       else
  415.      mode[0] = 'w';
  416.  
  417. /*
  418.  * The following code is operating-system dependent [@fsys.05].  Handle open
  419.  *  modes.
  420.  */
  421.  
  422. #if PORT
  423.       if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write))
  424.      mode[1] = '+';
  425. Deliberate Syntax Error
  426. #endif                    /* PORT */
  427.  
  428. #if AMIGA || ARM || UNIX || VMS
  429.       if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write))
  430.      mode[1] = '+';
  431. #endif                    /* AMIGA || ARM || UNIX || VMS */
  432.  
  433. #if MACINTOSH
  434.       /* nothing to do */
  435. #endif                    /* MACINTOSH */
  436.  
  437. #if MSDOS || OS2
  438.       if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) {
  439.      mode[1] = '+';
  440. #if CSET2
  441.          /* we don't have the 't' in C Set/2 */
  442.          if ((status & Fs_Untrans) != 0) mode[2] = 'b';
  443.          } /* End of if - open file for reading or writing */
  444.       else if ((status & Fs_Untrans) != 0) mode[1] = 'b';
  445. #else                    /* CSET2 */
  446.      mode[2] = ((status & Fs_Untrans) != 0) ? 'b' : 't';
  447.      }
  448.       else mode[1] = ((status & Fs_Untrans) != 0) ? 'b' : 't';
  449. #endif                    /* CSET2 */
  450. #endif                    /* MSDOS || OS2 */
  451.  
  452. /*
  453.  * End of operating-system specific code.
  454.  */
  455.  
  456.       /*
  457.        * Open the file with fopen or popen.
  458.        */
  459.  
  460. #ifdef Graphics
  461.       if (status & Fs_Window) {
  462.      /*
  463.       * allocate an empty event queue for the window
  464.       */
  465.      Protect(hp = alclist(0), runerr(0));
  466.      Protect(bp = alclstb(MinListSlots, (word)0, 0), runerr(0));
  467.      hp->listhead = hp->listtail = (union block *) bp;
  468. #ifdef ListFix
  469.      bp->listprev = bp->listnext = (union block *) hp;
  470. #endif                    /* ListFix */
  471.  
  472.      /*
  473.       * loop through attributes, checking validity
  474.       */
  475.      for (j = 0; j < n; j++) {
  476.         if (is:null(attr[j]))
  477.            attr[j] = emptystr;
  478.         if (!is:string(attr[j]))
  479.            runerr(109, attr[j]);
  480.         }
  481.  
  482.      f = (FILE *)wopen(fnamestr, hp, attr, n, &err_index);
  483.      if (f == NULL) {
  484.         if (err_index >= 0) runerr(145, attr[err_index]);
  485.         else if (err_index == -1) fail;
  486.         else runerr(305);
  487.         }
  488.      } else
  489. #endif                    /* Graphics */
  490.  
  491. #if AMIGA || ARM || OS2 || UNIX || VMS
  492.       if (status & Fs_Pipe) {
  493.      if (status != (Fs_Read|Fs_Pipe) && status != (Fs_Write|Fs_Pipe))
  494.         runerr(209, spec);
  495.      f = popen(fnamestr, mode);
  496.      }
  497.       else
  498. #endif                    /* AMIGA || ARM || OS2 || ... */
  499.  
  500.          {
  501. #ifdef ReadDirectory
  502.          struct stat sbuf;
  503.          if ((status & Fs_Write) == 0
  504.          && stat(fnamestr, &sbuf) == 0
  505.          && S_ISDIR(sbuf.st_mode)) {
  506.             status |= Fs_Directory;
  507.             f = (FILE*) opendir(fnamestr);
  508.             }
  509.          else
  510. #endif                    /* ReadDirectory */
  511.             f = fopen(fnamestr, mode);
  512.          }
  513.  
  514.       /*
  515.        * Fail if the file cannot be opened.
  516.        */
  517.       if (f == NULL) {
  518. #ifdef MSWindows
  519.          char tempbuf[512];
  520.      *tempbuf = '\0';
  521.          if (strchr(fnamestr, '*') || strchr(fnamestr, '?')) {
  522.             /*
  523.          * attempted to open a wildcard, do file completion
  524.          */
  525.         strcpy(tempbuf, fnamestr);
  526.             }
  527.      else {
  528.             /*
  529.          * check and see if the file was actually a directory
  530.          */
  531.             struct stat fs;
  532.             if (stat(fnamestr, &fs) == -1) fail;
  533.         if (fs.st_mode & _S_IFDIR) {
  534.            strcpy(tempbuf, fnamestr);
  535.            if (tempbuf[strlen(tempbuf)-1] != '\\')
  536.               strcat(tempbuf, "\\");
  537.            strcat(tempbuf, "*.*");
  538.            }
  539.         }
  540.          if (*tempbuf) {
  541.             FINDDATA_T fd;
  542.         if (!FINDFIRST(tempbuf, &fd)) fail;
  543.             f = tmpfile();
  544.             if (f == NULL) fail;
  545.             do {
  546.                fprintf(f, "%s\n", FILENAME(&fd));
  547.                } while (FINDNEXT(&fd));
  548.             FINDCLOSE(&fd);
  549.             fflush(f);
  550.             fseek(f, 0, SEEK_SET);
  551.             if (f == NULL) fail;
  552.         }
  553. #else                    /* MSWindows */
  554.      fail;
  555. #endif                    /* MSWindows */
  556.      }
  557.  
  558. #if MACINTOSH
  559. #if MPW
  560.       {
  561.      void SetFileToMPWText(const char *fname);
  562.  
  563.      if (status & Fs_Write)
  564.         SetFileToMPWText(fnamestr);
  565.       }
  566. #endif                    /* MPW */
  567. #endif                    /* MACINTOSH */
  568.  
  569.       /*
  570.        * Return the resulting file value.
  571.        */
  572.       StrLen(filename) = strlen(fnamestr);
  573.       StrLoc(filename) = fnamestr;
  574.  
  575.       Protect(fl = alcfile(f, status, &filename), runerr(0));
  576. #ifdef Graphics
  577.       /*
  578.        * link in the Icon file value so this window can find it
  579.        */
  580.       if (status & Fs_Window) {
  581.      ((wbp)f)->window->filep.dword = D_File;
  582.      BlkLoc(((wbp)f)->window->filep) = (union block *)fl;
  583.      if (is:null(lastEventWin)) {
  584.         lastEventWin = ((wbp)f)->window->filep;
  585.             lastEvFWidth = FWIDTH((wbp)f);
  586.             lastEvLeading = LEADING((wbp)f);
  587.             lastEvAscent = ASCENT((wbp)f);
  588.             }
  589.      }
  590. #endif                    /* Graphics */
  591.       return file(fl);
  592.       }
  593. end
  594.  
  595.  
  596. "read(f) - read line on file f."
  597.  
  598. function{0,1} read(f)
  599.    /*
  600.     * Default f to &input.
  601.     */
  602.    if is:null(f) then
  603.       inline {
  604.      f.dword = D_File;
  605.      BlkLoc(f) = (union block *)&k_input;
  606.      }
  607.    else if !is:file(f) then
  608.       runerr(105, f)
  609.  
  610.    abstract {
  611.       return string
  612.       }
  613.  
  614.    body {
  615.       register word slen, rlen;
  616.       register char *sp;
  617.       int status;
  618.       static char sbuf[MaxReadStr];
  619.       tended struct descrip s;
  620.       FILE *fp;
  621.  
  622.       /*
  623.        * Get a pointer to the file and be sure that it is open for reading.
  624.        */
  625.       fp = BlkLoc(f)->file.fd;
  626.       status = BlkLoc(f)->file.status;
  627.       if ((status & Fs_Read) == 0)
  628.      runerr(212, f);
  629.  
  630.       if (status & Fs_Writing) {
  631.      fseek(fp, 0L, SEEK_CUR);
  632.      BlkLoc(f)->file.status &= ~Fs_Writing;
  633.      }
  634.       BlkLoc(f)->file.status |= Fs_Reading;
  635.  
  636. #ifdef ReadDirectory
  637.       if ((BlkLoc(f)->file.status & Fs_Directory) != 0) {
  638.          struct dirent *de = readdir((DIR*) fp);
  639.          if (de == NULL)
  640.             fail;
  641.          slen = strlen(de->d_name);
  642.          Protect(sp = alcstr(de->d_name, slen), runerr(0));
  643.          return string(slen, sp);
  644.          }
  645. #endif                    /* ReadDirectory */
  646.  
  647. #ifdef ConsoleWindow
  648.       /*
  649.        * if file is &input, then make sure our console is open and read
  650.        * from it, unless input redirected
  651.        */
  652.       if (fp == stdin
  653.            && !(ConsoleFlags & StdInRedirect)
  654.            ) {
  655.         fp = OpenConsole();
  656.         status = Fs_Window | Fs_Read | Fs_Write;
  657.         }
  658.  
  659. #endif                    /* ConsoleWindow */
  660.       /*
  661.        * Use getstrg to read a line from the file, failing if getstrg
  662.        *  encounters end of file. [[ What about -2?]]
  663.        */
  664.       StrLen(s) = 0;
  665.       do {
  666. #ifdef Graphics
  667.      pollctr >>= 1;
  668.      pollctr++;
  669.      if (status & Fs_Window) {
  670.         slen = wgetstrg(sbuf,MaxReadStr,fp);
  671.         if (slen == -1)
  672.            runerr(141);
  673.         if (slen == -2)
  674.            runerr(143);
  675.         if (slen == -3)
  676.                fail;
  677.         }
  678.      else
  679. #endif                    /* Graphics */
  680.  
  681.      if ((slen = getstrg(sbuf, MaxReadStr, &BlkLoc(f)->file)) == -1)
  682.         fail;
  683.  
  684.      /*
  685.       * Allocate the string read and make s a descriptor for it.
  686.       */
  687.      rlen = slen < 0 ? (word)MaxReadStr : slen;
  688.  
  689.      Protect(reserve(Strings, rlen), runerr(0));
  690.      if (StrLen(s) > 0 && !InRange(strbase,StrLoc(s),strfree)) {
  691.         Protect(reserve(Strings, StrLen(s)+rlen), runerr(0));
  692.         Protect((StrLoc(s) = alcstr(StrLoc(s),StrLen(s))), runerr(0));
  693.         }
  694.  
  695.      Protect(sp = alcstr(sbuf,rlen), runerr(0));
  696.      if (StrLen(s) == 0)
  697.         StrLoc(s) = sp;
  698.      StrLen(s) += rlen;
  699.      } while (slen < 0);
  700.       return s;
  701.       }
  702. end
  703.  
  704.  
  705. "reads(f,i) - read i characters on file f."
  706.  
  707. function{0,1} reads(f,i)
  708.    /*
  709.     * Default f to &input.
  710.     */
  711.    if is:null(f) then
  712.       inline {
  713.      f.dword = D_File;
  714.      BlkLoc(f) = (union block *)&k_input;
  715.      }
  716.    else if !is:file(f) then
  717.       runerr(105, f)
  718.  
  719.    /*
  720.     * i defaults to 1 (read a single character)
  721.     */
  722.    if !def:C_integer(i,1L) then
  723.       runerr(101, i)
  724.  
  725.    abstract {
  726.       return string
  727.       }
  728.  
  729.    body {
  730.       long tally, nbytes;
  731.       int status;
  732.       FILE *fp;
  733.       tended struct descrip s;
  734.  
  735.       /*
  736.        * Get a pointer to the file and be sure that it is open for reading.
  737.        */
  738.       fp = BlkLoc(f)->file.fd;
  739.       status = BlkLoc(f)->file.status;
  740.       if ((status & Fs_Read) == 0)
  741.      runerr(212, f);
  742.  
  743.       if (status & Fs_Writing) {
  744.      fseek(fp, 0L, SEEK_CUR);
  745.      BlkLoc(f)->file.status &= ~Fs_Writing;
  746.      }
  747.       BlkLoc(f)->file.status |= Fs_Reading;
  748.  
  749. #ifdef ConsoleWindow
  750.       /*
  751.        * if file is &input, then make sure our console is open and read
  752.        * from it, unless input redirected
  753.        */
  754.       if (fp == stdin
  755.           && !(ConsoleFlags & StdInRedirect)
  756.           ) {
  757.         fp = OpenConsole();
  758.         status = Fs_Read | Fs_Write | Fs_Window;
  759.         }
  760. #endif                    /* ConsoleWindow */
  761.  
  762.       /*
  763.        * Be sure that a positive number of bytes is to be read.
  764.        */
  765.       if (i <= 0) {
  766.      irunerr(205, i);
  767.  
  768.      errorfail;
  769.      }
  770.  
  771. #ifdef ReadDirectory
  772.       /*
  773.        *  If reading a directory, return up to i bytes of next entry.
  774.        */
  775.       if ((BlkLoc(f)->file.status & Fs_Directory) != 0) {
  776.          char *sp;
  777.          struct dirent *de = readdir((DIR*) fp);
  778.          if (de == NULL)
  779.             fail;
  780.          nbytes = strlen(de->d_name);
  781.          if (nbytes > i)
  782.             nbytes = i;
  783.          Protect(sp = alcstr(de->d_name, nbytes), runerr(0));
  784.          return string(nbytes, sp);
  785.          }
  786. #endif                    /* ReadDirectory */
  787.  
  788.       /*
  789.        * For now, assume we can read the full number of bytes.
  790.        */
  791.       Protect(StrLoc(s) = alcstr(NULL, i), runerr(0));
  792.       StrLen(s) = 0;
  793.  
  794. #if AMIGA
  795. #if LATTICE
  796.       /*
  797.        * The following code is special for Lattice 4.0 -- it was different
  798.        *  for Lattice 3.10.  It probably won't work correctly with other
  799.        *  C compilers.
  800.        */
  801.       if (IsInteractive(_ufbs[fileno(fp)].ufbfh)) {
  802.      if ((i = read(fileno(fp),StrLoc(s),i)) <= 0)
  803.         fail;
  804.      StrLen(s) = i;
  805.      /*
  806.       * We may not have used the entire amount of storage we reserved.
  807.       */
  808.      nbytes = DiffPtrs(StrLoc(s) + i, strfree);
  809.      if (nbytes < 0)
  810.         EVVal(-nbytes, E_StrDeAlc);
  811.      else
  812.         EVVal(nbytes, E_String);
  813.      strtotal += nbytes;
  814.      strfree = StrLoc(s) + i;
  815.      return s;
  816.      }
  817. #endif                    /* LATTICE */
  818. #endif                    /* AMIGA */
  819.  
  820. #ifdef Graphics
  821.       pollctr >>= 1;
  822.       pollctr++;
  823.       if (status & Fs_Window) {
  824.      tally = wlongread(StrLoc(s),sizeof(char),i,fp);
  825.      if (tally == -1)
  826.         runerr(141);
  827.      else if (tally == -2)
  828.         runerr(143);
  829.      else if (tally == -3)
  830.             fail;
  831.      }
  832.       else
  833. #endif                    /* Graphics */
  834.       tally = longread(StrLoc(s),sizeof(char),i,fp);
  835.  
  836.       if (tally == 0)
  837.      fail;
  838.       StrLen(s) = tally;
  839.       /*
  840.        * We may not have used the entire amount of storage we reserved.
  841.        */
  842.       nbytes = DiffPtrs(StrLoc(s) + tally, strfree);
  843.       if (nbytes < 0)
  844.          EVVal(-nbytes, E_StrDeAlc);
  845.       else
  846.          EVVal(nbytes, E_String);
  847.       strtotal += nbytes;
  848.       strfree = StrLoc(s) + tally;
  849.       return s;
  850.       }
  851. end
  852.  
  853.  
  854. "remove(s) - remove the file named s."
  855.  
  856. function{0,1} remove(s)
  857.  
  858.    /*
  859.     * Make a C-style string out of s
  860.     */
  861.    if !cnv:C_string(s) then
  862.       runerr(103,s)
  863.    abstract {
  864.       return null
  865.       }
  866.  
  867.    inline {
  868.       if (remove(s) != 0)
  869.      fail;
  870.       return nulldesc;
  871.       }
  872. end
  873.  
  874.  
  875. "rename(s1,s2) - rename the file named s1 to have the name s2."
  876.  
  877. function{0,1} rename(s1,s2)
  878.  
  879.    /*
  880.     * Make C-style strings out of s1 and s2
  881.     */
  882.    if !cnv:C_string(s1) then
  883.       runerr(103,s1)
  884.    if !cnv:C_string(s2) then
  885.       runerr(103,s2)
  886.  
  887.    abstract {
  888.       return null
  889.       }
  890.  
  891.    body {
  892.       if (rename(s1,s2) != 0)
  893.      fail;
  894.       return nulldesc;
  895.       }
  896. end
  897.  
  898. #ifdef ExecImages
  899.  
  900. "save(s) - save the run-time system in file s"
  901.  
  902. function{0,1} save(s)
  903.  
  904.    if !cnv:C_string(s) then
  905.       runerr(103,s)
  906.  
  907.    abstract {
  908.       return integer
  909.       }
  910.  
  911.    body {
  912.       char sbuf[MaxCvtLen];
  913.       int f, fsz;
  914.  
  915.       dumped = 1;
  916.  
  917.       /*
  918.        * Open the file for the executable image.
  919.        */
  920.       f = creat(s, 0777);
  921.       if (f == -1)
  922.      fail;
  923.       fsz = wrtexec(f);
  924.       /*
  925.        * It happens that most wrtexecs don't check the system call return
  926.        *  codes and thus they'll never return -1.  Nonetheless...
  927.        */
  928.       if (fsz == -1)
  929.      fail;
  930.       /*
  931.        * Return the size of the data space.
  932.        */
  933.       return C_integer fsz;
  934.       }
  935. end
  936. #endif                    /* ExecImages */
  937.  
  938.  
  939. "seek(f,i) - seek to offset i in file f."
  940. " [[ What about seek error ? ]] "
  941.  
  942. function{0,1} seek(f,o)
  943.  
  944.    /*
  945.     * f must be a file
  946.     */
  947.    if !is:file(f) then
  948.       runerr(105,f)
  949.  
  950.    /*
  951.     * o must be an integer and defaults to 1.
  952.     */
  953.    if !def:C_integer(o,1L) then
  954.       runerr(0)
  955.  
  956.    abstract {
  957.       return file
  958.       }
  959.  
  960.    body {
  961.       FILE *fd;
  962.  
  963.       fd = BlkLoc(f)->file.fd;
  964.       if (BlkLoc(f)->file.status == 0)
  965.      fail;
  966. #ifdef ReadDirectory
  967.       if ((BlkLoc(f)->file.status & Fs_Directory) != 0)
  968.          fail;
  969. #endif                    /* ReadDirectory */
  970.  
  971. #ifdef Graphics
  972.       pollctr >>= 1;
  973.       pollctr++;
  974.       if (BlkLoc(f)->file.status & Fs_Window)
  975.      fail;
  976. #endif                    /* Graphics */
  977.  
  978.       if (o > 0) {
  979.      if (fseek(fd, o - 1, SEEK_SET) != 0)
  980.         fail;
  981.      }
  982.       else {
  983.  
  984. #if CSET2
  985. /* unreliable seeking from the end in CSet/2 on a text stream, so
  986.    we will fixup seek-from-end to seek-from-beginning */
  987.     long size;
  988.     long save_pos;
  989.  
  990.     /* save the position in case we have to reset it */
  991.     save_pos = ftell(fd);
  992.     /* seek to the end and get the file size */
  993.     fseek(fd, 0, SEEK_END);
  994.     size = ftell(fd);
  995.     /* try to accomplish the fixed-up seek */
  996.     if (fseek(fd, size + o, SEEK_SET)) {
  997.        fseek(fd, save_pos, SEEK_SET);
  998.        fail;
  999.        }  /* End of if - seek failed, reset position */
  1000. #else
  1001.      if (fseek(fd, o, SEEK_END) != 0)
  1002.         fail;
  1003. #endif                    /* CSET2 */
  1004.      }
  1005.       BlkLoc(f)->file.status &= ~(Fs_Reading | Fs_Writing);
  1006.       return f;
  1007.       }
  1008. end
  1009.  
  1010.  
  1011. "system(s) - execute string s as a system command."
  1012.  
  1013. function{1} system(s)
  1014.    /*
  1015.     * Make a C-style string out of s
  1016.     */
  1017.    if !cnv:C_string(s) then
  1018.       runerr(103,s)
  1019.  
  1020.    abstract {
  1021.       return integer
  1022.       }
  1023.  
  1024.    inline {
  1025.       /*
  1026.        * Pass the C string to the system() function and return
  1027.        * the exit code of the command as the result of system().
  1028.        * Note, the expression on a "return" may not have side effects,
  1029.        * so the exit code must be returned via a variable.
  1030.        */
  1031.       C_integer i;
  1032.  
  1033. #ifdef Graphics
  1034.       pollctr >>= 1;
  1035.       pollctr++;
  1036. #endif                    /* Graphics */
  1037.  
  1038.       i = (C_integer)system(s);
  1039.       return C_integer i;
  1040.       }
  1041. end
  1042.  
  1043.  
  1044.  
  1045. "where(f) - return current offset position in file f."
  1046.  
  1047. function{0,1} where(f)
  1048.  
  1049.    if !is:file(f) then
  1050.       runerr(105,f)
  1051.  
  1052.    abstract {
  1053.       return integer
  1054.       }
  1055.  
  1056.    body {
  1057.       FILE *fd;
  1058.       long ftell();
  1059.       long pos;
  1060.  
  1061.       fd = BlkLoc(f)->file.fd;
  1062.  
  1063.       if ((BlkLoc(f)->file.status == 0))
  1064.      fail;
  1065. #ifdef ReadDirectory
  1066.       if ((BlkLoc(f)->file.status & Fs_Directory) != 0)
  1067.          fail;
  1068. #endif                    /* ReadDirectory */
  1069.  
  1070. #ifdef Graphics
  1071.       pollctr >>= 1;
  1072.       pollctr++;
  1073.       if (BlkLoc(f)->file.status & Fs_Window)
  1074.      fail;
  1075. #endif                    /* Graphics */
  1076.  
  1077.       pos = ftell(fd) + 1;
  1078.       if (pos == 0)
  1079.      fail;    /* may only be effective on ANSI systems */
  1080.  
  1081.       return C_integer pos;
  1082.       }
  1083. end
  1084.  
  1085. /*
  1086.  * stop(), write(), and writes() differ in whether they stop the program
  1087.  *  and whether they output newlines. The macro GenWrite is used to
  1088.  *  produce all three functions.
  1089.  */
  1090. #define False 0
  1091. #define True 1
  1092.  
  1093. #begdef DefaultFile(error_out)
  1094.    inline {
  1095. #if error_out
  1096.       if ((k_errout.status & Fs_Write) == 0)
  1097.      runerr(213);
  1098.       else {
  1099. #ifndef ConsoleWindow
  1100.      f = k_errout.fd;
  1101. #else                    /* ConsoleWindow */
  1102.          f = (ConsoleFlags & StdErrRedirect) ? k_errout.fd : OpenConsole();
  1103. #endif                    /* ConsoleWindow */
  1104.      }
  1105. #else                    /* error_out */
  1106.       if ((k_output.status & Fs_Write) == 0)
  1107.      runerr(213);
  1108.       else {
  1109. #ifndef ConsoleWindow
  1110.      f = k_output.fd;
  1111. #else                    /* ConsoleWindow */
  1112.          f = (ConsoleFlags & StdOutRedirect) ? k_output.fd : OpenConsole();
  1113. #endif                    /* ConsoleWindow */
  1114.      }
  1115. #endif                    /* error_out */
  1116.       }
  1117. #enddef                    /* DefaultFile */
  1118.  
  1119. #begdef Finish(retvalue, nl, terminate)
  1120. #if nl
  1121.    /*
  1122.     * Append a newline to the file.
  1123.     */
  1124. #ifdef Graphics
  1125.    pollctr >>= 1;
  1126.    pollctr++;
  1127.    if (status & Fs_Window)
  1128.       wputc('\n',(wbp)f);
  1129.    else
  1130. #endif                    /* Graphics */
  1131.       putc('\n', f);
  1132. #endif                    /* nl */
  1133.  
  1134.    /*
  1135.     * Flush the file.
  1136.     */
  1137. #ifdef Graphics
  1138.    if (!(status & Fs_Window)) {
  1139. #endif                    /* Graphics */
  1140.       if (ferror(f))
  1141.      runerr(214);
  1142.       fflush(f);
  1143.  
  1144. #ifdef Graphics
  1145.       }
  1146. #ifdef PresentationManager
  1147.     /* must be writing to a window, then, if it is not the console,
  1148.        we have to set the background mix mode of the character bundle
  1149.        back to LEAVEALONE so the background is no longer clobbered */
  1150.     else if (f != ConsoleBinding) {
  1151.       /* have to set the background mode back to leave-alone */
  1152.       ((wbp)f)->context->charBundle.usBackMixMode = BM_LEAVEALONE;
  1153.       /* force the reload on next use */
  1154.       ((wbp)f)->window->charContext = NULL;
  1155.       } /* End of else if - not the console window we're writing to */
  1156. #endif                    /* PresentationManager */
  1157. #endif                    /* Graphics */
  1158.  
  1159.  
  1160. #if terminate
  1161.         c_exit(EXIT_FAILURE);
  1162. #else                    /* terminate */
  1163.         return retvalue;
  1164. #endif                    /* terminate */
  1165. #enddef                    /* Finish */
  1166.  
  1167. #begdef GenWrite(name, nl, terminate)
  1168.  
  1169. #name "(a,b,...) - write arguments"
  1170. #if !nl
  1171.    " without newline terminator"
  1172. #endif                    /* nl */
  1173. #if terminate
  1174.    " (starting on error output) and stop"
  1175. #endif                    /* terminate */
  1176. "."
  1177.  
  1178. #if terminate
  1179. function {} name(x[nargs])
  1180. #else                    /* terminate */
  1181. function {1} name(x[nargs])
  1182. #endif                    /* terminate */
  1183.  
  1184.    declare {
  1185.       FILE *f = NULL;
  1186.       word status =
  1187. #if terminate
  1188. #ifndef ConsoleWindow
  1189.     k_errout.status;
  1190. #else                    /* ConsoleWindow */
  1191.         (ConsoleFlags & StdErrRedirect) ? k_errout.status : Fs_Read | Fs_Write | Fs_Window;
  1192. #endif                    /* ConsoleWindow */
  1193. #else                    /* terminate */
  1194. #ifndef ConsoleWindow
  1195.     k_output.status;
  1196. #else                    /* ConsoleWindow */
  1197.         (ConsoleFlags & StdOutRedirect) ? k_output.status : Fs_Read | Fs_Write | Fs_Window;
  1198. #endif                    /* ConsoleWindow */
  1199. #endif                    /* terminate */
  1200.  
  1201. #ifdef BadCode
  1202.       struct descrip temp;
  1203. #endif                    /* BadCode */
  1204.       }
  1205.  
  1206. #if terminate
  1207.    abstract {
  1208.       return empty_type
  1209.       }
  1210. #endif                    /* terminate */
  1211.  
  1212.    len_case nargs of {
  1213.       0: {
  1214. #if !terminate
  1215.      abstract {
  1216.         return null
  1217.         }
  1218. #endif                    /* terminate */
  1219.      DefaultFile(terminate)
  1220.      body {
  1221.         Finish(nulldesc, nl, terminate)
  1222.         }
  1223.      }
  1224.  
  1225.       default: {
  1226. #if !terminate
  1227.      abstract {
  1228.         return type(x)
  1229.         }
  1230. #endif                    /* terminate */
  1231.      /*
  1232.       * See if we need to start with the default file.
  1233.       */
  1234.      if !is:file(x[0]) then
  1235.         DefaultFile(terminate)
  1236.  
  1237.      body {
  1238.         tended struct descrip t;
  1239.         register word n;
  1240.  
  1241.         /*
  1242.          * Loop through the arguments.
  1243.          */
  1244.         for (n = 0; n < nargs; n++) {
  1245.            if (is:file(x[n])) {    /* Current argument is a file */
  1246. #if nl
  1247.           /*
  1248.            * If this is not the first argument, output a newline to the
  1249.            * current file and flush it.
  1250.            */
  1251.           if (n > 0) {
  1252.  
  1253.              /*
  1254.               * Append a newline to the file and flush it.
  1255.               */
  1256. #ifdef Graphics
  1257.              pollctr >>= 1;
  1258.              pollctr++;
  1259.              if (status & Fs_Window) {
  1260.             wputc('\n',(wbp)f);
  1261.             wflush((wbp)f);
  1262.               }
  1263.              else {
  1264. #endif                    /* Graphics */
  1265.             putc('\n', f);
  1266.             if (ferror(f))
  1267.                runerr(214);
  1268.             fflush(f);
  1269. #ifdef Graphics
  1270.             }
  1271. #endif                    /* Graphics */
  1272.              }
  1273. #endif                    /* nl */
  1274.  
  1275. #ifdef PresentationManager
  1276.                  /* have to put the background mix back on the current file */
  1277.                  if (f != NULL && (status & Fs_Window) && f != ConsoleBinding) {
  1278.                    /* set the background back to leave-alone */
  1279.                    ((wbp)f)->context->charBundle.usBackMixMode = BM_LEAVEALONE;
  1280.                    /* unload the context from this window */
  1281.                    ((wbp)f)->window->charContext = NULL;
  1282.                    }
  1283. #endif                    /* PresentationManager */
  1284.  
  1285.           /*
  1286.            * Switch the current file to the file named by the current
  1287.            * argument providing it is a file.
  1288.            */
  1289.           status = BlkLoc(x[n])->file.status;
  1290.           if ((status & Fs_Write) == 0)
  1291.              runerr(213, x[n]);
  1292.           f = BlkLoc(x[n])->file.fd;
  1293. #ifdef ConsoleWindow
  1294.                   if ((f == stdout && !(ConsoleFlags & StdOutRedirect)) ||
  1295.                       (f == stderr && !(ConsoleFlags & StdErrRedirect))) {
  1296.                      f = OpenConsole();
  1297.                      status = Fs_Read | Fs_Write | Fs_Window;
  1298.                      }
  1299. #endif                    /* ConsoleWindow */
  1300. #ifdef PresentationManager
  1301.                   if (status & Fs_Window) {
  1302.                      /*
  1303.               * have to set the background to overpaint - the one
  1304.                       * difference between DrawString and write(s)
  1305.               */
  1306.                     ((wbp)f)->context->charBundle.usBackMixMode = BM_OVERPAINT;
  1307.                     /* unload the context from the window so it will be reloaded */
  1308.                     ((wbp)f)->window->charContext = NULL;
  1309.                     }
  1310. #endif                    /* PresentationManager */
  1311.           }
  1312.            else {
  1313.           /*
  1314.            * Convert the argument to a string, defaulting to a empty
  1315.            *  string.
  1316.            */
  1317.           if (!def:tmp_string(x[n],emptystr,t))
  1318.              runerr(109, x[n]);
  1319.  
  1320.           /*
  1321.            * Output the string.
  1322.            */
  1323. #ifdef Graphics
  1324.           if (status & Fs_Window)
  1325.              wputstr((wbp)f, StrLoc(t), StrLen(t));
  1326.           else
  1327. #endif                    /* Graphics */
  1328.           if (putstr(f, &t) == Failed) {
  1329.              runerr(214, x[n]);
  1330.              }
  1331.           }
  1332.            }
  1333.  
  1334.         Finish(x[n-1], nl, terminate)
  1335.         }
  1336.      }
  1337.       }
  1338. end
  1339. #enddef                    /* GenWrite */
  1340.  
  1341. GenWrite(stop,     True,    True)  /* stop(s, ...) - write message and stop */
  1342. GenWrite(write,  True,    False) /* write(s, ...) - write with new-line */
  1343. GenWrite(writes, False, False) /* writes(s, ...) - write with no new-line */
  1344.  
  1345. #ifdef KeyboardFncs
  1346.  
  1347. "getch() - return a character from console."
  1348.  
  1349. function{0,1} getch()
  1350.    abstract {
  1351.       return string;
  1352.       }
  1353.    body {
  1354.       int i;
  1355.       i = getch();
  1356.       if (i<0 || i>255)
  1357.      fail;
  1358.       return string(1, (char *)&allchars[i & 0xFF]);
  1359.       }
  1360. end
  1361.  
  1362. "getche() -- return a character from console with echo."
  1363.  
  1364. function{0,1} getche()
  1365.    abstract {
  1366.       return string;
  1367.       }
  1368.    body {
  1369.       int i;
  1370.       i = getche();
  1371.       if (i<0 || i>255)
  1372.      fail;
  1373.       return string(1, (char *)&allchars[i & 0xFF]);
  1374.       }
  1375. end
  1376.  
  1377.  
  1378. "kbhit() -- Check to see if there is a keyboard character waiting to be read."
  1379.  
  1380. function{0,1} kbhit()
  1381.    abstract {
  1382.       return null
  1383.       }
  1384.    inline {
  1385.       if (kbhit())
  1386.      return nulldesc;
  1387.       else
  1388.          fail;
  1389.       }
  1390. end
  1391. #endif                    /* KeyboardFncs */
  1392.  
  1393. "chdir(s) - change working directory to s."
  1394. function{0,1} chdir(s)
  1395.  
  1396.    if !cnv:C_string(s) then
  1397.       runerr(103,s)
  1398.    abstract {
  1399.       return null
  1400.       }
  1401.    inline {
  1402.  
  1403. /*
  1404.  * The following code is operating-system dependent [@fsys.01].
  1405.  *  Change directory.
  1406.  */
  1407.  
  1408. #if PORT
  1409.    Deliberate Syntax Error
  1410. #endif                    /* PORT */
  1411.  
  1412. #if ARM || MACINTOSH
  1413.       runerr(121);
  1414. #endif                    /* ARM || MACINTOSH ... */
  1415.  
  1416. #if AMIGA || MSDOS || OS2 || UNIX || VMS
  1417.    #if NT
  1418.       int nt_chdir(char *);
  1419.       if (nt_chdir(s) != 0)
  1420.      fail;
  1421.    #else                    /* NT */
  1422.       if (chdir(s) != 0)
  1423.      fail;
  1424.    #endif                    /* NT */
  1425.       return nulldesc;
  1426. #endif                    /* AMIGA || MSDOS || ... */
  1427.  
  1428. /*
  1429.  * End of operating-system specific code.
  1430.  */
  1431.    }
  1432. end
  1433.  
  1434. #if NT
  1435. #ifdef MSWindows
  1436. char *getenv(char *s)
  1437. {
  1438. static char tmp[1537];
  1439. DWORD rv;
  1440. rv = GetEnvironmentVariable(s, tmp, 1536);
  1441. if (rv > 0) return tmp;
  1442. return NULL;
  1443. }
  1444. #endif                    /* MSWindows */
  1445.  
  1446. #passthru #include <direct.h>
  1447. int nt_chdir(char *s)
  1448. {
  1449.     return chdir(s);
  1450. }
  1451. #endif                    /* NT */
  1452.  
  1453. "delay(i) - delay for i milliseconds."
  1454.  
  1455. function{1} delay(n)
  1456.  
  1457.    if !cnv:C_integer(n) then
  1458.       runerr(101,n)
  1459.    abstract {
  1460.       return null
  1461.       }
  1462.  
  1463.    inline {
  1464.       if (idelay(n) == Failed)
  1465.         fail;
  1466. #ifdef Graphics
  1467.       pollctr >>= 1;
  1468.       pollctr++;
  1469. #endif                    /* Graphics */
  1470.       return nulldesc;
  1471.       }
  1472. end
  1473.  
  1474. "flush(f) - flush file f."
  1475.  
  1476. function{1} flush(f)
  1477.    if !is:file(f) then
  1478.       runerr(105, f)
  1479.    abstract {
  1480.       return type(f)
  1481.       }
  1482.  
  1483.    body {
  1484.       FILE *fp;
  1485.       int status;
  1486.  
  1487.       fp = BlkLoc(f)->file.fd;
  1488.       status = BlkLoc(f)->file.status;
  1489.       if ((status & (Fs_Read | Fs_Write)) == 0)
  1490.      return f;            /* if already closed */
  1491.  
  1492. #ifdef ReadDirectory
  1493.       if ((BlkLoc(f)->file.status & Fs_Directory) != 0)
  1494.          return f;
  1495. #endif                    /* ReadDirectory */
  1496.  
  1497. #ifdef Graphics
  1498.       pollctr >>= 1;
  1499.       pollctr++;
  1500.  
  1501. #ifndef PresentationManager
  1502.       if (BlkLoc(f)->file.status & Fs_Window)
  1503.      wflush((wbp)fp);
  1504.       else
  1505. #else
  1506.        if (!(BlkLoc(f)->file.status & Fs_Window))
  1507. #endif                    /* PresentationManager */
  1508. #endif                    /* Graphics */
  1509.      fflush(fp);
  1510.  
  1511.       /*
  1512.        * Return the flushed file.
  1513.        */
  1514.       return f;
  1515.       }
  1516. end
  1517.