home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / C / others.c < prev   
Encoding:
C/C++ Source or Header  |  1989-03-04  |  16.2 KB  |  799 lines
  1. /*-------------------------------*/
  2. /*   TOOLPACK/1   Release: 1.1   */
  3. /*-------------------------------*/
  4. #include <ctype.h>
  5. #include "define.h"
  6.  
  7. #include <sys/types.h>
  8. #include <sys/time.h>
  9. #ifdef sgi
  10. #include <time.h>
  11. #endif
  12.  
  13. #ifdef sgi
  14. #define checkfd chckfd
  15. #define checkfn chckfn
  16. #endif
  17.  
  18.  
  19. #include <sys/stat.h>
  20.  
  21. #include <sys/dir.h>
  22.  
  23. #include "globals1.h"
  24. #include "globals2.h"
  25. #include "globals.h"
  26.  
  27.  
  28. crtzlng(charnam, access, fd)
  29. char *charnam;
  30. int access, fd;
  31. {
  32.  
  33.     /* the file charnam exists and may be open with associated file
  34.     descriptor fd. crtzlng truncates this file to zero length
  35.     and opens it in mode access */
  36.  
  37.         int uid,gid,len,i;
  38.         char newch[MAXPATH];
  39.         struct stat sbuf;
  40.  
  41.     int status;
  42.  
  43.     close(fd);
  44.  
  45.     /* truncate to zero length */
  46.     status = creat(charnam, RWXMODE);
  47.  
  48.  
  49.     /* now close and open again to get the access across */
  50.     close(status);
  51.  
  52.     status = open(charnam, access);
  53.  
  54.     return(status);
  55. /*   THIS CAN BE IMPROVED FOR 4.2 */
  56.  
  57.  
  58. }
  59.  
  60. flush(fd)
  61. int fd;
  62. {
  63.  
  64.     /* flush the buffer associated with the file descriptor fd */
  65.  
  66.     struct fdinfo *ptr;
  67.  
  68.     /* no effect if no charcaters in the buffer or current
  69.        access not write */
  70.     ptr = &files[fd];
  71.     if (ptr->chrleft == 0 || ptr->caccess != WRITE) return;
  72.  
  73.     /* write characters to file */
  74.     write(fd, ptr->buffer, ptr->chrleft);
  75.     return;
  76.  
  77. }
  78.  
  79.  
  80. fndnblk(end, length)
  81. char *end;
  82. int length;
  83. {
  84.  
  85.     /* end points at the newline at the end of a string of length
  86.        length (i.e. position length = NEWLINE). fndnblk finds the
  87.        first non-space character preceding this NEWLINE. Inserts
  88.        a newline after this character and returns the new string
  89.        length via the function name */
  90.  
  91.     int i;
  92.     
  93.     for (i=length-1; i>=1; i--)
  94.         if (*--end != BLANKCH && *end != TABCH) break;
  95.  
  96.     /* either i=0 & end is left at character position 1
  97.        or i>0 and end is pointing at the last non-space character */
  98.     if (i!=0) end++;
  99.     *end = NEWLINE;
  100.     return(++i);
  101.  
  102. }
  103.  
  104. isaname(name)
  105. char *name;
  106. {
  107.  
  108.     /* returns YES if name is a 'pure' name (no SLASHES)
  109.        NO otherwise */
  110.  
  111.     while (*name != EOSCH && *name != SLASHCH) name++;
  112.  
  113.     return(*name == EOSCH ? YES :NO);
  114.  
  115. }
  116.  
  117. isafile(pathnam)
  118. char *pathnam;
  119. {
  120.  
  121.     /* returns YES if pathname exists NO otherwise */
  122.  
  123.     struct stat buf;
  124.  
  125.     return ((stat(pathnam, &buf) == -1) ? NO :YES );
  126.  
  127. }
  128.  
  129. isadir(pathnam)
  130. char *pathnam;
  131. {
  132.  
  133.     /* returns YES if pathname is a directory NO otherwise */
  134.  
  135.     struct stat buf;
  136.  
  137.     if (stat(pathnam, &buf) == -1) return(NO);
  138.  
  139.     return(((buf.st_mode & S_IFMT) == S_IFDIR) ? YES : NO);
  140.  
  141. }
  142.  
  143.  
  144.  
  145. /* this is from allio.c */
  146.  
  147.  
  148. checkfd(fd)
  149. int fd;
  150.  
  151. {
  152.     /* check file descriptor value
  153.  
  154.     return NOTINRANGE if fd does not belong to [0, MAXFILE]
  155.  
  156.            DEVICE    if fd belongs to [0, DEVFD]
  157.  
  158.            FILES      if fd belongs to [FIRSTFD, MAXFILE-1]   */
  159.  
  160.  
  161.     if( fd < 0 || fd > MAXFILE )
  162.          return(NOTINRANGE);
  163.  
  164.     if( fd >= 0 && fd <= DEVFD)
  165.         return(DEVICE);
  166.  
  167.     return(FILES);
  168.  
  169. }
  170.  
  171. checkfn(charnm1)
  172. char *charnm1;
  173.  
  174. {
  175.     /* check the character string charname forms a valid path
  176.        name i.e the individual components making up the
  177.        path name do not exceed MAXNAME-1 characters in length
  178.     NOTE : MAXLINE includes the EOS character according to TRD */
  179.     int len = 0;
  180.     char ch;
  181.  
  182.     /* loop to end of string */
  183.     while (( ch = *charnm1++) != EOSCH)
  184.         {if (ch != SLASHCH) len++ ;
  185.  
  186.     /* ch is a SLASH check length of string */
  187.          else
  188.             { if (len >= MAXNAME) return(ERR) ;
  189.  
  190.     /* otherwise zero length for next component */
  191.               else len = 0;
  192.             }
  193.         }
  194.     
  195.     /* check last component */
  196.     return((len >= MAXNAME) ? ERR : NOERR);
  197.  
  198. }
  199.  
  200. chkrnum(recnum, fd)
  201. int recnum, fd;
  202. {
  203.  
  204.      /* check if the value of recnum, the record number in a direct
  205.     access file is in range. The value of MAXREC, the maximum
  206.     number of records allowed in a particular file, is stored
  207.     as the first record of the file and its value is placed
  208.     in files[fd].charsleft on creation or opening of the file */
  209.  
  210.     struct fdinfo *ptr;
  211.     ptr = &files[fd];
  212.     if (recnum > ptr->chrleft || recnum <= 0) return(ERR);
  213.  
  214.     return(NOERR);
  215. }
  216.  
  217. /* routines for performing IST string to C string and vice versa */
  218. /*CENTRY*/ 
  219. istchr_(istname, charnm1)
  220. int *istname;
  221. char *charnm1;
  222. {
  223.     char junk;
  224.     /* convert an IST string to a C string */
  225.     while( *istname != EOS)
  226.         zcitoc_(charnm1++,1L,istname++,&junk);
  227.     *charnm1 = EOSCH;
  228. }
  229.  
  230. chist_(s,iststr,length)
  231. int *iststr;
  232. long int length;
  233. char *s;
  234. {
  235.     /* makes an ist string out of an f77 character variable
  236.      * stripping off trailing blanks */
  237.  
  238.     char *ptr;
  239.     int junk;
  240.     if(length){
  241.     ptr = s + length - 1;
  242.     while(ptr >= s && *ptr == BLANKCH)
  243.         ptr--;
  244.     for(;s <= ptr;*iststr++ = zcctoi_(s++,&junk));
  245.     *iststr = EOS;
  246.     }
  247.     else *iststr = EOS;
  248. }
  249. /*ENDCENTRY*/ 
  250.  
  251. nxtfld(ptr, field)
  252. char *ptr, *field;
  253. {
  254.  
  255.      /*    get the next field out of the given filename and put it in
  256.     field. Fields are separated by a slash and the string ends
  257.     with an EOS. The search starts at ptr.
  258.     nextfield returns OK if more fields are present or EOS if
  259.     the final field has been extracted. */
  260.  
  261.     for(; *ptr != SLASHCH && *ptr != EOSCH; *field++ = *ptr++) ;
  262.  
  263.     /* move the pointer over the slash if it is present */
  264.     if (*ptr == SLASHCH) ptr++;
  265.  
  266.  
  267.     *field = EOSCH;
  268.     
  269.     return (*ptr == EOSCH ? EOS : OK );
  270.  
  271. }
  272.  
  273. mkpath(name, path)
  274. char *name, *path;
  275. {
  276.  
  277.      /*    generate the pathname (path) from the current local directory
  278.     (localdir - external) and the given name (name)
  279.  
  280.     ./ = current directory
  281.     ../ = parent directory
  282.     / as first character signifies a full path relative to root */
  283.  
  284.     char *ptr, *end, field[MAXPATH];
  285.     int exit, flen;
  286.  
  287.     /* check that the path name is valid  i.e. no fields
  288.        exceed MAXPATH-1 characters in length */
  289.     if (checkfn(name) == ERR) return(ERR);
  290.     strcpy(path, root);
  291.  
  292.     /* complete pathname case */
  293.     if (*name == SLASHCH) {
  294.         strcat(path,name);
  295.         return(OK);
  296.     }
  297.  
  298.     /* path is given relative to local directory */
  299.  
  300.     /* copy non-null local directory path into path */
  301.     if (strlen(lcldir) != 0){
  302.         strcat(path, "/");
  303.         strcat(path, lcldir);
  304.     }
  305.  
  306.     ptr = name;         /* point at start of name */
  307.     end = path + strlen(path); /* point at EOS in path */
  308.     
  309.     /* split up name a field at a time */
  310.     if (ptr == end) return(OK); /* exit on null names */
  311.     do {
  312.         exit = nxtfld(ptr, field);
  313.  
  314.         /* include the slash - before in path and after in name */
  315.         flen = strlen(field) + 1;
  316.         
  317.  
  318.         ptr += flen ; /* move ptr to start of next field */
  319.         
  320.         if (strcmp(field,"./") == 0 || strcmp(field,".") == 0 )
  321.             /* ignore it and it will go away */;
  322.         else if ( strcmp(field, "../") == 0 || strcmp(field,"..")==0){
  323.  
  324.             /* back up a field - if attempt to back up too far
  325.                ignore the request */
  326.             if (end != path + strlen(root) +1) {
  327.                 end--;
  328.                 while (*--end != SLASHCH)  ;
  329.                 *++end = EOSCH;
  330.                 /* first character is a slash so
  331.                 can't run off the start (happen!) */
  332.             }
  333.         }
  334.  
  335.         else /* append the string to the path string */
  336.         {
  337.             /* MAXPATH characters includes the EOS */
  338.             if (end-path+flen >= MAXPATH) return(ERR);
  339.             strcat(path,"/");
  340.             strcat(path, field);
  341.             end += flen;
  342.         }
  343.  
  344.     } while (exit != EOS);
  345.  
  346.     return(OK);
  347. }
  348.  
  349. mkfilnm(istname, filenam, status)
  350. int *istname;
  351. char *filenam;
  352. struct filinfo * status;
  353. {
  354.  
  355.      /*    transform the IST string into a UNIX file name
  356.  
  357.     1. If first character is HOSTFILE_ID then strip it off and
  358.     pass it back.
  359.  
  360.     2. Else it is a PFS file. Build a path of the form
  361.        pfs root directory/ local directory path/ istname
  362.  
  363.     where prs root directory is stored in root, local directory path
  364.     is stored in localdir (both extern).
  365.  
  366.     For details of the form of ISTNAME see the comments in mkpath.
  367.  
  368.     This is a 'middle of the road implementation'.
  369.  
  370.     On a UNIX system it should be possible to just glue the path
  371.     components together and let UNIX sort it out. Decoding is done
  372.     here in an attempt to minimize the string length of the final
  373.     path name */
  374.  
  375.     /* on exit status contains three integer fields
  376.  
  377.          ftype          subtype              exists
  378.          HOST         UNDEFINED             YES/NO
  379.           VFS      PLAIN/DIRECTORY       YES/NO
  380.         DEVICE  STDIN,STDOUT,STDERR,STDLST  UNDEFINED
  381.           ERR         UNDEFINED         UNDEFINED
  382.     */
  383.  
  384.     char path[MAXPATH], *ptr, *ptr2, *start;
  385.     
  386.     istchr_(istname, path);
  387.  
  388.     /* check for host file */
  389.     ptr = path;
  390.     if (*ptr == HOSTFILE_IDCH) {
  391.         start = ++ptr;
  392.         *filenam++ = *ptr;
  393.         
  394.         /* null name - error */
  395.         if(*ptr == EOSCH){
  396.             status->ftype1 = ERR;
  397.             status->subtype = status->exists = UNDEFINED;
  398.             return;
  399.         }
  400.  
  401.         /* check for preconnected units */
  402.         stdunit(ptr, status);
  403.         if(status->ftype1 == DEVICE) {
  404.             *filenam = EOSCH;
  405.             return;
  406.         }
  407.  
  408.         /* otherwise its a host file name proper */
  409.         status->ftype1 = HOST;
  410.         status->subtype = UNDEFINED;
  411.         while (*ptr != EOSCH) *filenam++ = *++ptr;
  412.         *filenam = EOSCH;
  413.  
  414.         /* check for existence */
  415.         status->exists = isafile(start);
  416.         /* or a directory - error in host file case */
  417.         if (isadir(start) == YES) {
  418.             status->ftype1 = ERR;
  419.             status->subtype = status->exists = UNDEFINED;
  420.             return;
  421.         }
  422.     return;
  423.  
  424.      }
  425.  
  426.  
  427.     /* deal with pfs name */
  428.     /* convert to lower case and strip off leading white space */
  429.  
  430.     for(ptr = path; *ptr == BLANKCH || *ptr == TABCH; ptr++) ;
  431.     ptr2 = ptr;
  432.     while ( *ptr2 != EOSCH ) {
  433.         *ptr2 = ( isupper(*ptr2) ? tolower(*ptr2) : *ptr2);
  434.         ptr2++;
  435.     }
  436.  
  437.     /* check for null name */
  438.     if (*ptr == EOSCH) {
  439.         status->ftype1 = ERR;
  440.         status->subtype = status->exists = UNDEFINED;
  441.         return;
  442.         }
  443.     
  444.     /* check for preconnected unit */
  445.     stdunit(ptr, status);
  446.     if (status->ftype1 == DEVICE) return;
  447.     
  448.     /* make up a path name */
  449.     if(mkpath(ptr ,filenam) == ERR) {
  450.         status->ftype1 = ERR;
  451.         status->subtype = status->exists = UNDEFINED;
  452.         return;
  453.         }
  454.     
  455.     /* otherwise return vfs info */
  456.     status->ftype1 = VFS;
  457.     
  458.     /* test to see if it exists */
  459.     status->exists = isafile(filenam);
  460.     
  461.     /* and if it is a directory */
  462.     status->subtype = ((isadir(filenam) == YES) ? DIRECTORY : PLAIN);
  463.     
  464.     return;
  465. }
  466.  
  467.  
  468. opnread(fd)
  469. int fd;
  470.  
  471. {
  472.     /* ensure that the file connected through the file
  473.       descriptor fd is
  474.  
  475.     (i) open (ERR if not)
  476.  
  477.     (ii) has access = read or readwrite (ERR if not)
  478.  
  479.     (iii) has currentaccess set to read if open in readwrite
  480.          this may require a write and a rewind.   */
  481.  
  482.  
  483.     struct fdinfo *ptr;
  484.  
  485.     /* check for valid file descriptor */
  486.     if ( checkfd(fd) == NOTINRANGE ) {
  487.         remark_("invalid file descriptor in putch", 32L);
  488.         return (ERR) ;
  489.         }
  490.     
  491.     ptr = &files[fd];
  492.  
  493.     /* error conditions first */
  494.     if ( ptr->access == NOTOPEN || ptr->access == WRITE){
  495.         remark_("file not open or open for reading only", 38L);
  496.         return(ERR);
  497.     }
  498.  
  499.     /* must be read or readwrite - check currentaccess */
  500.     if(ptr->caccess == WRITE) {
  501.         write(fd, ptr->buffer, ptr->chrleft);
  502.         lseek(fd,0L,0);
  503.         ptr->caccess = READ;
  504.         ptr->chrleft = 0;
  505.     }
  506.     return(OK);
  507. }
  508.  
  509. opnwrit(fd)
  510. int fd;
  511.  
  512. {
  513.     /* ensure that the file connected through the file
  514.       descriptor fd is
  515.  
  516.     (i) open (ERR if not)
  517.  
  518.     (ii) has access = write or readwrite (ERR if not)
  519.  
  520.     (iii) has currentaccess set to write if open in readwrite
  521.          this may require a rewind.   */
  522.  
  523.  
  524.     struct fdinfo *ptr;
  525.     int istname[MAXPATH], pmode=0644;
  526.  
  527.     /* check for valid file descriptor */
  528.     if ( checkfd(fd) == NOTINRANGE ) {
  529.         remark_("invalid file descriptor in putch", 32L);
  530.         return (ERR) ;
  531.         }
  532.     
  533.     ptr = &files[fd];
  534.  
  535.     /* error conditions first */
  536.     if ( ptr->access == NOTOPEN || ptr->access == READ){
  537.         remark_("file not open or open for reading only", 38L);
  538.         return(ERR);
  539.     }
  540.  
  541.     /* if access = WRITE then return OK */
  542.     if (ptr->access == WRITE) return(OK);
  543.  
  544.     /* access is now READWRITE - if currentaccess is READ
  545.        then truncate the file to zero length and reopen
  546.        it with the same fd.
  547.  
  548.        Careful with filenames here because any leading
  549.        HOSTFILE_IDCH have been eaten ! */
  550.  
  551.  
  552.     if(ptr->caccess == READ) {
  553.         fd = crtzlng(ptr->filenam, READWRITE, fd);
  554.         ptr->caccess = WRITE;
  555.         ptr->chrleft = 0;
  556.     }
  557.     return(OK);
  558. }
  559.  
  560.  
  561.  
  562. prconfl(unit, access)
  563. int access, unit;
  564. {
  565.      /* If access = READ, WRITE, READWRITE and the file is
  566.     a preconnected unit then a check is made that the
  567.     access mode is legal.,
  568.         i.e. not READ for STDERR, STDOUT, STDLST
  569.          and not WRITE for STDIN. */
  570.  
  571.     switch ( unit )
  572.     {
  573.       case STDIN :
  574.         return (access == WRITE ? ERR : NOERR);
  575.  
  576.       default:
  577.         return (access == READ ? ERR : NOERR);
  578.     
  579.     }
  580. }
  581.  
  582. stdunit(ptr, status)
  583. char *ptr;
  584. struct filinfo * status;
  585. {
  586.  
  587.      /*    returns a fileinfo pointer if ptr is pointing at a preconnnected
  588.     file else returns (ERR,UNDEFINED,UNDEFINED) */
  589.  
  590.  
  591.     /* set up default values */
  592.     status->ftype1 = ERR;
  593.     status->subtype = status->exists = UNDEFINED;
  594.  
  595.     if (strcmp(ptr,"0") == 0 || strcmp(ptr,"1") == 0
  596.        || strcmp(ptr,"2") == 0 || strcmp(ptr,"3") == 0 ){
  597.         status->ftype1 = DEVICE;
  598.         status->subtype = *ptr - '0';
  599.     }
  600.  
  601.     return;
  602.  
  603. }
  604.  
  605.  
  606. #ifdef VER4.1
  607.  
  608. tmkdir(charnm1, mode)
  609. int mode;
  610. char *charnm1;
  611. {
  612.  
  613.      /* create a new directory with name name in the local directory
  614.     The name name must be unique in this directory */
  615.  
  616.     int pid, status, w;
  617.     
  618.     if((pid = fork()) == -1) return(ERR);
  619.  
  620.     /* mode unused but passed through for consistency with
  621.     4.2 in the hope it may be useful one day ! */
  622.     if(pid == 0) execl(MKDIRPTH, "mkdir", charnm1, (char *) 0);
  623.  
  624.     while((w = wait(&status)) != pid && w != -1) ;
  625.  
  626.     if(w == -1) return(ERR);
  627.  
  628.     return(NOERR);
  629.  
  630. }
  631.  
  632. trmdir(charnm1)
  633. char *charnm1;
  634. {
  635.  
  636.      /* delete an empty directory with name name in the local directory
  637.     The name name must be unique in this directory */
  638.  
  639.     int pid, status, w;
  640.     
  641.     if((pid = fork()) == -1) return(ERR);
  642.  
  643.     if(pid == 0) execl(RMDIRPTH, "rmdir", charnm1, (char *) 0);
  644.  
  645.     while((w = wait(&status)) != pid && w != -1) ;
  646.  
  647.     if(w == -1) return(ERR);
  648.  
  649.     return(NOERR);
  650.  
  651. }
  652.  
  653. #endif
  654.  
  655. outcmps(status)
  656. int *status;
  657. {
  658.  
  659.     /* output the completion status if an error has occurred */
  660.  
  661.     int fderr = STDERR;
  662.  
  663.     zchout_("Tool Termination Status: .", &fderr, 26L);
  664.  
  665.     switch (*status) {
  666.  
  667.         case WARNING:
  668.             zmess_("WARNING.", &fderr, 8L);
  669.             break;
  670.  
  671.         case ERROR:
  672.             zmess_("ERROR.", &fderr, 6L);
  673.             break;
  674.  
  675.         case FATAL:
  676.             zmess_("FATAL.", &fderr, 6L);
  677.             break;
  678.  
  679.         case KILL:
  680.             zmess_("KILL.", &fderr,5L);
  681.             break;
  682.  
  683.         case TERMFLAG_0:
  684.             zmess_("TERMFLAG_0.", &fderr,11L);
  685.             break;
  686.  
  687.         case TERMFLAG_1:
  688.             zmess_("TERMFLAG_1.", &fderr,11L);
  689.             break;
  690.  
  691.         case TERMFLAG_2:
  692.             zmess_("TERMFLAG_2.", &fderr,11L);
  693.             break;
  694.  
  695.  
  696.         }
  697. }
  698.  
  699. writipc(status)
  700. int *status;
  701. {
  702.  
  703.     /* write the inter process communication file */
  704.  
  705.     char lcltmp[MAXPATH];
  706.     int istname[MAXPATH], fd, access = WRITE, length, size = MAXPATH;
  707.     int i, newline = NEWLINE;
  708.  
  709.     /* keep current directory and change to root */
  710.     strcpy(lcltmp, lcldir);
  711.     chist_("/", istname, 1L);
  712.     zlocal_(istname);
  713.  
  714.     /* create an empty inter process communication file */
  715.     chist_(IPCFILE, istname, strlen(IPCFILE));
  716.     fd = create_(istname, &access);
  717.  
  718.     /* output status information */
  719.     length = itoc_(status, istname, &size);
  720.     zptmes_(istname, &fd);
  721.     /* output lcldir, root and nxttool */
  722.     chist_(lcltmp, istname, strlen(lcltmp));
  723.     zptmes_(istname, &fd);
  724.     chist_(root, istname, strlen(root));
  725.     zptmes_(istname, &fd);
  726.     chist_(nxttool, istname, strlen(nxttool));
  727.     zptmes_(istname, &fd);
  728.  
  729.     /* output the information stored in the outparam
  730.       array - a null value means that no argument has been
  731.       assigned */
  732.     for (i=3; i <= MAXPRAM+2; i++) {
  733.         if (outparm[i] == NULLST) /* output a blank line */
  734.             putch_(&newline, &fd);
  735.         else {
  736.             chist_(outparm[i], istname, strlen(outparm[i]));
  737.             zptmes_(istname, &fd);
  738.         }
  739.     }
  740.  
  741.     /* close the inter process communication file */
  742.     close_(&fd);
  743. }
  744.  
  745. xexit()
  746. {
  747.  
  748.     /* general tidying up routine */
  749.  
  750.     char charnm[MAXPATH];
  751.     int istname[MAXPATH], i;
  752.     struct filinfo finf;
  753.  
  754.     /* close all sequential and direct access files - flushing
  755.        output as necessary */
  756.     ztidy_();
  757.  
  758.         /* close current directory descriptor */
  759.         if(dirp != (DIR*) NULLST) closedir(dirp);
  760. if(DEBUG) {
  761.         for (i=FIRSTFD;i<MAXFILE;i++)
  762.            if(close(i) == 0) printf("unclosed fd %d closed",i);
  763.           }
  764.  
  765.     /* flush the device files */
  766.     flush(STDOUT);
  767.     flush(STDERR);
  768.     flush(STDLST);
  769.  
  770.     /* print spool file and delete it - this assumes the system
  771.     copies the list file and doesn't just remember the name */
  772.     zspool_();
  773.     close(STDLST);
  774.     chist_(SPFLNAME, istname, strlen(SPFLNAME));
  775.     mkfilnm(istname, charnm, &finf);
  776.     unlink(charnm);
  777.  
  778. }
  779.  
  780. #ifdef SHELL_SCRIPTS
  781. outinfo(status)
  782. int *status;
  783. {
  784.  
  785.     /* create the file INFOFILE and write status therein */
  786.  
  787. #define INFOFILE "_.info"
  788.  
  789.     int infofile[MAXPATH];
  790.     int wmode = WRITE;
  791.     int width = 1;
  792.     int fdifile;
  793.  
  794.     chist_(INFOFILE, infofile, strlen(INFOFILE));
  795.     fdifile = create_(infofile,&wmode);
  796.     zptint_(status,&width,&fdifile);
  797. }
  798. #endif
  799.