Artifact 3d2898dde7c5c0674a4b3ed0ca023c5b95ff0f2277f86bca924a41396ebe66bf:
- Executable file
r37/packages/scope/codad2.red
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 60526) [annotate] [blame] [check-ins using] [more...]
- Executable file
r38/packages/scope/codad2.red
— part of check-in
[f2fda60abd]
at
2011-09-02 18:13:33
on branch master
— Some historical releases purely for archival purposes
git-svn-id: https://svn.code.sf.net/p/reduce-algebra/code/trunk/historical@1375 2bfe0521-f11c-4a00-b80e-6202646ff360 (user: arthurcnorman@users.sourceforge.net, size: 60526) [annotate] [blame] [check-ins using]
module codad2; % Facilities applied after optimization. % ------------------------------------------------------------------- ; % Copyright : J.A. van Hulzen, Twente University, Dept. of Computer ; % Science, P.O.Box 217, 7500 AE Enschede, the Netherlands.; % Authors : J.A. van Hulzen, B.J.A. Hulshof, W.N. Borst. ; % ------------------------------------------------------------------- ; symbolic$ % ------------------------------------------------------------------- ; % The module CODAD2 contains a number of facilities, to be applied ; % when the optimization process itself is finished and before produ- ; % cing output. This finishing touch, obtained by applying the function; % PrepFinalplst (see the module CODCTL), covers the following one-row ; % and/or one-column operations: ; % ; % PART 1 : Sum restructuring : s = (t1 + ... + tn) ^ exponent is re- ; % placed by name := t1 + ... + tn; s:= name ^ exponent. ; % Remark : This form allows application of an addition chain ; % algorithm on the exponent, as part of the print process, ; % and as defined in the module CODPRI. ; % ; % PART 2 : REMoval of REPeatedly occurring MULTiples of VARiables in ; % linear (sub)expressions, which could not be replaced by a ; % Breuer-search, since it requires one-column operations in ; % the PLUS-part of CodMat. If such a multiple occurs atleast ; % twice, it is replaced by a new name. The TIMES-part of ; % CodMat is consulted if such a multiple is found to allow ; % the replacement of such multiples in monomials as well. So ; % x = 3.a + b, y = 3.a + c, z = 3.a.b + c ; % is replaced by ; % s = 3.a ; % x = s + b, y = s + c, z = s.b + c. ; % ; % PART 3 : An UPDATE of MONOMIALS is performed. Constant multilpes of ; % identifiers are selected using the TIMES-part of CodMat. ; % Since the PLUS-part is already checked with REMREPMULTVARS ; % the search is limited to the TIMES-part. Replacement by a ; % new name is only effectuated if such a multiple literally ; % occurs twice. So ; % x = 3.a.b + 6.b.c, y = 3.a.c + 6.a.b ; % is replaced by ; % s1 = 3.a, s2 = 6.b ; % x = s1.b + s2.c, y = s1.c + s2.a. ; % ; % PART 4 : An all level factoring out of gcd's of constant coeff.'s in; % (composite) sums, using the function CODGCD. For example ; % sum = 9.a - 18.b + 6.sin(x) + 5.c -5.d ; % can be rewritten into ; % sum = 3.(3.a - 6.b + 2.sin(x)) + 5.(c - d). ; % But the arithmetic complexity of both representations of ; % sum is equal. We therefore produce ; % sum = 9.a - 18.b + 6.sin(x) + 5.(c - d). ; % Regrouping of (composite) products demands for an identical; % algorithm. For instance ; % 9 18 6 ; % prod = a b sin (x) ; % can be rewritten into ; % 3 ; % 3 6 2 ; % prod = {a b sin (x)} ; % thus reducing the required number of multiplications. ; % ; % PART 5 : A quotient-cse search. For example ; % kvarlst = ( (g1 quotient g2 g3) ; % (g4 quotient g5 dm) ) ; % matrix : g2 = nr * a ; % g3 = dm * b ; % g5 = nr * c ; % will be rewritten as ; % kvarlst = ( (g7 quotient nr dm) ; % (g1 quotient g2 b) ; % (g4 g5) ) ; % matrix : g2 = g7 * a ; % g5 = g7 * c ; % ------------------------------------------------------------------- ; % ------------------------------------------------------------------- ; % Global identifiers needed in this module are : ; % ------------------------------------------------------------------- ; global '(rowmin rowmax); % ------------------------------------------------------------------- ; % The meaning of these globals is given in the module CODMAT. ; % ------------------------------------------------------------------- ; symbolic smacro procedure find!+var(var,fa,iv); getcind(var,'varlst!+,'plus,fa,iv); symbolic smacro procedure find!*var(var,fa,iv); getcind(var,'varlst!*,'times,fa,iv); symbolic procedure getcind(var,varlst,op,fa,iv); % ------------------------------------------------------------------- ; % REMARK : GETCIND is also defined in the module CODAD1. This copy ; % allows seperate compilation. ; % ------------------------------------------------------------------- ; % The purpose of the procedure GetCind is to create a column in CODMAT; % which will be associated with the variable Var if this variable does; % not yet belong to the set Varlst,i.e.does not yet play a role in the; % corresponding PLUS- or TIMES setting (known by the value of Op).Once; % the column exists (either created or already available), its Zstrt ; % is modified by inserting the Z-element (Fa,IV) in it. Finally the ; % corresponding Z-element for the father-row, i.e. (Y,IV) is returned.; % ------------------------------------------------------------------- ; begin scalar y,z; if null(y:=get(var,varlst)) then <<y:=rowmin:=rowmin-1; put(var,varlst,y); setrow(y,op,var,nil,nil) >>; setzstrt(y,inszzzn(z:=mkzel(fa,iv),zstrt y)); return mkzel(y,val z) end; % ------------------------------------------------------------------- ; % PART 1 : SUM RESTRUCTURING ; % ------------------------------------------------------------------- ; symbolic procedure powerofsums; % ------------------------------------------------------------------- ; % The CODMAT PLUS-rows are investigated, who have an ExpCof-value > 1.; % Such rows define a sum raised to the exponent ExpCof(rowindex). ; % ------------------------------------------------------------------- ; begin scalar var,z,rmax; rmax:=rowmax; for x:=0:rmax do if opval(x) eq 'plus and expcof(x)>1 and not(farvar(x)=-1) then <<var:=fnewsym(); setrow(rowmax:=rowmax+1,'plus,var,list chrow x,zstrt x); % -------------------------------------------------------------- ; % A new name Var is introduced and 2 new CODMAT-rows to store the; % information about the new expression,in connection with the al-; % raedy available information. Furthermore some bookkeeping is ; % required. ; % The new row above contains all the information about the sum, ; % except its exponent.Below the second row is used to store Var ^; % ExpCof in the form of a Z-element in a TIMES-row. ; % This row becomes the only child of the old sum-defining row. ; % -------------------------------------------------------------- ; put(var,'rowindex,rowmax); foreach z in zstrt(x) do setzstrt(yind z,mkzel(rowmax,val z).delyzz(x,zstrt yind z)); foreach ch in chrow(x) do setfarvar(ch,rowmax); setprev(x,rowmax); % Preserve ordening; setrow(rowmax:=rowmax+1,'times,x,list nil, list(z:=mkzel(rowmin:=rowmin-1,expcof x))); % -------------------------------------------------------------- ; % The new row for the power of the sum is based on indirection to; % guarantee a correct functioning of the function Tchscheme. ; % -------------------------------------------------------------- ; setrow(rowmin,'times,var,nil,list mkzel(rowmax,val z)); % -------------------------------------------------------------- ; % A new column is generated, associated with the new name genera-; % ted for the sum. ; % -------------------------------------------------------------- ; setchrow(x,list rowmax); put(var,'varlst!*,rowmin); setzstrt(x,nil); setexpcof(x,1) >>; end; % ------------------------------------------------------------------- ; % PART 2 : REMoval of REPeatedly Occurring Constant MULTiples of PLUS ; % VARiableS. ; % ------------------------------------------------------------------- ; symbolic procedure remrepmultvars; % ------------------------------------------------------------------- ; % All PLUS-columns of CODMAT are investigated. Let Var be the variable; % associated with thw column Y. A list P(lus)col(umn)inf(ormation) is ; % made out of the Zstreet of column Y. Pcolinf consists of pairs of ; % the form constant(k). list of pairs (rowindex.sign(constant(k))), ; % such that 0<constant(i)<constant(j) if i<j and also such that coef- ; % ficient of Var in Zstreet(rowindex) is sign(k)*constant(k). ; % Then for each element of this list Pcolinf a corresponding list with; % T(imes)col(umn)inf(ormation) is made. This is a list consisting of ; % pairs of the form (rowindex . Z-element with the same index as value; % of its index-part and taken from the Zstreet of the column with the ; % index Prod(uct)col(umn)i(ndex), whose Expcof-value is a multiple of ; % the car of the element of Pcolinf, which is under consideration). ; % So assuming some multiples 3*A occur in some sums, which are easily ; % retrievable using the corresponding element of Pcolinf, we also re- ; % place parts of monomials of the same form. Hence 6*A^2*B is replaced; % by 2*A*B*(cse-name for 3*A).This does not increase the multiplicati-; % ve complexity. It can even decrease if some monomials of the form ; % 3*A*(something else) occur in the set of expressions currently being; % investigated. ; % ------------------------------------------------------------------- ; begin scalar rmin,var,prodcoli,pcolinf,mmult,srows,tcolinf,rindx,nvar,z,zz,zz1; rmin:=rowmin; for y:=rmin:(-1) do % ----------------------------------------------------------------- ; % Analysis of Zstreets of the PLUS-columns, which are associated ; % with variables Var. ; % ----------------------------------------------------------------- ; if (not numberp(var:=farvar y)) and (var neq '!+one) and (opval(y) eq 'plus) then <<prodcoli:=get(var,'varlst!*); pcolinf:=nil; foreach z in zstrt(y) do if not(!:onep dm!-abs(ival z)) then pcolinf:=inspcvv(xind(z).(if !:minusp(ival(z)) then -1 else 1), dm!-abs(ival z),pcolinf); % --------------------------------------------------------------- ; % The function InsPCvv, defined in the module CODOPT, is used to ; % produce the list Pcolinf. The NIL-initialisation is necessary ; % since a fresh start is required for each column under investiga-; % tion. The different elements of Pcolinf are used for a closer ; % look. ; % --------------------------------------------------------------- ; foreach cseinfo in pcolinf do <<mmult:=car(cseinfo); srows:=cdr(cseinfo); tcolinf:=nil; if prodcoli then foreach z in zstrt(prodcoli) do <<rindx:=xind(z); if dm!-eq(dm!-abs expcof rindx,mmult) then tcolinf:=(rindx.z).tcolinf >>; % ------------------------------------------------------------- ; % The list Tcolinf is now ready.If the number of elem.s of Srows; % and Tcolinf together is atleast 2 the multiplicative complexi-; % ty is not increasing if say 3*A is replaced by cse-name. ; % ------------------------------------------------------------- ; if length(srows)+length(tcolinf)>1 then << % --------------------------------------------------------- ; % A new expression is made and all required bookkeeping ac- ; % tions are performed. So all occurrences of say 3*A are re-; % moved from the Zstreet of the corresponding PLUS-column, a; % new column to store the placeholder for this 3*A is crea- ; % ted and all required modifications in the affected Zstrts ; % are carries out. ; % --------------------------------------------------------- ; z:=mkzel(y,mmult); nvar:=fnewsym(); rowmax:=rowmax+1; setrow(rowmax,'plus,nvar,list nil,list z); put(nvar,'rowindex,rowmax); rowmin:=rowmin-1; zz:=nil; foreach rowinf in srows do <<rindx:=car(rowinf); zz:=mkzel(rindx,cdr rowinf).zz; setzstrt(rindx,mkzel(rowmin,val car zz). delyzz(y,zstrt rindx)); setprev(rindx,rowmax) >>; setzstrt(y,mkzel(rowmax,val z).remzzzz(zz,zstrt y)); setrow(rowmin,'plus,nvar,nil,zz); put(nvar,'varlst!+,rowmin); if tcolinf then << % --------------------------------------------------- ; % Since Tcolinf is not empty some monomials have to be; % modified as well. ; % --------------------------------------------------- ; rowmin:=rowmin-1; zz1:=zz:=nil; foreach rowinf in tcolinf do <<rindx:=car(rowinf); z:=cdr(rowinf); zz:=mkzel(rindx,1).zz; if ival(z)>1 then setival(z,ival(z)-1) else <<zz1:=car(zz).zz1; setzstrt(rindx,delyzz(prodcoli,zstrt rindx)) >>; setzstrt(rindx,mkzel(rowmin,val car zz). zstrt(rindx)); setprev(rindx,rowmax); setexpcof(rindx,dm!-quotient(expcof(rindx),mmult)) >>; setzstrt(prodcoli,remzzzz(zz1,zstrt prodcoli)); setrow(rowmin,'times,nvar,nil,zz); put(nvar,'varlst!*,rowmin) >> >> >> >> end; % ------------------------------------------------------------------- ; % PART 3 : An UPDATE of MONOMIALS via a TIMES-columns search. ; % ------------------------------------------------------------------- ; symbolic procedure updatemonomials; % ------------------------------------------------------------------- ; % For each column, which is associated with an identifier, a Gclst is ; % produced. The syntax of such a list is given in PART 4. Each element; % of such a list, is itself a list, consisting of a constant and ; % structural information about the occurrences of this constant. These; % sublists are used to deside if constant multiples can be replaced by; % new names. The decision are made by applying the function REMGCMON. ; % ------------------------------------------------------------------- ; for y:=rowmin:(-1) do if not numberp(farvar y) and opval(y) eq 'times then foreach gcel in mkgclstmon(y) do remgcmon(gcel,y); symbolic procedure mkgclstmon(y); % ------------------------------------------------------------------- ; % All monomial coefficients of the TIMES-rows sharing an element with ; % the current TIMES-column are grouped in a Gclst if their absolute ; % value is atleast 2. ; % ------------------------------------------------------------------- ; begin scalar gclst,cof,indxsgn; foreach z in zstrt(y) do if not !:onep dm!-abs(cof:=expcof xind z) then << indxsgn:=cons(xind(z), if !:minusp cof then -1 else 1); gclst:=insgclst(cof,indxsgn,gclst,1) >>; return gclst end; symbolic procedure remgcmon(gcel,y); % ------------------------------------------------------------------- ; % RemGcMon is recursively applied on Gcel. Its purpose is finding re- ; % peatedly occurring multiples of idntifiers in monomials. However 6.a; % is not considered when 3.a proves to be a cse, simply because it ; % does not reduce the multiplicative complexity of the set of expres- ; % sions being optimized. ; % The srategy employed is very similar to the techniques used in PART ; % 4. ; % ------------------------------------------------------------------- ; begin scalar x,nvar,gc,zel,zzy,zzgc,ivalz; if length(cadr gcel)>1 then << gc:=car gcel; rowmin:=rowmin-1; rowmax:=rowmax+1; nvar:=fnewsym(); zel:=mkzel(y,1); setrow(rowmax,'times,nvar,list(nil,gc),list(zel)); put(nvar,'rowindex,rowmax); zzy:=mkzel(rowmax,val(zel)).zstrt(y); zzgc:=nil; foreach z in cadr(gcel) do << x:=car(z); setexpcof(x,1); setprev(x,rowmax); zel:=car(pnthxzz(x,zzy)); if ival(zel)>1 then << zzy:=inszzz(mkzel(x,ivalz:=dm!-difference(ival(zel),1)), delyzz(x,zzy)); setzstrt(x,inszzzr(mkzel(y,ivalz),delyzz(y,zstrt x))) >> else << zzy:=delyzz(x,zzy); setzstrt(x,delyzz(y,zstrt x)) >>; zzgc:=inszzz(zel:=mkzel(x,1),zzgc); setzstrt(x,mkzel(rowmin,val zel).zstrt(x)) >>; setzstrt(y,zzy); setrow(rowmin,'times,nvar,nil,zzgc); put(nvar,'varlst!*,rowmin) >>; if cddr(gcel) then foreach item in cddr(gcel) do remgcmon(item,y) end; % ------------------------------------------------------------------- ; % PART 4 : Gcd-based expression rewriting ; % ------------------------------------------------------------------- ; % We employ a two stage strategy. We start producing a Gclst, consis- ; % ting of row-information. If relevant, Gclst is used to rewrite the ; % expression (part), defined by the current row of CodMat. The Gclst- ; % syntax is : ; % ; % Gclst ::= (Gcdlst Gcdlst ... Gcdlst ) , n >= 1 . ; % 1 2 n ; % Gcdlst ::= (G Glocations glst ... glst ) , m >= 0 . ; % 1 m ; % G ::= positive integer ; % Glocations ::= (location ... location ) , k >= 0 . ; % 1 k ; % location ::= (index . coeffsign) ; % coeffsign ::= +1 | -1 ; % index ::= columnindex | rowindex ; % columnindex ::= negative integer (relative value, see CodMat def.) ; % rowindex ::= non-negative integer (relative value, see Codmat def.) ; % glst ::= (g Glocations) ; % g ::= positive integer ; % ; % Semantics : We assume G = gcd(g1,...,gm) > 1. When other domains are; % introduced, the presumed domain is not longer Z, implying that Gcd2,; % * and / have to be made generic, when producing Gclst and rewriting ; % the expression using the function RemGc. ; % When m = 0, i.e. no glst's occur, the absolute value of all coeffi- ; % cients is equal to G. ; % Glocations can be an empty list,as shown in the following example : ; % ; % ((3 NIL (9 ((a.1))) (18 ((b.-1))) (6 ((sin(x).1)))) ; % (5 ((c.1) (d.-1)))) ; % ; % is the Gclst, associated with ; % sum = 9.a - 18.b + 6.sin(x) + 5.c - 5.d, ; % when replacing the negative, relative column-indices by a,b,c and d,; % and the positive relative child row-index by sin(x). ; % This list is used for the remodelling. The Glocations list is NIL, ; % because sum has no coefficients equal to either 3 or -3. ; % ------------------------------------------------------------------- ; symbolic procedure codgcd(); begin scalar presentrowmax; % ------------------------------------------------------------------- ; % For all relevant rows of CodMat we compute the Gclst, by applying ; % the function MkGclst. Then each item in this list, a Gcdlst, is used; % for a reconstruction of the expression( part) defined by row X. ; % ------------------------------------------------------------------- ; presentrowmax:=rowmax; for x:=0:presentrowmax do if not(farvar(x)=-1)then foreach gcel in mkgclst(x) do remgc(gcel,x) end; symbolic procedure mkgclst(x); % ------------------------------------------------------------------- ; % The Gclst of row X is produced and returned. ; % ------------------------------------------------------------------- ; begin scalar gclst,iv,opv; foreach z in zstrt(x) do if not !:onep(dm!-abs(iv:=ival z)) then % -------------------------------------------------------------- ; % The location (Yind(Z).coeffsign) is added to the glst with g = ; % abs(IV). ; % -------------------------------------------------------------- ; if !:minusp(iv) then gclst:=insgclst(dm!-minus(iv),yind(z).(-1),gclst,1) else gclst:=insgclst(iv,yind(z) . 1,gclst,1); opv:=opval(x); foreach ch in chrow(x) do if not(opval(ch)=opv) and not(!:onep dm!-abs(iv:=expcof ch)) % --------------------------------------------------------------- ; % Only non *(+)-children of *(+)-parents are considered. ; % --------------------------------------------------------------- ; then % ------------------------------------------------------------- ; % The location (CH(=rowindex of child).coeffsign) is added to ; % the glst with g = abs(IV). ; % ------------------------------------------------------------- ; if !:minusp(iv) then gclst:=insgclst(dm!-minus iv,ch.(-1),gclst,1) else gclst:=insgclst(iv,ch . 1,gclst,1); return gclst; end; symbolic procedure insgclst(iv,y,gclst,gc0); % ------------------------------------------------------------------- ; % The most recent version of Gclst is returned after being updated by ; % adding the location Y to the glst with g = abs(IV) in Gclst, assu- ; % ming that G = Gc0. ; % ------------------------------------------------------------------- ; begin scalar gc,cgcl; return if null(gclst) then % ------------------------------------------------------------- ; % Start making such a list : If Y = (-1 . 1) and IV = 4 then we ; % get ((4 ((-1 . 1)))). ; % ------------------------------------------------------------- ; list(iv.(list(y).nil)) else % ------------------------------------------------------------- ; % Extend the Gclst. ; % ------------------------------------------------------------- ; if dm!-eq(caar(gclst),iv) % ------------------------------------------------------------ ; % Add floats only to Gcdlst's of type (G Glocations). ; % Then IV = G (of Gcdlst ) and Y is added to Glocations as new; % 1 1 ; % location (since Cadar(Gclst) = Glocations of Gcdlst , Cddar ; % 1 ; % (Gclst) = (glst ... glst ) and Cdr(Gclst) = (Gcdlst ... ; % 1 m 2 ; % Gcdlst )). ; % n ; % If now IV = 4 and Y =(-2 . 1) then Gclst = ((4 ((-1 . 1)))) ; % is extended to ((4 ((-2 . 1) (-1 . 1)))). ; % ------------------------------------------------------------ ; then (iv.((y.cadar(gclst)).cddar(gclst))).(cdr gclst) else if floatprop(iv) or floatprop(caar gclst) or (gc:=gcd2(iv,caar gclst)) <= gc0 then % ---------------------------------------------------------- ; % IV and G are relative prime. The elements Gcdlst , i > 1, ; % i ; % are further investigated, if existing. ; % So if IV = 5 and Y = (-2 . 1) then Gclst = ((4 (-1 . 1)))) ; % is extended to ((4 ((-1 . 1))) (5 ((-2 . 1))))). ; % ---------------------------------------------------------- ; car(gclst).insgclst(iv,y,cdr gclst,gc0) else % ----------------------------------------------------------- ; % Gc = gcd(IV,G ) > Gc0 (=1, initially). ; % 1 ; % ----------------------------------------------------------- ; if gc=caar(gclst) % -------------------------------------------------------- ; % IV > Gc = G , implying that the (IV,Y)-info has to be ; % 1 ; % stored in one of the Gcdlst lists, i > 1. ; % i ; % So if IV=8 and Y=(-2 . 1) then Gclst = ((4 ((-1 . 1)))) ; % is extended to ((4 ((-1 . 1)) (8 ((-2 . 1)))). ; % -------------------------------------------------------- ; then (append (list(gc,cadar gclst),insdiff(iv,y,cddar gclst))). (cdr gclst) else if gc=iv % ------------------------------------------------------- ; % Gc = IV < G demands for remodelling of Gcdlst , such ; % 1 1 ; % that now Gcdlst = (Gc Etc).So if IV = 2 and Y =(-2 . 1); % 1 ; % then Gclst = ((4 ((-1 . 1)))) is extended to the list ; % ((2 ((-2 . 1)) (4 ((-1 . 1))))). ; % ------------------------------------------------------- ; then << if null(cadar gclst) then list(append(list(gc,list(y)),cddar gclst)) else if cddar(gclst) and caddar(gclst) % ------------------------------------------------------- ; % ^ Neccesary test for R35. ; % Can't take car of cddar if cddar is NIL (a.o.t. R34) ; %----------------------------------------------JB 1994----; then (append(list(gc,list(y),list(caar gclst, cadar gclst)),cddar gclst)).(cdr gclst) else (gc.(list(y).list(car gclst))).(cdr gclst) >> else % ------------------------------------------------------ ; % Gc < IV and Gc < G , i.e. Glocations := NIL. So if IV =; % 1 1 ; % 6 and Y = (-2 . 1) then Gclst = ((4 (-1 . 1)))0 is ex- ; % tended to ((2 NIL (6 ((-2 . 1))) (4 ((-1 . 1))))). ; % ------------------------------------------------------ ; (gc.(nil.append(list(iv.(list(y).nil)), if cddar gclst then append(list(list(caar gclst,cadar gclst)), cddar gclst) else list(list(caar gclst,cadar gclst))))) .(cdr gclst) end; symbolic procedure insdiff(iv,y,glsts); % ------------------------------------------------------------------- ; % glstst is a list of glst 's, i >= 0. If IV = g , k<= i, then Y is ; % i k ; % inserted in glocations and else list(IV.(list(Y).NIL)) is added to ; % k ; % glsts. ; % ------------------------------------------------------------------- ; begin scalar b,rlst; while glsts and (not b) do << if caar(glsts)=iv then <<rlst:=list(iv,append(list(y),cadar glsts)).rlst; b:=t >> else rlst:=car(glsts).rlst; glsts:=cdr(glsts) >>; return if b then append(reverse(rlst),glsts) else append(list(iv.(list(y).nil)),reverse(rlst)) end; symbolic procedure remgc(gcel,x); % ------------------------------------------------------------------- ; % RemGc allows a recursive investigation of Gcel, a Gcdlst being an ; % element of the Gclst of row X. Therefore it returns a list of loca- ; % tions, which can be empty as well. These locations are remodelled ; % into Zstrt-elements, subject to some profitability criteria, which ; % will be explained in the body of this function. ; % Once the list of remodelled locations is ready, it is used to re- ; % arrange the corresponding CodMat-elements into the desired form. ; % ------------------------------------------------------------------- ; begin scalar zzch,zzchl,zzr,chr,zz,ch,nsum,nprod,ns,np,opv,gc,cof, cofloc,iv,var1,var2; % ----------------------------------------------------------------- ; % Gcel is a Gcdlst, i.e. it has the structure (G Glocations glst's).; % So Cddr(Gcel) = (glsts's) =(glst ... glst ), m>= 0. A glst itself; % 1 m ; % has the structure (g Glocations), i.e. Cddr(glst) = NIL. ; % Hence Gcel is either a Gcdlst or a glst. For both alternatives ; % holds : Car(Gcel) = a positive integer (G or g) and Cadr(Gcel) = ; % a Glocations-list, i.e. each element of Cadr(Gcel) ia a pair ; % (index.coeffsign), where Car(Gcel) is the absolute value of the ; % coefficient (exponent) to be associated with row X and a column- ; % index or the row-index of a child, respectively. ; % If Gcel defines the structure of a monomial the description is im-; % proved if atleast 2 exponents are G or if the exponents have a gcd; % 6 6 6 9 2 3 3 ; % > 1. So both a b and a b are restructured into (a b ) and ; % 6 ; % (ab) , respectively. ; % If Gcel defines the structure of a sum coefficients are factored ; % out (recursively), i.e. 6.a + 9.b remains unchanged and 6.a + 6.b ; % is restructured into 6.(a + b). The Gcel is (3 NIL (6 ((a.1))) ; % (9 ((b.1)))) and (6 ((a.1) (b.1))), respectively. ; % Restructuring requires a new TIMES(PLUS)-row to store the EXPCOF ; % value GC (6) and a new PLUS(TIMES)-row to store its base ab or ; % factor a + b, respectively. ; % ----------------------------------------------------------------- ; if ((opv:=opval(x)) eq 'times and (length(cadr gcel)>1 or cddr(gcel))) or ((opv eq 'plus) and (length(cadr gcel)>1)) then <<if opv eq 'times then << nsum:=rowmax:=rowmax+1; var1:=fnewsym(); put(var1,'rowindex,nsum); setprev(x,nsum); setrow(rowmin:=rowmin-1,'times,var1,nil, list(iv:=mkzel(x,gc:=car gcel))); setzstrt(x,inszzzr(mkzel(rowmin,val iv),zstrt x)); put(var1,'varlst!*,rowmin); setrow(nsum,'times,var1,list nil,nil) >> else << nprod:=rowmax+1; nsum:=rowmax:=rowmax+2; setchrow(x,nprod.chrow(x)); setrow(nprod,if opv eq 'plus then 'times else 'plus,x, list(list(nsum),gc:=car gcel),nil); setrow(nsum,opv,nprod,list nil,nil) >>; zzch:=updaterowinf(x,nsum,1,cadr gcel,zzr,chr); foreach y in cddr gcel do <<cof:=dm!-quotient(car(y),gc); cofloc:=cadr y; if cdr cofloc then << if opv eq 'plus then << np:=rowmax+1; ns:=rowmax:=rowmax+2; setrow(np,if opv eq 'plus then 'times else 'plus, nsum,list(list(ns),cof),nil); setrow(ns,opv,np,list nil,nil); setchrow(nsum,np.chrow(nsum)) >> else << ns:=rowmax:=rowmax+1; var2:=fnewsym(); put(var2,'rowindex,ns); setprev(get(var1,'rowindex),ns); setrow(rowmin:=rowmin-1,'times,var2,nil, list(iv:=mkzel(nsum,cof))); setzstrt(nsum,inszzzr(mkzel(rowmin,val iv), zstrt nsum)); put(var2,'varlst!*,rowmin); setrow(ns,'times,var2,list nil,nil) >>; zz:=ch:=nil; zzchl:=updaterowinf(x,ns,1,cofloc,zz,ch); setzstrt(ns,car zzchl); setchrow(ns,cdr zzchl) >> else zzch:=updaterowinf(x,nsum,cof,cofloc,car zzch,cdr zzch) >>; foreach zel in car(zzch) do setzstrt(nsum,inszzzr(zel,zstrt nsum)); setchrow(nsum,if chrow(nsum) then append(chrow(nsum),cdr zzch) else cdr zzch) >> else foreach item in cddr gcel do remgc(item,x) end; symbolic procedure updaterowinf(x,nrow,cof,infolst,zz,ch); % ------------------------------------------------------------------- ; % UpdateRowInf is used in the function RemGc to construct the Zstrt ; % ZZ and the list of children CH of row Nrow and using the Infol(i)st.; % Infolst is a glst. ; % ------------------------------------------------------------------- ; begin scalar indx,iv,mz,dyz; foreach item in infolst do << indx:=car(item); if indx < 0 then << zz:=inszzzr(iv:=mkzel(indx,dm!-times(cof,cdr(item))),zz); setzstrt(indx,inszzz(mkzel(nrow,val(iv)), delyzz(x,zstrt indx))); setzstrt(x,delyzz(indx,zstrt x)) >> else << ch:=indx.ch; chdel(x,indx); setfarvar(indx,nrow); setexpcof(indx,dm!-times(cof,cdr(item))) >> >>; return zz.ch end; % ------------------------------------------------------------------- ; % PART 5 : QUOTIENT-CSE SEARCH ; % ------------------------------------------------------------------- ; global '(kvarlst qlhs qrhs qlkvl); symbolic procedure tchscheme2; % --- % Moves every plus-row having just one z-element to the times-scheme. % Also copies every single child(i.e. it's the only child of its father) % of a plus-row to its father-row. % --- begin for x:=0:rowmax do << removechild x; to!*scheme x >>; end; symbolic procedure to!*scheme x; % --- % Moves plus-row x, which has just one z-element, to the times-scheme. % --- begin scalar z,yi,exp; if not(numberp farvar(x)) and opval(x) eq 'plus and length(zstrt x)=1 and null(chrow x) then << z:=car zstrt(x); yi:=yind z; exp:=expcof x; setexpcof(x,dm!-expt(ival z,exp)); z:=find!*var(farvar yi,x,exp.bval(z)); setzstrt(yi,delyzz(x,zstrt yi)); setzstrt(x,list z); setopval(x,'times); >> end; symbolic procedure removechild x; % --- % Copies the only child of plus-row x to row x. % --- begin scalar ch,exp,iv; if not(numberp farvar(x)) and opval(x) eq 'plus and null(zstrt x) and length(chrow x)=1 then << ch:=car chrow x; exp:=expcof x; foreach z in zstrt ch do << setzstrt(yind z,delyzz(ch,zstrt yind z)); iv:=dm!-times(ival(z),exp); setzstrt(yind z,inszzz(mkzel(x,iv),zstrt yind z)); setzstrt(x,inszzzr(mkzel(yind z,iv),zstrt x)) >>; foreach chld in chrow(ch) do setfarvar(chld,x); setopval(x,'times); setexpcof(x,dm!-times(expcof ch,exp)); setchrow(x,chrow ch); clearrow ch; >> end; symbolic procedure searchcsequotients; begin scalar res,continuesearch; tchscheme2(); res := continuesearch := searchcsequotients2(); while continuesearch do continuesearch := searchcsequotients2(); return res; end; symbolic procedure searchcsequotients2; % -------------------------------------------------------------------- ; % Quotient-structured cse's can exist in the prefixlist, defining the % result of an extended Breuer-search, since this search is performed % on a set of polynomial-like (sub)-expressions, which may contain % numerators and denominators as seperate expressions. % So we know after optimization that neither the subset of numerators % nor the subset of denominators have a cse in common. % This implies that possibly occurring cse's always have the form % (quotient numer denom), where both numer and denom are either numbers % or identifiers. % An example: % The set {x:=(ab)/(cd),y:=(ae)/(cf),z:=(bg)/(dh)} contains the cse's % s1:=a/c and s2:=b/d, % which can lead to the new set % {s1:=a/c,s2:=b/d, x:=s1.s2, y:=(s1.e)/f,z:=(s2.g)/h}, % thus saving 3 *'s but adding 1 /. % This function serves to produce such revisions when ever possible, % and assuming that one / is equivalent to at most two *'s. % -------------------------------------------------------------------- ; begin scalar j,quotients,dmlst,dm,numerinfol,nrlst,selecteddms, selectednrs,quotlst,b,quots,profit,qcse,cselst,var,s; qlkvl:=length(kvarlst); qlhs:=mkvect(qlkvl); qrhs:=mkvect(qlkvl); j:=0; quotients:=nil; foreach item in kvarlst do << putv(qlhs,j:=j+1,car item); putv(qrhs,j,cdr item); if relquottest(getv(qrhs,j)) then quotients:=cons(j,quotients); >>; % --- % quotients contains indices of relevant quotients in lhs-rhs (kvarlst) % --- if quotients then << foreach indx in quotients do dmlst:=insertin(dmlst,caddr getv(qrhs,indx),indx); dmlst:=addmatnords(dmlst); % --- % dmlst = ( (item.(indices to quotients containing item in denominator)) % ... ) % --- selecteddms:=selectmostfreqnord(dmlst); if selecteddms and length(cdr selecteddms)>1 then % at least 2 ../dm's. << % selecteddms = item which appears the most in % denominators. dm:=car selecteddms; numerinfol:=cdr selecteddms; nrlst:=nil; foreach indx in numerinfol do nrlst:=insertin(nrlst,cadr getv(qrhs,indx),indx); nrlst:=addmatnords(nrlst); % --- % nrlst = ((item.(indices of quotients containing item % in numerator and the selected denominator % in the denominator) ... ) % --- if (selectednrs:=selectmostfreqnord(nrlst)) then if length(cdr selectednrs)>1 then % cse is car(selectednrs)/dm. quotlst:=((car(selectednrs).dm).cdr(selectednrs)) . quotlst >>; % dmlst:=delete(selecteddms,dmlst); % --- % quotlst = (((numerator . denominator) . % st of indices to quotients containing quotient)) ...) % i.e. list of quotients containing the cse-quotient % --- if quotlst then << quots:=mkvect(qlkvl); foreach item in quotlst do << profit:=qprofit(item); % ----------------------------------------------------------- ; % qprofit delivers the pair *-savings./-savings. The assoc. ; % quotient, defined as pair numerator.denominator and stored ; % as car of the item, will be considered as cse if profit=t. ; % ----------------------------------------------------------- ; if ((cdr profit) geq 0) or ((car(profit)+2*cdr(profit)) geq 0) then % cse-quotient is profitable << b:=t; qcse:=list('quotient,caar item,cdar item); if (var:=assoc(qcse,s:=get(car qcse,'kvarlst))) then qcse:=cdr(var).qcse else << var:=fnewsym(); put(car qcse,'kvarlst,(qcse.var).s); qcse:=var.qcse; cselst:=qcse.cselst >>; foreach indx in cdr(item) do if car(qcse) neq getv(qlhs,indx) then substqcse(qcse,indx) >> >>; kvarlst:=nil; for j:=1:qlkvl do if getv(qlhs,j) then % remove cleared quotients kvarlst:=append(kvarlst,list(getv(qlhs,j).getv(qrhs,j))); % add new quotients kvarlst:=append(kvarlst,cselst); >> >>; qlkvl:=qlhs:=qrhs:=nil; return(b) end$ symbolic procedure relquottest(item); % -------------------------------------------------------------------- ; % returns t if item is a quotient with a numerator (cadr item) and a % denominator (caddr item), which are a product, a constant or an . ; % identifier i.e. , which have a relv(evant) str(ucture). ; % -------------------------------------------------------------------- ; eqcar(item,'quotient) and relvstr(cadr item) and relvstr(caddr item); symbolic procedure relvstr(item); % -------------------------------------------------------------------- ; % Only those numerators or denominators are relevant which can possibly; % contribute to cse-quotients, i.e. constants, identifiers or products ; % -------------------------------------------------------------------- ; begin scalar rowindx; return constp(item) or idp(item) %or % ((rowindx:=get(item,'rowindex)) and opval(rowindx) eq 'times) end; symbolic procedure addmatnords(nordlst); % --- % The numerators and denominators are concidered at two levels: % 1) nords in the kvarlst and % 2) nords in rows which are used in the kvarlst. Nordlst contains % relevant nords from level 1. % A row from level 1 is opened, i.e. replaced by relevant nords from % level 2 (its z-elements) when: % o The row occurs only once in the union of both levels. % o The row is only used for this nord and is used nowhere else in % codmat or kvarlst. % Otherwise the nord is unchanged. % --- begin scalar matnords,templst,rowindx; % First: find all the nords at level 2 (matnords) foreach nord in nordlst do foreach indx in cdr nord do if (rowindx:=get(car nord,'rowindex)) and opval(rowindx) eq 'times then << foreach z in zstrt rowindx do matnords:=insertin(matnords,farvar yind z,indx); if abs(expcof rowindx) neq 1 then matnords:=insertin(matnords,expcof rowindx,indx) >>; % Second: open the appropriate 1st level rows foreach nord in nordlst do << if length(cdr nord)>1 then foreach indx in cdr nord do templst:=insertin(templst,car nord,indx) else if assoc(car nord,matnords) then templst:=insertin(templst,car nord,cadr nord) else if (rowindx:=get(car nord,'rowindex)) and opval(rowindx) eq 'times and nofnordocc(car nord)=1 then << foreach z in zstrt rowindx do templst:=insertin(templst,farvar yind z,cadr nord); templst:=insertin(templst,expcof rowindx,cadr nord) >> >>; return templst end; symbolic procedure nofnordocc(nord); % --- % Finds out howmany times nord occurs in the kvarlst and the schemes. % --- begin scalar nofocc; nofocc:=nofmatnords nord; for i:=1:qlkvl do nofocc:=nofocc+numberofocc(nord,getv(qrhs,i)); return nofocc end; symbolic procedure numberofocc(var,expression); % -------------------------------------------------------------------- ; % The number of occurrences of Var in Expression is computed and ; % returned. ; % -------------------------------------------------------------------- ; if constp(expression) or idp(expression) then if var=expression then 1 else 0 else (if cdr expression then numberofocc(var,cdr expression) else 0) + (if var=car expression then 1 else if not atom car expression then numberofocc(var,car expression) else 0); symbolic procedure nofmatnords nord; begin scalar nofocc,colindx; nofocc:=0; if (colindx:=get(nord,'varlst!*)) then nofocc:=length zstrt colindx; if (colindx:=get(nord,'varlst!+)) then nofocc:=nofocc+length zstrt colindx; return nofocc end; symbolic procedure insertin(nordlst,item,indx); % -------------------------------------------------------------------- ; % Once it is known that item is a constant or an identifier it can be ; % stored in the nordlst list.If item is a negative number the -indx is ; % attached to the cdr of nordlst and -item is used as recognizer. ; % -------------------------------------------------------------------- ; begin scalar pr; return(if !:onep(dm!-abs item) then nordlst else if (pr:=assoc(item,nordlst)) then foreach el in nordlst collect if car(el)=item then item.append(cdr pr,list(indx)) else el else append(list(item.list(indx)),nordlst)) end; symbolic procedure selectmostfreqnord(nordlst); % -------------------------------------------------------------------- ; % The nordlst consists of pairs, formed by a constant or identifier as ; % car and a list of indices of rhs's, denoting the quotients containing; % this car. ; % The pair with the longest indxlst is selected and returned. ; % -------------------------------------------------------------------- ; begin scalar templst,temp,selectedpr,lmax; if nordlst then << selectedpr:=car nordlst; lmax:=length(cdr selectedpr); templst:=cdr nordlst; foreach pr in templst do << if lmax < (temp:=length(cdar templst)) then << lmax:=temp; selectedpr:=car templst >>; templst:=cdr templst >> >>; return(selectedpr) end; symbolic procedure qprofit(item); % -------------------------------------------------------------------- ; % indxlist consists of signed indices of the vectors lhs and rhs. The ; % structure of the rhs's, being quotients is used to determine the ; % number of multiplications and divisions saved by considering the ; % corresponding quotient as a cse. ; % The rules we apply are straightforward. Assume the cse-candidate ; % is defined by s:=nr/dm. Then we can distinguish between the 4 fol- ; % lowing situations: ; % -1- quotient=s, i.e. 1 /-operation can be saved. ; % -2- quotient=s/a, i.e. 1 *-operation can be saved. ; % -3- quotient=s*a, i.e. 1 /-operation can be saved. ; % -4- quotient=(s*a)/b, i.e. 1 *-operation can de saved, but no ; % /-operation is saved. ; % We simply test if dm is a constant or an identifier (1 /-saving) or a; % product (1 *-saving). ; % But if nr is a product we still need the /-operation ; % s will function as cse if nbof!/>=0 or when nbof!*+2*nbof!/>=0, ; % assuming that a division is atmost as costly as 2 multiplications. ; % We neglect for the moment the extra assignments, i.e. stores. ; % -------------------------------------------------------------------- ; begin scalar nbof!*,nbof!/,tempquot,h,f,tf,il; il:=cdr(item); while il do << h:= car(il); il:=cdr(il); f:=h.f; foreach indx in il do << if indx neq h then tf:=indx.tf >>; if not null(tf) then << il:=reverse tf, tf:=nil >> else il:=nil >>; if length(il:=reverse f)=1 then << nbof!*:=0; nbof!/:=-1 >> else << nbof!*:=0; nbof!/:=-1; % nbof!* is atmost 0. nbof!/ may be negative. foreach sgnindx in il do << tempquot:=getv(qrhs,sgnindx); % The rhs-struct. is '(quotient nr dm). if cdar(item)=caddr(tempquot) then nbof!/:=1+nbof!/ else nbof!*:=1+nbof!*; >> >>; return(cons(nbof!*,nbof!/)) end; symbolic procedure substqcse(csepair,indx); % -------------------------------------------------------------------- ; % csepair is a pair consisting of a system generated cse name and the ; % struct. of a quotient-cse. If sgnindx<0 the cse parent has a minus as; % leading operator. If minsgn the cse has also a minus as leading ope- ; % rator. Based on this information the rhs(abs(sgnindx)) is rewritten, ; % i.e. the cse-value is removed and replaced by the cse-name. ; % -------------------------------------------------------------------- ; begin scalar var,val,dm,nr,pnr,pdm,ninrow,dinrow,expo; var:=car(csepair); val:=cdr(csepair); nr:=cadr val; dm:=caddr val; pnr:=cadr(getv(qrhs,indx)); pdm:=caddr(getv(qrhs,indx)); ninrow:=if (nr neq pnr) then get(pnr,'rowindex) else nil; dinrow:=if (dm neq pdm) then get(pdm,'rowindex) else nil; expo:=min(nordexpo(nr,pnr),nordexpo(dm,pdm)); pnr:=remnord(nr,expo,pnr,indx); pnr:=insnord(var,expo,pnr,indx); pdm:=remnord(dm,expo,pdm,indx); pnr:=checknord(pnr,ninrow,indx); pdm:=checknord(pdm,dinrow,indx); % If we want to remove qlhs[indx] this should not be a protected % variable of some sort... if !:onep(pdm) and unprotected(getv(qlhs,indx)) then << remquotient(pnr,indx); putv(qlhs,indx,nil) >> else putv(qrhs,indx,if !:onep(pdm) then pnr else list('quotient,pnr,pdm)) end; symbolic procedure unprotected var; % States wether var is free to be removed or not. flagp(var,'newsym) and not get(var,'alias); symbolic procedure nordexpo(x,y); % --- % Calculates the power of x in product y. % Assumption : y contains x. % --- if constp x then 1 else if idp x then if x=y then 1 else begin scalar res; if (res:=assoc(get(x,'varlst!*),zstrt get(y,'rowindex))) then res := ival res else res := 0; return res end; symbolic procedure remnord(item,expo,dest,indx); % --- % Divides item^expo out of dest. Dest is a constant, a variable or a % variable determining a row in CODMAT. % Item is a constant or a variable. % Assumption : dest contains item^n, n >= expo. % --- begin scalar rowindx,colindx,z; return if constp dest then dm!-quotient(dest,dm!-expt(item,expo)) else if item=dest then << remquotordr(indx,item); if (rowindx:=get(item,'rowindex)) then remquotordr(indx,rowindx); 1 >> else << rowindx:=get(dest,'rowindex); if constp(item) then << if opval(rowindx)='times then setexpcof(rowindx,dm!-quotient(expcof rowindx, dm!-expt(item,expo))) else <<setzstrt(rowindx,foreach z in zstrt(rowindx) collect mkzel(xind z, dm!-quotient(ival z,dm!-expt(item,expo)) . bval(z))); foreach z in zstrt(rowindx) do setzstrt(yind z,inszzz(mkzel(rowindx,val z), zstrt(yind z))) >>; dest >> else << colindx:=get(item,'varlst!*); z:=assoc(colindx,zstrt rowindx); setzstrt(colindx,delyzz(rowindx,zstrt colindx)); setzstrt(rowindx,delete(z,zstrt rowindx)); if ival(z)=expo then << remprev(rowindx,item); if get(item,'rowindex) then remprev(rowindx,get(item,'rowindex)) >> else << setzstrt(colindx, inszzz(mkzel(rowindx,(ival(z)-expo).bval(z)), zstrt colindx)); setzstrt(rowindx, inszzzr(mkzel(colindx,(ival(z)-expo).bval(z)), zstrt rowindx)) >>; dest >> >> end; symbolic procedure insnord(item,expo,dest,indx); % --- % Multiplies item^expo into dest. Dest is a constant, a variable or a % variable determining a row in CODMAT. % Item is a constant or a variable. % --- begin scalar rowindx; return if constp dest then if constp item then dm!-times(dest,dm!-expt(item,expo)) else << %if (rowindx:=get(item,'rowindex)) then % insquotordr(indx,rowindx) %else % insquotordr(indx,item); item % dest = 1 >> else << rowindx:=get(dest,'rowindex); if constp item then <<setexpcof(rowindx, dm!-times(expcof rowindx,dm!-expt(item,expo))); dest >> else << setzstrt(rowindx,inszzzr(mkzel(car find!*var(item, rowindx,expo), expo),zstrt rowindx)); if get(item,'rowindex) then setprev(rowindx,get(item,'rowindex)) else setprev(rowindx,item); dest >> >> end; symbolic procedure insquotordr(indx,ord); % --- % This procedure inserts ord in all order-lists of rows containing the % quotient indiced by indx. % --- begin scalar col; if (col:=get(getv(qlhs,indx),'varlst!+)) then foreach z in zstrt(col) do setprev(xind z,ord); if (col:=get(getv(qlhs,indx),'varlst!*)) then foreach z in zstrt(col) do setprev(xind z,ord) end; symbolic procedure remquotordr(indx,ord); % --- % This procedure removes ord from all order-lists of rows containing % the quotient indiced by indx. % --- begin scalar col; if (col:=get(getv(qlhs,indx),'varlst!+)) then foreach z in zstrt(col) do remprev(xind z,ord); if (col:=get(getv(qlhs,indx),'varlst!*)) then foreach z in zstrt(col) do remprev(xind z,ord) end; symbolic procedure remprev(x,y); % --- % See setprev. % --- if numberp(farvar x) then remprev(farvar x,y) else setordr(x,remordr(y,ordr x)); symbolic procedure checknord(nord,inrow,indx); begin if inrow then << if null(zstrt inrow) and null(chrow inrow) then << nord:=expcof inrow; remquotordr(indx,inrow); remquotordr(indx,farvar inrow); clearrow(inrow) >> else insquotordr(indx,get(nord,'rowindex)) % In inrow obviously something usefull is defined, so % this cse should be defined for its use. % This means update ordr-fields. JB. 7-5-93. %else % if (zz:=zstrt(inrow)) and null(cdr zz) and % null(chrow inrow) and % !:onep(expcof inrow) and !:onep(ival car zz) then ... % handled by IMPROVELAYOUT >>; return nord end; symbolic procedure remquotient(pnr,indx); % pnr is a variable (row) begin scalar var,col,rowindx; var:=getv(qlhs,indx); if (col:=get(var,'varlst!+)) then foreach z in zstrt col do remprev(xind z,var); if (col:=get(var,'varlst!*)) then foreach z in zstrt col do remprev(xind z,var); tshrinkcol(getv(qlhs,indx),pnr,'varlst!+); tshrinkcol(getv(qlhs,indx),pnr,'varlst!*); for i:=1:(qlkvl) do putv(qrhs,i,subst(pnr,getv(qlhs,indx),getv(qrhs,i))); if (rowindx:=get(pnr,'rowindex)) then pnr:=rowindx; if (col:=get(pnr,'varlst!+)) then foreach z in zstrt col do setprev(xind z,pnr); if (col:=get(pnr,'varlst!*)) then foreach z in zstrt col do setprev(xind z,pnr) end; endmodule; end;