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