ipint.
[Integral polynomial common operations interpreter. 6/27/80.
6/9/82 - if file input is desired (i.e. A command is to be used),
then the environment variable FILE2 is expected to have been set
to the name of the input file.]
     const PUNIT=9.
     const ASIZE=50;
     safe w,r,i^,i,j,C.
     global I(ASIZE),V(ASIZE),r,i^,i,j,C.
(1)  begin4;  openn( 2,2);  openn(9,9);
     w=0; i^=0;
     W=-1;
(2)  [Read command and arguments.]
     print "enter command (M for menu)";  C=creadb();
     if C=='R'|C=='G'|C=='F'|
     C=='D'|C=='I'|C=='X'|
     C=='S'|C=='Z'|C=='P'|C=='*'|C=='+'|
     C=='-'|C=='B'|C=='L'|C=='Y' then
     {    i=aread();  if i>i^ |(i<1&C~='S') then
     { print "argument out of range";  go to 2 };
     if C=='R'|C=='G'|C=='*'|
     C=='+'|C=='-'|C=='B'
     then {  j=aread();  if j<1|j>i^ then
     { print "argument out of range";  go to 2 }; 
     if ~EQUAL(V[i],V[j])&C~='B' then
     { print "arguments have different variable lists";
     go to 2 }  };
     if i>=1 then r=length(V[i])   };
(3)  [Display menu (M command).]
     if C=='M' then {
     print "H      - command output to terminal (default)";
     print "W      - command output to output file";
     print "J      - set left and right margins";
     print "V      - enter new default variable list";
     print "U      - display current variable list";
     print "T      - display index of topmost item";
     print "S i    - show item i (negative arg for history)";
     print "L i    - show item i linear";
     print "Y i    - show variable list of item i";
     print "C      - restart item array";
     print "I i    - introduce variables with default variable list";
     print "P i    - permute item i with default variable list";
     print "E      - enter new item with default variable list";
     print "A      - enter new item from unit 2";
     print "+ i j  - sum of items i and j";
     print "- i j  - difference of items i and j";
     print "* i j  - product of items i and j";
     print "R i j  - resultant of items i and j";
     print "G i j  - gcd of items i and j";
     print "F i    - factor item i";
     print "D i    - discriminant of item i";
     print "Z i    - isolate real roots of (univariate) item i";
     print "X i    - graph item i, a bivariate polynomial";
     print "B i j  - algebraic basis from univar i and bivar j";
     print "Q      - quit";
     go to 2 };
(4)  [Miscellaneous commands which never have title line.]
     if C=='Q' then stop;
     if C=='J' then { clout("current LMARG is "); awrite(LMARG);
     clout(", current RMARG is "); awrite(RMARG); emptob;
     clout("enter LMARG"); emptob; LMARG=aread();
     clout("enter RMARG"); emptob; RMARG=aread() };
     if C=='T' then { clout("index of topmost item is "); 
     awrite(i^); emptob; go to 2 };
     if C=='C' then { i^=0;  go to 2 };
     if C=='H' then { w=0;  go to 2 };
     if C=='W' then { w=1;  go to 2 };
     if C=='U' then { if W=-1 then 
     print "no current default variable list" else vlwrit(W);
     emptob;  go to 2 };
     if C=='V' then 
     { clout("enter variable list");
     emptob;  W=vlread();  go to 2 };
     if C=='Y' then { vlwrit(V[i]);  emptob; go to 2 };
(5)  [Enter polynomial (E and A commands); no title line.]
     if C=='E'|C=='A' then {  if W=-1 then 
     { print "no current variable list"; go to 2 };
     if i^==ASIZE then go to 16;
     clout ("enter polynomial according to default variable list ");
     vlwrit(W); emptob;  i^=i^+1;
     if C=='A' then { i#=IUNIT;  IUNIT=2 };
     I[i^]=ipsr(W);  V[i^]=W;  
     if C=='A' then IUNIT=i#;
     cwrit2('I','('); awrite(i^); cwrit3(')',' ','='); emptob;
     ipsw(I[i^],V[i^])  };
(6)  [Enter title line.]
     if w==1 then 
     { print "enter a title line (standard character set)";
     OUNIT=PUNIT; blines(2);
     read; for k#=1,...,ISIZE do cwrite(cread());
     write; IPOS=ISIZE; blines(1) };
(7)  [Show items (S and L commands).]
     if C=='S' then {  if i<=0 then j=i^+i else j=i;
     if j<1 then j=1;  if i<=0 then i=i^;
     for k=j,...,i do 
     { cwrit2('I','('); awrite(k); cwrit3(')',' ','='); emptob;
     ipsw(I[k],V[k]) }  };
     if C=='L' then { ipswl(I[i],V[i]); emptob};
(8)  [Permute variables (P command).]
     if C=='P' then {   if W~=-1 then r'=length(W) else r'=-1;
     if r'~=r then { OUNIT=6;
     clout("default variable list has length "); awrite(r');
     emptob; clout("variable list of item has length "); 
     awrite(r); emptob; go to 2 };
     if i^==ASIZE then go to 16; i^=i^+1;
     W'=W;  P=();  while W'~=() do {  adv(W';W1,W');  
     k=0;  b=0;  V'=V[i];  while b==0&V'~=() do
     { k=k+1;  adv(V';V1,V');  b=EQUAL(V1,W1) };
     if b==0 then { OUNIT=6;
     print "unknown variable";  go to 2 };  P=comp(k,P)  };
     P=inv(P);
     I[i^]=PPERMV(r,I[i],P);  V[i^]=W; 
     cwrit2('I','('); awrite(i^); cwrit3(')',' ','='); emptob;
     ipsw(I[i^],V[i^])   };
(9)  [Introduce new variables (I command).]
     if C=='I' then
     {  if W=-1 then { OUNIT=6;
     print "no default variable list";  go to 2 };
     if i^==ASIZE then go to 16; i^=i^+1;
     W'=W;  while W'~=() do {  adv(W';W1,W');  
     b=0;  V'=V[i];  while b==0&V'~=() do
     { adv(V';V1,V');  b=EQUAL(V1,W1) };
     if b==1 then { OUNIT=6;
     clout("variable ");  clout(W1); clout(" already occurs");
     emptob;  go to 2 }  };
     k=length(W);
     I[i^]=PINV(r,I[i],k);  W'=cinv(W);  W'=inv(W');
     V[i^]=conc(W',V[i]); 
     cwrit2('I','('); awrite(i^); cwrit3(')',' ','='); emptob;
     ipsw(I[i^],V[i^])   };
(10) [Discriminant (D command).]
     if C=='D' then
     {  if i^==ASIZE then go to 16; i^=i^+1;
     Z=cinv(V[i]);  Z=red(Z);  Z=inv(Z);
     I[i^]=ipdscr(r,I[i]); V[i^]=Z;
     clout("discriminant = I"); cwrite('('); awrite(i^);
     cwrite(')'); emptob;
     ipsw(I[i^],Z)  };
(11) [Resultant (R command).]
     if C=='R' then
     {  if i^==ASIZE then go to 16; i^=i^+1;
     Z=cinv(V[i]);  Z=red(Z);  Z=inv(Z);
     I[i^]=ipres(r,I[i],I[j]); V[i^]=Z;
     clout("resultant = I"); cwrite('('); awrite(i^);
     cwrite(')'); emptob;
     ipsw(I[i^],Z)  };
(12) [Isolate real zeros (Z command).]
     if C=='Z' then {   if r~=1 then { OUNIT=6;
     print "argument is not univariate";  go to 2 };
     ipscpp(r,I[i];s,c,P);  clout("content is"); 
     iwrite(c); emptob;
     clout("primitive part is"); ipsw(P,V[i]);
     L=ipsf(r,P);  n=length(L);  awrite(n);
     clout (" squarefree factors"); emptob; blines(1);
     L'=L; while L'~=() do 
     {  adv(L';M,L');  first2(M;e,B);
     clout("exponent is "); awrite(e);
     clout(", factor is"); ipsw(B,V[i]);
     clout("real roots of factor");
     k=-15; K=iprch(B,(),k);
     blines(1);  i#=0;  K'=K;  while K'~=() do 
     { i#=i#+1;  adv(K';J,K'); I1=second(J); 
     clout("interval no. "); awrite(i#);  emptob;
     first2(I1;u,v);
     rnwrit(u); clout("      "); rndwr(u,5);  emptob;
     rnwrit(v); clout("      "); rndwr(v,5); emptob; 
     blines(1) }  }   };
(13) [Further commands; subrs used due to translator dying
     on garbage collection (7/82 larger translator now).]
     if C=='F'|C=='G'|C=='*'|
     C=='+'|C=='-' then IPINTS().
     if C=='B' then IPINT2().
(14) [Graph bivariate polynomial (X command).]
     if C=='X' then {  if LENGTH(V[i])~=2 then
     { OUNIT=6;  clout("item "); awrite(i); 
     clout(" is not a bivariate polynomial"); emptob;  go to 2 };
     CPLOT(I[i])  }.
(15) [Reset OUNIT to terminal if file output on.]
     if w==1 then OUNIT=6;  go to 2.
(16) [Item array full.]
     if w==1 then OUNIT=6;  
     print "item array full; use C command to restart";
     go to 2..