home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rximc175.zip / rxfn.c < prev    next >
C/C++ Source or Header  |  2002-08-06  |  99KB  |  3,662 lines
  1. /* The builtin functions of REXX/imc         (C) Ian Collier 1992 */
  2.  
  3. #include<stdio.h>
  4. #include<string.h>
  5. #include<memory.h>
  6. #include<unistd.h>
  7. #include<stdlib.h>     /* includes bsearch, random */
  8. #include<time.h>
  9. #include<pwd.h>
  10. #include<errno.h>
  11. #include<fcntl.h>
  12. #include<setjmp.h>
  13. #include<sys/types.h>
  14. #include<sys/time.h>
  15. #ifndef Solaris
  16. #include<sys/ioctl.h>
  17. #endif
  18. #include<sys/param.h>
  19. #ifndef FIONREAD
  20. #include<sys/filio.h>
  21. #endif
  22. #include<sys/stat.h>
  23. #ifdef HAS_TTYCOM
  24. #include<sys/ttycom.h>
  25. #else
  26. #include<termios.h>
  27. #endif
  28. #include"const.h"
  29. #include"globals.h"
  30. #include"functions.h"
  31. #define STDIN 0
  32.  
  33.  
  34. /* How to find the number of buffered bytes in a FILE *. */
  35. #ifdef NO_CNT
  36. # undef _CNT
  37. # define _CNT(x) (0)
  38. #endif
  39.  
  40. #ifndef _CNT
  41. # ifdef linux
  42. #  define _CNT(fp) ((fp)->_IO_read_end - (fp)->_IO_read_ptr)
  43. # else
  44. #  ifdef __FreeBSD__
  45. #   define _CNT(fp) ((fp)->_r)
  46. #  else
  47. #   define _CNT(fp) ((fp)->_cnt)
  48. #  endif
  49. # endif
  50. #endif
  51.  
  52. void rxsource();
  53. void rxerror();
  54. void rxlength();
  55. void rxtime();
  56. void rxdate();
  57. void rxleft();
  58. void rxright();
  59. void rxstrip();
  60. void rxvalue();
  61. void rxdatatype();
  62. void rxcopies();
  63. void rxspace();
  64. void rxrange();
  65. void c2x(),c2d(),b2x(),b2d(),d2c(),d2b(),d2x(),x2c(),x2d(),x2b();
  66. void xbyte();
  67. void rxsystem();
  68. void rxpos();
  69. void rxlastpos();
  70. void rxcentre();
  71. void rxjustify();
  72. void rxsubstr();
  73. void rxarg();
  74. void rxabbrev();
  75. void rxabs();
  76. void rxcompare();
  77. void rxdelstr();
  78. void rxdelword();
  79. void rxinsert();
  80. void rxmax();
  81. void rxmin();
  82. void rxoverlay();
  83. void rxrandom();
  84. void rxreverse();
  85. void rxsign();
  86. void rxsubword();
  87. void rxsymbol();
  88. void rxlate();
  89. void rxtrunc();
  90. void rxverify();
  91. void rxword();
  92. void rxwordindex();
  93. void rxwordlength();
  94. void rxwordpos();
  95. void rxwords();
  96. void rxdigits();
  97. void rxfuzz();
  98. void rxtrace();
  99. void rxform();
  100. void rxformat();
  101. void rxqueued();
  102. void rxlinesize();
  103. void rxbitand();
  104. void rxbitor();
  105. void rxbitxor();
  106. void rxuserid();
  107. void rxgetcwd();
  108. void rxchdir();
  109. void rxgetenv();
  110. void rxputenv();
  111. void rxopen();
  112. void rxlinein();
  113. void rxlineout();
  114. void rxcharin();
  115. void rxcharout();
  116. void rxchars();
  117. void rxlines();
  118. void rxchars2();
  119. void rxclose();
  120. void rxfileno();
  121. void rxfdopen();
  122. void rxpopen();
  123. void rxpclose();
  124. void rxftell();
  125. void rxstream();
  126. void rxaddress();
  127. void rxcondition();
  128. void rxfuncadd();
  129. void rxfuncdrop();
  130. void rxfuncquery();
  131.  
  132. int compar();
  133.  
  134. void binrel(); /* The calculator routine which implements binary relations */
  135.  
  136. struct fnlist {char *name;void (*fn)();};
  137.  
  138. int rxfn(name,argc)   /* does function if possible; returns 1 if successful */
  139.                       /* Returns -1 if the name was recognised as a math    */
  140.                       /* function, and 0 if the name was unrecognised.      */
  141. char *name;           /* Name of the function to call */
  142. int argc;             /* Number of arguments passed to it */
  143. {
  144.    static struct fnlist names[]={   /* The name and address of ever builtin */
  145.       "ABBREV",     rxabbrev,       /* function, in alphabetical order      */
  146.       "ABS",        rxabs,
  147.       "ADDRESS",    rxaddress,
  148.       "ARG",        rxarg,
  149.       "B2D",        b2d,
  150.       "B2X",        b2x,
  151.       "BITAND",     rxbitand,
  152.       "BITOR",      rxbitor,
  153.       "BITXOR",     rxbitxor,
  154.       "C2D",        c2d,
  155.       "C2X",        c2x,
  156.       "CENTER",     rxcentre,
  157.       "CENTRE",     rxcentre,
  158.       "CHARIN",     rxcharin,
  159.       "CHAROUT",    rxcharout,
  160.       "CHARS",      rxchars,
  161.       "CHDIR",      rxchdir,
  162.       "CLOSE",      rxclose,
  163.       "COMPARE",    rxcompare,
  164.       "CONDITION",  rxcondition,
  165.       "COPIES",     rxcopies,
  166.       "D2B",        d2b,
  167.       "D2C",        d2c,
  168.       "D2X",        d2x,
  169.       "DATATYPE",   rxdatatype,
  170.       "DATE",       rxdate,
  171.       "DELSTR",     rxdelstr,
  172.       "DELWORD",    rxdelword,
  173.       "DIGITS",     rxdigits,
  174.       "ERRORTEXT",  rxerror,
  175.       "FDOPEN",     rxfdopen,
  176.       "FILENO",     rxfileno,
  177.       "FORM",       rxform,
  178.       "FORMAT",     rxformat,
  179.       "FTELL",      rxftell,
  180.       "FUZZ",       rxfuzz,
  181.       "GETCWD",     rxgetcwd,
  182.       "GETENV",     rxgetenv,
  183.       "INSERT",     rxinsert,
  184.       "JUSTIFY",    rxjustify,
  185.       "LASTPOS",    rxlastpos,
  186.       "LEFT",       rxleft,
  187.       "LENGTH",     rxlength,
  188.       "LINEIN",     rxlinein,
  189.       "LINEOUT",    rxlineout,
  190.       "LINES",      rxlines,
  191.       "LINESIZE",   rxlinesize,
  192.       "MAX",        rxmax,
  193.       "MIN",        rxmin,
  194.       "OPEN",       rxopen,
  195.       "OVERLAY",    rxoverlay,
  196.       "PCLOSE",     rxpclose,
  197.       "POPEN",      rxpopen,
  198.       "POS",        rxpos,
  199.       "PUTENV",     rxputenv,
  200.       "QUEUED",     rxqueued,
  201.       "RANDOM",     rxrandom,
  202.       "REVERSE",    rxreverse,
  203.       "RIGHT",      rxright,
  204.       "RXFUNCADD",  rxfuncadd,
  205.       "RXFUNCDROP", rxfuncdrop,
  206.       "RXFUNCQUERY",rxfuncquery,
  207.       "SIGN",       rxsign,
  208.       "SOURCELINE", rxsource,
  209.       "SPACE",      rxspace,
  210.       "STREAM",     rxstream,
  211.       "STRIP",      rxstrip,
  212.       "SUBSTR",     rxsubstr,
  213.       "SUBWORD",    rxsubword,
  214.       "SYMBOL",     rxsymbol,
  215.       "SYSTEM",     rxsystem,
  216.       "TIME",       rxtime,
  217.       "TRACE",      rxtrace,
  218.       "TRANSLATE",  rxlate,
  219.       "TRUNC",      rxtrunc,
  220.       "USERID",     rxuserid,
  221.       "VALUE",      rxvalue,
  222.       "VERIFY",     rxverify,
  223.       "WORD",       rxword,
  224.       "WORDINDEX",  rxwordindex,
  225.       "WORDLENGTH", rxwordlength,
  226.       "WORDPOS",    rxwordpos,
  227.       "WORDS",      rxwords,
  228.       "X2B",        x2b,
  229.       "X2C",        x2c,
  230.       "X2D",        x2d,
  231.       "XRANGE",     rxrange
  232.       };
  233. #define nofun 0     /* "nofun" means "this function ain't here" */
  234. #define numfun 87   /* The number of builtin functions */
  235.  
  236.    struct fnlist test;
  237.    struct fnlist *ptr;
  238.    test.name=name; /* Initialise a structure with the candidate name */
  239.    ptr=(struct fnlist *) /* Search for a builtin function */
  240.       bsearch((char*)&test,(char*)names,numfun,sizeof(struct fnlist),compar);
  241.    if(!ptr)return 0;    /* no function recognised */
  242.    (*(ptr->fn))(argc);  /* Call the builtin function */
  243.    return 1;            /* Done. */
  244. }
  245.  
  246. int compar(s1,s2) /* Compares two items of a function list, */
  247. char *s1,*s2;     /* as required by bsearch()               */
  248. {
  249.    return strcmp(((struct fnlist*)s1)->name,((struct fnlist *)s2)->name);
  250. }
  251.  
  252. char *undelete(l) /* A utility function like delete(l) except that */
  253. int *l;           /* the value isn't deleted from the stack */
  254. {
  255.    char *ptr=cstackptr+ecstackptr-four;
  256.    (*l)= *(int *)ptr;
  257.    if(*l>=0)ptr-=align(*l);
  258.    else ptr=(char *)-1;/* I don't think this is ever used */
  259.    return ptr;
  260. }
  261.  
  262. /* The rest of this file contains the builtin functions listed in the
  263.    dictionary above.  In general, each function ABC() is implemented by
  264.    the C routine rxabc().  Each routine takes one parameter - namely
  265.    the number of arguments passed to the builtin function - and gives no
  266.    return value.  The arguments and result of the builtin function are
  267.    passed on the calculator stack.  A null argument (as in abc(x,,y))
  268.    is represented by a stacked value having length -1. */
  269.  
  270. void rxsource(argc) /* souceline() function */
  271. int argc;
  272. {
  273.    int i;
  274.    char *s;
  275.    if(!argc){
  276.       stackint(lines); /* the number of source lines */
  277.       return;
  278.    }
  279.    if(argc!=1)die(Ecall);
  280.    if((i=getint(1))>lines||i<1)die(Erange);
  281.    s=source[i];
  282.    stack(s,strlen(s)); /* the ith source line */
  283. }
  284.  
  285. void rxerror(argc)  /* errortext() function */
  286. int argc;
  287. {
  288.    char *msg;
  289.    if(argc!=1)die(Ecall);
  290.    msg=message(getint(1));
  291.    stack(msg,strlen(msg));
  292. }
  293. void rxlength(argc)
  294. int argc;
  295. {
  296.    int l;
  297.    if(argc!=1)die(Ecall);
  298.    delete(&l);
  299.    stackint(l);
  300. }
  301.  
  302. /* This is used for TIME() with three parameters to collect an input time
  303.    and convert it into a tm structure for output.  Return 0 -> successful */
  304. static int rxgettime(type, time, usec)
  305. char type;
  306. struct tm *time;
  307. long *usec;
  308. {
  309.    int input;
  310.    char *string;
  311.    char ampm[2];
  312.    int len;
  313.    int i;
  314.    char c;
  315.    time->tm_hour = time->tm_min = time->tm_sec = 0;
  316.    *usec=0;
  317.    if (type=='H' || type=='M' || type=='S') {
  318.       input=getint(1);
  319.       if (input<0 || input>86400) return -1;
  320.    } else {
  321.       string=delete(&len);
  322.       for (i=0; i<len; i++) if (!string[i]) return -1;
  323.       string[len]=0;
  324.    }
  325.    switch (type) {
  326.       case 'C':
  327.          if (sscanf(string,"%2d:%2d%2c%c",&time->tm_hour,&time->tm_min,
  328.             ampm,&c) != 3) return -1;
  329.          if (time->tm_hour<1 || time->tm_hour>12) return -1;
  330.          if (ampm[1]!='m') return -1;
  331.          switch (ampm[0]) {
  332.             case 'a':
  333.                if (time->tm_hour==12) time->tm_hour=0;
  334.                break;
  335.             case 'p':
  336.                if (time->tm_hour!=12) time->tm_hour+=12;
  337.                break;
  338.             default: return -1;
  339.          }
  340.          break;
  341.       case 'H': time->tm_hour=input; break;
  342.       case 'L':
  343.          if (sscanf(string,"%2d:%2d:%2d.%c",&time->tm_hour,&time->tm_min,
  344.             &time->tm_sec,&c) !=4) return -1;
  345.          string=strchr(string,'.');
  346.          if (!string) return -1;
  347.          i=100000;
  348.          while((c=*++string)) {
  349.             if (c<'0' || c>'9') return -1;
  350.             *usec+=i*(c-'0');
  351.             i/=10;
  352.          }
  353.          break;
  354.       case 'M':
  355.          time->tm_hour=input/60;
  356.          time->tm_min=input%60;
  357.          break;
  358.       case 'N':
  359.          if (sscanf(string,"%2d:%2d:%2d%c",&time->tm_hour,&time->tm_min,
  360.             &time->tm_sec,&c) !=3) return -1;
  361.          break;
  362.       case 'S':
  363.          time->tm_hour=input/3600;
  364.          input=input%3600;
  365.          time->tm_min=input/60;
  366.          time->tm_sec=input%60;
  367.          break;
  368.       default: return -1;
  369.    }
  370.    if (time->tm_hour<0 || time->tm_hour>23 || time->tm_min<0 ||
  371.       time->tm_min>59 || time->tm_sec<0 || time->tm_sec>59) return -1;
  372.    return 0;
  373. }
  374.  
  375. void rxtime(argc)
  376. int argc;
  377. {
  378.    struct tm t,*t2;
  379.    struct timezone tz;
  380.    char ans[20];
  381.    char opt='N';
  382.    char type=0;
  383.    char *arg;
  384.    long e1;
  385.    long e2;
  386.    int l;
  387.    long usec;
  388. #ifdef DECLARE_TIMEZONE  /* everything except Sun seems to declare this */
  389.    extern long int timezone;                               /* in time.h */
  390. #endif
  391.    if(!(timeflag&2))
  392.       gettimeofday(×tamp,&tz);/* Make a timestamp if necessary */
  393.    timeflag|=2;
  394.    if (argc>3) die(Ecall);
  395.    if (argc>1) {
  396.       if (argc==3) {
  397.          arg=delete(&l);
  398.          if(!l)die(Ecall);
  399.          type=arg[0]&0xdf;
  400.          if (isnull()) die(Ecall);
  401.       }
  402.       else type='N';
  403.       if (rxgettime(type,t2=&t,&usec)) die(Ecall);
  404.       argc=1;
  405.       if (isnull()) {
  406.          delete(&l);
  407.          argc--;
  408.       }
  409.    } else {
  410.       t2=localtime(×tamp.tv_sec);/* t2 now contains all the necessary info */
  411.       usec=timestamp.tv_usec;
  412.    }
  413.    if(argc==1){
  414.       arg=delete(&l);
  415.       if(!l)die(Ecall);
  416.       opt=arg[0]&0xdf;
  417.       if (type) if (opt=='E' || opt=='R' || opt=='O') die(Ecall);
  418.    }
  419.    switch(opt){
  420.       case 'C':l=t2->tm_hour%12;
  421.          if(l==0)l=12;
  422.          sprintf(ans,"%d:%02d%s",l,t2->tm_min,(t2->tm_hour <12)?"am":"pm");
  423.          break;
  424.       case 'N':sprintf(ans,"%02d:%02d:%02d",t2->tm_hour,t2->tm_min,t2->tm_sec);
  425.          break;
  426.       case 'L':sprintf(ans,"%02d:%02d:%02d.%06d",t2->tm_hour,t2->tm_min,
  427.                        t2->tm_sec,usec);
  428.          break;
  429.       case 'H':sprintf(ans,"%d",t2->tm_hour);
  430.          break;
  431.       case 'M':sprintf(ans,"%d",(t2->tm_hour)*60+(t2->tm_min));
  432.          break;
  433.       case 'S':sprintf(ans,"%d",((t2->tm_hour)*60+(t2->tm_min))*60+(t2->tm_sec));
  434.          break;
  435.       case 'O':
  436. #ifdef HAS_GMTOFF
  437.          sprintf(ans,"%ld",(long)(t2->tm_gmtoff));
  438. #else
  439.          sprintf(ans,"%ld",-(long)timezone+3600*(t2->tm_isdst>0));
  440. #endif
  441.          break;
  442.       case 'E':
  443.       case 'R':if(!(timeflag&1))secs=timestamp.tv_sec,
  444.                                 microsecs=timestamp.tv_usec;
  445.          timeflag|=1,
  446.          e2=timestamp.tv_usec-microsecs,
  447.          e1=timestamp.tv_sec-secs;
  448.          if(e2<0)e2+=1000000,e1--;
  449.          if(opt=='R')secs=timestamp.tv_sec,microsecs=timestamp.tv_usec;
  450.          if(e1||e2)sprintf(ans,"%ld.%06d",e1,e2);
  451.          else ans[0]='0',ans[1]=0; /* "0", not "0.000000" */
  452.          break;
  453.       default:die(Ecall);
  454.    }
  455.    stack(ans,strlen(ans));
  456. }
  457.  
  458. char *month[12]={"Jan","Feb","Mar","Apr","May","Jun","Jul",
  459.                  "Aug","Sep","Oct","Nov","Dec"};
  460. /* month names originally for rxdate() but needed for the Rexx version string*/
  461.  
  462. /* This is used in DATE() with three parameters to convert an input date
  463.    into a Unix date */
  464. static time_t rxgetdate(type,thisyear)
  465. char type;
  466. int thisyear;
  467. {
  468.    long t, t2;
  469.    char *date;
  470.    char mth[3];
  471.    struct tm time;
  472.    int len;
  473.    unsigned long maxtime = (~(unsigned long)0)>>1;
  474.    int i,y;
  475.    char c;
  476.    memset((void*)&time,0,sizeof time);
  477.    if (type=='B' || type=='C' || type=='D') {
  478.       t=getint(1);
  479.       if (t<0) return -1;
  480.    }
  481.    else {
  482.       date=delete(&len);
  483.       for (i=0; i<len; i++) if (!date[i]) return -1;
  484.       date[len]=0;
  485.    }
  486.    time.tm_isdst = 0;
  487.    time.tm_hour = 12; /* stop DST variations from changing the date */
  488.    time.tm_year = thisyear-1900;
  489.  
  490.    switch(type) {
  491.       case 'C':
  492.          if (t>36524) return -1;
  493.          y=t*100/36524; /* approximate year represented by input value */
  494.          if (y+2000-thisyear <= 50) t+=36524;
  495.          t+=693594L;
  496.          /* fall through */
  497.       case 'B':
  498.          t-=719162L;
  499.          if (t > (long)(maxtime/86400) || t < -(long)(maxtime/86400))
  500.             return -1;
  501.          return 86400*(time_t)t;
  502.       case 'J':
  503.          if (sscanf(date,"%2d%3ld%c",&y,&t,&c) != 2) return -1;
  504.          if (y<0) return -1;
  505.          if (y+2000-thisyear <= 50) y+=100;
  506.          time.tm_year = y;
  507.          /* fall through */
  508.       case 'D':
  509.          t2=mktime(&time);
  510.          if (t2==-1) return -1;
  511.          if (t>366) return -1;
  512.          return t2+t*86400;
  513.       case 'E':
  514.          if (sscanf(date,"%2d/%2d/%2d%c",&time.tm_mday,&time.tm_mon,
  515.             &y,&c) != 3) return -1;
  516.          if (y+2000-thisyear <= 50) y+=100;
  517.          time.tm_year=y;
  518.          break;
  519.       case 'N':
  520.          if (sscanf(date,"%2d %3c %4d%c",&time.tm_mday,mth,
  521.             &y,&c) != 3) return -1;
  522.          time.tm_year=y-1900;
  523.          for (i=0; i<12; i++) if (!memcmp(month[i],mth,3)) break;
  524.          if (i==12) return -1;
  525.          time.tm_mon=i+1;
  526.          break;
  527.       case 'O':
  528.          if (sscanf(date,"%2d/%2d/%2d%c",&y,&time.tm_mon,
  529.             &time.tm_mday,&c) != 3) return -1;
  530.          if (y+2000-thisyear <= 50) y+=100;
  531.          time.tm_year=y;
  532.          break;
  533.       case 'S':
  534.          if (sscanf(date,"%4d%2d%2d%c",&y,&time.tm_mon,
  535.             &time.tm_mday,&c) != 3) return -1;
  536.          time.tm_year=y-1900;
  537.          break;
  538.       case 'U':
  539.          if (sscanf(date,"%2d/%2d/%2d%c",&time.tm_mon,&time.tm_mday,
  540.             &y,&c) != 3) return -1;
  541.          if (y+2000-thisyear <= 50) y+=100;
  542.          time.tm_year=y;
  543.          break;
  544.       default: return -1;
  545.    }
  546.    time.tm_mon--;
  547.    if (time.tm_mday<1 || time.tm_mday>31 || time.tm_mon<0 || time.tm_mon>11
  548.       || time.tm_year<0) return -1;
  549.    return mktime(&time);
  550. }
  551.  
  552. void rxdate(argc)
  553. int argc;
  554. {
  555.    static char *wkday[7]={"Sunday","Monday","Tuesday","Wednesday",
  556.                           "Thursday","Friday","Saturday"};
  557.    static char *fullmonth[12]={"January","February","March","April","May",
  558.                           "June","July","August","September","October",
  559.                           "November","December"};
  560.    struct tm *t2;
  561.    struct timezone tz;
  562.    char ans[20];
  563.    char opt='N';
  564.    char type='N';
  565.    char *arg;
  566.    int l;
  567.    long t;
  568.    time_t time;
  569.    if(!(timeflag&2))
  570.       gettimeofday(×tamp,&tz);/* Make a timestamp if necessary */
  571.    timeflag|=2;
  572.    time=timestamp.tv_sec;
  573.    t2=localtime(×tamp.tv_sec);/* t2 now contains all the necessary info */
  574.    if(argc>3)die(Ecall);
  575.    if (argc>1) { /* get a type and an input date of that type */
  576.       if (argc==3) {
  577.          arg=delete(&l);
  578.          if(!l)die(Ecall);
  579.          type=arg[0]&0xdf;
  580.          if (isnull()) die(Ecall);
  581.       }
  582.       time=rxgetdate(type,t2->tm_year+1900);
  583.       if (time==-1) die(Ecall);
  584.       t2=localtime(&time);
  585.       argc=1;
  586.       if (isnull()) {
  587.          argc--;
  588.          delete(&l);
  589.       }
  590.    }
  591.    if(argc==1){
  592.       arg=delete(&l);
  593.       if(!l)die(Ecall);
  594.       opt=arg[0]&0xdf;
  595.    }
  596.    switch(opt){
  597.       case 'B':
  598.          if (time>=0) t=time/86400;
  599.          else t=-((-time-1)/86400)-1; /* make sure negative numbers round down */
  600.       sprintf(ans,"%ld",t+719162L);
  601.          break;
  602.       case 'C':
  603.          t=time/86400L+25568L;
  604.          if (t>36524) t-=36524;
  605.          sprintf(ans,"%ld",t);
  606.          break;
  607.       case 'D':sprintf(ans,"%d",t2 -> tm_yday+1);
  608.          break;
  609.       case 'E':sprintf(ans,"%02d/%02d/%02d",t2 ->tm_mday,t2->tm_mon+1,t2->tm_year%100);
  610.          break;
  611.       case 'J':sprintf(ans,"%02d%03d",t2->tm_year%100,t2->tm_yday+1);
  612.          break;
  613.       case 'M':strcpy(ans,fullmonth[t2->tm_mon]);
  614.          break;
  615.       case 'N':sprintf(ans,"%d %s %d",t2->tm_mday,month[t2->tm_mon],t2->tm_year+1900);
  616.          break;
  617.       case 'O':sprintf(ans,"%02d/%02d/%02d",t2->tm_year%100,t2->tm_mon+1,t2->tm_mday);
  618.          break;
  619.       case 'S':sprintf(ans,"%04d%02d%02d",t2->tm_year+1900,t2->tm_mon+1,t2->tm_mday);
  620.          break;
  621.       case 'U':sprintf(ans,"%02d/%02d/%02d",t2->tm_mon+1,t2->tm_mday,t2->tm_year%100);
  622.          break;
  623.       case 'W':strcpy(ans,wkday[t2->tm_wday]);
  624.          break;
  625.       default:die(Ecall);
  626.    }
  627.    stack(ans,strlen(ans));
  628. }
  629. void rxstrip(argc)
  630. int argc;
  631. {
  632.    char *arg;
  633.    int len;
  634.    char strip=' ';
  635.    int flg=0;
  636.    if(argc>3||!argc)die(Ecall);
  637.    if(argc==3){
  638.       arg=delete(&len);
  639.       if(len>1||len==0)die(Ecall);
  640.       else if(len==1)strip=arg[0];
  641.    }
  642.    if(argc>1){
  643.       arg=delete(&len);
  644.       if(!len)die(Ecall);
  645.       else if(len>0)switch(arg[0]&0xdf){
  646.       case 'T':flg=1;
  647.          break;
  648.       case 'L':flg= -1;
  649.       case 'B':break;
  650.       default:die(Ecall);
  651.       }
  652.    }
  653.    arg=delete(&len);
  654.    if(len<0)die(Enoarg);
  655.    if(flg<=0)for(;arg[0]==strip&&len;arg++,len--); /* strip leading chars */
  656.    if(flg>=0){while(len--&&arg[len]==strip);len++;}/* strip trailing chars */
  657.    mtest(workptr,worklen,len+5,len+5); /* move to worksp before stacking, */
  658.    memcpy(workptr,arg,len);            /* as stack() will destroy this copy */
  659.    stack(workptr,len);
  660. }
  661. void rxleft(argc)
  662. int argc;
  663. {
  664.    char *arg;
  665.    int len;
  666.    int len1;
  667.    char pad=' ';
  668.    int num;
  669.    if(argc>3||argc<2)die(Ecall);
  670.    if(argc==3){
  671.       arg=delete(&len);
  672.       if(len>=0){
  673.          if(len!=1)die(Ecall);
  674.          pad=arg[0];
  675.       }
  676.    }
  677.    if((num=getint(1))<0)die(Ecall);
  678.    arg=delete(&len);
  679.    if(len<0)die(Enoarg);
  680.    len1=len>num?len:num;
  681.    mtest(workptr,worklen,len1+5,len1+5);
  682.    len1=len<num?len:num;
  683.    memcpy(workptr,arg,len1);
  684.    for(;len1<num;workptr[len1++]=pad);
  685.    stack(workptr,num);
  686. }
  687. void rxright(argc)
  688. int argc;
  689. {
  690.    char *arg;
  691.    int len;
  692.    int len1;
  693.    int i;
  694.    char pad=' ';
  695.    int num;
  696.    if(argc>3||argc<2)die(Ecall);
  697.    if(argc==3){
  698.       arg=delete(&len);
  699.       if(len>0){
  700.          if(len!=1)die(Ecall);
  701.          pad=arg[0];
  702.       }
  703.    }
  704.    if((num=getint(1))<0)die(Ecall);
  705.    arg=delete(&len);
  706.    if(len<0)die(Enoarg);
  707.    len1=len>num?len:num;
  708.    mtest(workptr,worklen,len1+5,len1+5);
  709.    for(i=0;len+i<num;workptr[i++]=pad);
  710.    len1=len<num?len:num;
  711.    memcpy(workptr+i,arg+len-len1,len1);
  712.    stack(workptr,num);
  713. }
  714.  
  715. char *rxgetname(nl,t) /* get a symbol (if compound symbol, substitute values
  716.                          in tail). Afterwards, t=0 if invalid, otherwise:
  717.                          1 normal symbol, 2 constant symbol, 3 number. */
  718. int *nl,*t;           /* Return value is the name, nl is the length.  The   */
  719. {                     /* result may contain garbage if the symbol was bad.  */
  720.    static char name[maxvarname];
  721.    int len,l,m,e,z;
  722.    char *arg;
  723.    char *val;
  724.    int p;
  725.    int i=0;
  726.    char c;
  727.    int dot=0;
  728.    int constsym;
  729.    if (num(&m,&e,&z,&l)>=0){
  730.       /* Symbol is a number - must not contain spaces or a leading sign.
  731.          Uppercase any 'e' in the exponent. */
  732.       (*t)=0;
  733.       arg=delete(&len);
  734.       if (len>=maxvarname-1) return name;
  735.       if (!rexxsymbol(arg[0])) return name;
  736.       if (!rexxsymbol(arg[len-1])) return name;
  737.       (*t)=3;
  738.       (*nl)=len;
  739.       memcpy(name,arg,len);
  740.       name[len]=0;
  741.       arg=strchr(name,'e');
  742.       if (arg) arg[0]='E';
  743.       return name;
  744.    }
  745.    arg=delete(&len);
  746.    if (len<=0) return *t=0,name;
  747.    constsym=rexxsymbol(uc(arg[0]))<=0; /* is it a constant symbol? */
  748.    (*t)=1+constsym;
  749.    if(len>=maxvarname-1)return *t=0,name;
  750.    while(len&&arg[0]!='.') {        /* Get the stem part */
  751.       name[i++]=c=uc((arg++)[0]),
  752.       len--;
  753.       if(!rexxsymbol(c))return *t=0,name;
  754.    }
  755.    if(len==1&&arg[0]=='.'&&!constsym)
  756.       dot=1,len--;                  /* Delete final dot of a stem */
  757.    while(len&&arg[0]=='.'){         /* Get each element of the tail */
  758.       dot=1;
  759.       name[p= i++]='.',
  760.       ++p,
  761.       ++arg,
  762.       len--;
  763.       while(len&&arg[0]!='.'){      /* copy the element */
  764.          c=name[i++]=uc((arg++)[0]),len--;
  765.          if(!rexxsymbol(c))return *t=0,name;
  766.       }
  767.       if(p!=i&&!constsym){          /* substitute it */
  768.          name[i]=0;
  769.          if(val=varget(name+p,i-p,&l)){
  770.             if(len+l>=maxvarname-1)return *t=0,name;
  771.             memcpy(name+p,val,l),i=p+l;
  772.          }
  773.       }
  774.    }
  775.    (*nl)=i;
  776.    name[i]=0;
  777.    if(dot&&!constsym)name[0]|=128; /* Compound symbols have the MSB set */
  778.    return name;
  779. }
  780.       
  781. void rxvalue(argc)
  782. int argc;
  783. {
  784.    char *arg;
  785.    char *val;
  786.    char *pool=0;
  787.    char **entry;
  788.    int poollen;
  789.    char *new=0;
  790.    int newlen;
  791.    int l,len,t;
  792.    int oldlen;
  793.    int path;
  794.    if(argc==3){
  795.       pool=delete(&poollen);
  796.       argc--;
  797.       pool[poollen]=0;
  798.    }
  799.    if(argc==2){
  800.       new=delete(&newlen);
  801.       argc--;
  802.       if(newlen<0)new=0;
  803.       else{ /* stack will be corrupted, so copy to workspace */
  804.          mtest(workptr,worklen,newlen+1,newlen+1-worklen);
  805.          memcpy(workptr,new,newlen);
  806.          new=workptr;
  807.       }
  808.    }
  809.    if(argc!=1)die(Ecall);
  810.    if(pool)                /* The pool name determines what we do here */
  811.       if(!strcasecmp(pool,"ENVIRONMENT") || !strcmp(pool,"SYSTEM")){
  812.          arg=delete(&len);
  813.          if(len<1 || len>varnamelen-1)die(Ecall);
  814.          /* A valid environment variable contains REXX symbol characters
  815.             but no '$' or '.'.  It is not uppercased. */
  816.          if(whattype(arg[0])==2)die(Ecall);
  817.          for(l=0;l<len;l++)
  818.             if(whattype(arg[l])<1||arg[l]=='.'||arg[l]=='$')die(Ecall);
  819.             else varnamebuf[l]=arg[l];
  820.          arg=varnamebuf;
  821.          arg[len]=0;
  822.          if(val=getenv(arg))stack(val,strlen(val));
  823.          else stack(cnull,0);
  824.          if(!new)return;
  825.          if(memchr(new,0,newlen))die(Ecall);
  826.          path=strcmp(arg,"PATH");
  827.          entry=(char**)hashfind(0,arg,&l);
  828.          arg[len]='=';
  829.          arg[len+1]=0;
  830.          putenv(arg); /* release the previous copy from the environment */
  831.          if(!l)*entry=allocm(len+newlen+2);
  832.          else if(strlen(*entry)<len+newlen+2)
  833.             if(!(*entry=realloc(*entry,len+newlen+2)))die(Emem);
  834.          memcpy(*entry,arg,++len);
  835.          memcpy(*entry+len,new,newlen);
  836.          entry[0][len+newlen]=0;
  837.          putenv(*entry);
  838.          if(!path)hashclear(); /* clear shell's hash table on change of PATH */
  839.          return;
  840.       }
  841.       /* here add more "else if"s */
  842.       else if(strcasecmp(pool,"REXX"))die(Ecall);
  843.    arg=rxgetname(&len,&t); /* Get the symbol name, then try to get its value */
  844.    if (t>1) stack(arg,len); /* for constant symbol stack its name */
  845.    else if(t&&(val=varget(arg,len,&l)))stack(val,l);
  846.    else if(t<1)die(Ecall);/* die if it was bad */
  847.    else { /* stack the variable's name */
  848.       oldlen=len;
  849.       if((l=arg[0]&128)&&!memchr(arg,'.',len))arg[len++]='.';
  850.       arg[0]&=127,stack(arg,len);
  851.       arg[0]|=l;
  852.       len=oldlen;
  853.    }
  854.    if(new)
  855.       if (t>1) die(Ecall); /* can't set a constant symbol */
  856.       else varset(arg,len,new,newlen);
  857. }
  858.  
  859. void rxdatatype(argc)
  860. int argc;
  861. {
  862.    char *arg;
  863.    int len;
  864.    int i,numb=1,fst=1;
  865.    int m,e,z,l;
  866.    char c;
  867.    if(argc>2||!argc)die(Ecall);
  868.    if(argc==2&&isnull())delete(&len),argc--;
  869.    if(argc==1){
  870.       if(num(&m,&e,&z,&l)>=0)  /* numeric if true */
  871.          delete(&l),
  872.          stack("NUM",3);
  873.       else delete(&l),stack("CHAR",4);
  874.    }
  875.    else{
  876.       arg=delete(&len);
  877.       if(isnull())die(Enoarg);
  878.       if(len<1)die(Ecall);
  879.       switch(arg[0]&0xdf){ /* Depending on type, set i to the answer */
  880.       case 'A':arg=delete(&len);
  881.          if(!len){i=0;break;}
  882.          i=1;
  883.          while(len--)if((m=alphanum((arg++)[0]))<1||m==3)i=0;
  884.          break;
  885.       case 'B':arg=delete(&len);
  886.          if(!len){i=0;break;}
  887.          i=1;
  888.          while(len--)if((c=(arg++)[0])!='0'&&c!='1')i=0;
  889.          break;
  890.       case 'L':arg=delete(&len);
  891.          if(!len){i=0;break;}
  892.          i=1;
  893.          while(len--)if((c=(arg++)[0])<'a'||c>'z')i=0;
  894.          break;
  895.       case 'M':arg=delete(&len);
  896.          if(!len){i=0;break;}
  897.          i=1;
  898.          while(len--)if((c=(arg++)[0]|0x20)<'a'||c>'z')i=0;
  899.          break;
  900.       case 'N':i=(num(&m,&e,&z,&l)>=0),
  901.          delete(&len);
  902.          break;
  903.       case 'S':arg=rxgetname(&len,&l);
  904.          i = l>0;
  905.          break;
  906.       case 'U':arg=delete(&len);
  907.          if(!len){i=0;break;}
  908.          i=1;
  909.          while(len--)if((c=(arg++)[0])<'A'||c>'Z')i=0;
  910.          break;
  911.       case 'W':numb=num(&m,&e,&z,&l),
  912.          i=numb>=0&&(z||isint(numb,l,e)),
  913.          delete(&len);
  914.          break;
  915.       case 'X':arg=delete(&len);
  916.          i=1,l=0;
  917.     /*   while(len&&arg[0]==' ')arg++,len--; */
  918.          if(len && (arg[0]==' '||arg[len-1]==' ')){i=0; break;}
  919.          while(len){
  920.             if(arg[0]==' '){
  921.                if(fst)fst=0;
  922.                else if(l%2)i=0;
  923.                l=0;
  924.                while(len&&arg[0]==' ')arg++,len--;
  925.             }
  926.             if(len==0)break;
  927.             c=(arg++)[0],len--;
  928.             if((c-='0')<0)i=0;
  929.             else if(c>9){
  930.                if((c-=7)<10)i=0;
  931.                if(c>15)if((c-=32)<10)i=0;
  932.                if(c>15)i=0;
  933.             }
  934.             l++;
  935.          }
  936.          if(!fst&&(l%2))i=0;
  937.          break;
  938.       default:die(Ecall);
  939.       }
  940.       stack((c=i+'0',&c),1);
  941.    }
  942. }
  943. void rxcopies(argc)
  944. int argc;
  945. {
  946.    int copies;
  947.    char *arg,*p;
  948.    char *mtest_old;
  949.    long mtest_diff;
  950.    int len;
  951.    int a;
  952.    if(argc!=2)die(Ecall);
  953.    if((copies=getint(1))<0)die(Ecall);
  954.    arg=delete(&len);
  955.    if(len<0)die(Enoarg);
  956.    if(!(len&&copies)){stack(cnull,0);return;}
  957.    if dtest(cstackptr,cstacklen,ecstackptr+len*copies+16,len*copies+16)
  958.       arg+=mtest_diff; /* Make room for the copies, then stack them directly */
  959.    for(a=len*(copies-1),p=arg+len;a--;p++[0]=arg++[0]);
  960.    ecstackptr+=align(len*=copies),
  961.    *(int *)(cstackptr+ecstackptr)=len,
  962.    ecstackptr+=four;
  963. }
  964. void rxspace(argc)
  965. int argc;
  966. {
  967.    char *arg;
  968.    int len;
  969.    int len1,len2;
  970.    char pad=' ';
  971.    int num=1;
  972.    int i;
  973.    if(argc<1||argc>3)die(Ecall);
  974.    if(argc==3){  /* First we find the character to pad with */
  975.       argc--;
  976.       arg=delete(&len);
  977.       if(len>=0){
  978.          if(len!=1)die(Ecall);
  979.          pad=arg[0];
  980.       }
  981.    }
  982.    if(argc==2){ /* Then the number of spaces between each word */
  983.       argc--;
  984.       if(isnull())delete(&len);
  985.       else if((num=getint(1))<0)die(Ecall);
  986.    }
  987.    arg=delete(&len); /* and finally the phrase to operate on */
  988.    if(len<0)die(Enoarg);
  989.    while(len--&&arg[0]==' ')arg++;
  990.    len++;
  991.    while(len--&&arg[len]==' ');
  992.    len++;
  993.    mtest(workptr,worklen,len*(num+1),len*(num+2));
  994.    for(len1=len2=0;len2<len;){ /* Make the result string in the workspace */
  995.       while((workptr[len1++]=arg[len2++])!=' '&&len2<=len);
  996.       while(len2<len&&arg[len2]==' ')len2++;
  997.       for(i=0,len1--;i<num;workptr[len1++]=pad)i++;
  998.    }
  999.    if(len)len1-=num;  /* Remove the padding from after the last word */
  1000.    stack(workptr,len1);
  1001. }
  1002. void rxrange(argc)
  1003. int argc;
  1004. {
  1005.    unsigned int c2=255;
  1006.    unsigned int c1=0;
  1007.    unsigned char *arg;
  1008.    int len;
  1009.    if(argc>2)die(Ecall);
  1010.    if(argc>1){
  1011.       arg=(unsigned char *)delete(&len);
  1012.       if(len>=0)
  1013.          if(len!=1)die(Ecall);
  1014.          else c2=arg[0];
  1015.    }
  1016.    if(argc){
  1017.       arg=(unsigned char *)delete(&len);
  1018.       if(len>=0)
  1019.          if(len!=1)die(Ecall);
  1020.          else c1=arg[0];
  1021.    }
  1022.    if(c1>c2)c2+=256;
  1023.    len=c2-c1+1;
  1024.    mtest(cstackptr,cstacklen,ecstackptr+len+16,len+16);
  1025.    for(arg=(unsigned char *)(cstackptr+ecstackptr);c1<=c2;(*(arg++))=(c1++)&255);
  1026.    *(int *)(cstackptr+(ecstackptr+=align(len)))=len,
  1027.    ecstackptr+=four;
  1028. }
  1029. void c2x(argc)
  1030. int argc;
  1031. {
  1032.    char *arg;
  1033.    int len;
  1034.    int i;
  1035.    if(argc!=1)die(Ecall);
  1036.    arg=delete(&len);
  1037.    mtest(workptr,worklen,len+len,len+len-worklen);
  1038.    for(i=0;i<len;i++)xbyte(workptr+i+i,arg[i]);
  1039.    stack(workptr,len+len);
  1040. }
  1041. void xbyte(where,what) /* Place two hex digits representing "what", "where" */
  1042. char *where;
  1043. unsigned char what;
  1044. {
  1045.    unsigned char c1=what>>4;
  1046.    what&=15;
  1047.    if(what>9)what+=7;
  1048.    if(c1>9)c1+=7;
  1049.    where[0]=c1+'0',where[1]=what+'0';
  1050. }
  1051. void c2d(argc)
  1052. int argc;
  1053. {
  1054.    unsigned char *arg;
  1055.    int len;
  1056.    int n=-1;
  1057.    unsigned int num=0;
  1058.    unsigned char sign;
  1059.    int s=0;
  1060.    if(argc==2){
  1061.       argc--;
  1062.       if((n=getint(1))<0)die(Ecall);
  1063.    }
  1064.    if(argc!=1)die(Ecall);
  1065.    arg=(unsigned char *)delete(&len);
  1066.    if(n<0)n=len+1;
  1067.    while(n-->0)
  1068.       if(len>0){
  1069.          num|=(sign=arg[--len])<<s;
  1070.          if(sign&&s>=8*four||(int)num<0)die(Ecall);
  1071.          s+=8;
  1072.       }
  1073.       else sign=0;
  1074.    sign= -(sign>127);
  1075.    while(s<8*four)num|=sign<<s,s+=8;
  1076.    stackint((int)num);
  1077. }
  1078. void b2x(argc)
  1079. int argc;
  1080. {
  1081.    char *arg;
  1082.    char *ans;
  1083.    int len;
  1084.    int anslen=0;
  1085.    int n;
  1086.    int d;
  1087.    char c;
  1088.    if(argc!=1)die(Ecall);
  1089.    ans=arg=delete(&len);
  1090.    for(n=0;n<len && arg[n]!=' ' && arg[n]!='\t';n++);
  1091.                                     /* count up to first space */
  1092.    if(len && !n)die(Ebin);          /* leading spaces not allowed */
  1093.    if(!(n%=4))n=4;                  /* how many digits in first nybble */
  1094.    while(len){                      /* for each nybble */
  1095.       d=0;
  1096.       while(n--){                   /* for each digit */
  1097.          if(!len)die(Ebin);
  1098.          c=arg++[0];
  1099.          len--;
  1100.          if(c!='0' && c!='1')die(Ebin);
  1101.          d=(d<<1)+(c=='1');         /* add digit to d */
  1102.       }
  1103.       n=4;                          /* next nybble has 4 digits */
  1104.       if((d+='0')>'9')d+='A'-'9'-1; /* convert digit to hex */
  1105.       ans++[0]=d;
  1106.       anslen++;
  1107.       while(len && (*arg==' '||*arg=='\t')){
  1108.          arg++;                     /* spaces allowed between nybbles */
  1109.          if(!--len)die(Ebin);       /* trailing spaces not allowed */
  1110.       }
  1111.    }
  1112.    ecstackptr+=align(anslen);       /* finish the calculator stack */
  1113.    *(int*)(cstackptr+ecstackptr)=anslen;
  1114.    ecstackptr+=four;
  1115. }
  1116. void b2d(argc)
  1117. int argc;
  1118. {
  1119.    char *arg;
  1120.    int len;
  1121.    if(argc!=1)die(Ecall);
  1122.    arg=delete(&len);
  1123.    /* hack: do b2c then c2d */
  1124.    mtest(workptr,worklen,len,len-worklen);
  1125.    memcpy(workptr,arg,len);
  1126.    stackb(workptr,len);
  1127.    c2d(1);
  1128. }
  1129. void d2c(argc)
  1130. int argc;
  1131. {
  1132.    unsigned int num,minus;
  1133.    int n=-1;
  1134.    int l;
  1135.    unsigned char sign;
  1136.    char *ans;
  1137.    if(argc==2){
  1138.       argc--;
  1139.       if((n=getint(1))<0)die(Ecall);
  1140.    }
  1141.    if(argc!=1)die(Ecall);
  1142.    num=(unsigned)getint(1);
  1143.    minus=-num;
  1144.    sign=-((int)num<0);
  1145.    mtest(workptr,worklen,n<four?four:n,n+1+four);
  1146.    if(n<0){
  1147.       if(!num){
  1148.          stack("",1); /* stack d2c(0) - the null char from "" */
  1149.          return;
  1150.       }
  1151.       for(n=0,ans=workptr+four-1;num&−n++,num>>=8,minus>>=8)
  1152.          *ans--=(char)num;
  1153.       stack(++ans,n);
  1154.       return;
  1155.    }
  1156.    for(l=n,ans=workptr+n-1;n--;num>>=8)*ans--=num?(char)num:sign;
  1157.    stack(workptr,l);
  1158. }
  1159. void d2b(argc)
  1160. int argc;
  1161. {
  1162.    int num;
  1163.    char c[8*four];
  1164.    int i;
  1165.    if(argc!=1)die(Ecall);
  1166.    if((num=getint(1))<0)die(Ecall);
  1167.    if(!num)stack("00000000",8);
  1168.    else{
  1169.       for(i=8*four;num||(i&7);c[--i]=(num&1)+'0',num>>=1);
  1170.       stack(c+i,8*four-i);
  1171.    }
  1172. }
  1173. void d2x(argc)
  1174. int argc;
  1175. {
  1176.    unsigned int num,minus;
  1177.    unsigned char sign;
  1178.    int l;
  1179.    int n=-1;
  1180.    char *ans;
  1181.    if(argc==2){
  1182.       argc--;
  1183.       if((n=getint(1))<0)die(Ecall);
  1184.    }
  1185.    if(argc!=1)die(Ecall);
  1186.    num=getint(1);
  1187.    minus=-num;
  1188.    sign=-((int)num<0);
  1189.    if(n<0){
  1190.       if(!num){stack("0",1);return;}
  1191.       mtest(workptr,worklen,2*four,2*four);
  1192.       for(n=0,ans=workptr+2*four-2;num&−n+=2,num>>=8,minus>>=8)
  1193.          xbyte(ans,(char)num),ans-=2;
  1194.       if((ans+=2)[0]==(sign?'F':'0')&&(!sign||ans[1]>'7'))ans++,n--;
  1195.       stack(ans,n);
  1196.    }
  1197.    else{
  1198.       mtest(workptr,worklen,n+1,n+1-worklen);
  1199.       for(l=n,ans=workptr+n;n>0;n-=2,ans-=2,num>>=8)
  1200.          xbyte(ans,num?(char)num:sign);
  1201.       if(n<0)ans++;
  1202.       stack(ans+2,l);
  1203.    }
  1204. }
  1205. void x2c(argc)
  1206. int argc;
  1207. {
  1208.    char *arg;
  1209.    int len;
  1210.    if(argc!=1)die(Ecall);
  1211.    arg=delete(&len);
  1212.    mtest(workptr,worklen,len+1,len+1-worklen);
  1213.    memcpy(workptr,arg,len),
  1214.    stackx(workptr,len);
  1215. }
  1216. void x2d(argc)
  1217. int argc;
  1218. {
  1219.    char *arg;
  1220.    int len;
  1221.    int i;
  1222.    int num=0;
  1223.    int n=-1;
  1224.    char c;
  1225.    int k;
  1226.    int minus=0;
  1227.    if(argc==2){
  1228.       if((n=getint(1))<0)die(Ecall);
  1229.       argc--;
  1230.    }
  1231.    if(argc!=1)die(Ecall);
  1232.    arg=delete(&len);
  1233.    if(len<0)die(Enoarg);
  1234.    if(n<0)n=len+1;
  1235.    if(n==0){stack("0",1);return;}
  1236.    if(n<=len){
  1237.       k=n;
  1238.       arg+=len-k;
  1239.       if(arg[0]>='8')minus=(~(unsigned)0)<<(4*k);
  1240.    }
  1241.    else k=len;
  1242.    for(i=0;i<k;i++){
  1243.       if((c=arg[i]-'0')<0)die(Ehex);
  1244.       if(c>9){
  1245.          if((c-=7)<0)die(Ehex);
  1246.          if(c>15)if((c-=32)<0||c>15)die(Ehex);
  1247.       }
  1248.       if((num=num*16+c)<0)die(Erange);
  1249.    }
  1250.    stackint(num|minus);
  1251. }
  1252. void x2b(argc)
  1253. int argc;
  1254. {
  1255.    char *arg,*ans;
  1256.    int len,anslen=0;
  1257.    int n;
  1258.    int i;
  1259.    int c;
  1260.    if(argc!=1)die(Ecall);
  1261.    arg=delete(&len);
  1262.    mtest(workptr,worklen,len,len-worklen);
  1263.    memcpy(workptr,arg,len);        /* copy the shorter string */
  1264.    arg=workptr;
  1265.    mtest(cstackptr,cstacklen,len*4+10,len*4+10-cstacklen);
  1266.                         /* prepare to stack the longer string */
  1267.    ans=cstackptr+ecstackptr;
  1268.    for(n=0;n<len && arg[n]!=' ' && arg[n]!='\t';n++);
  1269.                                     /* count up to first space */
  1270.    if(len && !n)die(Ebin);          /* leading spaces not allowed */
  1271.    n%=2;                            /* how many digits in first nybble */
  1272.    while(len){                      /* for each digit */
  1273.       c=arg++[0];
  1274.       len--;
  1275.       if((c<'0'||c>'9') && (c<'A'||c>'F') && (c<'a'||c>'f'))die(Ehex);
  1276.       if(c>='a')c-='a'-'A';         /* convert from hex */
  1277.       if((c-='0')>9)c-='A'-'9'-1;
  1278.       for(i=4;i--;anslen++,c=(c<<1)&15) /* convert to binary */
  1279.          ans++[0]=(c>=8)+'0';
  1280.       if(n)                         /* spaces allowed between nybbles */
  1281.          while(len && (*arg==' '||*arg=='\t')){
  1282.             arg++;
  1283.             if(!--len)die(Ebin);       /* trailing spaces not allowed */
  1284.          }
  1285.       n=!n;
  1286.    }
  1287.    if(n)die(Ehex);
  1288.    ecstackptr+=align(anslen);       /* finish the calculator stack */
  1289.    *(int*)(cstackptr+ecstackptr)=anslen;
  1290.    ecstackptr+=four;
  1291. }
  1292.    
  1293. void rxsystem(argc)
  1294. int argc;
  1295. {
  1296.    char *arg;
  1297.    int len;
  1298.    FILE *p;
  1299.    char c;
  1300.    int rc;
  1301.    int type;
  1302.    if(argc!=1)die(Ecall);
  1303.    arg=delete(&len);
  1304.    arg[len]=0;
  1305.    len=0;
  1306.    if(p=popen(arg,"r")){ /* Open a pipe, read the output, close the pipe */
  1307.       while(1){
  1308.          c=getc(p);
  1309.          if(feof(p)||ferror(p))break;
  1310.          mtest(workptr,worklen,len+1,50);
  1311.          workptr[len++]=c;
  1312.       }
  1313.       rc=pclose(p)/256;
  1314.    }
  1315.    else rc= -1;
  1316.    stack(workptr,len);
  1317.    if(rc<0||rc==1)type=Efailure;
  1318.    else type=Eerror;
  1319.    rcset(rc,type,arg);
  1320. }
  1321.  
  1322. int rxseterr(info)        /* Set info->errnum to indicate the I/O error */
  1323. struct fileinfo *info;    /* which just occurred on info->fp. */
  1324. {
  1325.    info->errnum=Eerrno;
  1326.    if(feof(info->fp))info->errnum=Eerrno+Eeof;
  1327.    if(ferror(info->fp))info->errnum=errno+Eerrno;
  1328.    return 0;
  1329. }
  1330.  
  1331. void rxpos(argc)
  1332. int argc;
  1333. {
  1334.    char *s1,*s2,*p;
  1335.    int l1,l2,start;
  1336.    if(argc!=2&&argc!=3)die(Ecall);
  1337.    if(argc==3&&isnull())argc--,delete(&l1);
  1338.    if(argc==3)start=getint(1);
  1339.    else start=1;
  1340.    if(--start<0)die(Erange);
  1341.    p=(s1=delete(&l1))+start;
  1342.    if(l1<0)die(Enoarg);
  1343.    l1-=start,
  1344.    s2=delete(&l2);
  1345.    if(l2<0)die(Enoarg);
  1346.    if(l2==0){stack("0",1);return;}
  1347.    while(l1>=l2&&memcmp(p,s2,l2))p++,l1--;
  1348.    if(l1<l2)stack("0",1);
  1349.    else stackint(p-s1+1);
  1350. }
  1351. void rxlastpos(argc)
  1352. int argc;
  1353. {
  1354.    char *s1,*s2,*p;
  1355.    int l1,l2,start;
  1356.    if(argc!=2&&argc!=3)die(Ecall);
  1357.    if(argc==3&&isnull())argc--,delete(&l1);
  1358.    if(argc==3){
  1359.       start=getint(1);
  1360.       if(start<1)die(Erange);
  1361.    }
  1362.    else start=0;
  1363.    s1=delete(&l1),
  1364.    s2=delete(&l2);
  1365.    if(l1<0||l2<0)die(Enoarg);
  1366.    if(!l2){stack("0",1);return;}
  1367.    if(start&&start<l1)l1=start;
  1368.    p=s1+l1-l2;
  1369.    while(p>=s1&&memcmp(p,s2,l2))p--;
  1370.    if(p<s1)stack("0",1);
  1371.    else stackint(p-s1+1);
  1372. }
  1373. void rxsubstr(argc)
  1374. int argc;
  1375. {
  1376.    char *arg;
  1377.    int len;
  1378.    int len1,len2;
  1379.    int i;
  1380.    char pad=' ';
  1381.    int num;
  1382.    int strlen= -1;
  1383.    if(argc>4||argc<2)die(Ecall);
  1384.    if(argc==4){
  1385.       arg=delete(&len);
  1386.       if(len>=0)
  1387.          if(len!=1)die(Ecall);
  1388.          else pad=arg[0];
  1389.    }
  1390.    if(argc>2&&isnull())delete(&len1),argc=2;
  1391.    if(argc>2)if((strlen=getint(1))<0)die(Ecall);
  1392.    num=getint(1);
  1393.    arg=delete(&len);
  1394.    if(len<0)die(Enoarg);
  1395.    strlen=len1=strlen<0?len-num+1:strlen; /* fix up the default length */
  1396.    if(strlen<=0){          /* e.g. in substr("xyz",73) */
  1397.       stack("",0);
  1398.       return;
  1399.    }
  1400.    mtest(workptr,worklen,len1+5,len1+5);
  1401.    for(i=0;num<1&&len1;workptr[i++]=pad)num++,len1--; /* The initial padding */
  1402.    len2=len-num+1<len1?len-num+1:len1;
  1403.    if(len2<=0)len2=0;
  1404.    memcpy(workptr+i,arg+num-1,len2);  /* The substring */
  1405.    i+=len2;
  1406.    len1-=len2;
  1407.    for(;len1--;workptr[i++]=pad);    /* The final padding */
  1408.    stack(workptr,strlen);
  1409. }
  1410. void rxcentre(argc)
  1411. int argc;
  1412. {
  1413.    char *arg;
  1414.    int len;
  1415.    int num;
  1416.    int i;
  1417.    int spleft;
  1418.    char pad=' ';
  1419.    if(argc==3){
  1420.       arg=delete(&len);
  1421.       if(len>=0)
  1422.          if(len!=1)die(Ecall);
  1423.          else pad=arg[0];
  1424.       argc--;
  1425.    }
  1426.    if(argc!=2)die(Ecall);
  1427.    if((num=getint(1))<=0)die(Ecall);
  1428.    arg=delete(&len);
  1429.    if(len<0)die(Enoarg);
  1430.    mtest(workptr,worklen,num+5,num+5);
  1431.    if(len>=num)memcpy(workptr,arg+(len-num)/2,num); /* centre window on text */
  1432.    else {                                           /* centre text in window */
  1433.       spleft=(num-len)/2;
  1434.       for(i=0;i<spleft;workptr[i++]=pad);
  1435.       memcpy(workptr+i,arg,len);
  1436.       for(i+=len;i<num;workptr[i++]=pad);
  1437.    }
  1438.    stack(workptr,num);
  1439. }
  1440. void rxjustify(argc)
  1441. int argc;
  1442. {
  1443.    char *arg,*ptr;
  1444.    int len;
  1445.    int num;
  1446.    int i,j;
  1447.    int sp;
  1448.    int n=0;
  1449.    int a;
  1450.    char pad=' ';
  1451.    if(argc==3){
  1452.       arg=delete(&len);
  1453.       if(len>=0)
  1454.          if(len!=1)die(Ecall);
  1455.          else pad=arg[0];
  1456.       argc--;
  1457.    }
  1458.    if(argc!=2)die(Ecall);
  1459.    if((num=getint(1))<0)die(Ecall);
  1460.    rxspace(1);
  1461.    arg=delete(&len);
  1462.    if((sp=num-len)<=0){
  1463.       for(len=num,ptr=arg;len--;ptr++)if(ptr[0]==' ')ptr[0]=pad;
  1464.       stack(arg,num);
  1465.       return;
  1466.    }
  1467.    mtest(workptr,worklen,num+5,num+5);
  1468.    for(i=0;i<len;i++)if(arg[i]==' ')n++;
  1469.    if(!n){
  1470.       memcpy(workptr,arg,len);
  1471.       for(i=len;i<num;workptr[i++]=pad);
  1472.    }
  1473.    else{
  1474.       a=n/2;
  1475.       for(i=j=0;i<len;workptr[j++]=arg[i++])
  1476.          if(arg[i]==' '){
  1477.             arg[i]=pad;
  1478.             for(a+=sp;a>=n;a-=n)workptr[j++]=pad;
  1479.          }
  1480.    }
  1481.    stack(workptr,num);
  1482. }
  1483.  
  1484. void rxarg(argc)
  1485. int argc;
  1486. {
  1487.    int n;
  1488.    int i;
  1489.    int ex;
  1490.    char opt='A';
  1491.    char *arg;
  1492.    for(n=0;curargs[n];n++); /* count arguments to current procedure */
  1493.    if(argc>2)die(Ecall);
  1494.    if(argc>0&&isnull()){
  1495.       delete(&i);
  1496.       argc--;
  1497.       if(argc>0&&isnull()){
  1498.          delete(&i);
  1499.          argc--;
  1500.       }
  1501.    }
  1502.    if(argc==0){stackint(n);return;}
  1503.    if(argc==2){
  1504.       arg=delete(&i);
  1505.       if(i<1)die(Ecall);
  1506.       if((opt=arg[0]&0xdf)!='E'&&opt!='O')die(Ecall);
  1507.    }
  1508.    i=getint(1);
  1509.    if(i-- <=0)die(Ecall);
  1510.    ex=(i<n &&curarglen[i]>=0);
  1511.    switch(opt){
  1512.       case 'A':if(ex)stack(curargs[i],curarglen[i]);
  1513.          else stack(cnull,0);
  1514.          break;
  1515.       case 'O':ex=!ex;
  1516.       case 'E':stack((opt='0'+ex,&opt),1);
  1517.    }
  1518. }
  1519. void rxabbrev(argc)
  1520. int argc;
  1521. {
  1522.    int al= -1;
  1523.    char *longs,*shorts;
  1524.    int longl,shortl;
  1525.    char c;
  1526.    if(argc==3&&isnull())argc--,delete(&longl);
  1527.    if(argc==3)if((argc--,al=getint(1))<0)die(Ecall);
  1528.    if(argc!=2)die(Ecall);
  1529.    shorts=delete(&shortl);
  1530.    longs=delete(&longl);
  1531.    if(shortl<0||longl<0)die(Enoarg);
  1532.    if(al<0)al=shortl;
  1533.    c= '1'-(al>shortl||shortl>longl||memcmp(longs,shorts,shortl)),
  1534.    stack(&c,1);
  1535. }
  1536.  
  1537. void rxabs(argc)
  1538. int argc;
  1539. {
  1540.    int m,e,z,l,n;
  1541.    if(argc!=1)die(Ecall);
  1542.    if((n=num(&m,&e,&z,&l))<0)die(Enum);
  1543.    delete(&m);
  1544.    stacknum(workptr+n,l,e,0);
  1545. }
  1546.  
  1547. void rxcompare(argc)
  1548. int argc;
  1549. {
  1550.    char pad=' ';
  1551.    char *s1,*s2;
  1552.    int l1,l2,l3;
  1553.    int i;
  1554.    if(argc==3){
  1555.       s1=delete(&l1);
  1556.       if(l1>=0)
  1557.          if(l1!=1)die(Ecall);
  1558.          else pad=s1[0];
  1559.       argc--;
  1560.    }
  1561.    if(argc!=2)die(Ecall);
  1562.    s2=delete(&l2),
  1563.    s1=delete(&l1);
  1564.    if(l1<0||l2<0)die(Enoarg);
  1565.    l3=((l1<l2)?l2:l1);  /* the length of the larger string */
  1566.    for(i=0;i<l3&&(i<l2?s2[i]:pad)==(i<l1?s1[i]:pad);i++);
  1567.    if(i++==l3)i=0;
  1568.    stackint(i);
  1569. }
  1570.  
  1571. void rxdelstr(argc)
  1572. int argc;
  1573. {
  1574.    int n,l,d= -1;
  1575.    int osp;
  1576.    char *s;
  1577.    if(argc==3){
  1578.       argc--;
  1579.       if(isnull())delete(&l);
  1580.       else if((d=getint(1))<0)die(Ecall);
  1581.    }
  1582.    if(argc!=2)die(Ecall);
  1583.    if((n=getint(1))<1)die(Ecall);
  1584.    osp=ecstackptr;
  1585.    s=delete(&l);
  1586.    if(l<0)die(Enoarg);
  1587.    if(n>l||!d){ecstackptr=osp;return;}/* delete nothing:return the old string*/
  1588.    mtest(workptr,worklen,l,l);
  1589.    n--;
  1590.    if(d<0||n+d>l)d=l-n;
  1591.    memcpy(workptr,s,n),
  1592.    memcpy(workptr+n,s+n+d,l-n-d);
  1593.    stack(workptr,l-d);
  1594. }
  1595.  
  1596. void rxdelword(argc)
  1597. int argc;
  1598. {
  1599.    int n,l,d= -1,n1,d1,l1,i;
  1600.    int osp;
  1601.    char *s;
  1602.    if(argc==3){
  1603.       argc--;
  1604.       if(isnull())delete(&l);
  1605.       else if((d=getint(1))<0)die(Ecall);
  1606.    }
  1607.    if(argc!=2)die(Ecall);
  1608.    if((n=getint(1))<1)die(Ecall);
  1609.    osp=ecstackptr;
  1610.    s=delete(&l1);
  1611.    if(l1<0)die(Enoarg);
  1612.    for(i=0;i<l1&&s[i]==' ';i++);
  1613.    if(i==l1||!d){ecstackptr=osp;return;}
  1614.    n--;
  1615.    for(l=0;i<l1;l++){
  1616.       if(l==n)n1=i;
  1617.       if(l==n+d&&d>0)d1=i-n1;
  1618.       while(i<l1&&s[i]!=' ')i++;
  1619.       while(i<l1&&s[i]==' ')i++;
  1620.    }
  1621.    if(n>l-1){ecstackptr=osp;return;}
  1622.    mtest(workptr,worklen,l1,l1);
  1623.    if(d<0||n+d>l-1)d1=l1-n1;
  1624.    memcpy(workptr,s,n1),
  1625.    memcpy(workptr+n1,s+n1+d1,l1-n1-d1);
  1626.    stack(workptr,l1-d1);
  1627. }
  1628.  
  1629. void rxinsert(argc)
  1630. int argc;
  1631. {
  1632.    char *new,*target;
  1633.    int nl,tl;
  1634.    int n=0,length= -1;
  1635.    int i;
  1636.    char pad=' ';
  1637.    if(argc==5){
  1638.       argc--;
  1639.       new=delete(&nl);
  1640.       if(nl>=0)
  1641.          if(nl==1)pad=new[0];
  1642.          else die(Ecall);
  1643.    }
  1644.    if(argc==4){
  1645.       argc--;
  1646.       if(isnull())delete(&nl);
  1647.       else if((length=getint(1))<0)die(Ecall);
  1648.    }
  1649.    if(argc==3){
  1650.       argc--;
  1651.       if(isnull())delete(&nl);
  1652.       else if((n=getint(1))<0)die(Ecall);
  1653.    }
  1654.    if(argc!=2)die(Ecall);
  1655.    target=delete(&tl);
  1656.    new=delete(&nl);
  1657.    if(tl<0||nl<0)die(Enoarg);
  1658.    if(length<0)length=nl;
  1659.    mtest(workptr,worklen,length+n+tl,length+n+tl);
  1660.    memcpy(workptr,target,n<tl?n:tl);
  1661.    if(n>tl)for(i=tl;i<n;workptr[i++]=pad);
  1662.    memcpy(workptr+n,new,length<nl?length:nl);
  1663.    if(length>nl)for(i=nl;i<length;workptr[i++ +n]=pad);
  1664.    if(n<tl)memcpy(workptr+n+length,target+n,tl-n);
  1665.    else tl=n;
  1666.    stack(workptr,tl+length);
  1667. }
  1668.  
  1669. void rxminmax(argc,op) /* Calculate the minimum/maximum of a list of numbers */
  1670. int argc;   /* How many numbers are supplied */
  1671. int op;     /* What comparison operator to use */
  1672. {
  1673.    int m1,z1,e1,l1,n1,m2,z2,e2,l2,n2,d,owp;
  1674.    if(!argc)die(Enoarg);
  1675.    if((n1=num(&m1,&e1,&z1,&l1))<0)die(Enum);
  1676.    delete(&d);
  1677.    owp=eworkptr;
  1678.    while(--argc){
  1679.       eworkptr=owp;
  1680.       if((n2=num(&m2,&e2,&z2,&l2))<0)die(Enum);
  1681.       stacknum(workptr+n1,l1,e1,m1);
  1682.       binrel(op);
  1683.       if((delete(&d))[0]=='1')n1=n2,m1=m2,e1=e2,l1=l2,owp=eworkptr;
  1684.    }
  1685.    stacknum(workptr+n1,l1,e1,m1);
  1686. }
  1687.  
  1688. void rxmax(argc)
  1689. int argc;
  1690. {
  1691.    rxminmax(argc,OPgeq);
  1692. }
  1693.  
  1694. void rxmin(argc)
  1695. int argc;
  1696. {
  1697.    rxminmax(argc,OPleq);
  1698. }
  1699.  
  1700. void rxoverlay(argc)
  1701. int argc;
  1702. {
  1703.    char *new,*target;
  1704.    int nl,tl;
  1705.    int n=1,length= -1;
  1706.    int i;
  1707.    char pad=' ';
  1708.    if(argc==5){
  1709.       argc--;
  1710.       new=delete(&nl);
  1711.       if(nl>=0)
  1712.          if(nl==1)pad=new[0];
  1713.          else die(Ecall);
  1714.    }
  1715.    if(argc==4){
  1716.       argc--;
  1717.       if(isnull())delete(&nl);
  1718.       else if((length=getint(1))<0)die(Ecall);
  1719.    }
  1720.    if(argc==3){
  1721.       argc--;
  1722.       if(isnull())delete(&nl);
  1723.       else if((n=getint(1))<=0)die(Ecall);
  1724.    }
  1725.    n--;
  1726.    if(argc!=2)die(Ecall);
  1727.    target=delete(&tl);
  1728.    new=delete(&nl);
  1729.    if(tl<0||nl<0)die(Enoarg);
  1730.    if(length<0)length=nl;
  1731.    mtest(workptr,worklen,length+n+tl,length+n+tl);
  1732.    memcpy(workptr,target,n<tl?n:tl);
  1733.    if(n>tl)for(i=tl;i<n;workptr[i++]=pad);
  1734.    memcpy(workptr+n,new,length<nl?length:nl);
  1735.    if(length>nl)for(i=nl;i<length;workptr[i++ +n]=pad);
  1736.    if(n+length<tl)memcpy(workptr+n+length,target+n+length,tl-n-length);
  1737.    else tl=n+length;
  1738.    stack(workptr,tl);
  1739. }
  1740.  
  1741. void rxrandom(argc)
  1742. int argc;
  1743. {
  1744.    struct timeval t1;
  1745.    struct timezone tz;
  1746.    int min=0,max=999;
  1747.    int dummy;
  1748. #ifdef DECLARE_RANDOM
  1749.    long random();   /* everything except Sun defines this in stdlib.h */
  1750. #endif
  1751.    unsigned long r;
  1752.    if(argc==3){
  1753.       argc--;
  1754.       srandom(getint(1)),timeflag|=4;
  1755.    }
  1756.    if(!(timeflag&4)){
  1757.       timeflag|=4;
  1758.       gettimeofday(&t1,&tz);
  1759.       srandom(t1.tv_sec*50+(t1.tv_usec/19999));
  1760.    }
  1761.    if(argc>2)die(Ecall);
  1762.    if(argc&&isnull())argc--,delete(&dummy);
  1763.    if(argc&&isnull())argc--,delete(&dummy);
  1764.    if(argc)argc--,max=getint(1);
  1765.    if(argc)
  1766.       if(isnull())delete(&dummy);
  1767.       else min=getint(1);
  1768.    if(min>max||max-min>100000)die(Ecall);
  1769.    if(min==max)r=0;
  1770.    else max=max-min+1,
  1771.         r=(unsigned long)random()%max;
  1772.    stackint((int)r+min);
  1773. }
  1774.  
  1775. void rxreverse(argc)
  1776. int argc;
  1777. {
  1778.    char *s;
  1779.    int i,l,l2;
  1780.    char c;
  1781.    if(argc!=1)die(Ecall);
  1782.    s=undelete(&l);
  1783.    l2=l--/2;
  1784.    for(i=0;i<l2;i++)c=s[i],s[i]=s[l-i],s[l-i]=c;
  1785. }
  1786.  
  1787. void rxsign(argc)
  1788. int argc;
  1789. {
  1790.    int m,z,e,l;
  1791.    char c;
  1792.    if(argc!=1)die(Ecall);
  1793.    if(num(&m,&e,&z,&l)<0)die(Enum);
  1794.    delete(&l);
  1795.    if(m)stack("-1",2);
  1796.    else c='1'-z,stack(&c,1);
  1797. }
  1798.  
  1799. void rxsubword(argc)
  1800. int argc;
  1801. {
  1802.    char *s;
  1803.    int l,n,k= -1,i,n1,k1,l1;
  1804.    if(argc==3){
  1805.       if((k=getint(1))<0)die(Ecall);
  1806.       argc--;
  1807.    }
  1808.    if(argc!=2)die(Ecall);
  1809.    if((n=getint(1))<=0)die(Ecall);
  1810.    s=delete(&l1);
  1811.    if(l1<0)die(Enoarg);
  1812.    for(i=0;i<l1&&s[i]==' ';i++);
  1813.    n--;
  1814.    for(l=0;i<l1;l++){
  1815.       if(n==l)n1=i;
  1816.       if(k>=0&&k+n==l)k1=i-n1;
  1817.       while(i<l1&&s[i]!=' ')i++;
  1818.       while(i<l1&&s[i]==' ')i++;
  1819.    }
  1820.    if(n>=l||k==0){stack(cnull,0);return;}
  1821.    if(k<0||k+n>=l)k1=l1-n1;
  1822.    while(k1>0&&s[n1+k1-1]==' ')k1--;
  1823.    stack(s+n1,k1);
  1824. }
  1825.  
  1826. void rxsymbol(argc)
  1827. int argc;
  1828. {
  1829.    char *arg;
  1830.    int len,good;
  1831.    int l;
  1832.    if(argc!=1)die(Ecall);
  1833.    arg=rxgetname(&len,&good);
  1834.    if(good==1 && varget(arg,len,&l)) stack("VAR",3);
  1835.    else if(!good)stack("BAD",3);
  1836.    else stack("LIT",3);
  1837. }
  1838.  
  1839. void rxlate(argc)
  1840. int argc;
  1841. {
  1842.    char *s,*ti,*to;
  1843.    int sl,til= -1,tol=-1;
  1844.    int j;
  1845.    char pad=' ';
  1846.    if(argc==4){
  1847.       s=delete(&sl);
  1848.       if(sl==1)pad=s[0];
  1849.       else die(Ecall);
  1850.       argc--;
  1851.    }
  1852.    if(argc==3)argc--,ti=delete(&til);
  1853.    if(argc==2)argc--,to=delete(&tol);
  1854.    if(argc!=1)die(Ecall);
  1855.    s=undelete(&sl);
  1856.    if(sl<0)die(Enoarg);
  1857.    if(tol==-1&&til== -1)for(;sl--;s++)s[0]=uc(s[0]);
  1858.    else for(;sl--;s++){
  1859.       if(til== -1)j=s[0];
  1860.       else{
  1861.          for(j=0;j<til&&s[0]!=ti[j];j++);
  1862.          if(j==til)continue;
  1863.       }
  1864.       if(j>=tol)s[0]=pad;
  1865.       else s[0]=to[j];
  1866.    }
  1867. }
  1868.  
  1869. void rxtrunc(argc)
  1870. int argc;
  1871. {
  1872.    int d=0,n,m,e,z,l,i;
  1873.    char *p;
  1874.    if(argc==2){
  1875.       if(isnull())delete(&l);
  1876.       else if((d=getint(1))<0||d>5000)die(Ecall);
  1877.       argc--;
  1878.    }
  1879.    if(argc!=1)die(Ecall);
  1880.    eworkptr=2; /* Save room for a carry digits */
  1881.    if((n=num(&m,&e,&z,&l))<0)die(Enum); /* Get the number to truncate */
  1882.    delete(&i);
  1883.    if(e>0)i=l+d+e+5;
  1884.    else i=l+d+5;
  1885.    mtest(workptr,worklen,i,i);
  1886.    p=workptr+n;
  1887.    if(l>precision)  /* round it to precision before truncating */
  1888.    if(p[l=precision]>='5'){
  1889.       for(i=l-1;i>=0;i--){
  1890.          p[i]++;
  1891.          if(p[i]<='9')break;
  1892.          p[i]='0';
  1893.       }
  1894.       if(i<0)(--p)[0]='1',e++;
  1895.    }
  1896.    for(i=l;i<=e;p[i++]='0'); /* Extend the number to the decimal point */
  1897.    if(d==0&&e<0){p[0]='0';stack(p,1);return;}  /* 0 for trunc(x) where |x|<1 */
  1898.    if(d>0){
  1899.       if(e<0){
  1900.          if(e<-d)e= -d-1;
  1901.          for(i=l;i--;)p[i-e]=p[i];
  1902.          for(i=0;i<-e;p[i++]='0');
  1903.          l-=e;
  1904.          e=0;
  1905.       }
  1906.       if(l>e+1)for(i=l;i>e;i--)p[i+1]=p[i];
  1907.       p[e+1]='.';
  1908.       if(l<e+2)l=e+2;
  1909.       else l++;
  1910.       for(i=l;i<e+d+2;p[i++]='0');
  1911.       d++;
  1912.    }
  1913.    if(m)(--p)[0]='-',d++;
  1914.    stack(p,d+e+1);
  1915. }
  1916.  
  1917. void rxverify(argc)
  1918. int argc;
  1919. {
  1920.    char *s,*r;
  1921.    int sl,rl,st=1,opt=0;
  1922.    int i,j;
  1923.    if(argc==4){
  1924.       argc--;
  1925.       if(isnull())delete(&sl);
  1926.       else if((st=getint(1))<1)die(Ecall);
  1927.    }
  1928.    if(argc==3){
  1929.       argc--;
  1930.       s=delete(&sl);
  1931.       if(sl>=0){
  1932.          if(sl==0)die(Ecall);
  1933.          switch(s[0]&0xdf){
  1934.             case 'M':opt=1;
  1935.             case 'N':break;
  1936.             default:die(Ecall);
  1937.          }
  1938.       }
  1939.    }
  1940.    if(argc!=2)die(Ecall);
  1941.    r=delete(&rl),
  1942.    s=delete(&sl);
  1943.    if(rl<0||sl<0)die(Enoarg);
  1944.    if(st>sl)i=0;
  1945.    else{
  1946.       s+=(--st);
  1947.       for(i=st;i<sl;i++,s++){
  1948.          for(j=0;j<rl&&s[0]!=r[j];j++);
  1949.          if((j==rl)^opt)break;
  1950.       }
  1951.       if(i==sl)i=0;
  1952.       else i++;
  1953.    }
  1954.    stackint(i); 
  1955. }
  1956.  
  1957. void rxword(argc)
  1958. int argc;
  1959. {
  1960.    if(argc!=2)die(Ecall);
  1961.    stack("1",1);
  1962.    rxsubword(3);
  1963. }
  1964.  
  1965. void rxwordindex(argc)
  1966. int argc;
  1967. {
  1968.    char *s;
  1969.    int sl,n,i,l;
  1970.    if(argc!=2)die(Ecall);
  1971.    if((n=getint(1))<1)die(Ecall);
  1972.    s=delete(&sl);
  1973.    if(sl<0)die(Enoarg);
  1974.    for(i=0;i<sl&&s[0]==' ';s++,i++);
  1975.    n--;
  1976.    for(l=0;i<sl;l++){
  1977.       if(n==l)break;
  1978.       while(i<sl&&s[0]!=' ')i++,s++;
  1979.       while(i<sl&&s[0]==' ')i++,s++;
  1980.    }
  1981.    if(i==sl)i=0;
  1982.    else i++;
  1983.    stackint(i);
  1984. }
  1985.  
  1986. void rxwordlength(argc)
  1987. int argc;
  1988. {
  1989.    rxword(argc);
  1990.    rxlength(1);
  1991. }
  1992.  
  1993. void rxwordpos(argc)
  1994. int argc;
  1995. {
  1996.    char *p,*s;
  1997.    int pl,sl,st=1;
  1998.    int i,l,j,k;
  1999.    if(argc==3){
  2000.       if((st=getint(1))<1)die(Ecall);
  2001.       argc--;
  2002.    }
  2003.    if(argc!=2)die(Ecall);
  2004.    s=delete(&sl),
  2005.    p=delete(&pl);
  2006.    if(sl<0||pl<0)die(Enoarg);
  2007.    for(i=0;i<sl&&s[0]==' ';s++,i++);
  2008.    while(pl&&p[0]==' ')p++,pl--;
  2009.    while(pl--&&p[pl]==' ');
  2010.    if(!++pl){stack("0",1);return;}
  2011.    st--;
  2012.    for(l=0;i<sl;l++){
  2013.       if(l>=st){
  2014.          for(j=k=0;j<pl&&k<sl-i;j++,k++){
  2015.             if(s[k]!=p[j])break;
  2016.             if(s[k]!=' ')continue;
  2017.             while(++k<sl-i&&s[k]==' ');
  2018.             while(++j<pl&&p[j]==' ');
  2019.             j--,k--;
  2020.          }
  2021.          if(j==pl && (k==sl-i || s[k]==' '))break;
  2022.          if(k==sl-i){l= -1;break;}
  2023.       }
  2024.       while(i<sl&&s[0]!=' ')i++,s++;
  2025.       while(i<sl&&s[0]==' ')i++,s++;
  2026.    }
  2027.    if(i==sl)l=0;
  2028.    else l++;
  2029.    stackint(l);
  2030. }
  2031.  
  2032. void rxwords(argc)
  2033. int argc;
  2034. {
  2035.    char *s;
  2036.    int l1,l;
  2037.    if(argc!=1)die(Ecall);
  2038.    s=delete(&l1);
  2039.    while(l1&&s[0]==' ')s++,l1--;
  2040.    for(l=0;l1;l++){
  2041.       while(l1&&s[0]!=' ')s++,l1--;
  2042.       while(l1&&s[0]==' ')s++,l1--;
  2043.    }
  2044.    stackint(l);
  2045. }
  2046.  
  2047. void rxdigits(argc)
  2048. int argc;
  2049. {
  2050.    if(argc)die(Ecall);
  2051.    stackint(precision);
  2052. }
  2053.  
  2054. void rxfuzz(argc)
  2055. int argc;
  2056. {
  2057.    if(argc)die(Ecall);
  2058.    stackint(precision-fuzz);
  2059. }
  2060.  
  2061. void rxaddress(argc)
  2062. int argc;
  2063. {
  2064.    extern int address1;  /* from rexx.c */
  2065.    char *address=envtable[address1].name;
  2066.    if(argc)die(Ecall);
  2067.    stack(address,strlen(address));
  2068. }
  2069.  
  2070. void rxtrace(argc)
  2071. int argc;
  2072. {
  2073.    char *arg;
  2074.    int len;
  2075.    char ans[2];
  2076.    int q=0;
  2077.    if(argc>1)die(Ecall);
  2078.    if(trcflag&Tinteract)ans[q++]='?';
  2079.    switch(trcflag&~Tinteract&0xff){
  2080.       case Tclauses:             ans[q]='A';break;
  2081.       case Tcommands|Terrors:    ans[q]='C';break;
  2082.       case Terrors:              ans[q]='E';break;
  2083.       case Tfailures:            ans[q]='F';break;
  2084.       case Tclauses|Tintermed:   ans[q]='I';break;
  2085.       case Tlabels:              ans[q]='L';break;
  2086.       case 0:                    ans[q]='O';break;
  2087.       case Tresults|Tclauses:    ans[q]='R';
  2088.    }
  2089.    if(argc){
  2090.       arg=delete(&len);
  2091.       if(!(trcflag&Tinteract)&&interact<0 ||
  2092.           (interact==interplev-1 && interact>=0)){
  2093.                /* if interactive trace, only interpret
  2094.                   trace in the actual command, also use old trace flag
  2095.                   as the starting value */
  2096.          if (interact>=0)trclp=2,trcflag=otrcflag;
  2097.          arg[len]=0;
  2098.          settrace(arg);
  2099.       }
  2100.    }
  2101.    stack(ans,++q);
  2102. }
  2103.  
  2104. void rxform(argc)
  2105. int argc;
  2106. {
  2107.    if(argc)die(Ecall);
  2108.    if(numform)stack("ENGINEERING",11);
  2109.          else stack("SCIENTIFIC",10);
  2110. }
  2111.  
  2112. void rxformat(argc)
  2113. int argc;
  2114. {
  2115.    int n,l,e,m,z;
  2116.    int before=0,after= -1, expp= -1,expt= precision;
  2117.    char *ptr1;
  2118.    int len1=0;
  2119.    int i;
  2120.    int p;
  2121.    int c=argc;
  2122.    char *num1;
  2123.    int exp;
  2124.    if(argc==5){  /* Get the value of expt */
  2125.       argc--;
  2126.       if(!isnull()){if((expt=getint(1))<0)die(Ecall);}
  2127.       else delete(&i);
  2128.    }
  2129.    if(argc==4){  /* Get the value of expp */
  2130.       argc--;
  2131.       if(!isnull()){if((expp=getint(1))<0)die(Ecall);}
  2132.       else delete(&i);
  2133.    }
  2134.    if(argc==3){  /* Get the value of after */
  2135.       argc--;
  2136.       if(!isnull()){if((after=getint(1))<0)die(Ecall);}
  2137.       else delete(&i);
  2138.    }
  2139.    if(argc==2){  /* Get the value of before */
  2140.       argc--;
  2141.       if(!isnull()){if((before=getint(1))<=0)die(Ecall);}
  2142.       else delete(&i);
  2143.    }
  2144.    if(argc!=1)die(Ecall); /* The number to be formatted must be supplied */
  2145.    eworkptr=1;            /* allow for overflow one place to the left */
  2146.    if((n=num(&m,&e,&z,&l))<0)die(Enum);
  2147.    delete(&i);
  2148.    num1=n+workptr;
  2149.    if(c==1){ /* A simple format(number) command, in which case */
  2150.       stacknum(num1,l,e,m);                 /* format normally */
  2151.       return;
  2152.    }
  2153.    if(l>precision) /* Before processing, the number is rounded to digits() */
  2154.       if(num1[l=precision]>='5'){
  2155.          for(i=l-1;i>=0;i--){
  2156.             if(++num1[i]<='9')break;
  2157.             num1[i]='0';
  2158.          }
  2159.          if(i<0)*--num1='1';
  2160.       }
  2161.    i=l+before+after+expp+30;
  2162.    mtest(cstackptr,cstacklen,i+ecstackptr,i);
  2163.    ptr1=cstackptr+ecstackptr;
  2164.    if(z)num1[0]='0',m=e=0,l=1;              /* adjust zero to be just "0" */
  2165.    if(exp=((e<expt&&!(e<0&&l-e-1>2*expt))||!expp)) {/* no exponent */
  2166.       if(e<0)n=1+m;  /* calculate number of places before . */
  2167.       else n=e+1+m;
  2168.       p=1+e;
  2169.    }
  2170.    else{
  2171.       if(numform)n=1+m+e%3; /* number of places before . in expon. notation */
  2172.       else n=1+m;
  2173.       p=n-m;
  2174.    }
  2175.    if((p+=after)>precision||after<0)p=precision; /* what precision? */
  2176.    if (p<0 || (p==0&&num1[0]<'5')) { /* number is too small so make it "0" */
  2177.       num1[0]='0'; m=e=0; l=1;
  2178.    }
  2179.    if(l>p&&p>=0)  /* if l>p, round the number; if p<0 it needs rounding down */
  2180.       if(num1[l=p]>='5'){              /* anyway, so we don't need to bother */
  2181.          for(i=l-1;i>=0;i--){
  2182.             if(++num1[i]<='9')break;
  2183.             num1[i]='0';
  2184.          }
  2185.          if(i<0){
  2186.             (--num1)[0]='1';
  2187.             if(!l)l++; /* if that's the only '1' in the whole number, */
  2188.                        /* count it. */
  2189.             if(++e==expt&&expt&&expp)
  2190.                exp=0; /* just nudged into exponential form */
  2191.             if(exp){if(e>0)n++;}
  2192.             else
  2193.                if(numform)n=1+m+e%3;
  2194.                else n=1+m;
  2195.          }
  2196.       }
  2197.    /* should now have number rounded to fit into format, and n
  2198.       is the number of characters required for the integer part */
  2199.    if(before<n&&before)die(Eformat);
  2200.    for(n=before-n;n>0;n--)ptr1[len1++]=' ';
  2201.    if(m)ptr1[len1++]='-';
  2202.    if(exp){/* stack floating point number; no exponent */
  2203.       if(e<0){
  2204.          ptr1[len1++]='0';
  2205.          if(after){
  2206.             ptr1[len1++]='.';
  2207.             for(i= -1;i>e&&after;i--)ptr1[len1++]='0',after--;
  2208.          }
  2209.       }
  2210.       while(l&&(e>=0||after)){
  2211.          ptr1[len1++]=num1[0],
  2212.          num1++,
  2213.          l--,
  2214.          e--;
  2215.          if(l&&e==-1&&after)ptr1[len1++]='.';
  2216.          if(e<-1)after--;
  2217.       }
  2218.       while(e>-1)ptr1[len1++]='0',e--;
  2219.       if(after>0){
  2220.          if(e==-1)ptr1[len1++]='.';
  2221.          while(after--)ptr1[len1++]='0';
  2222.       }
  2223.    }
  2224.    else{/*stack floating point in appropriate form with exponent */
  2225.       ptr1[len1++]=num1[0];
  2226.       if(numform)while(e%3)
  2227.             e--,
  2228.             ptr1[len1++]=((--l)>0 ? (++num1)[0] : '0');
  2229.       else --l;
  2230.       if((l>0 && after<0)||after>0){
  2231.          ptr1[len1++]='.';
  2232.          while(l--&&after)ptr1[len1++]=(++num1)[0],after--;
  2233.          while(after-- >0)ptr1[len1++]='0';
  2234.       }
  2235.       if(!e){
  2236.          if(expp>0)for(i=expp+2;i--;ptr1[len1++]=' ');
  2237.       }
  2238.       else{
  2239.          ptr1[len1++]='E',
  2240.          ptr1[len1++]= e<0 ? '-' : '+',
  2241.          e=abs(e);
  2242.          for(p=0,i=1;i<=e;i*=10,p++);
  2243.          if(expp<0)expp=p;
  2244.          if(expp<p)die(Eformat);
  2245.          for(p=expp-p;p--;ptr1[len1++]='0');
  2246.          for(i/=10;i>=1;i/=10)
  2247.             ptr1[len1++]=e/i+'0',
  2248.             e%=i;
  2249.       }
  2250.    }
  2251.    *(int *)(ptr1+align(len1))=len1;
  2252.    ecstackptr+=align(len1)+four;
  2253. }
  2254.  
  2255. void rxqueued(argc)
  2256. int argc;
  2257. {
  2258.    int l;
  2259.    static char buff[8];
  2260.    if(argc)die(Ecall);
  2261.    if(write(rxstacksock,"N",1)<1)die(Esys);
  2262.    if(read(rxstacksock,buff,7)<7)die(Esys);
  2263.    sscanf(buff,"%x",&l);
  2264.    stackint(l);
  2265. }
  2266.  
  2267. void rxlinesize(argc)
  2268. int argc;
  2269. {
  2270.    int ans;
  2271.    struct winsize sz;
  2272.    if(argc)die(Ecall);
  2273.    if(!ioctl(fileno(ttyout),TIOCGWINSZ,&sz))ans=sz.ws_col;
  2274.    else ans=0;
  2275.    stackint(ans);
  2276. }
  2277.  
  2278. void rxbitand(argc)
  2279. int argc;
  2280. {
  2281.    char *arg1,*arg2,*argt;
  2282.    int len1,len2,lent;
  2283.    unsigned char pad=255;
  2284.    if(argc==3){
  2285.       argt=delete(&lent);
  2286.       if(lent!=1)die(Ecall);
  2287.       pad=argt[0];
  2288.       argc--;
  2289.    }
  2290.    if(argc==2){
  2291.       arg2=delete(&len2);
  2292.       if(len2==-1)len2=0;
  2293.    }
  2294.    else{
  2295.       if(argc!=1)die(Ecall);
  2296.       len2=0;
  2297.    }
  2298.    arg1=delete(&len1);
  2299.    if(len1<0)die(Ecall);
  2300.    if(len1<len2)argt=arg1,arg1=arg2,arg2=argt,lent=len1,len1=len2,len2=lent;
  2301.    argt=cstackptr+ecstackptr;
  2302.    for(lent=0;lent<len1;lent++)
  2303.       argt[lent]=arg1[lent]&(lent<len2?arg2[lent]:pad);
  2304.    argt+=lent=align(len1);
  2305.    *(int *)argt=len1;
  2306.    ecstackptr+=lent+four;
  2307. }
  2308. void rxbitor(argc)
  2309. int argc;
  2310. {
  2311.    char *arg1,*arg2,*argt;
  2312.    int len1,len2,lent;
  2313.    char pad=0;
  2314.    if(argc==3){
  2315.       argt=delete(&lent);
  2316.       if(lent!=1)die(Ecall);
  2317.       pad=argt[0];
  2318.       argc--;
  2319.    }
  2320.    if(argc==2){
  2321.       arg2=delete(&len2);
  2322.       if(len2==-1)len2=0;
  2323.    }
  2324.    else{
  2325.       if(argc!=1)die(Ecall);
  2326.       len2=0;
  2327.    }
  2328.    arg1=delete(&len1);
  2329.    if(len1<0)die(Ecall);
  2330.    if(len1<len2)argt=arg1,arg1=arg2,arg2=argt,lent=len1,len1=len2,len2=lent;
  2331.    argt=cstackptr+ecstackptr;
  2332.    for(lent=0;lent<len1;lent++)
  2333.       argt[lent]=arg1[lent]|(lent<len2?arg2[lent]:pad);
  2334.    argt+=lent=align(len1);
  2335.    *(int *)argt=len1;
  2336.    ecstackptr+=lent+four;
  2337. }
  2338. void rxbitxor(argc)
  2339. int argc;
  2340. {
  2341.    char *arg1,*arg2,*argt;
  2342.    int len1,len2,lent;
  2343.    char pad=0;
  2344.    if(argc==3){
  2345.       argt=delete(&lent);
  2346.       if(lent!=1)die(Ecall);
  2347.       pad=argt[0];
  2348.       argc--;
  2349.    }
  2350.    if(argc==2){
  2351.       arg2=delete(&len2);
  2352.       if(len2==-1)len2=0;
  2353.    }
  2354.    else{
  2355.       if(argc!=1)die(Ecall);
  2356.       len2=0;
  2357.    }
  2358.    arg1=delete(&len1);
  2359.    if(len1<0)die(Ecall);
  2360.    if(len1<len2)argt=arg1,arg1=arg2,arg2=argt,lent=len1,len1=len2,len2=lent;
  2361.    argt=cstackptr+ecstackptr;
  2362.    for(lent=0;lent<len1;lent++)
  2363.       argt[lent]=arg1[lent]^(lent<len2?arg2[lent]:pad);
  2364.    argt+=lent=align(len1);
  2365.    *(int *)argt=len1;
  2366.    ecstackptr+=lent+four;
  2367. }
  2368.  
  2369. void rxuserid(argc)
  2370. int argc;
  2371. {
  2372.    void endpwent();
  2373.    static int uid=-1;
  2374.    int cuid;
  2375.    static struct passwd *pw=0;
  2376.    if(argc)die(Ecall);
  2377.    if((cuid=getuid())!=uid)
  2378.       uid=cuid,
  2379.       pw=getpwuid(cuid),
  2380.       endpwent();
  2381.    if(!pw)stack(cnull,0);
  2382.    else stack(pw->pw_name,strlen(pw->pw_name));
  2383. }
  2384.  
  2385. void rxgetcwd(argc)
  2386. int argc;
  2387. {
  2388.    static char name[MAXPATHLEN];
  2389.    if(argc)die(Ecall);
  2390.    if (!getcwd(name,MAXPATHLEN)) {
  2391.       char *err=strerror(errno);
  2392.       if (!err) err="Unknown error occurred";
  2393.       if (strlen(err) < MAXPATHLEN) strcpy(name,err);
  2394.       else {
  2395.          memcpy(name,err,MAXPATHLEN-1);
  2396.          name[MAXPATHLEN-1]=0;
  2397.       }
  2398.    }
  2399.    stack(name,strlen(name));
  2400. }
  2401.  
  2402. void rxchdir(argc)
  2403. int argc;
  2404. {
  2405.    char *arg;
  2406.    int len;
  2407.    if(argc!=1)die(Ecall);
  2408.    arg=delete(&len);
  2409.    arg[len]=0; /* that location must exist since the length used to be
  2410.                   after the string */
  2411.    if(chdir(arg))stackint(errno);
  2412.    else stack("0",1);
  2413. }
  2414.  
  2415. void rxgetenv(argc)
  2416. int argc;
  2417. {
  2418.    char *arg;
  2419.    int len;
  2420.    if(argc!=1)die(Ecall);
  2421.    arg=delete(&len);
  2422.    arg[len]=0;
  2423.    if(arg=getenv(arg))stack(arg,strlen(arg));
  2424.    else stack(cnull,0);
  2425. }
  2426.  
  2427. void rxputenv(argc)
  2428. int argc;
  2429. {
  2430.    char *arg;
  2431.    char *eptr;
  2432.    int len;
  2433.    int exist;
  2434.    char **value;
  2435.    int path;
  2436.    if(argc!=1)die(Ecall);
  2437.    arg=delete(&len);
  2438.    arg[len++]=0;
  2439.    if(!(eptr=strchr(arg,'=')))die(Ecall);
  2440.    eptr[0]=0;
  2441.    value=(char**)hashfind(0,arg,&exist);
  2442.    path=strcmp(arg,"PATH");
  2443.    eptr[0]='=';
  2444.    putenv(arg); /* release the previous copy from the environment */
  2445.    if(!exist)*value=allocm(len);
  2446.    else if(strlen(*value)<len)
  2447.       if(!(*value=realloc(*value,len)))die(Emem);
  2448.    strcpy(*value,arg);
  2449.    if(putenv(*value))stack("1",1);
  2450.    else stack("0",1);
  2451.    if(!path)hashclear(); /* clear shell's hash table on change of PATH */
  2452. }
  2453.  
  2454. void rxopen2(stream,mode,mlen,path,plen)
  2455. char *stream,*mode,*path;   /* implement open(stream,mode,path) */
  2456. int mlen,plen;
  2457. {
  2458.    char modeletter[3];
  2459.    struct fileinfo *info;
  2460.    FILE *fp;
  2461.    int rc;
  2462.    modeletter[0]='r';
  2463.    modeletter[1]=modeletter[2]=0;
  2464.    if(plen<=0)path=stream,plen=strlen(stream);
  2465.    if(memchr(path,0,plen))die(Ecall);
  2466.    path[plen]=0;
  2467.    if(mlen>0)switch(mode[0]&0xdf){
  2468.       case 'R': break;
  2469.       case 'W': modeletter[0]='w';
  2470.                 modeletter[1]='+';
  2471.                 break;
  2472.       case 'A': rc=access(path,F_OK);
  2473.                 modeletter[0]=rc?'w':'r';
  2474.                 modeletter[1]='+';
  2475.                 break;
  2476.       default:  die(Ecall);
  2477.    }
  2478.    if(info=(struct fileinfo *)hashget(1,stream,&rc)){
  2479.       fp=info->fp;          /* if "stream" already exists, perform freopen */
  2480.       free((char *)info);
  2481.       *(struct fileinfo **)hashfind(1,stream,&rc)=0;
  2482.       fp=freopen(path,modeletter,info->fp);
  2483.    }
  2484.    else fp=fopen(path,modeletter);
  2485.    if(!fp){
  2486.       stackint(errno);
  2487.       return;
  2488.    }
  2489.    if(modeletter[0]=='r'&&modeletter[1]=='+') /* for append, go to eof */
  2490.       fseek(fp,0L,2);
  2491.    info=fileinit(stream,path,fp);
  2492.    info->wr=modeletter[1]=='+';
  2493.    stack("0",1);
  2494. }
  2495. void rxopen(argc)
  2496. int argc;
  2497. {
  2498.    char *stream,*mode,*path;
  2499.    int len=0,mlen=0,plen;
  2500.    if(argc==3){
  2501.       argc--;
  2502.       stream=delete(&len);
  2503.       if(len<0)stream=0;
  2504.       else
  2505.          if(memchr(stream,0,len))die(Ecall);
  2506.          else stream[len]=0;
  2507.       if(!len)die(Ecall);
  2508.    }
  2509.    if(argc==2){
  2510.       argc--;
  2511.       mode=delete(&mlen);
  2512.    }
  2513.    if(argc!=1)die(Ecall);
  2514.    path=delete(&plen);
  2515.    if(plen<=0)die(Ecall);
  2516.    path[plen]=0;
  2517.    if(len<=0)stream=path,len=plen;
  2518.    rxopen2(stream,mode,mlen,path,plen);
  2519. }
  2520. void rxfdopen2(stream,mode,modelen,n,nlen) /* implement fdopen(stream,mode,n)*/
  2521. char *stream;
  2522. char *n;
  2523. int nlen;
  2524. char *mode;
  2525. int modelen;
  2526. {
  2527.    int fd;
  2528.    char fmode[3];
  2529.    FILE *fp;
  2530.    int streamlen=strlen(stream);
  2531.    fmode[0]='r';
  2532.    fmode[1]=fmode[2]=0;
  2533.    if(nlen<=0)n=stream,nlen=streamlen; /* default number is same as name */
  2534.    mtest(workptr,worklen,nlen+streamlen+2,nlen+streamlen+2-worklen);
  2535.    memcpy(workptr,n,nlen);
  2536.    workptr[nlen]=0;
  2537.    memcpy(workptr+nlen+1,stream,streamlen+1);
  2538.    eworkptr=nlen+streamlen+2;
  2539.    stack(workptr,nlen);
  2540.    fd=getint(1);       /* convert the fd to an integer */
  2541.    if(modelen>0)switch(mode[0]&0xdf){
  2542.       case 'R': break;
  2543.       case 'W': fmode[0]='w';
  2544.                 fmode[1]='+';
  2545.                 break;
  2546.       case 'A': fmode[0]='r';
  2547.                 fmode[1]='+';
  2548.                 break;
  2549.       default:  die(Ecall);
  2550.    }
  2551.    if(fp=fdopen(fd,fmode)){
  2552.       fileinit(workptr+nlen+1,cnull,fp)->wr=fmode[1]=='+';
  2553.       errno=0;
  2554.    }
  2555.    stackint(errno);
  2556. }
  2557. void rxfdopen(argc)
  2558. int argc;
  2559. {
  2560.    char *stream,*n,*mode;
  2561.    int len=0,nlen=0,modelen=0;
  2562.    if(argc==3){
  2563.       argc--;
  2564.       stream=delete(&len);
  2565.       if(len>0)
  2566.          if(memchr(stream,0,len))die(Ecall);
  2567.          else stream[len]=0;
  2568.       if(len==0)die(Ecall);
  2569.       stream[len]=0;
  2570.    }
  2571.    if(argc==2){
  2572.       argc--;
  2573.       mode=delete(&modelen);
  2574.       if(modelen==0)die(Ecall);
  2575.    }
  2576.    if(argc!=1)die(Ecall);
  2577.    n=delete(&nlen);
  2578.    n[nlen]=0;
  2579.    if(nlen<=0)die(Ecall);
  2580.    if(len<=0)stream=n,len=nlen;
  2581.    rxfdopen2(stream,mode,modelen,n,nlen);
  2582. }
  2583. void rxpopen2(stream,mode,mlen,command,comlen)
  2584. char *stream,*mode,*command;      /* implement popen(stream,mode,command) */
  2585. int mlen,comlen;
  2586. {
  2587.    char fmode[2];
  2588.    int rc;
  2589.    FILE *fp;
  2590.    struct fileinfo *info;
  2591.    fmode[0]='r';
  2592.    fmode[1]=0;
  2593.    if(mlen>0)fmode[0]=mode[0]|0x20;
  2594.    if(fmode[0]!='r'&&fmode[0]!='w')die(Ecall);
  2595.    if(comlen<=0)command=stream,comlen=strlen(stream);
  2596.    else command[comlen]=0;
  2597.    if(memchr(command,0,comlen))die(Ecall);
  2598.    if(fp=popen(command,fmode)){
  2599.       info=fileinit(stream,cnull,fp);
  2600.       info->wr=-(fmode[0]=='w'),
  2601.       info->lastwr=-(info->wr);
  2602.       rc=0;
  2603.    }
  2604.    else rc=errno;
  2605.    stackint(rc);
  2606. }
  2607. void rxpopen(argc)
  2608. int argc;
  2609. {
  2610.    char *stream,*mode,*command;
  2611.    int len=0,mlen=0,comlen;
  2612.    if(argc==3){
  2613.       argc--;
  2614.       stream=delete(&len);
  2615.       if(len<0)stream=0;
  2616.       else
  2617.          if(memchr(stream,0,len))die(Ecall);
  2618.          else stream[len]=0;
  2619.       if(!len)die(Ecall);
  2620.    }
  2621.    if(argc==2){
  2622.       argc--;
  2623.       mode=delete(&mlen);
  2624.    }
  2625.    if(argc!=1)die(Ecall);
  2626.    command=delete(&comlen);
  2627.    if(comlen<=0)die(Ecall);
  2628.    command[comlen]=0;
  2629.    if(len<=0)stream=command,len=comlen;
  2630.    rxpopen2(stream,mode,mlen,command,comlen);
  2631. }
  2632. void rxlinein(argc)
  2633. int argc;
  2634. {
  2635.    char *name=0;
  2636.    int lines=1;
  2637.    int pos= 0;
  2638.    int len;
  2639.    int call;
  2640.    int ch=0;
  2641.    long filepos;
  2642.    struct fileinfo *info;
  2643.    FILE *fp;
  2644.    if(argc==3){
  2645.       argc--;
  2646.       if(isnull())delete(&len);
  2647.       else if((lines=getint(1))!=0&&lines!=1)die(Ecall);
  2648.    }
  2649.    if(argc==2){
  2650.       argc--;
  2651.       if(isnull())delete(&len);
  2652.       else if((pos=getint(1))<1)die(Ecall);
  2653.    }
  2654.    if(argc==1){
  2655.       argc--;
  2656.       name=delete(&len);
  2657.       if(len<=0)name=0;
  2658.       else
  2659.          if(memchr(name,0,len))die(Ecall);
  2660.          else name[len]=0;
  2661.    }
  2662.    if(argc)die(Ecall);
  2663.    if(!name)name="stdin";
  2664.    if(!(info=(struct fileinfo *)hashget(1,name,&len))){/* If not found, then */
  2665.       fp=fopen(name,"r");                             /* open it for reading */
  2666.       info=fileinit(name,name,fp);
  2667.       if(!fp){
  2668.          info->errnum=errno+Eerrno;
  2669.          rcset(errno,Enotready,name);
  2670.          stack(cnull,0);
  2671.          return;
  2672.       }
  2673.       info->lastwr=0;
  2674.    }
  2675.    else fp=info->fp;
  2676.    if(!fp){
  2677.       rcset(info->errnum-Eerrno,Enotready,name);
  2678.       stack(cnull,0);
  2679.       return;
  2680.    }
  2681.    if(info->wr<0){
  2682.       info->errnum=Eread;
  2683.       rcset(Eread-Eerrno,Enotready,name);
  2684.       stack(cnull,0);
  2685.       return;
  2686.    }
  2687.    if(info->persist && info->lastwr==0 &&
  2688.          (filepos=ftell(info->fp))>=0 && filepos!=info->rdpos)
  2689.       info->rdpos=filepos,
  2690.       info->rdline=0; /* position has been disturbed by external prog */
  2691.    clearerr(fp);      /* Ignore errors and try from scratch */
  2692.    info->errnum=0;
  2693.    if(info->lastwr || pos>0)len=fseek(fp,info->rdpos,0);
  2694.    else len=0;
  2695.    info->lastwr=0;
  2696.    if(pos>0 && (len<0 || !info->persist)){
  2697.       info->errnum=Eseek;        /* Seek not allowed on transient stream */
  2698.       rcset(Eseek-Eerrno,Enotready,name);
  2699.       stack(cnull,0);
  2700.       return;
  2701.    }
  2702.    if(pos>0){                   /* Search for given line number (ugh!) */
  2703.       if(info->rdline==0 || info->rdline+info->rdchars>pos)
  2704.          fseek(fp,0L,0),
  2705.          info->rdline=1;
  2706.       info->rdchars=0;
  2707.       for(;ch!=EOF&&info->rdline<pos;info->rdline++)
  2708.          while((ch=getc(fp))!='\n'&&ch!=EOF);
  2709.       if(ch==EOF){
  2710.          info->rdline--;
  2711.          info->errnum=Ebounds;
  2712.          rcset(Ebounds-Eerrno,Enotready,name);
  2713.          stack(cnull,0);
  2714.          return;
  2715.       }
  2716.    }
  2717.    len=0;
  2718.    if(lines){
  2719.       call=sgstack[interplev].callon&(1<<Ihalt) |
  2720.            sgstack[interplev].delay &(1<<Ihalt);
  2721.       if(!call)siginterrupt(2,1); /* Allow ^C during read */
  2722.       while((ch=getc(fp))!='\n'&&ch!=EOF){
  2723.          mtest(pull,pulllen,len+1,256);
  2724.          pull[len++]=ch;
  2725.       }
  2726.       siginterrupt(2,0);
  2727.       if(delayed[Ihalt] && !call)
  2728.          delayed[Ihalt]=0,
  2729.          fseek(fp,info->rdpos,0), /* reset to start of line, if possible */
  2730.          die(Ehalt);
  2731.       if(info->rdline)info->rdline++;
  2732.       info->rdchars=0;
  2733.    }
  2734.    if(ch==EOF&&!len)rxseterr(info);
  2735.    if(info->persist && (info->rdpos=ftell(fp))<0)info->rdpos=0;
  2736.    if(info->errnum || setrcflag)rcset(info->errnum-Eerrno,Enotready,name);
  2737.    stack(pull,len);
  2738. }
  2739.       
  2740. void rxlineout(argc)
  2741. int argc;
  2742. {
  2743.    char *name=0;
  2744.    char *file;
  2745.    int pos= 0;
  2746.    int charlen=0;
  2747.    int len;
  2748.    int acc;
  2749.    int ch=0;
  2750.    char *chars=0;
  2751.    long filepos;
  2752.    struct fileinfo *info;
  2753.    FILE *fp;
  2754.    if(argc==3){
  2755.       argc--;
  2756.       if(isnull())delete(&len);
  2757.       else if((pos=getint(1))<1)die(Ecall);
  2758.    }
  2759.    if(argc==2){
  2760.       argc--;
  2761.       chars=delete(&charlen);
  2762.       if(charlen<0)chars=0;
  2763.       else if(memchr(chars,'\n',charlen))die(Ecall);
  2764.    }
  2765.    if(argc==1){
  2766.       argc--;
  2767.       name=delete(&len);
  2768.       if(len<=0)name=0;
  2769.       else
  2770.          if(memchr(name,0,len))die(Ecall);
  2771.          else name[len]=0;
  2772.    }
  2773.    if(argc)die(Ecall);
  2774.    if(!name)name="stdout";
  2775.    if(!(info=(struct fileinfo *)hashget(1,name,&len))){
  2776.       acc=access(name,F_OK);  /* If not found in table, then open for append */
  2777.       fp=fopen(name,acc?"w+":"r+");
  2778.       if(fp)fseek(fp,0L,2);
  2779.       info=fileinit(name,name,fp);
  2780.       if(!fp){
  2781.          info->errnum=errno+Eerrno;
  2782.          rcset(errno,Enotready,name);
  2783.          stack(chars?"1":"0",1);
  2784.          return;
  2785.       }
  2786.       info->wr=1;
  2787.    }
  2788.    else fp=info->fp;
  2789.    if(!fp){
  2790.       rcset(info->errnum-Eerrno,Enotready,name);
  2791.       stack(chars?"1":"0",1);
  2792.       return;
  2793.    }
  2794.    if(!info->wr){  /* If it is open for reading, try to reopen for writing */
  2795.       file=(char*)(info+1);
  2796.       if(!file[0]){ /* reopen not allowed, since file name not given */
  2797.          info->errnum=Eaccess;
  2798.          rcset(Eaccess-Eerrno,Enotready,name);
  2799.          stack(chars?"1":"0",1);
  2800.          return;
  2801.       }
  2802.       if(!(fp=freopen(file,"r+",fp))){
  2803.          info->errnum=errno+Eerrno;
  2804.          fp=fopen(file,"r");/* try to regain read access */
  2805.          info->fp=fp;
  2806.          if(fp)fseek(fp,info->rdpos,0);
  2807.          rcset(info->errnum-Eerrno,Enotready,name);
  2808.          stack(chars?"1":"0",1);
  2809.          file[0]=0;         /* Prevent this whole thing from happening again */
  2810.          return;
  2811.       }
  2812.       info->wr=1;
  2813.       fseek(fp,0L,2);
  2814.       info->wrline=0;
  2815.       info->lastwr=1;
  2816.       if((info->wrpos=ftell(fp))<0)info->wrpos=0;
  2817.    }
  2818.    if(info->persist && info->lastwr &&
  2819.          (filepos=ftell(fp))>=0 && filepos!=info->wrpos)
  2820.       info->wrpos=filepos,
  2821.       info->wrline=0;  /* position has been disturbed by external prog */
  2822.    clearerr(fp);       /* Ignore errors and try from scratch */
  2823.    info->errnum=0;
  2824.    if(info->lastwr==0 || pos>0)len=fseek(fp,info->wrpos,0);
  2825.    else len=0;
  2826.    info->lastwr=1;
  2827.    if(pos>0 && (len<0 || !info->persist)){
  2828.       info->errnum=Eseek;       /* Seek not allowed on transient stream */
  2829.       rcset(Eseek-Eerrno,Enotready,name);
  2830.       stack(chars?"1":"0",1);
  2831.       return;
  2832.    }
  2833.    if(pos>0){                   /* Search for required line number (Ugh!) */
  2834.       if(info->wrline==0 || info->wrline+info->wrchars>pos)
  2835.          fseek(fp,0L,0),
  2836.          info->wrline=1;
  2837.       info->wrchars=0;
  2838.       for(;ch!=EOF&&info->wrline<pos;info->wrline++)
  2839.          while((ch=getc(fp))!='\n'&&ch!=EOF);
  2840.       fseek(fp,0L,1);          /* seek between read and write */
  2841.       if(ch==EOF){
  2842.          info->wrline--;
  2843.          info->errnum=Ebounds;
  2844.          rcset(Ebounds-Eerrno,Enotready,name);
  2845.          stack(chars?"1":"0",1);
  2846.          return;
  2847.       }
  2848.    }
  2849.    if(!chars){
  2850.       if(!pos){   /* No data and no position given so flush and go to EOF */
  2851.          if (fflush(fp)) rxseterr(info);
  2852.          fseek(fp,0L,2);
  2853.          info->wrline=0;
  2854.       }
  2855.       if((info->wrpos=ftell(fp))<0)info->wrpos=0; /* just pos given */
  2856.       if(info->errnum || setrcflag)rcset(info->errnum-Eerrno,Enotready,name);
  2857.       stack("0",1);
  2858.       return;
  2859.    }
  2860.    chars[charlen++]='\n';
  2861.    if(fwrite(chars,charlen,1,fp)){
  2862.       stack("0",1);
  2863.       if(info->wrline)info->wrline++;
  2864.       info->wrchars=0;
  2865.       if(info->persist && (info->wrpos=ftell(fp))<0) info->wrpos=0;
  2866.       if(setrcflag)rcset(0,Enotready,name);
  2867.    }else{
  2868.       stack("1",1);
  2869.       rxseterr(info);
  2870.       fseek(fp,info->wrpos,0);
  2871.       rcset(info->errnum-Eerrno,Enotready,name);
  2872.    }
  2873. }
  2874. void rxcharin(argc)
  2875. int argc;
  2876. {
  2877.    char *name=0;
  2878.    int chars=1;
  2879.    int pos= 0;
  2880.    int len;
  2881.    int l;
  2882.    int call;
  2883.    long filepos;
  2884.    struct fileinfo *info;
  2885.    FILE *fp;
  2886.    if(argc==3){
  2887.       argc--;
  2888.       if(isnull())delete(&len);
  2889.       else if((chars=getint(1))<0)die(Ecall);
  2890.    }
  2891.    if(argc==2){
  2892.       argc--;
  2893.       if(isnull())delete(&len);
  2894.       else if((pos=getint(1))<1)die(Ecall);
  2895.    }
  2896.    if(argc==1){
  2897.       argc--;
  2898.       name=delete(&len);
  2899.       if(len<=0)name=0;
  2900.       else
  2901.          if(memchr(name,0,len))die(Ecall);
  2902.          else name[len]=0;
  2903.    }
  2904.    if(argc)die(Ecall);
  2905.    if(!name)name="stdin";
  2906.    if(!(info=(struct fileinfo *)hashget(1,name,&len))){
  2907.       fp=fopen(name,"r"); /* not found in table so try to open */
  2908.       info=fileinit(name,name,fp);
  2909.       if(!fp){
  2910.          info->errnum=errno+Eerrno;
  2911.          rcset(errno,Enotready,name);
  2912.          stack(cnull,0);
  2913.          return;
  2914.       }
  2915.       info->lastwr=0;
  2916.    }
  2917.    else fp=info->fp;
  2918.    if(!fp){
  2919.       rcset(info->errnum-Eerrno,Enotready,name);
  2920.       stack(cnull,0);
  2921.       return;
  2922.    }
  2923.    if(info->wr<0){
  2924.       info->errnum=Eread;
  2925.       rcset(Eread-Eerrno,Enotready,name);
  2926.       stack(cnull,0);
  2927.       return;
  2928.    }
  2929.    if(info->persist && info->lastwr==0 &&
  2930.          (filepos=ftell(info->fp))>=0 && filepos!=info->rdpos)
  2931.       info->rdpos=filepos,
  2932.       info->rdline=0; /* position has been disturbed by external prog */
  2933.    clearerr(fp);
  2934.    info->errnum=0;
  2935.    if(pos>0 && (!info->persist || fseek(fp,0L,2)<0)){
  2936.       info->errnum=Eseek;       /* Seek not allowed on transient stream */
  2937.       rcset(Eseek-Eerrno,Enotready,name);
  2938.       stack(cnull,0);
  2939.       return;
  2940.    }
  2941.    if(pos){
  2942.       filepos=ftell(fp);      
  2943.       if(fseek(fp,(long)pos-1,0)>=0)info->rdpos=pos-1;
  2944.       info->rdline=0;
  2945.       if(filepos<pos){          /* Seek was out of bounds */
  2946.          info->errnum=Ebounds;
  2947.          rcset(Ebounds-Eerrno,Enotready,name);
  2948.          stack(cnull,0);
  2949.          return;
  2950.       }
  2951.    }
  2952.    else if(info->lastwr)fseek(fp,info->rdpos,0);
  2953.    info->lastwr=0;
  2954.    call=sgstack[interplev].callon&(1<<Ihalt) |
  2955.         sgstack[interplev].delay &(1<<Ihalt);
  2956.    if(!call)siginterrupt(2,1); /* allow ^C to interrupt */
  2957.    mtest(workptr,worklen,chars,chars-worklen);
  2958.    len=fread(workptr,1,chars,fp);
  2959.    siginterrupt(2,0);
  2960.    if(delayed[Ihalt] && !call)
  2961.       delayed[Ihalt]=0,
  2962.       fseek(fp,info->rdpos,0),
  2963.       die(Ehalt);
  2964.    if(len&&info->rdline){ /* Try to keep the line counter up to date */
  2965.       for(l=0;l<len;)if(workptr[l++]=='\n')info->rdline++;
  2966.       if(workptr[len-1]!='\n')info->rdchars=1;
  2967.    }
  2968.    if(len<chars)rxseterr(info);
  2969.    if(info->persist && (info->rdpos=ftell(fp))<0)info->rdpos=0;
  2970.    if(info->errnum || setrcflag)rcset(info->errnum-Eerrno,Enotready,name);
  2971.    stack(workptr,len);
  2972. }
  2973. void rxcharout(argc)
  2974. int argc;
  2975. {
  2976.    char *name=0;
  2977.    char *file;
  2978.    int pos= 0;
  2979.    int charlen;
  2980.    int len;
  2981.    int acc;
  2982.    int l;
  2983.    char *chars=0;
  2984.    long filepos;
  2985.    struct fileinfo *info;
  2986.    FILE *fp;
  2987.    if(argc==3){
  2988.       argc--;
  2989.       if(isnull())delete(&len);
  2990.       else if((pos=getint(1))<1)die(Ecall);
  2991.    }
  2992.    if(argc==2){
  2993.       argc--;
  2994.       chars=delete(&charlen);
  2995.       if(charlen<0)chars=0,charlen=0;
  2996.    }
  2997.    else charlen=0;
  2998.    if(argc==1){
  2999.       argc--;
  3000.       name=delete(&len);
  3001.       if(len<=0)name=0;
  3002.       else
  3003.          if(memchr(name,0,len))die(Ecall);
  3004.          else name[len]=0;
  3005.    }
  3006.    if(argc)die(Ecall);
  3007.    if(!name)name="stdout";
  3008.    if(!(info=(struct fileinfo *)hashget(1,name,&len))){
  3009.       acc=access(name,F_OK); /* If not found in table, open for append */
  3010.       fp=fopen(name,acc?"w+":"r+");
  3011.       if(fp)fseek(fp,0L,2);
  3012.       info=fileinit(name,name,fp);
  3013.       if(!fp){
  3014.          info->errnum=errno+Eerrno;
  3015.          rcset(errno,Enotready,name);
  3016.          stackint(charlen);
  3017.          return;
  3018.       }
  3019.       info->wr=1;
  3020.    }
  3021.    else fp=info->fp;
  3022.    if(!fp){
  3023.       rcset(info->errnum-Eerrno,Enotready,name);
  3024.       stackint(charlen);
  3025.       return;
  3026.    }
  3027.    if(!info->wr){ /* If not open for write, try to gain write access */
  3028.       file=(char*)(info+1);
  3029.       if(!file[0]){
  3030.          info->errnum=Eaccess;
  3031.          rcset(Eaccess-Eerrno,Enotready,name);
  3032.          stackint(charlen);
  3033.          return;
  3034.       }
  3035.       if(!(fp=freopen(file,"r+",fp))){
  3036.          info->errnum=errno+Eerrno;
  3037.          fp=fopen(file,"r");/* try to regain read access */
  3038.          info->fp=fp;
  3039.          if(fp)fseek(fp,info->rdpos,0);
  3040.          rcset(info->errnum-Eerrno,Enotready,name);
  3041.          stackint(charlen);
  3042.          file[0]=0;         /* Prevent this whole thing from happening again */
  3043.          return;
  3044.       }
  3045.       info->wr=1;
  3046.       fseek(fp,0L,2);
  3047.       info->wrline=0;
  3048.       info->lastwr=1;
  3049.       if((info->wrpos=ftell(fp))<0)info->wrpos=0;
  3050.    }
  3051.    if(info->persist && info->lastwr &&
  3052.          (filepos=ftell(fp))>=0 && filepos!=info->wrpos)
  3053.       info->wrpos=filepos,
  3054.       info->wrline=0;  /* position has been disturbed */
  3055.    clearerr(fp);
  3056.    info->errnum=0;
  3057.    if(pos>0 && (!info->persist || fseek(fp,0L,2)<0)){
  3058.       info->errnum=Eseek;        /* Seek not allowed on transient stream */
  3059.       rcset(Eseek-Eerrno,Enotready,name);
  3060.       stackint(charlen);
  3061.       return;
  3062.    }
  3063.    if(pos){
  3064.       filepos=ftell(fp);
  3065.       if(fseek(fp,(long)pos-1,0)>=0)info->wrpos=pos-1;
  3066.       info->wrline=0;
  3067.       if(filepos+1<pos){        /* Seek was out of bounds */
  3068.          info->errnum=Ebounds;
  3069.          rcset(Ebounds-Eerrno,Enotready,name);
  3070.          stack(cnull,0);
  3071.          return;
  3072.       }
  3073.    }
  3074.    else if(info->lastwr==0)fseek(fp,info->wrpos,0);
  3075.    info->lastwr=1;
  3076.    if(!chars){
  3077.       if(!pos){   /* No data, no pos, so flush and seek to EOF */
  3078.          if (fflush(fp)) rxseterr(info);
  3079.          fseek(fp,0L,2);
  3080.          info->wrline=0;
  3081.       }
  3082.       if((info->wrpos=ftell(fp))<0)info->wrpos=0; /* no data, so OK */
  3083.       if(info->errnum || setrcflag)rcset(info->errnum-Eerrno,Enotready,name);
  3084.       stack("0",1);
  3085.       return;
  3086.    }
  3087.    len=fwrite(chars,1,charlen,fp);
  3088.    info->wrpos+=len;
  3089.    if(len&&info->wrline){
  3090.       for(l=0;l<len;)if(chars[l++]=='\n')info->wrline++;
  3091.       if(chars[len-1]!='\n')info->wrchars=1;
  3092.    }
  3093.    if(len<charlen)rxseterr(info);
  3094.    if(info->persist && (info->wrpos=ftell(fp))<0) info->wrpos=0;
  3095.    if(info->errnum || setrcflag)rcset(info->errnum-Eerrno,Enotready,name);
  3096.    stackint(charlen-len);
  3097. }
  3098. void rxchars(argc)
  3099. int argc;
  3100. {
  3101.    rxchars2(argc,0);
  3102. }
  3103. void rxlines(argc)
  3104. int argc;
  3105. {
  3106.    rxchars2(argc,1);
  3107. }
  3108. void rxchars2(argc,line) /* = rxchars(argc) if line==0, or rxlines(argc) o/w */
  3109. int argc,line;
  3110. {
  3111.    long chars;
  3112.    long(filepos);
  3113.    int lines;
  3114.    char *name=0;
  3115.    int len;
  3116.    struct fileinfo *info;
  3117.    struct stat buf;
  3118.    int ch,c2;
  3119.    FILE *fp;
  3120.    if(argc==1){
  3121.       name=delete(&len);
  3122.       if(len<=0)name=0;
  3123.       else
  3124.          if(memchr(name,0,len))die(Ecall);
  3125.          else name[len]=0;
  3126.    }
  3127.    else if(argc)die(Ecall);
  3128.    if(!name)name="stdin";
  3129.    info=(struct fileinfo *)hashget(1,name,&len);
  3130.    if(info && !info->fp){
  3131.       rcset(info->errnum-Eerrno,Enotready,name);
  3132.       stack("0",1);
  3133.       return;
  3134.    }
  3135.    if(info && info->wr<0){
  3136.       info->errnum=Eread;
  3137.       rcset(Eread-Eerrno,Enotready,name);
  3138.       stack("0",1);
  3139.       return;
  3140.    }
  3141.    if(info){
  3142. #ifdef FSTAT_FOR_CHARS  /* fstat appears to be quicker (and more
  3143.                            correct) than seeking to EOF and back. */
  3144.       if(   info->persist &&
  3145.             !fstat(fileno(info->fp),&buf) &&
  3146.             S_ISREG(buf.st_mode)){
  3147.          if(info->lastwr || (filepos=ftell(info->fp))<0)
  3148.             filepos=info->rdpos;
  3149.          chars=buf.st_size-filepos;
  3150.          if(chars<0)chars=0;
  3151.       } else
  3152. #endif
  3153.       {
  3154.          if(info->lastwr)fseek(info->fp,info->rdpos,0);
  3155.          if(ioctl(fileno(info->fp),FIONREAD,&chars))chars=0;
  3156.          chars+=_CNT(info->fp); /* add the number of buffered chars */
  3157.       }
  3158.       if(line && info->persist && (filepos=ftell(info->fp))>=0){
  3159.          lines=0;
  3160.          c2='\n';
  3161.          while((ch=getc(info->fp))!=EOF){ /* count lines */
  3162.             if(ch=='\n')lines++;
  3163.             c2=ch;
  3164.          }
  3165.          if(c2!='\n')lines++;
  3166.          fseek(info->fp,filepos,0);
  3167.       }
  3168.       else lines=(chars>0);
  3169.    }
  3170.    else { /* Not open.  Try to open it (to see whether we have access) */
  3171.           /* Funny thing is, we only make a fileinfo structure for it if
  3172.              there is an error (to hold the error number). */
  3173.       chars=lines=0;
  3174.       if(!(fp=fopen(name,"r"))){
  3175.          info=fileinit(name,name,fp);
  3176.          info->errnum=errno+Eerrno;
  3177.          rcset(errno,Enotready,name);
  3178.       }
  3179.       else if(fstat(fileno(fp),&buf)){
  3180.          info=fileinit(name,name,fp);
  3181.          info->errnum=errno+Eerrno;
  3182.          rcset(errno,Enotready,name);
  3183.          /* file is still open, but that's OK since its info is stored */
  3184.       }
  3185.       else if(!S_ISREG(buf.st_mode)){
  3186.          /* Not a regular file.  Sometimes we are allowed to fopen a directory,
  3187.             in which case EISDIR should be reported.  Otherwise, since we
  3188.             were allowed to open the file, assume it is a readable file with
  3189.             no characters (e.g. a tty) and do not report an error. */
  3190.          if(S_ISDIR(buf.st_mode)){
  3191.             fclose(fp);
  3192.             info=fileinit(name,cnull,(FILE *)0);
  3193.             info->errnum=EISDIR+Eerrno;
  3194.             rcset(EISDIR,Enotready,name);
  3195.          }
  3196.          else fclose(fp);
  3197.       }
  3198.       else{
  3199.          chars=buf.st_size;
  3200.          if(line){    /* Count lines */
  3201.             c2='\n';
  3202.             while((ch=getc(fp))!=EOF){
  3203.                if(ch=='\n')lines++;
  3204.                c2=ch;
  3205.             }
  3206.             if(c2!='\n')lines++;
  3207.          }
  3208.          else lines=(chars>0);
  3209.          fclose(fp);
  3210.       }
  3211.    }
  3212.    if(line)stackint(lines);
  3213.    else stackint((int)chars); /* Ahem! */
  3214. }
  3215. void rxclose(argc)
  3216. int argc;
  3217. {
  3218.    char *name;
  3219.    int len;
  3220.    if(argc!=1)die(Ecall);
  3221.    name=delete(&len);
  3222.    if(memchr(name,0,len))die(Ecall);
  3223.    else name[len]=0;
  3224.    if(!len)die(Ecall);
  3225.    stackint(fileclose(name));
  3226. }
  3227. void rxpclose(argc)
  3228. int argc;
  3229. {
  3230.    char *name;
  3231.    int len;
  3232.    int rc;
  3233.    char *ptr;
  3234.    struct fileinfo *info;
  3235.    if(argc!=1)die(Ecall);
  3236.    name=delete(&len);
  3237.    if(memchr(name,0,len))die(Ecall);
  3238.    else name[len]=0;
  3239.    if(!len)die(Ecall);
  3240.    ptr=hashsearch(1,name,&len);
  3241.    if(len&&(info=(struct fileinfo *)(((hashent *)ptr)->value))){
  3242.       if(info->fp)rc=pclose(info->fp);
  3243.       else rc=-1;
  3244.       if(info->fp && rc<0)fclose(info->fp); /* if error, close anyway */
  3245.       free((char*)info);
  3246.       ((hashent *)ptr)->value=0;
  3247.    }
  3248.    else rc=0;
  3249.    if(rc==-1)stack("-1",2);
  3250.    else stackint((char)(rc/256));
  3251. }
  3252.    
  3253. void rxfileno(argc)
  3254. int argc;
  3255. {
  3256.    char *name;
  3257.    int len;
  3258.    struct fileinfo *info;
  3259.    if(argc!=1)die(Ecall);
  3260.    name=delete(&len);
  3261.    if(memchr(name,0,len))die(Ecall);
  3262.    else name[len]=0;
  3263.    if(!len)die(Ecall);
  3264.    if(!(info=(struct fileinfo *)hashget(1,name,&len)) || !(info->fp))
  3265.       stack("-1",2);
  3266.    else stackint(fileno(info->fp));
  3267. }
  3268. void rxftell(argc)
  3269. int argc;
  3270. {
  3271.    char *name;
  3272.    int len;
  3273.    struct fileinfo *info;
  3274.    if(argc!=1)die(Ecall);
  3275.    name=delete(&len);
  3276.    if(memchr(name,0,len))die(Ecall);
  3277.    else name[len]=0;
  3278.    if(!len)die(Ecall);
  3279.    if(!(info=(struct fileinfo *)hashget(1,name,&len)) || !(info->fp))len=-1;
  3280.    else len=ftell(info->fp); /* Ahem! */
  3281.    if(len>=0)len++;
  3282.    stackint(len);
  3283. }
  3284. void rxquery2(stream,info,param,len) /* used for stream(file,"c","query ...") */
  3285. char *stream;
  3286. struct fileinfo *info;
  3287. char *param;
  3288. int len;
  3289. {
  3290.    struct stat st;
  3291.    struct tm *tp;
  3292.    char *name;
  3293.    char *cp;
  3294.    char *dir;
  3295.    static char tmp[MAXPATHLEN];
  3296.    static char curdir[MAXPATHLEN];
  3297.    int statrc;
  3298.    int fd=-1;
  3299.    /* if the stream is open, fstat it, otherwise stat the named file */
  3300.    if (info && info->fp) {
  3301.       fd=fileno(info->fp);
  3302.       statrc=fstat(fd,&st);
  3303.    }
  3304.    else statrc=stat(stream,&st);
  3305.    if (statrc) { /* answer is "" if the file does not exist */
  3306.       stack(cnull,0);
  3307.       return;
  3308.    }
  3309.    tp=localtime(&st.st_mtime);
  3310.    param[len]=0;
  3311.    if (!strcasecmp(param,"datetime")) {
  3312.       sprintf(tmp,"%02d-%02d-%02d %02d:%02d:%02d",
  3313.          tp->tm_mon+1,tp->tm_mday,tp->tm_year%100,
  3314.          tp->tm_hour,tp->tm_min,tp->tm_sec);
  3315.       stack(tmp,strlen(tmp));
  3316.       return;
  3317.    }
  3318.    if (!strcasecmp(param,"exists")) {
  3319.       if (fd>=0) { /* stream is open; fetch the associated file name */
  3320.          name=(char*)(info+1);
  3321.          if (!name[0]) { /* no name known so return the stream name */
  3322.             stack(stream,strlen(stream));
  3323.             return;
  3324.          }
  3325.          if (stat(name,&st)) { 
  3326.             /* name was known but the file does not seem to exist */
  3327.             stack(stream,strlen(stream));
  3328.             return;
  3329.          }
  3330.       }
  3331.       else name=stream; /* use the supplied name */
  3332.       /* since the stat worked the file exists so qualify and return it */
  3333.       /* (files of form "/foo" don't need qualification) */
  3334.       if (getcwd(curdir,sizeof curdir) && curdir[0]=='/' && 
  3335.           (cp=strrchr(name,'/')) != name) {
  3336.          dir=curdir;
  3337.          if (cp && cp-name<sizeof tmp) {
  3338.             memcpy(tmp,name,cp-name);
  3339.             tmp[cp-name]=0;
  3340.             if (!chdir(tmp) && getcwd(tmp,sizeof tmp) && tmp[0]=='/') {
  3341.                name=cp+1;
  3342.                dir=tmp;
  3343.             }
  3344.             chdir(curdir);
  3345.          }
  3346.          /* the answer is now dir concatenated to name */
  3347.          /* In case dir was not found or name is just '.', remove leading '.' */
  3348.          if (name[0]=='.') {
  3349.             if (name[1]=='/') name+=2;
  3350.             else if (!name[1]) name++;
  3351.          }
  3352.          if (strlen(name)+strlen(dir)+1 < sizeof tmp) {
  3353.             strcat(dir,"/");
  3354.             strcat(dir,name);
  3355.             name=dir;
  3356.          }
  3357.       }
  3358.       stack(name,strlen(name));
  3359.       return;
  3360.    }
  3361.    if (!strcasecmp(param,"handle")) {
  3362.       if (fd<0) stack(cnull,0);
  3363.       else stackint(fd);
  3364.       return;
  3365.    }
  3366.    if (!strcasecmp(param,"size")) {
  3367.       if (S_ISREG(st.st_mode)) stackint(st.st_size);
  3368.       else stack("0",1);
  3369.       return;
  3370.    }
  3371.    if (!strcasecmp(param,"streamtype")) {
  3372.       if (fd<0) stack("UNKNOWN",7);
  3373.       else if (info->persist) stack("PERSISTENT",10);
  3374.       else stack("TRANSIENT",9);
  3375.       return;
  3376.    }
  3377.    if (!strcasecmp(param,"timestamp")) {
  3378.       sprintf(tmp,"%04d-%02d-%02d %02d:%02d:%02d",
  3379.          tp->tm_year+1900,tp->tm_mon+1,tp->tm_mday,
  3380.          tp->tm_hour,tp->tm_min,tp->tm_sec);
  3381.       stack(tmp,strlen(tmp));
  3382.       return;
  3383.    }
  3384.    die(Ecall);
  3385. }
  3386. void rxstream(argc)
  3387. int argc;
  3388. {
  3389.    char *stream;
  3390.    char option='S';
  3391.    char *command=0;
  3392.    char *param;
  3393.    int comlen;
  3394.    int len;
  3395.    int isnull=0;
  3396.    int exist;
  3397.    char *answer;
  3398.    struct fileinfo *info;
  3399.    if(argc==3){
  3400.       command=delete(&comlen);
  3401.       argc--;
  3402.       if(comlen<=0)die(Ecall);
  3403.    }
  3404.    if(argc==2){
  3405.       stream=delete(&len);
  3406.       argc--;
  3407.       if(len==0)die(Ecall);
  3408.       if(len>0)option=stream[0]&0xdf;
  3409.    }
  3410.    if(argc!=1)die(Ecall);
  3411.    stream=delete(&len);
  3412.    if(len<0)die(Ecall);
  3413.    if(len==0){stream="stdin";isnull=1;}
  3414.    else {
  3415.       if(memchr(stream,0,len))die(Ecall);
  3416.       stream[len]=0;
  3417.    }
  3418.    info=(struct fileinfo *)hashget(1,stream,&exist);
  3419.    switch(option){
  3420.       case 'D': if(command)die(Ecall);
  3421.          if(!info)answer="Stream is not open";
  3422.          else if(!info->errnum)answer="Ready";
  3423.          else answer=message(info->errnum);
  3424.          stack(answer,strlen(answer));
  3425.          return;
  3426.       case 'S': if(command)die(Ecall);
  3427.          if(!info)stack("UNKNOWN",7);
  3428.          else if(!info->errnum)stack("READY",5);
  3429.          else if(info->errnum==Eeof+Eerrno || info->errnum<Eerrno)
  3430.             stack("NOTREADY",8);
  3431.          else stack("ERROR",5);
  3432.          return;
  3433.       case 'C': break; /* out of the switch to do the work */
  3434.       default: die(Ecall);
  3435.    }
  3436.    if(!command)die(Ecall);
  3437.    param=command;
  3438.    while(comlen--&& *param++!=' ');    /* Find the command end */
  3439.    if(comlen>=0){
  3440.       param[-1]=0;                     /* terminate the command */
  3441.       while(comlen--&& *param++==' '); /* Find the parameter */
  3442.       comlen++,param--;
  3443.    }
  3444.    else param[0]=comlen=0;
  3445.    /***/if(!strcasecmp(command,"close")){ /* syntax: "close" */
  3446.       if(comlen)die(Ecall);
  3447.       stackint(fileclose(stream));
  3448.    }
  3449.    else if(!strcasecmp(command,"fdopen")){/* syntax: "fdopen [mode][,n]" */
  3450.       char *n;
  3451.       if (isnull) die(Ecall);
  3452.       for(len=0;len<comlen&¶m[len]!=','&¶m[len]!=' ';len++);
  3453.       comlen-=len+1;
  3454.       for(n=param+len+1;comlen>0&&n[0]==' ';n++,comlen--);
  3455.       if(comlen<0)comlen=0;
  3456.       rxfdopen2(stream,param,len,n,comlen);
  3457.    }
  3458.    else if(!strcasecmp(command,"fileno")){/* syntax: "fileno" */
  3459.       if(info && info->fp)stackint(fileno(info->fp));
  3460.       else stack("-1",2);
  3461.    }
  3462.    else if(!strcasecmp(command,"flush")){ /* syntax: "flush" */
  3463.       if (isnull) die(Ecall);
  3464.       if(info && info->fp) {
  3465.          int answer=fflush(info->fp);
  3466.          if (answer<0) rxseterr(info);
  3467.          if(info->errnum || setrcflag)rcset(info->errnum-Eerrno,Enotready,stream);
  3468.          stackint(answer);
  3469.       }
  3470.       else stack("-1",2);
  3471.    }
  3472.    else if(!strcasecmp(command,"ftell")){ /* syntax: "ftell" */
  3473.       if(info && info->fp)stackint(ftell(info->fp));
  3474.       else stack("-1",2);
  3475.    }
  3476.    else if(!strcasecmp(command,"open")){  /* syntax: "open [mode][,path]" */
  3477.       char *path=0;
  3478.       if (isnull) die(Ecall);
  3479.       /* for compatibility, accept "open both *", "open write append" and */
  3480.       /* "open write replace" before parsing the usual parameters. */
  3481.       if (comlen==12 && !strncasecmp(param,"write append",comlen)) {
  3482.          param="a";
  3483.          len=1;
  3484.          comlen=0;
  3485.       }
  3486.       else if (comlen==13 && !strncasecmp(param,"write replace",comlen)) {
  3487.          param="w";
  3488.          len=1;
  3489.          comlen=0;
  3490.       }
  3491.       else if (comlen>4 && !strncasecmp(param,"both",5)){
  3492.          if (comlen==4) {
  3493.             param="a";
  3494.          }
  3495.          else if (comlen==11 && !strncasecmp(param+4," append",7)) {
  3496.             param="a";
  3497.          }
  3498.          else if (comlen==12 && !strncasecmp(param+4," replace",8)) {
  3499.             param="w";
  3500.          }
  3501.          else die(Ecall);
  3502.          len=1;
  3503.          comlen=0;
  3504.       }
  3505.       else {
  3506.          for(len=0;len<comlen&¶m[len]!=','&¶m[len]!=' ';len++);
  3507.          comlen-=len+1;
  3508.          for(path=param+len+1;comlen>0&&path[0]==' ';path++,comlen--);
  3509.          if(comlen<0)comlen=0;
  3510.       }
  3511.       rxopen2(stream,param,len,path,comlen);
  3512.    }
  3513.    else if(!strcasecmp(command,"pclose")){/* syntax: "pclose" */
  3514.       char *ptr=hashsearch(1,stream,&exist);
  3515.       int rc;
  3516.       if(exist&&(info=(struct fileinfo *)(((hashent *)ptr)->value))){
  3517.          if(info->fp)rc=pclose(info->fp);
  3518.          else rc=-1;
  3519.          if(info->fp && rc<0)fclose(info->fp); /* if error, close anyway */
  3520.          free((char*)info);
  3521.          ((hashent *)ptr)->value=0;
  3522.       }
  3523.       else rc=0;
  3524.       if(rc==-1)stack("-1",2);
  3525.       else stackint((char)(rc/256));
  3526.    }
  3527.    else if(!strcasecmp(command,"popen")){ /* syntax: "popen [mode][,command]"*/
  3528.       char *cmd;
  3529.       if (isnull) die(Ecall);
  3530.       for(len=0;len<comlen&¶m[len]!=','&¶m[len]!=' ';len++);
  3531.       comlen-=len+1;
  3532.       for(cmd=param+len+1;comlen>0&&cmd[0]==' ';cmd++,comlen--);
  3533.       if(comlen<0)comlen=0;
  3534.       rxpopen2(stream,param,len,cmd,comlen);
  3535.    }
  3536.    else if(!strcasecmp(command,"query")){ /* syntax: "query <info>" */
  3537.       rxquery2(stream,info,param,comlen);
  3538.    }
  3539.    else if (!strcasecmp(command,"persistent")){ /* syntax: persistent */
  3540.       if (info) {
  3541.          info->persist=1;
  3542.          stack("0",1);
  3543.       }
  3544.       else stack("-1",2);
  3545.    }
  3546.    else if (!strcasecmp(command,"transient")) {/* syntax: transient */
  3547.       if (info) {
  3548.          info->persist=0;
  3549.          stack("0",1);
  3550.       }
  3551.       else stack("-1",2);
  3552.    }
  3553.    else die(Ecall);
  3554. }
  3555. void rxcondition(argc)
  3556. int argc;
  3557. {
  3558.    char option='I';
  3559.    char *arg;
  3560.    int len;
  3561.    int which=sgstack[interplev].which;
  3562.    if(argc>1)die(Ecall);
  3563.    if(argc){
  3564.       arg=delete(&len);
  3565.       if(len<=0)die(Ecall);
  3566.       option=arg[0]&0xdf;
  3567.    }
  3568.    switch(option){
  3569.       case 'I': arg=sgstack[interplev].type==1?"SIGNAL":"CALL";  break;
  3570.       case 'C': arg=conditions[which];                           break;
  3571.       case 'D': for(len=interplev;len>=0 && !(arg=sgstack[len].data);len--);
  3572.                                                                  break;
  3573.       case 'S': arg=sgstack[interplev].delay  &(1<<which)? "DELAY":
  3574.                     sgstack[interplev].callon &(1<<which)? "ON":
  3575.                     sgstack[interplev].bits   &(1<<which)? "ON":
  3576.                     "OFF";                                       break;
  3577.       default: die(Ecall);
  3578.    }
  3579.    if(!sgstack[interplev].type)arg=0;
  3580.    if(!arg)stack("",0);
  3581.    else stack(arg,strlen(arg));
  3582. }
  3583. static char *getstring() { /* unstack a string, check and nul-terminate it */
  3584.    char *ans;
  3585.    int len;
  3586.    ans=delete(&len);
  3587.    if (len<=1) die(Ecall);
  3588.    ans[len]=0;
  3589.    while (len--) if (!ans[len]) die(Ecall);
  3590.    return ans;
  3591. }
  3592. #define INCL_RXFUNC
  3593. #include "rexxsaa.h"
  3594. void rxfuncadd(argc)
  3595. int argc;
  3596. {
  3597.    char *entry;
  3598.    char *dll;
  3599.    char *func;
  3600.    int ans;
  3601.    int i;
  3602.    char C,c;
  3603.    if (argc!=3) die(Ecall);
  3604.    entry=getstring();
  3605.    dll=getstring();
  3606.    func=getstring();
  3607.    ans=RexxRegisterFunctionDll(func,dll,entry);
  3608.    if (ans) {
  3609.       stackint(ans);
  3610.       return;
  3611.    }
  3612.    /* Also register the uppercase of the function */
  3613.    for(i=0;(c=func[i]);i++) {
  3614.       C=uc(c);
  3615.       if (c!=C) {ans=1; func[i]=C;}
  3616.    }
  3617.    if (ans) ans=RexxRegisterFunctionDll(func,dll,entry);
  3618.    stackint(ans);
  3619. }
  3620.       
  3621. void rxfuncdrop(argc)
  3622. int argc;
  3623. {
  3624.    char *func;
  3625.    int i;
  3626.    int ans=0;
  3627.    char c,C;
  3628.    int doupper=0;
  3629.    if (argc!=1) die(Ecall);
  3630.    func=getstring();
  3631.    ans=RexxDeregisterFunction(func);
  3632.    /* also drop the uppercase of the function */
  3633.    for(i=0;(c=func[i]);i++) {
  3634.       C=uc(c);
  3635.       if (c!=C) {doupper=1; func[i]=C;}
  3636.    }
  3637.    if (doupper) ans=ans && RexxDeregisterFunction(func);
  3638.    if (ans) stack("1",1);
  3639.    else stack("0",1);
  3640. }
  3641. void rxfuncquery(argc)
  3642. int argc;
  3643. {
  3644.    char *func;
  3645.    int i;
  3646.    int ans=0;
  3647.    char c,C;
  3648.    if (argc!=1) die(Ecall);
  3649.    func=getstring();
  3650.    if (RexxQueryFunction(func)) {
  3651.       /* Also query the uppercase of the function */
  3652.       for(i=0;(c=func[i]);i++) {
  3653.          C=uc(c);
  3654.          if (c!=C) {ans=1; func[i]=C;}
  3655.       }
  3656.       if (ans) ans=RexxQueryFunction(func);
  3657.       else ans=1;
  3658.    }
  3659.    if (ans) stack("1",1);
  3660.    else stack("0",1);
  3661. }
  3662.