home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / icon / Source / Iconx / C / Fsys < prev    next >
Encoding:
Text File  |  1990-07-19  |  28.3 KB  |  1,317 lines
  1. /*
  2.  * File: fsys.c
  3.  *  Contents: close, exit, getenv, open, read, reads, remove, rename, [save],
  4.  *   seek, stop, [system], where, write, writes, [getch, getche, kbhit]
  5.  */
  6.  
  7. #include "../h/config.h"
  8. #include "../h/rt.h"
  9. #include "rproto.h"
  10.  
  11. #if MICROSOFT || SCO_XENIX
  12. #define BadCode
  13. #endif                    /* MICROSOFT || SCO_XENIX */
  14.  
  15. #ifdef XENIX_386
  16. #define register
  17. #endif                    /* XENIX_386 */
  18.  
  19. #if MACINTOSH
  20. #if MPW
  21. #include <Files.h>
  22. #include <FCntl.h>
  23. #include <IOCtl.h>
  24. #define isatty(fd) (!ioctl((fd), FIOINTERACTIVE))
  25. #define fflush(f) 0
  26. #endif                    /* MPW */
  27. #endif                    /* MACINTOSH */
  28.  
  29. /*
  30.  * close(f) - close file f.
  31.  */
  32.  
  33. FncDcl(close,1)
  34.    {
  35.    FILE *f;
  36.  
  37.    /*
  38.     * Arg1 must be a file.
  39.     */
  40.    if (Arg1.dword != D_File) 
  41.       RunErr(105, &Arg1);
  42.  
  43.    /*
  44.     * Close Arg1, using fclose or pclose as appropriate.
  45.     */
  46.  
  47. #if ARM || OS2 || UNIX || VMS
  48.    if (BlkLoc(Arg1)->file.status & Fs_Pipe) {
  49.       BlkLoc(Arg1)->file.status = 0;
  50.       MakeInt((long)((pclose(BlkLoc(Arg1)->file.fd) >> 8) & 0377), &Arg0);
  51.       Return;
  52.       }
  53.    else
  54. #endif                    /* ARM || OS2 || UNIX || VMS */
  55.  
  56.       f = BlkLoc(Arg1)->file.fd;
  57.  
  58.    fclose(f);
  59.    BlkLoc(Arg1)->file.status = 0;
  60.  
  61.    /*
  62.     * Return the closed file.
  63.     */
  64.    Arg0 = Arg1;
  65.    Return;
  66.    }
  67.  
  68. /*
  69.  * exit(status) - exit process with specified status, defaults to 0.
  70.  */
  71.  
  72. FncDcl(exit,1)
  73.    {
  74.    if (defshort(&Arg1, NormalExit) == Error) 
  75.       RunErr(0, NULL);
  76.    c_exit((int)IntVal(Arg1));
  77.    }
  78.  
  79. /*
  80.  * getenv(s) - return contents of environment variable s
  81.  */
  82.  
  83. FncDcl(getenv,1)
  84.    {
  85.  
  86. #ifndef EnvVars
  87.    RunErr(-121, NULL);
  88. #else                    /* EnvVars */
  89.  
  90.    register char *p;
  91.    register word len;
  92.    char sbuf[256];
  93.  
  94.  
  95.    /*
  96.     * Make a C-style string out of Arg1
  97.     */
  98.    switch (cvstr(&Arg1, sbuf)) {
  99.  
  100.       case Cvt:   /* Already converted to a C-style string */
  101.          break;
  102.  
  103.       case NoCvt:
  104.          qtos(&Arg1, sbuf);
  105.          break;
  106.  
  107.       default:
  108.          RunErr(103, &Arg1);
  109.       }
  110.  
  111.    if ((p = getenv(StrLoc(Arg1))) != NULL) {    /* get environment variable */
  112.       len = strlen(p);
  113.       if (strreq(len) == Error) 
  114.          RunErr(0, NULL);
  115.       StrLen(Arg0) = len;
  116.       StrLoc(Arg0) = alcstr(p, len);
  117.       Return;
  118.       }
  119.    else                 /* fail if not in environment */
  120.       Fail;
  121. #endif                    /* EnvVars */
  122.    }
  123.  
  124. /*
  125.  * open(s1,s2,s3) - open file s1 with mode s2 and attributes s3.
  126.  */
  127. FncDcl(open,3)
  128.    {
  129.    register word slen;
  130.    register int i;
  131.    register char *s;
  132.    int status;
  133.    char mode[4];
  134.    extern FILE *fopen();
  135.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  136.    char *openstring;
  137.    FILE *f;
  138.  
  139. #ifdef OpenAttributes
  140.    char sbuf3[MaxCvtLen];
  141.    char *attrstring;
  142. #endif                    /* OpenAttributes */
  143.  
  144. /*
  145.  * The following code is operating-system dependent [@fsys.01].  Make
  146.  *  declarations as needed for opening files.
  147.  */
  148.  
  149. #if PORT
  150. Deliberate Syntax Error
  151. #endif                                  /* PORT */
  152.  
  153. #if ARM
  154.    extern FILE *popen(const char *, const char *);
  155.    extern int pclose(FILE *);
  156. #endif                                  /* ARM */
  157.  
  158. #if AMIGA || MACINTOSH
  159.    /* nothing is needed */
  160. #endif                                  /* AMIGA || MACINTOSH */
  161.  
  162. #if ATARI_ST || HIGHC_386 || MSDOS || OS2
  163.    char untranslated;
  164. #endif                                  /* ATARI_ST || HIGHC_386 ... */
  165.  
  166. #if MACINTOSH
  167. #if LSC
  168.    char untranslated;
  169. #endif                    /* LSC */
  170. #endif                    /* MACINTOSH */
  171.  
  172. #if MVS || VM
  173.    char untranslated;
  174. #if SASC
  175. #include <lcio.h>
  176. #endif                    /* SASC */
  177. #endif                                  /* MVS || VM */
  178.  
  179. #if OS2 || UNIX || VMS
  180.    extern FILE *popen();
  181. #endif                                  /* OS2 || UNIX || VMS */
  182.  
  183. /*
  184.  * End of operating-system specific code.
  185.  */
  186.  
  187.  
  188.    /*
  189.     * Arg1 must be a string and a C string copy of it is also needed.
  190.     *  Make it a string if it is not one; make a C string if Arg1 is
  191.     *  a string.
  192.     */
  193.    switch (cvstr(&Arg1, sbuf1)) {
  194.  
  195.       case Cvt:
  196.          openstring = StrLoc(Arg1);
  197.          if (strreq(StrLen(Arg1)) == Error)
  198.             RunErr(0, NULL);
  199.          StrLoc(Arg1) = alcstr(StrLoc(Arg1), StrLen(Arg1));
  200.          break;
  201.  
  202.       case NoCvt:
  203.          tended[1] = Arg1;
  204.          ntended = 1;
  205.          qtos(&tended[1], sbuf1);
  206.          openstring = StrLoc(tended[1]);
  207.          break;
  208.  
  209.       default:
  210.          RunErr(103, &Arg1);
  211.       }
  212.    /*
  213.     * s2 defaults to "r".
  214.     */
  215.    if (defstr(&Arg2, sbuf2, &letr) == Error)
  216.       RunErr(0, NULL);
  217.  
  218. #ifdef OpenAttributes
  219.    /*
  220.     * Convert s3 to a string, defaulting to "".
  221.     */
  222.    ntended++;
  223.    tended[ntended] = Arg3;
  224.    if (ChkNull(tended[ntended]))
  225.       tended[ntended] = emptystr;
  226.    switch (cvstr(&tended[ntended], sbuf3)) {
  227.  
  228.       case Cvt:
  229.          attrstring = StrLoc(Arg3);
  230.          if (strreq(StrLen(Arg3)) == Error)
  231.             RunErr(0, NULL);
  232.          StrLoc(Arg3) = alcstr(StrLoc(Arg3), StrLen(Arg3));
  233.          break;
  234.  
  235.       case NoCvt:
  236.          qtos(&tended[ntended], sbuf3);
  237.          attrstring = StrLoc(tended[ntended]);
  238.          break;
  239.  
  240.       default:
  241.          RunErr(103, &Arg3);
  242.       }
  243. #endif                                  /* OpenAttributes */
  244.  
  245.    if (blkreq((word)sizeof(struct b_file)) == Error)
  246.       RunErr(0, NULL);
  247.    status = 0;
  248.  
  249. /*
  250.  * The following code is operating-system dependent [@fsys.02].  Provide
  251.  *  declaration for untranslated line-termination mode, if supported.
  252.  */
  253.  
  254. #if PORT
  255.    /* nothing to do */
  256. Deliberate Syntax Error
  257. #endif                                  /* PORT */
  258.  
  259. #if AMIGA
  260.    /* translated mode could be supported, but is not now */
  261. #endif                                  /* AMIGA */
  262.  
  263. #if ATARI_ST || HIGHC_386 || MSDOS || MVS || OS2 || VM
  264.    untranslated = 0;
  265. #endif                                  /* ATARI_ST || HIGHC_386 ... */
  266.  
  267. #if MACINTOSH
  268. #if LSC
  269.    untranslated = 0;
  270. #endif                    /* LSC */
  271. #endif                    /* MACINTOSH */
  272.  
  273. #if ARM || UNIX || VMS
  274.    /* nothing to do */
  275. #endif                                  /* ARM || UNIX || VMS */
  276.  
  277. /*
  278.  * End of operating-system specific code.
  279.  */
  280.  
  281.    /*
  282.     * Scan Arg2, setting appropriate bits in status.  Produce a run-time error
  283.     *  if an unknown character is encountered.
  284.     */
  285.    s = StrLoc(Arg2);
  286.    slen = StrLen(Arg2);
  287.    for (i = 0; i < slen; i++) {
  288.       switch (*s++) {
  289.          case 'a':
  290.          case 'A':
  291.             status |= Fs_Write|Fs_Append;
  292.             continue;
  293.          case 'b':
  294.          case 'B':
  295.             status |= Fs_Read|Fs_Write;
  296.             continue;
  297.          case 'c':
  298.          case 'C':
  299.             status |= Fs_Create|Fs_Write;
  300.             continue;
  301.          case 'r':
  302.          case 'R':
  303.             status |= Fs_Read;
  304.             continue;
  305.          case 'w':
  306.          case 'W':
  307.             status |= Fs_Write;
  308.             continue;
  309.  
  310. /*
  311.  * The following code is operating-system dependent [@fsys.03].  Handle
  312.  * untranslated line-terminator mode and pipes, if supported.
  313.  */
  314.  
  315. #if PORT
  316.          case 't':
  317.          case 'T':
  318.          case 'u':
  319.          case 'U':
  320.             continue;            /* no-op */
  321. Deliberate Syntax Error
  322. #endif                    /* PORT */
  323.  
  324. #if AMIGA
  325.          case 't':
  326.          case 'T':
  327.          case 'u':
  328.          case 'U':
  329.             continue;            /* no-op */
  330. #endif                    /* AMIGA */
  331.  
  332. #if ATARI_ST || HIGHC_386 || MSDOS || OS2 || SASC
  333.          case 't':
  334.          case 'T':
  335.             untranslated = 0;
  336.  
  337. #if OS2
  338.      case 'p':
  339.      case 'P':
  340.         status |= Fs_Pipe;
  341.         continue;
  342. #endif                    /* OS2 */
  343.  
  344. #ifdef RecordIO
  345.             status &= ~Fs_Record;
  346. #endif                    /* RecordIO */
  347.  
  348.             continue;
  349.          case 'u':
  350.          case 'U':
  351.             untranslated = 1;
  352.  
  353. #ifdef RecordIO
  354.             status &= ~Fs_Record;
  355. #endif                    /* RecordIO */
  356.  
  357.             continue;
  358. #endif                    /* ATARI_ST || HIGHC_386 || ... */
  359.  
  360. #ifdef RecordIO
  361.          case 's':
  362.          case 'S':
  363.             untranslated = 1;
  364.             status |= Fs_Record;
  365.             continue;
  366. #endif                                  /* RecordIO */
  367.  
  368. #if MACINTOSH
  369. #if LSC
  370.          case 't':
  371.          case 'T':
  372.             untranslated = 0;
  373.             continue;
  374.          case 'u':
  375.          case 'U':
  376.             untranslated = 1;
  377.             continue;
  378. #endif                    /* LSC */
  379. #endif                    /* MACINTOSH */
  380.  
  381. #if ARM || UNIX || VMS
  382.          case 't':
  383.          case 'T':
  384.          case 'u':
  385.          case 'U':
  386.             continue;            /* no-op */
  387.          case 'p':
  388.          case 'P':
  389.             status |= Fs_Pipe;
  390.             continue;
  391. #endif                    /* ARM || UNIX || VMS */
  392.  
  393. /*
  394.  * End of operating-system specific code.
  395.  */
  396.  
  397.          default:
  398.             RunErr(209, &Arg2);
  399.          }
  400.       }
  401.  
  402.    /*
  403.     * Construct a mode field for fopen/popen.
  404.     */
  405.    mode[0] = '\0';
  406.    mode[1] = '\0';
  407.    mode[2] = '\0';
  408.    mode[3] = '\0';
  409.  
  410.    if ((status & (Fs_Read|Fs_Write)) == 0)   /* default: read only */
  411.       status |= Fs_Read;
  412.    if (status & Fs_Create)
  413.       mode[0] = 'w';
  414.    else if (status & Fs_Append)
  415.       mode[0] = 'a';
  416.    else if (status & Fs_Read)
  417.       mode[0] = 'r';
  418.    else
  419.       mode[0] = 'w';
  420.  
  421. /*
  422.  * The following code is operating-system dependent [@fsys.04].  Handle open
  423.  *  modes.
  424.  */
  425.  
  426. #if PORT
  427.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write))
  428.       mode[1] = '+';
  429. Deliberate Syntax Error
  430. #endif                                  /* PORT */
  431.  
  432. #if AMIGA || ARM || UNIX || VMS
  433.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write))
  434.       mode[1] = '+';
  435. #endif                                  /* AMIGA || ARM || UNIX || VMS */
  436.  
  437. #if ATARI_ST
  438.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) {
  439.       mode[1] = '+';
  440.       mode[2] = untranslated ? 'b' : 'a';
  441.       }
  442.    else mode[1] = untranslated ? 'b' : 'a';
  443. #endif                                  /* ATARI_ST */
  444.  
  445. #if HIGHC_386 || OS2
  446.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) {
  447.       mode[1] = '+';
  448.       mode[2] = untranslated ? 'b' : 't';
  449.       }
  450.    else mode[1] = untranslated ? 'b' : 't';
  451. #endif                                  /* HIGHC_386 || OS2 */
  452.  
  453. #if MACINTOSH
  454. #if LSC
  455.    untranslated = 0;
  456. #endif                    /* LSC */
  457. #endif                    /* MACINTOSH */
  458.  
  459. #if MVS || VM
  460.    if ((status & (Fs_Read|Fs_Write)) == (Fs_Read|Fs_Write)) {
  461.       mode[1] = '+';
  462.       mode[2] = untranslated ? 'b' : 0;
  463.       }
  464.    else mode[1] = untranslated ? 'b' : 0;
  465. #endif                                  /* MVS || VM */
  466.  
  467. /*
  468.  * End of operating-system specific code.
  469.  */
  470.  
  471.    /*
  472.     * Open the file with fopen or popen.
  473.     */
  474.  
  475. #ifdef OpenAttributes
  476. #if SASC
  477. #ifdef RecordIO
  478.       f = afopen(openstring, mode, status & Fs_Record ? "seq" : "",
  479.                  attrstring);
  480. #else                    /* RecordIO */
  481.       f = afopen(openstring, mode, "", attrstring);
  482. #endif                                  /* RecordIO */
  483. #endif                                  /* SASC */
  484.  
  485. #else                                   /* OpenAttributes */
  486.  
  487. #if ARM || OS2 || UNIX || VMS
  488.    if (status & Fs_Pipe) {
  489.       if (status != (Fs_Read|Fs_Pipe) && status != (Fs_Write|Fs_Pipe))
  490.          RunErr(209, &Arg2);
  491.       f = popen(openstring, mode);
  492.       }
  493.    else
  494. #endif                                  /* ARM || OS2 || UNIX || VMS */
  495.  
  496.       f = fopen(openstring, mode);
  497. #endif                                  /* OpenAttributes */
  498.  
  499.    /*
  500.     * Fail if the file cannot be opened.
  501.     */
  502.    if (f == NULL)
  503.       Fail;
  504.  
  505.    /*
  506.     * Return the resulting file value.
  507.     */
  508.    Arg0.dword = D_File;
  509.    BlkLoc(Arg0) = (union block *) alcfile(f, status, &Arg1);
  510.    ntended = 0;
  511.    Return;
  512.    }
  513.  
  514. /*
  515.  * read(f) - read line on file f.
  516.  */
  517. FncDcl(read,1)
  518.    {
  519.    register word slen, rlen;
  520.    register char *sp;
  521.    int status;
  522.    static char sbuf[MaxReadStr];
  523.    FILE *f;
  524.  
  525.    /*
  526.     * Default Arg1 to &input.
  527.     */
  528.    if (deffile(&Arg1, &input) == Error) 
  529.       RunErr(0, NULL);
  530.  
  531.    /*
  532.     * Get a pointer to the file and be sure that it is open for reading.
  533.     */
  534.    f = BlkLoc(Arg1)->file.fd;
  535.    status = (int)BlkLoc(Arg1)->file.status;
  536.    if ((status & Fs_Read) == 0) 
  537.       RunErr(212, &Arg1);
  538.  
  539. #ifdef StandardLib
  540.    if (status & Fs_Writing) {
  541.       fseek(f, 0L, SEEK_CUR);
  542.       BlkLoc(Arg1)->file.status &= ~Fs_Writing;
  543.       }
  544.    BlkLoc(Arg1)->file.status |= Fs_Reading;
  545. #endif                    /* StandardLib */
  546.  
  547.    /*
  548.     * Use getstrg to read a line from the file, failing if getstrg
  549.     *  encounters end of file. [[ What about -2?]]
  550.     */
  551.    StrLen(Arg0) = 0;
  552.    do {
  553.  
  554. #ifdef RecordIO
  555.       if ((slen = (status & Fs_Record ? getrec(sbuf, MaxReadStr, f) :
  556.                                         getstrg(sbuf, MaxReadStr, f)))
  557.           == -1) Fail;
  558. #else                    /* RecordIO */
  559.       if ((slen = getstrg(sbuf,MaxReadStr,f)) == -1)
  560.          Fail;
  561. #endif                                  /* RecordIO */
  562.  
  563.       /*
  564.        * Allocate the string read and make Arg0 a descriptor for it.
  565.        */
  566.       rlen = slen < 0 ? (word)MaxReadStr : slen;
  567.       if (strreq(rlen) == Error) 
  568.          RunErr(0, NULL);
  569.       sp = alcstr(sbuf,rlen);
  570.       if (StrLen(Arg0) == 0)
  571.          StrLoc(Arg0) = sp;
  572.       StrLen(Arg0) += rlen;
  573.       } while (slen < 0);
  574.    Return;
  575.    }
  576.  
  577. /*
  578.  * reads(f,i) - read i characters on file f.
  579.  */
  580. FncDcl(reads,2)
  581.    {
  582.    register word cnt;
  583.    long tally;
  584.    int status;
  585.    FILE *f;
  586.  
  587.    /*
  588.     * Arg1 defaults to &input and Arg2 defaults to 1 (character).
  589.     */
  590.    if ((deffile(&Arg1, &input) == Error) ||
  591.        (defshort(&Arg2, 1) == Error)) 
  592.       RunErr(0, NULL);
  593.  
  594.    /*
  595.     * Get a pointer to the file and be sure that it is open for reading.
  596.     */
  597.    f = BlkLoc(Arg1)->file.fd;
  598.    status = (int)BlkLoc(Arg1)->file.status;
  599.    if ((status & Fs_Read) == 0) 
  600.       RunErr(212, &Arg1);
  601.  
  602. #ifdef StandardLib
  603.    if (status & Fs_Writing) {
  604.       fseek(f, 0L, SEEK_CUR);
  605.       BlkLoc(Arg1)->file.status &= ~Fs_Writing;
  606.       }
  607.    BlkLoc(Arg1)->file.status |= Fs_Reading;
  608. #endif                    /* StandardLib */
  609.  
  610.    /*
  611.     * Be sure that a positive number of bytes is to be read.
  612.     */
  613.    if ((cnt = IntVal(Arg2)) <= 0) 
  614.       RunErr(205, &Arg2);
  615.  
  616.    /*
  617.     * Ensure that enough space for the string exists and read it directly
  618.     *  into the string space.  (By reading directly into the string space,
  619.     *  no arbitrary restrictions are placed on the size of the string that
  620.     *  can be read.)  Make Arg0 a descriptor for the string and return it.
  621.     */
  622.    if (strreq(cnt) == Error) 
  623.       RunErr(0, NULL);
  624.    if (strfree + cnt > strend)
  625.       syserr("reads allocation botch");
  626.    StrLoc(Arg0) = strfree;
  627.  
  628. #if AMIGA
  629.    /*
  630.     * The following code is special for Lattice 4.0 -- it was different
  631.     *  for Lattice 3.10.  It probably won't work correctly with other
  632.     *  C compilers.
  633.     */
  634.    if (IsInteractive(_ufbs[fileno(f)].ufbfh)) {
  635.       if ((cnt = read(fileno(f),StrLoc(Arg0),cnt)) <= 0)
  636.          Fail;
  637.       StrLen(Arg0) = cnt;
  638.       alcstr(NULL, cnt);
  639.       Return;
  640.       }
  641. #endif                    /* AMIGA */
  642.  
  643.    tally = longread(StrLoc(Arg0),sizeof(char),cnt,f);
  644.    if (tally == 0)
  645.       Fail;
  646.    StrLen(Arg0) = tally;
  647.    alcstr(NULL, (word)tally);
  648.    Return;
  649.    }
  650.  
  651. /*
  652.  * remove(s) - remove the file named s.
  653.  */
  654.  
  655. FncDcl(remove,1)
  656.    {
  657.    char sbuf[MaxCvtLen];
  658.  
  659.    /*
  660.     * Make a C-style string out of Arg1
  661.     */
  662.    switch (cvstr(&Arg1, sbuf)) {
  663.  
  664.       case Cvt:   /* Already converted to a C-style string */
  665.          break;
  666.  
  667.       case NoCvt:
  668.          qtos(&Arg1, sbuf);
  669.          break;
  670.  
  671.       default:
  672.          RunErr(103, &Arg1);
  673.       }
  674.    if (unlink(StrLoc(Arg1)) != 0)
  675.       Fail;
  676.    Arg0 = nulldesc;
  677.    Return;
  678.    }
  679.  
  680. /*
  681.  * rename(s1,s2) - rename the file named s1 to have the name s2.
  682.  */
  683.  
  684. FncDcl(rename,2)
  685.    {
  686.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  687.  
  688.    /*
  689.     * Make a C-style string out of Arg1
  690.     */
  691.    switch (cvstr(&Arg1, sbuf1)) {
  692.  
  693.       case Cvt:   /* Already converted to a C-style string */
  694.          break;
  695.  
  696.       case NoCvt:
  697.          qtos(&Arg1, sbuf1);
  698.          break;
  699.  
  700.       default:
  701.          RunErr(103, &Arg1);
  702.       }
  703.  
  704.    /*
  705.     * Make a C-style string out of Arg2
  706.     */
  707.    switch (cvstr(&Arg2, sbuf2)) {
  708.  
  709.       case Cvt:   /* Already converted to a C-style string */
  710.          break;
  711.  
  712.       case NoCvt:
  713.          qtos(&Arg2, sbuf2);
  714.          break;
  715.  
  716.       default:
  717.          RunErr(103, &Arg2);
  718.       }
  719.  
  720. /*
  721.  * The following code is operating-system dependent [@fsys.05].  Rename the
  722.  *  file, and fail if unsuccessful.
  723.  */
  724.  
  725. #if PORT
  726.    /* need something */
  727. Deliberate Syntax Error
  728. #endif                    /* PORT */
  729.  
  730. #if AMIGA || ARM || ATARI_ST || HIGHC_386 || MACINTOSH || MSDOS || MVS || OS2 || VM || VMS
  731.    {
  732.    if (rename(StrLoc(Arg1),StrLoc(Arg2)) != 0)
  733.       Fail;
  734.    }
  735. #endif                    /* AMIGA || ARM || ATARI_ST ... */
  736.  
  737. #if UNIX
  738.    if (link(StrLoc(Arg1),StrLoc(Arg2)) != 0)
  739.       Fail;
  740.    if (unlink(StrLoc(Arg1)) != 0) {
  741.       unlink(StrLoc(Arg2));    /* try to undo partial rename */
  742.       Fail;
  743.       }
  744. #endif                    /* UNIX */
  745.  
  746. /*
  747.  * End of operating-system specific code.
  748.  */
  749.  
  750.    Arg0 = nulldesc;
  751.    Return;
  752.    }
  753.  
  754. #ifdef ExecImages
  755. /*
  756.  * save(s) - save the run-time system in file s
  757.  */
  758.  
  759. FncDcl(save,1)
  760.    {
  761.    char sbuf[MaxCvtLen];
  762.    int f, fsz;
  763.  
  764.    dumped = 1;
  765.  
  766.    /* if (ChkNull(Arg1)) { abort(); } */
  767.  
  768.    /*
  769.     * Make a C-style string out of Arg1.
  770.     */
  771.    switch (cvstr(&Arg1, sbuf)) {
  772.  
  773.       case Cvt:   /* Already converted to a C-style string */
  774.          break;
  775.  
  776.       case NoCvt:
  777.          qtos(&Arg1, sbuf);
  778.          break;
  779.  
  780.       default:
  781.          RunErr(103, &Arg1);
  782.       }
  783.  
  784.  
  785.    /*
  786.     * Open the file for the executable image.
  787.     */
  788.    f = creat(StrLoc(Arg1), 0777);
  789.    if (f == -1)
  790.       Fail;
  791.    fsz = wrtexec(f);
  792.    /*
  793.     * It happens that most wrtexecs don't check the system call return
  794.     *  codes and thus they'll never return -1.  Nonetheless...
  795.     */
  796.    if (fsz == -1)
  797.       Fail;
  798.    /*
  799.     * Return the size of the data space.
  800.     */
  801.    MakeInt(fsz, &Arg0);
  802.    Return;
  803.    }
  804.  
  805. #endif                    /* ExecImages */
  806.  
  807. /*
  808.  * seek(file,position) - seek to byte byte position in file.
  809.  */
  810.  
  811. FncDcl(seek,2)
  812.    {
  813.    long l1;
  814.    FILE *fd;
  815.  
  816.    if (Arg1.dword != D_File) 
  817.       RunErr(-105, NULL);
  818.  
  819.    if (defint(&Arg2, &l1, 1L) == Error)
  820.       RunErr(0, NULL);
  821.  
  822.    fd = BlkLoc(Arg1)->file.fd;
  823.  
  824.    if (BlkLoc(Arg1)->file.status == 0)
  825.       Fail;
  826.     if (l1 > 0) {
  827.  
  828. #ifdef StandardLib
  829.        if (fseek(fd, l1 - 1, SEEK_SET) == -1)
  830. #else                    /* StandardLib */
  831.        if (fseek(fd, l1 - 1, 0) == -1)
  832. #endif                    /* StandardLib */
  833.  
  834.           Fail;
  835.        }
  836.     else {
  837.  
  838. #ifdef StandardLib
  839.        if (fseek(fd, l1, SEEK_END) == -1)
  840. #else                    /* StandardLib */
  841.        if (fseek(fd, l1, 2) == -1)
  842. #endif                    /* StandardLib */
  843.           Fail;
  844.        }
  845.  
  846. #ifdef StandardLib
  847.     BlkLoc(Arg1)->file.status &= ~(Fs_Reading | Fs_Writing);
  848. #endif                    /* StandardLib */
  849.  
  850.    Arg0 = Arg1;
  851.    Return;
  852.    }
  853.  
  854. /*
  855.  * stop(a,b,...) - write arguments (starting on error output) and stop.
  856.  */
  857.  
  858. FncDclV(stop)
  859.     {
  860.    register word n;
  861.    char sbuf[MaxCvtLen];
  862.    FILE *f;
  863.  
  864. #ifdef BadCode
  865.    struct descrip temp;
  866. #endif                    /* BadCode */
  867.  
  868.    f = stderr;
  869.    ntended = 1;
  870.    /*
  871.     * Loop through arguments.
  872.     */
  873.  
  874.    for (n = 1; n <= nargs; n++) {
  875.  
  876. #ifdef BadCode 
  877.       temp = Arg(n);            /* workaround for Microsoft C bug */
  878.       tended[1] = temp;
  879. #else                    /* BadCode */
  880.       tended[1] = Arg(n);
  881. #endif                    /* BadCode */
  882.  
  883.       if (tended[1].dword == D_File) {
  884.          if (n > 1)
  885.             putc('\n', f);
  886.          if ((BlkLoc(tended[1])->file.status & Fs_Write) == 0) 
  887.             RunErr(213, &tended[1]);
  888.          f = BlkLoc(tended[1])->file.fd;
  889.  
  890. #ifdef StandardLib
  891.          if (BlkLoc(tended[1])->file.status & Fs_Reading) {
  892.             fseek(f, 0L, SEEK_CUR);
  893.             BlkLoc(tended[1])->file.status &= ~Fs_Reading;
  894.             }
  895.          BlkLoc(tended[1])->file.status |= Fs_Writing;
  896. #endif                    /* StandardLib */
  897.          }
  898.       else {
  899.  
  900.          if (n == 1 && (k_output.status & Fs_Write) == 0)
  901.             RunErr(-213, NULL);
  902.  
  903. #ifdef StandardLib
  904.          if (n == 1) {
  905.             if (k_output.status & Fs_Reading) {
  906.                fseek(f, 0L, SEEK_CUR);
  907.                k_output.status &= ~Fs_Reading;
  908.                }
  909.             k_output.status |= Fs_Writing;
  910.          }
  911. #endif                    /* StandardLib */
  912.  
  913.          if (ChkNull(tended[1]))
  914.             tended[1] = emptystr;
  915.          if (cvstr(&tended[1], sbuf) == CvtFail) 
  916.             RunErr(109, &tended[1]);
  917.          putstr(f, &tended[1]);
  918.          }
  919.       }
  920.  
  921.    putc('\n', f);
  922.    fflush(f);
  923.    c_exit(ErrorExit);
  924.    }
  925.  
  926. #ifdef SystemFnc
  927. /*
  928.  * system(s) - execute string s as a system command.
  929.  */
  930.  
  931. FncDcl(system,1)
  932.    {
  933.    char sbuf[MaxCvtLen];
  934.    char *systemstring;
  935.  
  936.    /*
  937.     * Make a C-style string out of Arg1
  938.     */
  939.    switch (cvstr(&Arg1, sbuf)) {
  940.  
  941.       case Cvt:   /* Already converted to a C-style string */
  942.          break;
  943.  
  944.       case NoCvt:
  945.          qtos(&Arg1, sbuf);
  946.          break;
  947.  
  948.       default:
  949.          RunErr(103, &Arg1);
  950.       }
  951.       systemstring = StrLoc(Arg1);
  952.  
  953.    /*
  954.     * Pass the C string to the system() function and return the exit code
  955.     *  of the command as the result of system().
  956.     */
  957.  
  958. /*
  959.  * The following code is operating-system dependent [@fsys.06].  Perform system
  960.  *  call.  Should not get here unless system(s) is supported.
  961.  */
  962.  
  963. #if PORT
  964. Deliberate Syntax Error
  965. #endif                    /* PORT */
  966.  
  967. #if AMIGA || MSDOS || OS2 || UNIX
  968.    MakeInt((long)((system(systemstring) >> 8) & 0377), &Arg0);
  969. #endif                    /* AMIGA || MSDOS || ... */
  970.  
  971. #if ATARI_ST || VMS
  972.    MakeInt(system(systemstring), &Arg0);
  973. #endif                    /* ATARI_ST || VMS */
  974.  
  975. #if ARM || HIGHC_386
  976.    MakeInt((long)system(systemstring), &Arg0);
  977. #endif                    /* ARM || HIGHC_386 */
  978.  
  979. #if MACINTOSH
  980.    /* Should not get here */
  981. #endif                    /* HIGHC_386 */
  982.  
  983. #if MVS || VM
  984. #if SASC && MVS
  985.    {
  986.       char *wprefix;
  987.       wprefix = malloc(strlen(systemstring)+5);
  988.                      /* hope this will do no harm... */
  989.       sprintf(wprefix,"tso:%s",systemstring);
  990.       MakeInt((long)system(wprefix), &Arg0);
  991.       free(wprefix);
  992.    }
  993. #else                    /* SASC && MVS */
  994.    MakeInt((long)system(systemstring), &Arg0);
  995. #endif                    /* SASC && MVS */
  996. #endif                                  /* MVS || VM */
  997.  
  998. /*
  999.  * End of operating-system specific code.
  1000.  */
  1001.    Return;
  1002.    }
  1003.  
  1004. #endif                    /* SystemFnc */
  1005. /*
  1006.  * where(file) - return current offset position in file.
  1007.  */
  1008.  
  1009. FncDcl(where,1)
  1010.    {
  1011.    FILE *fd;
  1012.    long ftell();
  1013.    long pos;
  1014.  
  1015.    if (Arg1.dword != D_File) 
  1016.       RunErr(-105, NULL);
  1017.  
  1018.    fd = BlkLoc(Arg1)->file.fd;
  1019.  
  1020.    if ((BlkLoc(Arg1)->file.status == 0))
  1021.       Fail;
  1022.  
  1023. #ifdef StandardLib
  1024.    MakeInt(pos = ftell(fd) + 1, &Arg0);
  1025.    if (pos == 0)
  1026.       Fail;  /* may only be effective on ANSI systems */
  1027. #else                    /* StandardLib */
  1028.    MakeInt(ftell(fd) + 1, &Arg0);
  1029. #endif                    /* StandardLib */
  1030.  
  1031.    Return;
  1032.    }
  1033.  
  1034. /*
  1035.  * write(a,b,...) - write arguments.
  1036.  */
  1037. FncDclV(write)
  1038.    {
  1039.    register word n;
  1040.    char sbuf[MaxCvtLen];
  1041.    FILE *f;
  1042.  
  1043. #ifdef RecordIO
  1044.    word status = k_output.status;
  1045. #endif                    /* RecordIO */
  1046.  
  1047. #ifdef BadCode
  1048.    struct descrip temp;
  1049. #endif                    /* BadCode */
  1050.  
  1051.    f = stdout;
  1052.    ntended = 1;
  1053.    tended[1] = emptystr;
  1054.  
  1055.    /*
  1056.     * Loop through the arguments.
  1057.     */
  1058.    for (n = 1; n <= nargs; n++) {
  1059.  
  1060. #ifdef BadCode
  1061.       temp = Arg(n);            /* workaround for Microsoft bug */
  1062.       tended[1] = temp;
  1063. #else                    /* BadCode */
  1064.       tended[1] = Arg(n);
  1065. #endif                    /* BadCode */
  1066.  
  1067.       if (tended[1].dword == D_File)    {    /* Current argument is a file */
  1068.          /*
  1069.           * If this is not the first argument, output a newline to the current
  1070.           *  file and flush it.
  1071.           */
  1072.          if (n > 1) {
  1073.  
  1074. #ifdef RecordIO
  1075.             if (status & Fs_Record)
  1076.                flushrec(f);
  1077.             else
  1078. #endif                    /* RecordIO */
  1079.  
  1080.             putc('\n', f);
  1081.             fflush(f);
  1082.             }
  1083.          /*
  1084.           * Switch the current file to the file named by the current argument
  1085.           *  providing it is a file.  tended[1] is made to be a empty string to
  1086.           *  avoid a special case.
  1087.           */
  1088.          if ((BlkLoc(tended[1])->file.status & Fs_Write) == 0) 
  1089.             RunErr(213, &tended[1]);
  1090.          f = BlkLoc(tended[1])->file.fd;
  1091.  
  1092. #ifdef StandardLib
  1093.          if (BlkLoc(tended[1])->file.status & Fs_Reading) {
  1094.             fseek(f, 0L, SEEK_CUR);
  1095.             BlkLoc(tended[1])->file.status &= ~Fs_Reading;
  1096.             }
  1097.          BlkLoc(tended[1])->file.status |= Fs_Writing;
  1098. #endif                    /* StandardLib */
  1099.  
  1100. #ifdef RecordIO
  1101.          status = BlkLoc(tended[1])->file.status;
  1102. #endif                    /* RecordIO */
  1103.  
  1104.          tended[1] = emptystr;
  1105.          }
  1106.       else {    /* Current argument is a string */
  1107.          /*
  1108.           * On first argument, check to be sure that &output is open
  1109.           *  for output.
  1110.           */
  1111.          if (n == 1 && (k_output.status & Fs_Write) == 0)
  1112.             RunErr(-213, NULL);
  1113.  
  1114. #ifdef StandardLib
  1115.          if (n == 1) {
  1116.             if (k_output.status & Fs_Reading) {
  1117.                fseek(f, 0L, SEEK_CUR);
  1118.                k_output.status &= ~Fs_Reading;
  1119.                }
  1120.             k_output.status |= Fs_Writing;
  1121.          }
  1122. #endif                    /* StandardLib */
  1123.  
  1124.          /*
  1125.           * Convert the argument to a string, defaulting to a empty string.
  1126.           */
  1127.          if (ChkNull(tended[1]))
  1128.             tended[1] = emptystr;
  1129.          if (cvstr(&tended[1], sbuf) == CvtFail) 
  1130.             RunErr(109, &tended[1]);
  1131.  
  1132.          /*
  1133.           * Output the string.
  1134.           */
  1135.  
  1136. #ifdef RecordIO
  1137.          if ((status & Fs_Record ? putrec(f, &tended[1]) :
  1138.                                    putstr(f, &tended[1])) == Failure)
  1139. #else                    /* RecordIO */
  1140.          if (putstr(f, &tended[1]) == Failure)
  1141. #endif                    /* RecordIO */
  1142.             RunErr(-214, NULL);
  1143.          }
  1144.       }
  1145.    /*
  1146.     * Append a newline to the file and flush it.
  1147.     */
  1148.  
  1149. #ifdef RecordIO
  1150.    if (status & Fs_Record)
  1151.       flushrec(f);
  1152.    else
  1153. #endif                    /* RecordIO */
  1154.  
  1155.    putc('\n', f);
  1156.    if (ferror(f))
  1157.       RunErr(-214, NULL);
  1158.  
  1159.    fflush(f);
  1160.  
  1161.    /*
  1162.     * Return the last argument.
  1163.     */
  1164.    ntended = 0;
  1165.    Arg(0) = Arg(n - 1);
  1166.    Return;
  1167.    }
  1168.  
  1169. /*
  1170.  * writes(a,b,...) - write arguments without newline terminator.
  1171.  */
  1172.  
  1173. FncDclV(writes)
  1174.    {
  1175.    register word n;
  1176.    char sbuf[MaxCvtLen];
  1177.    FILE *f;
  1178.  
  1179. #ifdef BadCode
  1180.    struct descrip temp;
  1181. #endif                    /* BadCode */
  1182.  
  1183.    f = stdout;
  1184.    ntended = 1;
  1185.    tended[1] = emptystr;
  1186.  
  1187.    /*
  1188.     * Loop through the arguments.
  1189.     */
  1190.    for (n = 1; n <= nargs; n++) {
  1191.  
  1192. #ifdef BadCode
  1193.       temp = Arg(n);            /* workaround for Microsoft bug */
  1194.       tended[1] = temp;
  1195. #else                    /* BadCode */
  1196.       tended[1] = Arg(n);
  1197. #endif                    /* BadCode */
  1198.  
  1199.       if (tended[1].dword == D_File)    {    /* Current argument is a file */
  1200.          /*
  1201.           * Switch the current file to the file named by the current argument
  1202.           *  providing it is a file.  tended[1] is made to be a empty string to
  1203.           *  avoid a special case.
  1204.           */
  1205.          if ((BlkLoc(tended[1])->file.status & Fs_Write) == 0) 
  1206.             RunErr(213, &tended[1]);
  1207.          f = BlkLoc(tended[1])->file.fd;
  1208.  
  1209. #ifdef StandardLib
  1210.          if (BlkLoc(tended[1])->file.status & Fs_Reading) {
  1211.             fseek(f, 0L, SEEK_CUR);
  1212.             BlkLoc(tended[1])->file.status &= ~Fs_Reading;
  1213.             }
  1214.          BlkLoc(tended[1])->file.status |= Fs_Writing;
  1215. #endif                    /* StandardLib */
  1216.  
  1217.          tended[1] = emptystr;
  1218.          }
  1219.       else {    /* Current argument is a string */
  1220.          /*
  1221.           * On first argument, check to be sure that &output is open
  1222.           *  for output.
  1223.           */
  1224.          if (n == 1 && (k_output.status & Fs_Write) == 0) 
  1225.             RunErr(-213, NULL);
  1226.  
  1227. #ifdef StandardLib
  1228.          if (n == 1) {
  1229.             if (k_output.status & Fs_Reading) {
  1230.                fseek(f, 0L, SEEK_CUR);
  1231.                k_output.status &= ~Fs_Reading;
  1232.                }
  1233.             k_output.status |= Fs_Writing;
  1234.          }
  1235. #endif                    /* StandardLib */
  1236.  
  1237.          /*
  1238.           * Convert the argument to a string, defaulting to a empty string.
  1239.           */
  1240.          if (ChkNull(tended[1]))
  1241.             tended[1] = emptystr;
  1242.          if (cvstr(&tended[1], sbuf) == CvtFail)
  1243.             RunErr(109, &tended[1]);
  1244.          /*
  1245.           * Output the string and flush the file.
  1246.           */
  1247.          if (putstr(f, &tended[1]) == Failure)
  1248.             RunErr(-214, NULL);
  1249.  
  1250. #if !MVS && !VM         /* forces record break on the 370! */
  1251.          fflush(f);
  1252. #endif                    /* !MVS && !VM */
  1253.  
  1254.          }
  1255.       }
  1256.    /*
  1257.     * Return the last argument.
  1258.     */
  1259.    ntended = 0;
  1260.    Arg(0) = Arg(n - 1);
  1261.    Return;
  1262.    }
  1263.  
  1264. #ifdef KeyboardFncs
  1265. /*
  1266.  * getch() - return a character from console.
  1267.  */
  1268.  
  1269. FncDcl(getch,0)
  1270.    {
  1271.    unsigned char c;
  1272.    int i;
  1273.    i = getch();
  1274.    if (i<0)
  1275.       Fail;
  1276.    if (strreq((word)1) == Error)
  1277.       RunErr(0, NULL);
  1278.    c = (unsigned char) i;
  1279.    StrLoc(Arg0) = alcstr((char *)&c,(word)1);
  1280.    StrLen(Arg0) = 1;
  1281.    Return;
  1282.    }
  1283.  
  1284. /*
  1285.  * getche() -- return a character from console with echo.
  1286.  */
  1287.  
  1288. FncDcl(getche,0)
  1289.    {
  1290.    unsigned char c;
  1291.    int i;
  1292.    i = getche();
  1293.    if (i<0)
  1294.       Fail;
  1295.    if (strreq((word)1) == Error)
  1296.       RunErr(0, NULL);
  1297.    c = (unsigned char) i;
  1298.    StrLoc(Arg0) = alcstr((char *)&c,(word)1);
  1299.    StrLen(Arg0) = 1;
  1300.    Return;
  1301.    }
  1302.  
  1303. /*
  1304.  * kbhit() -- Check to see if there is a keyboard character waiting to
  1305.  *  be read.
  1306.  */
  1307.  
  1308. FncDcl(kbhit,0)
  1309.    {
  1310.    if (kbhit()) {
  1311.       Arg0 = nulldesc;
  1312.       Return;
  1313.       }
  1314.    else Fail;
  1315.    }
  1316. #endif                    /* KeyboardFncs */
  1317.