BSD 3 development

[unix-history] / usr / src / cmd / apl / ai.c

#include "apl.h"

funedit(an_editor)
register char *an_editor;
{
register struct item *p;
register f;
int      a, q;

       p = sp[-1];
       if(p->type != LV)
               error("ed B");
       f = fork();
       if(f==0) {
               for(f=3; f<7; f++)
                       close(f);
               execl(an_editor+4, an_editor+9, p->namep, 0);
               execl(an_editor, an_editor+9, p->namep, 0);
               aprintf("exec failure: ");
               aprintf(an_editor);
               exit(0);
       }
       if(f==-1)
               error("try again");
       a = signal(2, 1);
       while((q=wait(&integ))!=f)
               if(q==-1)
                       break;
       signal(2, a);
       funload(0);
}

funload(s)
{
       register struct item *p;
       register int *f;

       p = sp[-1];
       sp--;
       if(p->type != LV)
               error("fnl B");
       f = open(p->namep, 0);
       if((int)f <= 0)
               error("cannot open");
       switch(s) {
case 0:
               fundef(f);
               return;
case 2:
               clear();
case 1:
               wsload(f);
               aputchar('\n');
       }
}

fundef(f)
{
       short i;
       register char *a, *c;
       struct nlist *np;
       int  oifile;
       long    b[256]; 
       char    bbuf[BUFSIZ];

       oifile = ifile;
       ifile = f;
       a = rline(0);
       if(a == 0)
               error("fnd eof");
       c = compile(a, 2);
       afree(a);
       if(c == 0)
               goto out;
       copy(IN, c+1, &np, 1);
       erase(np);
       np->use = c->c[0];
       fstat(wfile, b);
       np->label = b[4];
       lseek(wfile, 0,2);
       lseek(ifile, 0, 0);
       while((a=read(ifile, bbuf, BUFSIZ)) > 0)
               write(wfile, bbuf, a);
       write(wfile, '\0', 1);
out:
       close(ifile);
       ifile = oifile;
}

struct  lablist labldefs = { 0, 0, 0 };

funcomp(np)
struct nlist *np;
{
       register a, c, *p;
       int err, size;
       int oifile;

       ifile = dup(wfile);
       lseek(ifile, np->label, 0);
       size = 0;
       err = 0;
       labldefs.nextll = 0;
       now_xeq.name = np->namep;
       now_xeq.line = 0;
       afree(rline(0));                /* Rather inefficient */
pass1A:
       now_xeq.line = size++;
       if((a=rline(0))==0) {
               lseek(ifile, np->label, 0);
               size = 0;
               now_xeq.line = -1;
               goto pass1B;
       }
       lablchk(a,size);
       afree(a);
       goto pass1A;

pass1B:
       ++now_xeq.line;
       a = rline(0);
       if(a == 0) {
               if(err)
                       goto out;
               p = alloc((size+2)*SINT);
               *p = size;
               size = 0;
               now_xeq.line = -1;
               lseek(ifile, np->label, 0);
               err++;
               goto pass2;
       }
       c = compile(a, size==0? 3: 5);
       size++;
       afree(a);
       if(c == 0) {
               err++;
               goto pass1B;
       }
       afree(c);
       goto pass1B;

pass2:
       ++now_xeq.line;
       a = rline(0);
       if(a == 0)
               goto pass3;
       c = compile(a, size==0? 3: 5);
       size++;
       afree(a);
       if(c == 0)
               goto out;
       p[size] = c;
       goto pass2;

pass3:
       now_xeq.line = 0;
       lseek(ifile, np->label, 0);
       a = rline(0);
       if(a == 0)
               goto out;
       c = compile(a, 4);
       afree(a);
       if(c == 0)
               goto out;
       p[size+1] = c;
#ifdef SOMED
       if(debug) {
               dump(p[1]);
               dump(c);
       }
#endif
       np->itemp = p;
       err = 0;

out:
       unlabel();
       close(ifile);
       ifile = oifile;
       if(err)
               error("syntax");
}

lablchk(line,line_no)
register char *line;
{
register struct lablist *lblthru = &labldefs;
register char *match;
int      i, len;

       match = line;
       while(*match++==' ')
               continue;
       line = --match;
       if(!alpha(*match++))
               return;
       len = 1;
       while(alpha(*match)||digit(*match))
               ++len, ++match;
       while(*match++==' ')
               continue;
       --match;
       if(*match++!='>')
               return;
       match[-1] = '\0';
       while(lblthru->nextll) {
               if(equal(line,lblthru->lname)) {
                       xeq_mark();
                       aprintf(lblthru->lname);
                       aprintf("> ");
                       error("dup label");
               }
               lblthru = lblthru->nextll;
       }
       lblthru = lblthru->nextll = alloc(sizeof(struct lablist));
       lblthru->lno    = line_no;
       lblthru->lname  = alloc(match-line);
       lblthru->nextll = 0;
       match = line;
       line = lblthru->lname;
       for(i=0; i<len; ++i)
               *line++ = *match++;
       *line = '\0';
}

unlabel()
{
register struct lablist *lblthru, *nextdef;

       lblthru = labldefs.nextll;
       while(lblthru) {
               afree(lblthru->lname);
               lblthru = lblthru->nextll;
       }
       lblthru = &labldefs;
       while(nextdef=lblthru->nextll) {
               lblthru = nextdef->nextll;
               afree(nextdef);
               if(!lblthru)
                       goto quit;
       }
quit:
       labldefs.nextll = 0;
}

ex_fun()
{
       struct nlist *np;
       register *p, s;
       int oldflc, oldpcp;

       pcp += copy(IN, pcp, &np, 1);
       if(np->itemp == 0)
               funcomp(np);
       switch(np->use) {
           default:
               error("arg B");
           case NF:
               break;
           case DF:
               insulate(-2);
           case MF:
               insulate(-1);
       }
       p = np->itemp;
       oldflc = funlc;
       oldpcp = pcp;
       funlc = 0;
       s = *p;
loop:
       funlc++;
       now_xeq.name = np->namep;
       now_xeq.line = funlc;
       execute(p[funlc]);
       if(intflg)
               error("I");
       if(funlc <= 0 || funlc >= s) {
               execute(p[s+1]);
               funlc = oldflc;
               pcp = oldpcp;
               now_xeq.name = now_xeq.line = 0;
               return;
       }
       pop();
       goto loop;
}

insulate(arg)
{
register s, p;

       p = sp[arg];
       switch(p->type) {
           case DA:
           case CH:
               p->index = 0;
               return;
           case LV:
               p = p->itemp;
               s = newdat(p->type, p->rank, p->size);
               copy(IN, p->dim, s->dim, p->rank);
               copy(p->type, p->datap, s->datap, p->size);
               sp[arg] = s;
               return;
           default:
               error("ins B");
       }
}

ex_arg1()
{
       register struct item *p;
       struct nlist *np;

       pcp += copy(IN, pcp, &np, 1);
       p = fetch1();
       sp[-1] = np->itemp;
       np->itemp = p;
       np->use = DA;
}

ex_arg2()
{
       register struct item *p;
       struct nlist *np;

       pcp += copy(IN, pcp, &np, 1);
       p = fetch(sp[-2]);
       sp[-2] = np->itemp;
       np->itemp = p;
       np->use = DA;
}

ex_auto()
{
       struct nlist *np;

       pcp += copy(IN, pcp, &np, 1);
       push(np->itemp);
       np->itemp = 0;
       np->use = 0;
}

ex_rest()
{
       register struct item *p;
       struct nlist *np;

       p = fetch1();
       pcp += copy(IN, pcp, &np, 1);
       erase(np);
       np->itemp = sp[-2];
       np->use = 0;
       if(np->itemp)
               np->use = DA;
       sp--;
       sp[-1] = p;
}

ex_br0()
{

       funlc = 0;
       ex_elid();
}

ex_br()
{
       register struct item *p;

       p = fetch1();
       if(p->size == 0)
               return;
       if(p->size != 1)
               error("branch C");
       funlc = fix(getdat(p));
}