home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 18 REXX / 18-REXX.zip / rximc175.zip / interface.c < prev    next >
Text File  |  2002-08-06  |  42KB  |  1,257 lines
  1. /* Functions of REXX/imc relating to the SAA API     (C) Ian Collier 1994 */
  2.  
  3. #include <stdio.h>
  4. #include <stdlib.h>
  5. #include <unistd.h>
  6. #include <string.h>
  7. #include <memory.h>
  8. #include <signal.h>
  9. #include <setjmp.h>
  10. #include <sys/types.h>
  11. #include <sys/time.h>
  12. #include <sys/param.h>
  13. #include "const.h"
  14. #include "globals.h"
  15. #include "functions.h"
  16. #define INCL_REXXSAA
  17. #include "rexxsaa.h"
  18. #include <sys/socket.h>
  19. #ifdef Solaris
  20. #include <sys/uio.h>
  21. #endif
  22. #ifdef STUFF_STACK
  23. #include<sys/termios.h>
  24. #endif
  25.  
  26. struct status{        /* Saved things from a previous incarnation of REXX */
  27.       int stmt;
  28.       char trcflag,timeflag,trcresult;
  29.       char form;
  30.       int precision,fuzz;
  31.       long tsec,tmic,sec,mic;
  32.       int address0,address1,address2;
  33.       int varlevel;
  34.       char *psource;
  35.       program *prog;
  36.       int stmts;
  37.       char **source;
  38.       int lines;
  39.       char *labels;
  40.       char *cstackptr;
  41.       int ecstackptr,cstacklen;
  42.       char *pstackptr;
  43.       int epstackptr,pstacklen;
  44.       int pstacklev;
  45.       struct sigstruct *sgstack;
  46.       unsigned sigstacklen;
  47.       int interplev;
  48.       char **arg;
  49.       int *arglen;
  50.       jmp_buf *exitbuf;
  51.    };
  52.  
  53. /* list of environments for environmental functions below */
  54. struct environ *envtable;
  55. static int envtablelen=0;
  56. static int envs;
  57.  
  58. /* list of registered exits for exitary functions below */
  59. static struct exitentry{
  60.    char name[maxenviron+1];
  61.    RexxExitHandler *handler;
  62.    unsigned char *area;
  63. } *exittable;
  64. static int exitlen=0;
  65. static int exits=0;
  66.  
  67. char version[80];       /* REXX version string */
  68. char *psource;          /* the string parsed by PARSE SOURCE */
  69.  
  70. /* Starting REXX */
  71.  
  72. static int rexxdepth=0; /* nesting level of RexxStart() */
  73. static char rxque[maxvarname]; /* where to find rxque */
  74. static char rxstackholder[128];/* to hold the output of "rxque" */
  75. /* the following structure mirrors struct sockaddr, but has a longer name
  76.    field.  It is to contain the file name of the stack socket. */
  77. static struct {u_short af;char name[maxvarname];} rxsockname={AF_UNIX};
  78. static int rxsocklen;          /* the length of the above structure */
  79. static int rxstackproc=0;      /* the process number of "rxque" */
  80.  
  81. static void stackinit(rxpathname) /* sets up the stack */
  82. char *rxpathname;                 /* argv[0], if supplied */
  83. {
  84.    char *rxstackname=getenv("RXSTACK");
  85.    char *imcpath=getenv("REXXIMC");
  86.    static char _rxpath[maxvarname];
  87.    int f,l;
  88.    char *basename;
  89.    int pipefd[2];
  90.    char *answer;
  91. /* Construct the REXX auxiliary file path names if necessary */
  92.    if(!rxque[0]){
  93.       strcpy(rxque,imcpath?imcpath:REXXIMC); /* use $REXXIMC if possible, */
  94.       l=strlen(rxque);                       /* otherwise the REXXIMC macro */
  95.       rxque[l++]='/';
  96.       strcpy(rxque+l,rxquename);
  97.       if(access(rxque,X_OK)){                /* rxque does not exist. */
  98.          l=0;
  99.          if(rxpathname && strchr(rxpathname,'/')){/* Try some other directory */
  100.             strcpy(rxque,rxpathname);        /* for instance our path name */
  101.             basename=strrchr(rxque,'/')+1;
  102.             strcpy(basename,rxquename);
  103.             if(!access(rxque,X_OK))l=basename-rxque;
  104.          }
  105.          if(!l){                             /* OK, now try the entire path! */
  106.             if(!which(rxquename,-1,rxque)){
  107.                fprintf(stderr,"Unable to find \'%s\'\n",rxquename);
  108.                die(Einit);
  109.             }
  110.             l=strrchr(rxque,'/')+1-rxque;
  111.          }
  112.       }
  113.       /* libraries: if REXXLIB not set then the default is the compiled-in
  114.          value, if any, otherwise the same place where rxque was found. */
  115. #ifdef REXXLIB
  116.       if (REXXLIB[0]) rxpath=REXXLIB;
  117.       else
  118. #endif
  119.       {
  120.          rxpath=_rxpath;
  121.          memcpy(rxpath,rxque,l);
  122.          rxpath[l-1]=0;
  123.       }
  124.    }
  125. /* open the stack */
  126.    if(!rxstackname || !*rxstackname){ /* it doesn't exist already, so fork off "rxque" */
  127.       if(pipe(pipefd))perror("pipe"),die(Einit);
  128.       if((f=vfork())<0)perror("vfork"),die(Einit);
  129.       if(!f){  /* the child: attach pipe to stdout and exec rxque */
  130.          close(pipefd[0]);
  131.          if(dup2(pipefd[1],1)<0)perror("dup2"),_exit(-1);
  132.          close(pipefd[1]);
  133.          execl(rxque,"rxque",cnull);
  134.          perror(rxque);
  135.          _exit(-1);
  136.       } /* now the parent: read from pipe into rxstackholder. The answer
  137.             should be RXSTACK=(name) RXSTACKPROC=(number).  Split off the
  138.             second token, search for "=", store number in rxstackproc, and
  139.             put RXSTACK into the environment. */
  140.       close(pipefd[1]);
  141.       if(read(pipefd[0],rxstackholder,sizeof rxstackholder)<20
  142.        ||!(answer=strchr(rxstackholder,' '))
  143.        ||!(answer[0]=0,answer=strchr(answer+1,'='))
  144.        ||!(rxstackproc=atoi(answer+1)))
  145.          fputs("Cannot create stack process\n",stderr),die(Einit);
  146.       close(pipefd[0]);
  147.       rxstackname=strchr(rxstackholder,'=')+1;
  148.       putenv(rxstackholder);
  149.       wait((int*)0);     /* delete child from process table */
  150.    }  /* The stack exists. Open a socket to it. */
  151.    strcpy(rxsockname.name,rxstackname),
  152.    rxsocklen=sizeof(u_short)+strlen(rxstackname);
  153.    if((rxstacksock=socket(AF_UNIX,SOCK_STREAM,0))<0)
  154.       perror("REXX: couldn't make socket"),die(Einit);
  155.    if(connect(rxstacksock,(struct sockaddr *)&rxsockname,rxsocklen)<0)
  156.       perror("REXX: couldn't connect socket"),die(Einit);
  157. }
  158.  
  159. static void rexxterm(old)        /* Destroy the REXX data structures */
  160. struct status *old;
  161. {
  162.    if(cstackptr)free(cstackptr),cstackptr=0;
  163.    if(pstackptr)free(pstackptr),pstackptr=0;
  164.    if(sgstack)free(sgstack),sgstack=0;
  165.    if(source)
  166.       free(source[0]),      /* the file name */
  167.       free(source[1]),      /* the source characters */
  168.       free((char*)source),source=0;
  169.    if(prog)
  170.       free(prog[0].line),   /* the program characters */
  171.       free((char*)prog),prog=0;
  172.    if(labelptr)free(labelptr),labelptr=0;
  173.    if(rexxdepth==0){
  174.       if(varstk)free(varstk),varstk=0;
  175.       if(vartab)free(vartab),vartab=0;
  176.       if(hashlen[2])hashfree();/* This *shouldn't* close stdin, stdout or stderr, but
  177.                                   havoc might ensue anyway if the REXX program changed
  178.                                   them... */
  179.       if(workptr)free(workptr),workptr=0;
  180.       if(pull)free(pull),pull=0;
  181.       if(varnamebuf)free(varnamebuf),varnamebuf=0;
  182.       if(ttyin && ttyin!=stdin)fclose(ttyin),ttyin=0;
  183.       if(ttyout && ttyout!=stdout)fclose(ttyout),ttyout=0;
  184.    /* Neutralise OPTIONs */
  185.       if(traceout!=stderr)fclose(traceout),traceout=stderr;
  186.       setrcflag=0;
  187.       exposeflag=0;
  188.    }
  189.    else {
  190.       ppc=old->stmt;
  191.       trcflag=old->trcflag;
  192.       timeflag=old->timeflag;
  193.       trcresult=old->trcresult;
  194.       numform=old->form;
  195.       precision=old->precision;
  196.       fuzz=old->fuzz;
  197.       timestamp.tv_sec=old->tsec;
  198.       timestamp.tv_usec=old->tmic;
  199.       secs=old->sec;
  200.       microsecs=old->mic;
  201.       address0=old->address0;
  202.       address1=old->address1;
  203.       address2=old->address2;
  204.       varstkptr=old->varlevel;
  205.       psource=old->psource;
  206.       prog=old->prog;
  207.       stmts=old->stmts;
  208.       source=old->source;
  209.       lines=old->lines;
  210.       labelptr=old->labels;
  211.       cstackptr=old->cstackptr;
  212.       ecstackptr=old->ecstackptr;
  213.       cstacklen=old->cstacklen;
  214.       pstackptr=old->pstackptr;
  215.       epstackptr=old->epstackptr;
  216.       pstacklen=old->pstacklen;
  217.       pstacklev=old->pstacklev;
  218.       sgstack=old->sgstack;
  219.       sigstacklen=old->sigstacklen;
  220.       interplev=old->interplev;
  221.       curargs=old->arg;
  222.       curarglen=old->arglen;
  223.       exitbuf=old->exitbuf;
  224.    }
  225. }
  226.  
  227. long RexxStart(argc,argv,name,instore,envname,calltype,myexits,rc,result)
  228. long argc;
  229. PRXSTRING argv;
  230. char *name;
  231. PRXSTRING instore;
  232. char *envname;
  233. long calltype;
  234. PRXSYSEXIT myexits;
  235. short *rc;
  236. PRXSTRING result;
  237. {
  238.    /* this is just an interface for RexxStartProgram.  The extra arguments
  239.       are given as zeros. */
  240.    return RexxStartProgram((char*)0,argc,argv,name,(char*)0,instore,envname,
  241.           calltype,0,myexits,rc,result);
  242. }
  243.  
  244. long RexxStartProgram(argv0,argc,argv,name,callname,instore,envname,
  245.                       calltype,flags,myexits,rc,result)
  246. char *argv0;
  247. long argc;
  248. PRXSTRING argv;
  249. char *name;
  250. char *callname;
  251. PRXSTRING instore;
  252. char *envname;
  253. long calltype;
  254. int flags;
  255. PRXSYSEXIT myexits;
  256. short *rc;
  257. PRXSTRING result;
  258. {
  259.    char *answer;      /* result of executing the program */
  260.    int anslen;        /* length of that result */
  261.    char *input=0;     /* The source code from disk or wherever */
  262.    int ilen;          /* The length of the source code */
  263.    struct fileinfo *info; /* for initialising stdin, stdout, stderr */
  264.    char *basename;    /* basename of the program to execute */
  265.    char *tail;        /* file extension of the program */
  266.    extern char *month[]; /* from rxdate() in rxfn.c */
  267.    char **arglist=0;  /* a copy of the argument addresses */
  268.    int *arglens=0;    /* a copy of the argument lengths */
  269.    int i,j,l;
  270.    long n;
  271.    char *howcall;     /* string to represent calltype */
  272.    char sourcestring[200]; /* string for "parse source" */
  273.    int olddepth=rexxdepth;
  274.    char env[maxenviron+1]; /* a copy of the environment name */
  275.    volatile sighandler sigint,sigterm,sighup,      /* saved signal handlers */
  276.             sigquit,sigsegv,sigbus,sigill,sigpipe;
  277.    struct status old;
  278.    jmp_buf exbuf;     /* buffer for exitbuf */
  279.  
  280. /* construct version string (should be constant, but it's easier this way) */
  281.    sprintf(version,"REXX/imc-%s %s %d %s %d",VER,LEVEL,DAY,month[MONTH-1],YEAR+1900);
  282.    if(flags&RXVERSION){
  283.       puts(version);
  284.       if(flags==RXVERSION)return 0;
  285.    }
  286.  
  287. /* Argument checking */
  288.    if(instore && instore[1].strptr)
  289.       return 1;             /* no tokenised program.  May be fixed later... */
  290.    if(instore && !(instore[0].strptr && instore[0].strlength))
  291.       return 1;             /* no macros.  May possibly be fixed later... */
  292.    if(!name)
  293.       if(instore)name="anonymous";
  294.       else return 1;
  295.    if(envname && strlen(envname)>maxenviron) return 1;
  296.    if(calltype!=RXCOMMAND && calltype!=RXFUNCTION && calltype!=RXSUBROUTINE)
  297.       return 1;
  298.  
  299.    if(!(flags&RXEXITS))
  300.       for(i=0;i<RXEXITNUM;i++)exitlist[i]=0; /* prepare to set exits */
  301.    if(myexits)
  302.       for(i=0;myexits[i].sysexit_code!=RXENDLST; i++){
  303.          if(!exitlen)return RXEXIT_NOTREG;   /* unregistered exit name */
  304.          for(j=0;j<exits && strcmp(exittable[j].name,myexits[i].sysexit_name);j++);
  305.          if(j==exits || !exittable[j].handler)return RXEXIT_NOTREG;
  306.          if(myexits[i].sysexit_code>=RXEXITNUM)
  307.             return RXEXIT_BADTYPE;           /* unrecognised exit code */
  308.          exitlist[myexits[i].sysexit_code]=exittable[j].handler;
  309.       }
  310.  
  311.    if(rexxdepth){
  312.       old.stmt=ppc;
  313.       old.trcflag=trcflag;
  314.       old.timeflag=timeflag;
  315.       old.trcresult=trcresult;
  316.       old.form=numform;
  317.       old.precision=precision;
  318.       old.fuzz=fuzz;
  319.       old.tsec=timestamp.tv_sec;
  320.       old.tmic=timestamp.tv_usec;
  321.       old.sec=secs;
  322.       old.mic=microsecs;
  323.       old.address0=address0;
  324.       old.address1=address1;
  325.       old.address2=address2;
  326.       old.varlevel=varstkptr;
  327.       newlevel();
  328.       old.psource=psource;
  329.       old.prog=prog;prog=0;
  330.       old.stmts=stmts;
  331.       old.source=source;source=0;
  332.       old.lines=lines;
  333.       old.labels=labelptr;labelptr=0;
  334.       old.cstackptr=cstackptr;cstackptr=0;
  335.       old.ecstackptr=ecstackptr;
  336.       old.cstacklen=cstacklen;
  337.       old.pstackptr=pstackptr;pstackptr=0;
  338.       old.epstackptr=epstackptr;
  339.       old.pstacklen=pstacklen;
  340.       old.pstacklev=pstacklev;
  341.       old.sgstack=sgstack;sgstack=0;
  342.       old.sigstacklen=sigstacklen;
  343.       old.interplev=interplev;interplev=-1;
  344.       old.arg=curargs;
  345.       old.arglen=curarglen;
  346.       old.exitbuf=exitbuf;exitbuf=addressof(exbuf);
  347.    }
  348.    else{
  349.       interplev=-1;
  350.       exitbuf=addressof(exbuf);
  351.    }
  352.    if(!envtablelen)envinit();
  353.    if(!hashlen[2]){
  354.       for(i=0;i<3;i++)hashptr[i]=allocm(hashlen[i]=256),ehashptr[i]=0;
  355.       if(!hashlen[2])return Emem;
  356.    }
  357.  
  358.    if((i=setjmp(*exitbuf))){    /* catch error during setup */
  359.       rexxterm(&old);
  360.       return i>0 ? i : -i;
  361.    }
  362.  
  363. /* Initialise all the global variables */
  364.    if (traceout==0) traceout=stderr;
  365.    if(rexxdepth==0){
  366.       stackinit(argv0);
  367.       varstk=(int *)allocm(varstklen=256),
  368.       varstkptr=0,
  369.       varstk[0]=varstk[1]=0,
  370.       vartab=allocm(vartablen=1024);
  371.       worklen=maxvarname+10,
  372.       workptr=allocm(worklen),
  373.       pull=allocm(pulllen=256),
  374.       varnamebuf=allocm(varnamelen=maxvarname);
  375.       if(!(ttyin=fopen("/dev/tty","r")))ttyin=stdin;
  376.       if(!(ttyout=fopen("/dev/tty","w")))ttyout=stderr;
  377.       (info=fileinit("stdin",cnull,stdin))->lastwr=0; /* set up stdin */
  378.       info->rdpos=info->wrpos;    /* wrpos has been set to the current position */
  379.       info->rdline=info->wrline;  /* now rdpos will be there as well */
  380.       fileinit("stdout",cnull,stdout)->wr=-1; /* set up stdout and stderr */
  381.       fileinit("stderr",cnull,stderr)->wr=-1; /* for writing */
  382.    }
  383.    cstackptr=allocm(cstacklen=256),
  384.    ecstackptr=0,
  385.    pstackptr=allocm(pstacklen=512),
  386.    pstacklev=epstackptr=0,
  387.    sgstack=(struct sigstruct *)malloc(sizeof(struct sigstruct)*(sigstacklen=20));
  388.    if(!(flags&RXDIGITS))precision=9;
  389.    fuzz=9;
  390.    numform=0;
  391.    trcresult=0;
  392.    timeflag&=4;
  393.    if(!(flags&RXMAIN))trcflag=Tfailures;
  394.    psource=sourcestring;
  395.  
  396.    if((i=setjmp(*exitbuf))){
  397.       if(i!=Esig && exitlist[RXTER])exitcall(RXTER,RXTEREXT,(PEXIT)0);
  398.       goto RexxEnd; /* catch execution errors */
  399.    }
  400. #define sigsetup(var,sig,handler) if((var=signal(sig,handler))!=SIG_DFL)\
  401.                                      signal(sig,var);
  402.    sigsetup(sigint,SIGINT,halt_handler);
  403.    sigsetup(sigterm,SIGTERM,halt_handler);
  404.    sigsetup(sighup,SIGHUP,halt_handler);
  405.    sigsetup(sigquit,SIGQUIT,sigtrace);
  406.    /* the following are set even if handlers already exist for them */
  407.    sigpipe=signal(SIGPIPE,pipe_handler);
  408.    sigsegv=signal(SIGSEGV,error_handler);
  409.    sigbus=signal(SIGBUS,error_handler);
  410.    sigill=signal(SIGILL,error_handler);
  411. #undef sigsetup
  412.  
  413. /* Get the program's details and load it */
  414.    if((basename=strrchr(name,'/')))basename++;
  415.    else basename=name;           /* basename points to the file's name */
  416.    if((tail=strrchr(basename,'.'))&&strlen(tail)<maxextension&&tail[1])
  417.       strcpy(extension,tail);       /* this will be the default extension */
  418.    else strcpy(extension,rexxext()); /* if none, use the system default */
  419.    extlen=strlen(extension);
  420.    if(instore){
  421.       input=allocm(ilen=instore[0].strlength);
  422.       memcpy(input,instore[0].strptr,ilen);
  423.       strcpy(fname,name);
  424.    }
  425.    else{
  426.       if(which(name,(flags&RXOPTIONX) || !(flags&RXMAIN),fname)!=1) /* search for the file */
  427.          errordata=fname,die(-3);      /* error - not found */
  428.       if(!(input=load(fname,&ilen)))
  429.          errordata=fname,die(-3);      /* Error - could not load file */
  430.    }
  431.    tokenise(input,ilen,0,flags&RXOPTIONX);
  432.    source[0]=allocm(strlen(fname)+1);
  433.    strcpy(source[0],fname);
  434. /* construct source string (one per invocation of RexxStart) */
  435.    howcall=(calltype&RXSUBROUTINE)?"SUBROUTINE":
  436.            (calltype&RXFUNCTION)?"FUNCTION":
  437.            "COMMAND";
  438.    if(!envname){
  439.       envname=env;
  440.       if(tail && tail[1] && strlen(tail)<=maxenviron){
  441.          for(i=0;tail[i+1];i++)env[i]=uc(tail[i+1]);
  442.          env[i]=0;
  443.       }
  444.       else strcpy(env,"UNIX");
  445.    }
  446.    address2=address1=address0=envsearch(envname);
  447.    if(address1<0)die(Emem);
  448.    if(callname)basename=callname;
  449.    sprintf(psource,"UNIX %s %s %s %s",howcall,source[0],basename,envname);
  450. /* call the interpreter */
  451.    arglist=(char**)allocm((argc+1)*sizeof(char*));
  452.    arglens=(int*)allocm((argc+1)*four);
  453.    for(i=0;i<argc;i++){
  454.       arglist[i]=argv[i].strptr,
  455.       arglens[i]=argv[i].strlength;
  456.       if(!arglist[i])arglist[i]=(char*)-1,arglens[i]=-1;
  457.    }
  458.    arglist[argc]=0;
  459.    arglens[argc]=0;
  460.  
  461.    interplev=0;
  462.    rexxdepth++;
  463.    if(exitlist[RXINI])exitcall(RXINI,RXINIEXT,(PEXIT)0);
  464.    answer=interpreter(&anslen,1,basename,calltype,arglist,arglens,0,0);
  465.    if(exitlist[RXTER])exitcall(RXTER,RXTEREXT,(PEXIT)0);
  466.    rexxdepth--;
  467.    if (rc) *rc=1<<15;
  468.    i=answer && anslen && answer[0]=='-';
  469.    if(answer && anslen>i){
  470.       for(n=0;i<anslen;i++){
  471.          if(answer[i]<'0' || answer[i]>'9'){i=0;break;}
  472.          n=n*10+answer[i]-'0';
  473.          if(n<0 || n>=(1<<15)){i=0;break;}
  474.       }
  475.       if (i>0 && rc) *rc = answer[0]=='-' ? -n : n;
  476.       else if(flags&RXMAIN) /* environment raises an error for non-integer */
  477.          interplev=-1,die(Enonint);
  478.    }
  479.    if(result){
  480.       if(!answer)
  481.          result->strptr=0,
  482.          result->strlength=0;
  483.       else {
  484.          if(!result->strptr || result->strlength<anslen){
  485.             if((result->strptr=malloc(anslen)))result->strlength=anslen;
  486.             else result->strlength=0;
  487.          }
  488.          else result->strlength=anslen;
  489.          if(result->strptr)memcpy(result->strptr,answer,anslen);
  490.       }
  491.    }
  492.    i=0;
  493. RexxEnd:
  494.    if(arglist)free(arglist);
  495.    if(arglens)free(arglens);
  496.    if(!(rexxdepth=olddepth)){
  497.       if(rxstackproc){
  498. #ifdef STUFF_STACK
  499.          while(flags&RXMAIN){ /* either nop or infinite loop */
  500.             if(i || write(rxstacksock,"G",1)<1 || /* don't copy if an error */
  501.                     read(rxstacksock,pull,7)<7 || /* has occurred or the    */
  502.                     !memcmp(pull,"FFFFFF",6)) break; /* stack is empty      */
  503.             sscanf(pull,"%x",&l);
  504.             while(l--&&
  505.                   read(rxstacksock,pull,1) &&
  506.                   0==ioctl(fileno(ttyin),TIOCSTI,pull)); /* Stuff one character */
  507.             if(l>=0)break;
  508.             pull[0]='\n';               /* a return at the end of each line */
  509.             if(ioctl(fileno(ttyin),TIOCSTI,pull)) break;
  510.          }
  511. #endif
  512.          kill(rxstackproc,SIGTERM);
  513.          putenv("RXSTACK=");
  514.       }
  515.       close(rxstacksock);
  516.    }
  517.    rexxterm(&old);   /* put everything back as it was */
  518.    /* restore signal handlers to their previous values */
  519.    signal(SIGINT,sigint);
  520.    signal(SIGTERM,sigterm);
  521.    signal(SIGHUP,sighup);
  522.    signal(SIGQUIT,sigquit);
  523.    signal(SIGSEGV,sigsegv);
  524.    signal(SIGBUS,sigbus);
  525.    signal(SIGILL,sigill);
  526.    signal(SIGPIPE,sigpipe);
  527.    return -i;
  528. }
  529.  
  530. /* Here are the signal handlers. */
  531. /* Each halt signal (SIGINT, SIGHUP, SIGTERM) is handled by recording it.    */
  532. /* SIGHUP and SIGTERM are more forceful signals; too many of them terminates */
  533. /* the interpreter.                                                          */
  534. static void halt_handler(sig)
  535. int sig;
  536. {
  537.    signal(sig,halt_handler);   /* required on SysV */
  538.    on_halt();                  /* Find the line number at which halt occurred */
  539.    delayed[Ihalt]++;
  540.    switch(sig){
  541.       case SIGINT: sigdata[Ihalt]="SIGINT"; putc('\n',ttyout); break;
  542.       case SIGHUP: sigdata[Ihalt]="SIGHUP"; break;
  543.       default:     sigdata[Ihalt]="SIGTERM";
  544.    }
  545.    if(sig!=SIGINT && delayed[Ihalt]>2)
  546.       fputs("Emergency stop\n",ttyout),
  547.       longjmp(*exitbuf,Esig);
  548. }
  549.  
  550. /* SIGPIPE causes the interpreter to stop immediately unless */
  551. /* OPTIONS SIGPIPE was specified, in which case it is just   */
  552. /* ignored (the write or flush will return an error).        */
  553. static void pipe_handler(sig)/*ARGSUSED*/
  554. int sig;
  555. {
  556.    if (!sigpipeflag) error_handler(sig);
  557.    signal(sig,pipe_handler);    /* required on SysV */
  558. }
  559.  
  560. /* SIGSEGV, SIGBUS, and SIGILL cause the interpreter to stop */
  561. /* immediately.  This may also be called for SIGPIPE above.  */
  562. static void error_handler(sig)
  563. int sig;
  564. {
  565.    signal(sig,error_handler);   /* required on SysV */
  566.    switch(sig){
  567.       case SIGSEGV: fputs("Segmentation fault",ttyout); break;
  568.       case SIGBUS:  fputs("Bus error",ttyout); break;
  569.       case SIGILL:  fputs("Illegal instruction",ttyout);
  570.    }
  571.    if(sig!=SIGPIPE) fputs(" (cleaning up)\n",ttyout);
  572.    longjmp(*exitbuf,Esig);
  573. }
  574.  
  575. /* A SIGQUIT is handled by going to interactive trace */
  576. /* mode, or by stopping immediately.  Only stop if we */
  577. /* have already tried to interrupt the program.       */
  578. static void sigtrace(sig)
  579. int sig;
  580. {
  581.    signal(sig,sigtrace);   /* required on SysV */
  582.    fputs("\b\b  \b\b",ttyout);
  583.    fflush(ttyout);
  584.    if(delayed[Ihalt] && (trcflag&Tinteract)){
  585.       fputs("Emergency stop\n",ttyout);
  586.       longjmp(*exitbuf,Esig);
  587.    }
  588.    trcflag=Tinteract|Tclauses|Tlabels|Tresults;
  589.    interactmsg=1;
  590. }
  591.  
  592. /* Subcommand environment handling routines */
  593.  
  594. /* Environments will be held in a table of names and addresses (above) */
  595. /* Initially the environments are UNIX, SYSTEM, COMMAND and PATH. */
  596. /* Environment UNIX or SYSTEM gives the command to a Bourne Shell. */
  597. static unsigned long unixhandler(command,flags,returnval)
  598. RXSTRING *command;
  599. unsigned short *flags;
  600. RXSTRING *returnval;
  601. {
  602.    int ret;
  603.    char *cmd=command->strptr;
  604.    *flags=RXSUBCOM_ERROR;
  605.    cmd[command->strlength]=0; /* there should always be room for this kludge */
  606.    ret=(char)(system(cmd)/256);
  607.    if(ret==1 || ret<0)*flags=RXSUBCOM_FAILURE;
  608.    else if(ret==0)*flags=RXSUBCOM_OK;
  609.    sprintf(returnval->strptr,"%d",ret);
  610.    returnval->strlength=strlen(returnval->strptr);
  611.    return 0;
  612. }
  613.  
  614. /* Environment COMMAND or PATH gives the command to the builtin shell. */
  615. static unsigned long commandhandler(command,flags,returnval)
  616. RXSTRING *command;
  617. unsigned short *flags;
  618. RXSTRING *returnval;
  619. {
  620.    int ret;
  621.    char *cmd=command->strptr;
  622.    *flags=RXSUBCOM_ERROR;
  623.    cmd[command->strlength]=0;
  624.    ret=shell(cmd);
  625.    if(ret<0)*flags=RXSUBCOM_FAILURE;
  626.    else if(ret==0)*flags=RXSUBCOM_OK;
  627.    sprintf(returnval->strptr,"%d",ret);
  628.    returnval->strlength=strlen(returnval->strptr);
  629.    return 0;
  630. }
  631.  
  632. /* All other environments just return -3 with FAILURE. */
  633. static unsigned long defaulthandler(command,flags,returnval)
  634. RXSTRING *command;
  635. unsigned short *flags;
  636. RXSTRING *returnval;
  637. {
  638.    *flags=RXSUBCOM_FAILURE;
  639.    returnval->strlength=2;
  640.    returnval->strptr[0]='-';
  641.    returnval->strptr[1]='3';
  642.    return 0;
  643. }
  644.  
  645. /* The initial environments are registered. */
  646. void envinit()
  647. {
  648.    envtable=(struct environ *)allocm((envtablelen=16)*sizeof(struct environ));
  649.    envs=0;
  650.    RexxRegisterSubcomExe("UNIX",unixhandler,NULL);
  651.    RexxRegisterSubcomExe("SYSTEM",unixhandler,NULL);
  652.    RexxRegisterSubcomExe("COMMAND",commandhandler,NULL);
  653.    RexxRegisterSubcomExe("PATH",commandhandler,NULL);
  654. }
  655.  
  656. /* This function returns a number for each environment name.  The name
  657.    must be null terminated and within the length limits.  A negative
  658.    answer means a memory error. */
  659. int envsearch(name)
  660. char *name;
  661. {
  662.    int i;
  663.    struct environ *tmp;
  664.    for(i=0;i<envs;i++) if(!strcmp(envtable[i].name,name))return i;
  665.    /* if the name is not found, make an undefined environment. */
  666.    if(++envs==envtablelen){
  667.       envtablelen+=16;
  668.       tmp=(struct environ *)realloc(envtable,envtablelen*sizeof(struct environ));
  669.       if(!tmp){
  670.          envtablelen-=16;
  671.          return -1;
  672.       }
  673.       envtable=tmp;
  674.    }
  675.    strcpy(envtable[i].name,name);
  676.    envtable[i].handler=defaulthandler;
  677.    envtable[i].area=0;
  678.    envtable[i].defined=0;
  679.    return i;
  680. }
  681.  
  682. /* And now the three API calls: */
  683. unsigned long RexxRegisterSubcomExe(name,handler,area)
  684. char *name;
  685. RexxSubcomHandler *handler;
  686. unsigned char *area;
  687. {
  688.    int i;
  689.    if(!envtablelen)envinit();
  690.    if(strlen(name)>maxenviron)return RXSUBCOM_BADTYPE;
  691.    i=envsearch(name);
  692.    if(i<0)return RXSUBCOM_NOEMEM;
  693.    if(envtable[i].defined)return RXSUBCOM_NOTREG;
  694.    envtable[i].handler=handler;
  695.    envtable[i].area=area;
  696.    envtable[i].defined=1;
  697.    return RXSUBCOM_OK;
  698. }
  699.  
  700. unsigned long RexxDeregisterSubcom(name,mod)
  701. char *name,*mod;
  702. {
  703.    int ans=RXSUBCOM_OK;
  704.    int i;
  705.    if(strlen(name)>maxenviron)return RXSUBCOM_BADTYPE;
  706.    if(!envtablelen)return RXSUBCOM_NOTREG;
  707.    i=envsearch(name);
  708.    if(i<0)return RXSUBCOM_NOTREG;
  709.    if(!envtable[i].defined)ans=RXSUBCOM_NOTREG;
  710.    else{
  711.       envtable[i].handler=defaulthandler;
  712.       envtable[i].area=0;
  713.       envtable[i].defined=0;
  714.    }
  715.    while(envs && !envtable[envs-1].defined)envs--;  /* reclaim unused entries */
  716.    return ans;
  717. }
  718.  
  719. unsigned long RexxQuerySubcom(name,mod,flag,area)
  720. char *name,*mod;
  721. unsigned short *flag;
  722. unsigned char *area;
  723. {
  724.    int ans=RXSUBCOM_OK;
  725.    int i;
  726.    if(flag)*flag=RXSUBCOM_NOTREG;
  727.    if(strlen(name)>maxenviron)return RXSUBCOM_BADTYPE;
  728.    if(!envtablelen)return RXSUBCOM_NOTREG;
  729.    i=envsearch(name);
  730.    if(i<0)return RXSUBCOM_NOTREG;
  731.    if(!envtable[i].defined)ans=RXSUBCOM_NOTREG;
  732.    if(i==envs-1)envs--;
  733.    else if(area && envtable[i].area)memcpy(area,envtable[i].area,8);
  734.    else if(area)memset(area,0,8);
  735.    if(flag)*flag=ans;
  736.    return ans;
  737. }
  738.  
  739. /* Call environment number num with command cmd of length len and
  740.    return the result ans of length anslen.  The return value is
  741.    0 for OK, otherwise Eerror or Efailure.  Note: cmd must have a
  742.    writeable byte after it. */
  743. int envcall(num,cmd,len,ans,anslen)
  744. int num,len,*anslen;
  745. char *cmd,**ans;
  746. {
  747.    unsigned short rc;
  748.    static char data[RXRESULTLEN];
  749.    RXSTRING input,output;
  750.    RXCMDHST_PARM rxcmd;
  751.    input.strptr=cmd;
  752.    input.strlength=len;
  753.    cmd[len]=0;
  754.    MAKERXSTRING(output,data,RXRESULTLEN);
  755.    if(exitlist[RXCMD]){
  756.       rxcmd.rxcmd_address=envtable[num].name;
  757.       rxcmd.rxcmd_addressl=strlen(envtable[num].name);
  758.       rxcmd.rxcmd_dll_len=0;
  759.       rxcmd.rxcmd_command=input;
  760.       rxcmd.rxcmd_retc=output;
  761.       if(exitcall(RXCMD,RXCMDHST,&rxcmd)==RXEXIT_HANDLED){
  762.          rc=0;
  763.          if(rxcmd.rxcmd_flags.rxfcfail)rc=Efailure;
  764.          else if(rxcmd.rxcmd_flags.rxfcerr)rc=Eerror;
  765.          if(!output.strptr){
  766.             *ans="0";
  767.             *anslen=1;
  768.          } else {
  769.             *ans=output.strptr;
  770.             *anslen=output.strlength;
  771.             if(output.strptr!=data){
  772.                /* The string is user-allocated.  Let's put it on the
  773.                   calculator stack... */
  774.                stack(*ans,*anslen);
  775.                *ans=delete(anslen);
  776.                free(output.strptr);
  777.             }
  778.          }
  779.          return rc;
  780.       }
  781.    }
  782.    envtable[num].handler(&input,&rc,&output);
  783.    if(!output.strptr){
  784.       *ans="0";
  785.       *anslen=1;
  786.    }
  787.    else{
  788.       *ans=output.strptr;
  789.       *anslen=output.strlength;
  790.       if(output.strptr!=data){
  791.          /* The string is user-allocated.  Let's put it on the
  792.             calculator stack... */
  793.          stack(*ans,*anslen);
  794.          *ans=delete(anslen);
  795.          free(output.strptr);
  796.       }
  797.    }
  798.    if(rc==RXSUBCOM_OK)return 0;
  799.    if(rc==RXSUBCOM_FAILURE)return Efailure;
  800.    return Eerror;
  801. }
  802.  
  803. /* The RexxVariablePool request interpreter. */
  804. unsigned long RexxVariablePool(request)
  805. SHVBLOCK *request;
  806. {
  807.    extern varent *nextvar;               /* next variable for RXSHV_NEXTV */
  808.    static varent *endvars=0;             /* upper limit of nextvar */
  809.    static varent *nexttail=0;            /* next tail for RXSHV_NEXTV */
  810.    static varent *endtails=0;            /* upper limit of nexttail */
  811.    varent *thisvar;
  812.    unsigned long ret=0;
  813.    char *name;
  814.    int namelen;
  815.    int i;
  816.    int nlen;
  817.    char *nptr;
  818.    int vallen;
  819.    char *valptr;
  820.    int lev;
  821.    if(rexxdepth==0)return RXSHV_NOAVL;
  822.    for(;request;ret|=request->shvret,request=request->shvnext){
  823.       name=request->shvname.strptr;
  824.       namelen=request->shvname.strlength;
  825.       request->shvret=0;
  826.       switch(request->shvcode){ /* variable name massaging */
  827.          case RXSHV_SYFET:
  828.          case RXSHV_SYDRO:      /* turn symbolic into direct */
  829.          case RXSHV_SYSET:
  830.             mtest(workptr,worklen,namelen+1,namelen+1-worklen);
  831.             for(i=0;i<namelen;i++)workptr[i]=uc(name[i]);
  832.             workptr[namelen]=0;
  833.             i=0;
  834.             getvarname(workptr,&i,varnamebuf,&nlen,varnamelen);
  835.             if(nlen==0 || i!=namelen) request->shvret=RXSHV_BADN;
  836.             else name=varnamebuf,namelen=nlen;
  837.             break;
  838.          case RXSHV_DROPV:  /* check variable and set compound/stem bits */
  839.          case RXSHV_FETCH:
  840.          case RXSHV_SET:
  841.             mtest(workptr,worklen,namelen,namelen-worklen);
  842.             memcpy(workptr,name,namelen);
  843.             for(i=0;i<namelen&&name[i]!='.';i++)
  844.                if(!rexxsymbol(name[i])){
  845.                   request->shvret=RXSHV_BADN;
  846.                   break;
  847.                }
  848.             if(rexxsymbol(name[0])<0){
  849.                request->shvret=RXSHV_BADN;
  850.                break;
  851.             }
  852.             if(i<namelen){
  853.                workptr[0]|=128;
  854.                if(i==namelen-1)namelen--;
  855.             }
  856.             name=workptr;
  857.       }
  858.       if(request->shvret)continue;
  859.       switch(request->shvcode){
  860.          /* FIXME: It is impossible for RXSHV_NEWV or RXSHV_MEMFL to
  861.             be returned for a set or drop operation. */
  862.          case RXSHV_DROPV:
  863.          case RXSHV_SYDRO:
  864.             nextvar=0;
  865.             varset(name,namelen,0,-1); 
  866.             break;
  867.          case RXSHV_SET:
  868.          case RXSHV_SYSET:
  869.             nextvar=0;
  870.             varset(name,namelen,request->shvvalue.strptr,
  871.                    request->shvvalue.strlength);
  872.             break;
  873.          case RXSHV_FETCH:
  874.          case RXSHV_SYFET: 
  875.             nextvar=0;
  876.             valptr=varget(name,namelen,&vallen);
  877.             if(!valptr)
  878.                name[0]&=127,
  879.                valptr=name,
  880.                vallen=namelen,
  881.                request->shvret=RXSHV_NEWV;
  882.             if(!request->shvvalue.strptr){
  883.                request->shvvalue.strptr=malloc(vallen);
  884.                if(!request->shvvalue.strptr){
  885.                   request->shvret|=RXSHV_MEMFL;
  886.                   break;
  887.                }
  888.                else request->shvvalue.strlength=request->shvvaluelen=vallen;
  889.             } else {
  890.                if(vallen>request->shvvaluelen)
  891.                   vallen=request->shvvaluelen,request->shvret|=RXSHV_TRUNC;
  892.                request->shvvalue.strlength=vallen;
  893.             }
  894.             memcpy(request->shvvalue.strptr,valptr,vallen);
  895.             break;
  896.          case RXSHV_NEXTV:
  897.          case_RXSHV_NEXTV:
  898.             if(!nextvar){
  899.                nexttail=0;
  900.                nextvar=(varent*)(vartab+varstk[varstkptr]);
  901.                endvars=(varent*)(vartab+varstk[varstkptr+1]);
  902.             }
  903.             if(nexttail && nexttail>=endtails){
  904.                nexttail=0;
  905.                nextvar=(varent*)((char*)nextvar+nextvar->next);
  906.             }
  907.             if(!nexttail && nextvar>=endvars){
  908.                request->shvret=RXSHV_LVAR;
  909.                break;
  910.             }
  911.             nlen=nextvar->namelen;
  912.             mtest(workptr,worklen,nlen,nlen-worklen+256);
  913.             memcpy(workptr,nptr=(char*)(nextvar+1),nlen);
  914.             if(!nexttail){
  915.                if(!(workptr[0]&128)){
  916.                   thisvar=nextvar;
  917.                   nextvar=(varent*)((char*)nextvar+nextvar->next);
  918.                   if((lev=-(thisvar->valalloc))>0)
  919.                      thisvar=(varent*)varsearch(nptr,nlen,&lev,&i);
  920.                   if(thisvar->vallen<0)goto case_RXSHV_NEXTV;
  921.                   vallen=thisvar->vallen;
  922.                   valptr=(char*)(thisvar+1)+align(thisvar->namelen);
  923.                   nptr=workptr;
  924.                }
  925.                else {
  926.                   thisvar=nextvar;
  927.                   if((lev=-(thisvar->valalloc))>0)
  928.                      thisvar=(varent*)varsearch(nptr,nlen,&lev,&i);
  929.                   valptr=(char*)(thisvar+1)+align(thisvar->namelen);
  930.                   vallen=((int*)valptr)[1];
  931.                   nexttail=(varent*)(valptr+((int*)valptr)[0]+2*four);
  932.                   endtails=(varent*)((char*)(thisvar+1)
  933.                           +align(thisvar->namelen)+thisvar->vallen);
  934.                   if(vallen>=0){
  935.                      valptr+=2*four;
  936.                      workptr[nlen++]='.';
  937.                      workptr[0]&=127;
  938.                      nptr=workptr;
  939.                   }
  940.                   else valptr=0;
  941.                }
  942.             }
  943.             else valptr=0;
  944.             if(!valptr){
  945.                workptr[nlen++]='.';
  946.                nptr=(char*)(nexttail+1);
  947.                i=nexttail->namelen;
  948.                mtest(workptr,worklen,i+nlen,i+nlen-worklen);
  949.                memcpy(workptr+nlen,nptr,i);
  950.                nlen+=i;
  951.                thisvar=nexttail;
  952.                nexttail=(varent*)((char *)nexttail+nexttail->next);
  953.                if((lev=-(thisvar->valalloc))>0)
  954.                   thisvar=(varent*)valuesearch(workptr,nlen,&lev,&i,&valptr);
  955.                workptr[0]&=127;
  956.                valptr=(char*)(thisvar+1)+align(thisvar->namelen);
  957.                vallen=thisvar->vallen;
  958.                if(vallen<0)goto case_RXSHV_NEXTV;
  959.                nptr=workptr;
  960.             }
  961.             if(!request->shvname.strptr){
  962.                request->shvname.strptr=malloc(request->shvnamelen=nlen);
  963.                if(!request->shvname.strptr){
  964.                   request->shvret=RXSHV_MEMFL;
  965.                   break;
  966.                }
  967.             }
  968.             if(nlen>request->shvnamelen){
  969.                request->shvret=RXSHV_TRUNC;
  970.                nlen=request->shvnamelen;
  971.             }
  972.             memcpy(request->shvname.strptr,nptr,nlen);
  973.             request->shvname.strlength=nlen;
  974.             if(!request->shvvalue.strptr){
  975.                request->shvvalue.strptr=malloc(request->shvvaluelen=vallen);
  976.                if(!request->shvvalue.strptr){
  977.                   request->shvret|=RXSHV_MEMFL;
  978.                   break;
  979.                }
  980.             }
  981.             if(vallen>request->shvvaluelen){
  982.                request->shvret=RXSHV_TRUNC;
  983.                vallen=request->shvvaluelen;
  984.             }
  985.             memcpy(request->shvvalue.strptr,valptr,vallen);
  986.             request->shvvalue.strlength=vallen;
  987.             break;
  988.          default: request->shvret=RXSHV_BADF;
  989.       }
  990.    }
  991.    return ret;
  992. }
  993.  
  994. /* Call a Unix program as a REXX function */
  995. int unixcall(name,callname,argc)
  996. char *name,*callname;
  997. int argc;
  998. {
  999.    static char *argv[2+maxargs];
  1000.    int i;
  1001.    int l;
  1002.    int pid;
  1003.    int fd[2];
  1004.    char *ptr;
  1005.    for(i=argc;i>0;i--){
  1006.       argv[i]=delete(&l);
  1007.       if(l<0)argv[i]="";
  1008.       else argv[i][l]=0;
  1009.    }
  1010.    argv[0]=callname;
  1011.    argv[argc+1]=0;
  1012.    if(pipe(fd))perror("REXX: couldn't make a pipe"),die(Esys);
  1013.    if((pid=vfork())<0)perror("REXX: couldn't vfork"),die(Esys);
  1014.    if(!pid){  /* child: attach pipe to stdout and exec the function */
  1015.       close(fd[0]);
  1016.       if(dup2(fd[1],1)<0)perror("REXX: couldn't dup2"),_exit(-1);
  1017.       close(fd[1]);
  1018.       execv(name,argv);
  1019.       perror(name);
  1020.       _exit(-1);
  1021.    }  /* parent: read the result and stack it */
  1022.    close(fd[1]);
  1023.    i=0;
  1024.    ptr=cstackptr+ecstackptr;
  1025.    while(read(fd[0],cstackptr+ecstackptr+i,1)==1){
  1026.       i++;
  1027.       mtest(cstackptr,cstacklen,ecstackptr+i+2*four,256);
  1028.    }
  1029.    close(fd[0]);
  1030.    waitpid(pid,&l,0);         /* delete child from process table */
  1031.    if(i==0 && l==0xff00)die(Eincalled); /* catch one of the above exit(-1)s */
  1032.    if(i==0)return 0;
  1033.    ptr=cstackptr+ecstackptr;
  1034.    if(ptr[i-1]=='\n')i--;     /* knock off a trailing newline */
  1035.    l=align(i);
  1036.    *(int*)(ptr+l)=i;
  1037.    ecstackptr+=l+four;
  1038.    return 1;
  1039. }
  1040.  
  1041. /* API-supplied REXX functions */
  1042. int funccall(func,name,argc)  /* call function with SAA calling sequence. */
  1043. unsigned long (*func)();      /* funccall() has builtin calling sequence. */
  1044. char *name;
  1045. int argc;
  1046. {
  1047.    static RXSTRING argv[maxargs];
  1048.    static char data[RXRESULTLEN];
  1049.    RXSTRING result;
  1050.    unsigned long i;
  1051.    int j;
  1052.    int l;
  1053.    for(j=argc-1;j>=0;j--){
  1054.       argv[j].strptr=delete(&l);
  1055.       if(l<0)argv[j].strptr=0,argv[j].strlength=0;
  1056.       else argv[j].strptr[argv[j].strlength=l]=0;
  1057.    }
  1058.    MAKERXSTRING(result,data,RXRESULTLEN);
  1059.    i=func(name,argc,argv,"SESSION",&result);
  1060.    if(i)return -Ecall;
  1061.    if(!result.strptr)return 0;
  1062.    stack(result.strptr,result.strlength);
  1063.    if(result.strptr!=data)free(result.strptr);
  1064.    return 1;
  1065. }
  1066.  
  1067. unsigned long RexxRegisterFunctionDll(name,dllname,entryname)
  1068. char *name;
  1069. char *dllname;
  1070. char *entryname;
  1071. {
  1072.    funcinfo *info;
  1073.    int l,exist;
  1074.    void **slot;
  1075.    void *handle;
  1076.    void *address;
  1077.    static char path[MAXPATHLEN];
  1078. #ifdef NO_LDL
  1079.    return RXFUNC_NOTREG;
  1080. #else
  1081.    if(!hashlen[2]){
  1082.       for(l=0;l<3;l++)hashptr[l]=allocm(hashlen[l]=256),ehashptr[l]=0;
  1083.       if(!hashlen[2])return RXFUNC_NOMEM;
  1084.    }
  1085.    exist=which(dllname,3,path);
  1086.    if (!exist) return RXFUNC_NOTREG;
  1087.    handle=dlopen(path,1);
  1088.    if (!handle) return RXFUNC_NOTREG;
  1089. #ifdef _REQUIRED
  1090.    if (strlen(entryname)+2>sizeof path) return RXFUNC_NOMEM;
  1091.    strcpy(path+1,entryname);
  1092.    path[0]='_';
  1093.    entryname=path;
  1094. #endif
  1095.    address=dlsym(handle,entryname);
  1096.    if (!address) return RXFUNC_NOTREG;
  1097.    slot=hashfind(2,name,&exist);
  1098.    if(exist&&*slot){
  1099.       if(((funcinfo *)*slot)->dlfunc)return RXFUNC_DEFINED;
  1100.       free((char*)*slot); /* it was only a hashed file name */
  1101.    }
  1102.    info=(funcinfo *)malloc(sizeof(funcinfo));
  1103.    if(!info)return RXFUNC_NOMEM;
  1104.    *slot=(void *)info;
  1105.    info->dlhandle=handle;
  1106.    info->dlfunc=(int(*)())address;
  1107.    info->saa=1;
  1108.    return RXFUNC_OK;
  1109. #endif
  1110. }
  1111.  
  1112. unsigned long RexxRegisterFunctionExe(name,address)
  1113. char *name;
  1114. RexxFunctionHandler *address;
  1115. {
  1116.    funcinfo *info;
  1117.    int l,exist;
  1118.    void **slot;
  1119.    if(!hashlen[2]){
  1120.       for(l=0;l<3;l++)hashptr[l]=allocm(hashlen[l]=256),ehashptr[l]=0;
  1121.       if(!hashlen[2])return RXFUNC_NOMEM;
  1122.    }
  1123.    slot=hashfind(2,name,&exist);
  1124.    if(exist&&*slot){
  1125.       if(((funcinfo *)*slot)->dlfunc)return RXFUNC_DEFINED;
  1126.       free((char*)*slot); /* it was only a hashed file name */
  1127.    }
  1128.    info=(funcinfo *)malloc(sizeof(funcinfo));
  1129.    if(!info)return RXFUNC_NOMEM;
  1130.    *slot=(void *)info;
  1131.    info->dlhandle=0;
  1132.    info->dlfunc=(int(*)())address;
  1133.    info->saa=1;
  1134.    return RXFUNC_OK;
  1135. }
  1136.  
  1137. unsigned long RexxDeregisterFunction(name)
  1138. char *name;
  1139. {
  1140.    int exist;
  1141.    hashent *ptr;
  1142.    if(!hashlen[2])return RXFUNC_NOTREG;
  1143.    ptr=(hashent *)hashsearch(2,name,&exist);
  1144.    if(!(exist && ptr->value))return RXFUNC_NOTREG;
  1145.    if(!(((funcinfo*)ptr->value)->dlfunc))
  1146.       return RXFUNC_NOTREG;  /* it was only a hashed file name */
  1147.    free(ptr->value);
  1148.    ptr->value=0;
  1149.    return RXFUNC_OK;
  1150. }
  1151.  
  1152. unsigned long RexxQueryFunction(name)
  1153. char *name;
  1154. {
  1155.    int exist;
  1156.    hashent *ptr;
  1157.    if(!hashlen[2])return RXFUNC_NOTREG;
  1158.    ptr=(hashent *)hashsearch(2,name,&exist);
  1159.    if(!(exist && ptr->value))return RXFUNC_NOTREG;
  1160.    if(!(((funcinfo*)ptr->value)->dlfunc))
  1161.       return RXFUNC_NOTREG;  /* it was only a hashed file name */
  1162.    return RXFUNC_OK;
  1163. }
  1164.  
  1165. void hashfree() /* minimise memory used by hash table 1. */
  1166. {               /* Tables 0 (environment variables) and 2 (functions) */
  1167.    int hash;    /* might be needed as long as the process lives. */
  1168.    int len;
  1169.    hashent *ptr;
  1170.    FILE *fp;
  1171.    hash=1; /* used to be a for loop */
  1172.    if((ptr=(hashent *)hashptr[hash])){
  1173.       for(len=ehashptr[hash];len;
  1174.           len-=ptr->next,ptr=(hashent*)((char *)ptr+ptr->next))
  1175.          /* for hash table 1 */
  1176.          if(ptr->value){
  1177.             if((fp=((struct fileinfo *)(ptr->value))->fp))
  1178.                if(fp!=stdin && fp!=stdout && fp!=stderr)
  1179.                   fclose(fp);
  1180.             free((char*)ptr->value);
  1181.          }
  1182.       free(hashptr[hash]);
  1183.       hashptr[hash]=allocm(hashlen[hash]=256);
  1184.    }
  1185.    ehashptr[hash]=0;
  1186. }
  1187.  
  1188. /* Exit API calls */
  1189.  
  1190. /* Exit names are stored in a list (above), like environment names.  They are
  1191.    only ever needed by RexxStart(). */
  1192.  
  1193. unsigned long RexxRegisterExitExe(name,address,area)
  1194. char *name;
  1195. RexxExitHandler *address;
  1196. unsigned char *area;
  1197. {
  1198.    int i;
  1199.    char *tmp;
  1200.    if(!exitlen){
  1201.       exittable=(struct exitentry *)
  1202.                 malloc((exitlen=16)*sizeof(struct exitentry));
  1203.       if(!exittable){
  1204.          exitlen=0;
  1205.          return RXEXIT_NOEMEM;
  1206.       }
  1207.    }
  1208.    if(strlen(name)>maxenviron)return RXEXIT_BADTYPE;
  1209.    for(i=0;i<exits && strcmp(exittable[i].name,name);i++);
  1210.    if(i<exits && exittable[i].handler)return RXEXIT_NOTREG;
  1211.    if(i==exits && exits++==exitlen){
  1212.       tmp=realloc(exittable,(exitlen+16)*sizeof(struct exitentry));
  1213.       if(!tmp)return RXEXIT_NOEMEM;
  1214.       exittable=(struct exitentry *)tmp;
  1215.       exitlen+=16;
  1216.    }
  1217.    strcpy(exittable[i].name,name);
  1218.    exittable[i].handler=address;
  1219.    exittable[i].area=area;
  1220.    return RXEXIT_OK;
  1221. }
  1222.  
  1223. unsigned long RexxDeregisterExit(name,mod)
  1224. char *name,*mod;
  1225. {
  1226.    int i;
  1227.    if(strlen(name)>maxenviron)return RXEXIT_BADTYPE;
  1228.    if(!exitlen)return RXEXIT_NOTREG;
  1229.    for(i=0;i<exits && strcmp(exittable[i].name,name);i++);
  1230.    if(i<exits && exittable[i].handler){
  1231.       exittable[i].handler=0;
  1232.       while(exits && !exittable[exits-1].handler)exits--; /* reclaim unused entries */
  1233.       return RXEXIT_OK;
  1234.    }
  1235.    return RXEXIT_NOTREG;
  1236. }
  1237.  
  1238. unsigned long RexxQueryExit(name,mod,flag,area)
  1239. char *name,*mod;
  1240. unsigned short *flag;
  1241. unsigned char *area;
  1242. {
  1243.    int i;
  1244.    if(flag)*flag=RXEXIT_NOTREG;
  1245.    if(strlen(name)>maxenviron)return RXEXIT_BADTYPE;
  1246.    if(!exitlen)return RXEXIT_NOTREG;
  1247.    for(i=0;i<exits && strcmp(exittable[i].name,name);i++);
  1248.    if(i<exits && exittable[i].handler){
  1249.       if(area && exittable[i].area)memcpy(area,exittable[i].area,8);
  1250.       else if(area)memset(area,0,8);
  1251.       if(flag)*flag=RXEXIT_OK;
  1252.       return RXEXIT_OK;
  1253.    }
  1254.    return RXEXIT_NOTREG;
  1255. }
  1256.  
  1257.