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