PLAOpsImplA.mesa
Copyright © 1984 by Xerox Corporation. All rights reserved.
Last edited by Curry, December 20, 1985 10:45:54 am PST
Don Curry August 16, 1987 1:47:57 pm PDT
DIRECTORY
Basics,
IO,
PLAOps,
Rope;
PLAOpsImplA: CEDAR PROGRAM IMPORTS Basics, IO, PLAOps, Rope EXPORTS PLAOps =
BEGIN OPEN Basics, PLAOps;
Trace:   PUBLIC BOOLFALSE;
FinishMin: PUBLIC BOOLFALSE;
FinishCS:  PUBLIC BOOLFALSE;
Abort:   PUBLIC BOOLFALSE;
InvalidTermRope: PUBLIC SIGNAL[rope: IO.ROPE] = CODE;
CardSeq:  TYPE = REF CardSeqRec;
CardSeqRec: TYPE = RECORD[SEQUENCE size: CARDINAL OF CARDINAL];
incross:  QWSeq ← NIL;
SavedTerms: PUBLIC Term ← NIL; -- must reuse terms to keep VM from running out
NewTerm: PUBLIC PROC[inBitSize, outBitSize: CARDINAL] RETURNS[term: Term] = {
inWdSize: CARDINAL ← (inBitSize -1)/16+1;
outWdSize: CARDINAL ← (outBitSize -1)/16+1;
IF SavedTerms# NIL
THEN {
term ← SavedTerms; SavedTerms ← SavedTerms.next;
IF inWdSize  # term.in.wdSize THEN term.in ← NEW[QWSeqRec[inWdSize]];
IF outWdSize # term.out.wdSize THEN term.out ← NEW[QWSeqRec[outWdSize]] }
ELSE {
term  ← NEW[TermRec ← [ ]];
term.in ← NEW[QWSeqRec[inWdSize]];
term.out ← NEW[QWSeqRec[outWdSize]] };
term.next ← term.last ← term.kkin ← NIL;
term.use ← term.old ← avail;
term.kin ← NIL;
FOR i: INT IN [0..inWdSize) DO term.in[i]  ← initInQrtWdc ENDLOOP;
FOR i: INT IN [0..outWdSize) DO term.out[i] ← initOutQrtWz ENDLOOP };
CopyTerm: PUBLIC PROC[ref: Term] RETURNS[new: Term] = {
new ← NewTerm[ref.in.wdSize*16, ref.out.wdSize*16];
new.use ← ref.use;
new.old ← ref.old;
new.kin ← ref.kin;
new.kkin ← ref.kkin;
FOR i: CARDINAL IN [0..ref.in.wdSize) DO new.in[i]  ← ref.in[i] ENDLOOP;
FOR i: CARDINAL IN [0..ref.out.wdSize) DO new.out[i] ← ref.out[i] ENDLOOP };
RopeToTerm: PUBLIC PROC[
rope:   IO.ROPE,
list:   TermList,
iFormat:  Format ← NIL,
oFormat:  Format ← NIL] RETURNS[term: Term] = {
SetIn: PROC[q: Qrt] = {
IF iFormat#NIL THEN IF recIdx=(iFormat[fldIdx].firstBit+iFormat[fldIdx].bitSize) THEN
{fldIdx𡤏ldIdx+1; recIdx ← iFormat[fldIdx].firstBit};
IF recIdx >= list.inBits THEN SIGNAL InvalidTermRope[rope];
SetInQrt[q, term, recIdx]; recIdx ← recIdx + 1 };
SetOut: PROC[q: Qrt] = {
IF oFormat#NIL THEN IF recIdx=(oFormat[fldIdx].firstBit+oFormat[fldIdx].bitSize) THEN
{fldIdx𡤏ldIdx+1; recIdx ← oFormat[fldIdx].firstBit};
IF recIdx >= list.outBits THEN SIGNAL InvalidTermRope[rope];
SetOutQrt[q, term, recIdx]; recIdx ← recIdx + 1};
fldIdx: INT ← 0;
recIdx: INT ← 0;
ropeIdx: INT ← 0;
term ← NewTerm[list.inBits, list.outBits];
recIdx ← iFormat[fldIdx].firstBit;
FOR ropeIdx ← ropeIdx, ropeIdx+1 WHILE ropeIdx < rope.Length[] DO
SELECT rope.Fetch[ropeIdx] FROM
'0, '- => SetIn[zero]; '1 => SetIn[one]; 'x, '. => SetIn[dontcare]; '| => EXIT;
ENDCASE
ENDLOOP;
fldIdx ← 0;
recIdx ← oFormat[fldIdx].firstBit;
FOR ropeIdx ← ropeIdx, ropeIdx+1 WHILE ropeIdx < rope.Length[] DO
SELECT rope.Fetch[ropeIdx] FROM
'0, '- => SetOut[ zero]; '1, '+ => SetOut[ one]; 'x, '. => SetOut[ dontcare]; '( => GOTO use;
ENDCASE;
REPEAT use => term.use ← RopeToUse[rope.Substr[ropeIdx+1]] ENDLOOP };
TermToRope: PUBLIC PROC[
term:   Term,
list:   TermList,
showUse:  BOOLFALSE,
iFormat:  Format ← NIL,
oFormat:  Format ← NIL]
RETURNS[rope: IO.ROPE] = {
fldIdx: CARDINAL ← 0;
st:   IO.STREAMIO.ROS[];
inFieldSp: BOOL ← iFormat#NIL AND iFormat[iFormat.size -1].firstBit+1 > iFormat.size;
outFieldSp: BOOL ← oFormat#NIL AND oFormat[oFormat.size -1].firstBit+1 > oFormat.size;
FOR recIdx: INT IN [0..list.inBits) DO
IF iFormat#NIL THEN {
IF recIdx=(iFormat[fldIdx].firstBit+iFormat[fldIdx].bitSize)
THEN{IF inFieldSp THEN st.PutChar[' ];fldIdx𡤏ldIdx+1};
IF fldIdx=iFormat.size THEN EXIT;
IF recIdx< iFormat[fldIdx].firstBit THEN LOOP };
SELECT GetInQrt[term, recIdx] FROM
dontcare => st.PutChar['.];
one  => st.PutChar['1];
zero  => st.PutChar['0]; ENDCASE ENDLOOP;
st.PutRope[" | "];
fldIdx ← 0;
FOR recIdx: INT IN [0..list.outBits) DO
IF oFormat#NIL THEN {
IF recIdx=(oFormat[fldIdx].firstBit+oFormat[fldIdx].bitSize)
THEN{IF outFieldSp THEN st.PutChar[' ];fldIdx𡤏ldIdx+1};
IF fldIdx=oFormat.size THEN EXIT;
IF recIdx< oFormat[fldIdx].firstBit THEN LOOP };
SELECT GetOutQrt[term, recIdx] FROM
dontcare => st.PutChar['.];
one  => st.PutChar['1];
zero  => st.PutChar['-] ENDCASE ENDLOOP;
IF showUse THEN st.PutF[" (%g)", IO.rope[UseToRope[term.use]]];
RETURN[IO.RopeFromROS[st] ]};
AppendTerm: PUBLIC PROC[ref: Term, list: TermList] = {
IF list.end # NIL THEN list.end.next ← ref ELSE list.begin ← ref;
ref.last ← list.end; list.end ← ref; ref.next ← NIL;
list.length ← list.length +1 };
DeleteTerm: PUBLIC PROC[old: Term, list: TermList] = {
IF old = NIL THEN ERROR;
IF old.next # NIL THEN old.next.last ← old.last ELSE list.end ← old.last;
IF old.last  # NIL THEN old.last.next ← old.next ELSE list.begin ← old.next;
list.length ← list.length -1;
SaveTerm[old] };
Add: PUBLIC PROC[tl1, tl2, tl3, tl4, tl5: TermList ← NIL] RETURNS[new: TermList] = {
tl: ARRAY[1..5] OF TermList ← [tl1, tl2, tl3, tl4, tl5];
IF tl1 = NIL THEN RETURN[NIL];
new ← tl1;
FOR i: NAT IN [2..5] DO
IF tl[i] = NIL THEN EXIT; new ← AddTermLists[new, tl[i]] ENDLOOP };
AddTermLists: PROC[list1, list2: TermList] RETURNS[new: TermList] = {
IF list1.inBits  # list2.inBits THEN ERROR;
IF list1.outBits # list2.outBits THEN ERROR;
IF list1.length=0 THEN RETURN[list2];
IF list2.length=0 THEN RETURN[list1];
new ← list1;
list1.end.next ← list2.begin;  list2.begin.last ← list1.end; list1.end ← list2.end;
list1.length ← list1.length + list2.length;
list2^ ← [ ]; RETURN[list1]};
MissingArguments: SIGNAL = CODE;
Or: PUBLIC PROC[tl1, tl2, tl3, tl4, tl5: TermList ← OrFalse] RETURNS[new: TermList] = {
tl: ARRAY[1..5] OF TermList ← [tl1, tl2, tl3, tl4, tl5];
new ← OrFalse;
FOR i: NAT IN [1..5] DO
IF tl[i] = OrFalse THEN LOOP;
IF new=OrFalse
THEN new ← CopyTermList[tl[i]]
ELSE new ← OrTermLists[new, tl[i]] ENDLOOP;
IF new = OrFalse THEN {MissingArguments[]; new ← NIL}};
no arguments - probably should be an ERROR
OrTermLists: PROC[list1, list2: TermList] RETURNS[new: TermList] = {
IF list1.inBits  # list2.inBits THEN ERROR;
IF list1.outBits # list2.outBits THEN ERROR;
IF list1.length=0 THEN RETURN[CopyTermList[list2]];
IF list2.length=0 THEN RETURN[CopyTermList[list1]];
list1 ← CopyTermList[list1];
FOR t: Term ← list2.begin, t.next WHILE t#NIL DO
AppendTerm[CopyTerm[t], list1]; ENDLOOP;
IF list1.length>1 THEN [ ] ← ConvertTermListToCompleteSum[list1, FALSE, FALSE];
RETURN[list1]};
AndTrue: PUBLIC TermList ← NEW[TermListRec];
And: PUBLIC PROC[tl1, tl2, tl3, tl4, tl5: TermList ← AndTrue] RETURNS[new: TermList] = {
tl: ARRAY[1..5] OF TermList ← [tl1, tl2, tl3, tl4, tl5];
new ← AndTrue;
FOR i: NAT IN [1..5] DO
IF tl[i] = AndTrue THEN LOOP;
IF new=AndTrue
THEN new ← tl[i]
ELSE new ← AndTermLists[new, tl[i]] ENDLOOP;
IF new = AndTrue THEN {MissingArguments[]; new ← NIL}};
no arguments - probably should be an ERROR
AndTermLists: PROC[list1, list2: TermList] RETURNS[new: TermList] = {
IF list1 = NIL OR list2 = NIL THEN RETURN[NIL];
IF list1.inBits  # list2.inBits THEN ERROR;
IF list1.outBits # list2.outBits THEN ERROR;
IF list1.length = 0 OR list2.length = 0 THEN RETURN[NIL];
new ← NEW[TermListRec ← [inBits: list1.inBits, outBits: list1.outBits] ];
FOR t: Term ← list1.begin, t.next WHILE t#NIL DO
andTerms: TermList ← AndTerm[t, list2];
IF andTerms.end = NIL OR andTerms.begin = NIL THEN LOOP;
andTerms.end.next ← new.begin;
new.begin   ← andTerms.begin;
andTerms.begin  ← andTerms.end ← NIL;
new.length   ← new.length + andTerms.length;
andTerms.length  ← 0;
IF new.length>1 THEN [ ] ← ConvertTermListToCompleteSum[new, FALSE, FALSE];
ENDLOOP};
AndTerm: PROC[term: Term, list: TermList] RETURNS[new: TermList] = {
intersection: Term ← NewTerm[inBitSize: term.in.wdSize*16, outBitSize: term.out.wdSize*16];
new ← NEW[TermListRec ← [inBits: list.inBits, outBits: list.outBits] ];
FOR t: Term ← list.begin, t.next WHILE t#NIL DO
IF NOT Intersection[term, t, intersection] THEN LOOP;
[ ] ← UpdateCompleteSumWithTerm[new, intersection, FALSE, FALSE];
ENDLOOP };
Not: PUBLIC PROC[tl: TermList] RETURNS[new: TermList] = {
true: Term ← NewTrueTerm[inBitSize: tl.inBits, outBitSize: tl.outBits];
new ← NEW[TermListRec ← [inBits: tl.inBits, outBits: tl.outBits] ];
AppendTerm[true, new];
FOR t: Term ← tl.begin, t.next WHILE t#NIL DO
old: TermList ← new;
notTerm: TermList ← NotTerm[t];
new ← AndTermLists[old, notTerm];
IF old   #NIL THEN SaveListTerms[old];
IF notTerm #NIL THEN SaveListTerms[notTerm];
ENDLOOP };
NotTerm: PROC[term: Term] RETURNS[new: TermList] = {
true: Term ← NewTrueTerm[term.in.wdSize*16, term.out.wdSize*16];
new ← NEW[TermListRec ← [inBits: term.in.wdSize*16, outBits: term.out.wdSize*16] ];
FOR i: CARDINAL IN [0..term.in.wdSize*16) DO
q: Qrt ← GetInQrt[term, i];
SELECT q FROM
dontcare => LOOP;
one => SetInQrt[zero, true, i];
zero => SetInQrt[one,  true, i]; ENDCASE;
AppendTerm[CopyTerm[true], new]; SetInQrt[q, true, i] ENDLOOP;
SaveTerm[true] };
NewTrueTerm:PROC[inBitSize, outBitSize: CARDINAL] RETURNS[copy: Term] = {
copy ← NewTerm[inBitSize: inBitSize, outBitSize: outBitSize];
FOR i: NAT IN [0..copy.in.wdSize)  DO copy.in[i].d ← copy.in[i].m ← 0  ENDLOOP;
FOR i: NAT IN [0..copy.out.wdSize) DO copy.out[i].d ← copy.out[i].m ← 177777B ENDLOOP};
InsUsed: PUBLIC PROC[
list:  TermList] RETURNS[count: CARDINAL] = {
term: Term ← NewTerm[list.inBits, list.outBits];
IF list = NIL THEN RETURN[0];
FOR i: CARDINAL IN [0..term.in.wdSize) DO term.in[i] ← initInQrtWdc ENDLOOP;
FOR t: Term ← list.begin, t.next WHILE t#NIL DO
FOR i: CARDINAL IN [0..term.in.wdSize) DO
term.in[i].m ← BITOR[term.in[i].m, t.in[i].m] ENDLOOP;
ENDLOOP;
count ← CountInMaskOnes[term.in];
SaveTerm[term] };
CopyTermListForField: PUBLIC PROC[
list:  TermList,
firstBit: CARDINAL,
bitSize: CARDINAL ]
RETURNS[newList: TermList] = {
term: Term;
IF list = NIL THEN RETURN[NIL];
term ← NewTerm[list.inBits, list.outBits]; term.in ← NIL; -- Throw away sequence
FOR i: CARDINAL IN [0..term.out.wdSize) DO
term.out[i] ← initOutQrtWz ENDLOOP;
newList ← NEW[TermListRec ← [inBits: list.inBits, outBits: list.outBits]];
FOR t: Term ← list.begin, t.next WHILE t#NIL DO
interesting: BOOLFALSE;
FOR i: CARDINAL IN [firstBit..firstBit+bitSize) DO
q: Qrt ← GetOutQrt[t, i];
SetOutQrt[q, term, i];
interesting ← interesting OR q=one OR q=dontcare ENDLOOP;
IF ~interesting THEN LOOP;
term.in ← t.in; ACopy[term, newList ];
ENDLOOP;
term.in ← NIL };
CopyTermList: PUBLIC PROC[
list:  TermList,
firstOut: CARDINAL ← 0,
lastOut: CARDINAL ← 177777B]
RETURNS[newList: TermList] = {
term: Term;
IF list = NIL THEN RETURN[NIL];
lastOut ← MIN[list.outBits-1, lastOut];
term ← NewTerm[list.inBits, lastOut+1-firstOut]; term.in ← NIL; -- Throw away sequence
FOR i: CARDINAL IN [0..term.out.wdSize) DO
term.out[i] ← initOutQrtWz ENDLOOP;
newList ← NEW[TermListRec ← [inBits: list.inBits, outBits: lastOut+1-firstOut ]];
FOR t: Term ← list.begin, t.next WHILE t#NIL DO
interesting: BOOLFALSE;
FOR i: CARDINAL IN [firstOut..lastOut] DO
q: Qrt ← GetOutQrt[t, i];
SetOutQrt[q, term, i-firstOut];
interesting ← interesting OR q=one OR q=dontcare ENDLOOP;
IF ~interesting THEN LOOP;
term.in ← t.in; ACopy[term, newList ];
ENDLOOP;
term.in ← NIL };
ListTermList: PUBLIC PROC[
list:   TermList,
showUse:  BOOL   ← FALSE,
omitDeletes: BOOL   ← FALSE,
log:   IO.STREAM ← NIL,
iFormat:  Format  ← NIL,
oFormat:  Format  ← NIL ] = {
IF log=NIL THEN log ← IO.noWhereStream;
FOR term: Term ← list.begin, term.next WHILE term#NIL DO
IF omitDeletes AND term.use = del THEN LOOP;
log.PutRope["\n"];
log.PutRope[TermToRope[term, list, showUse, iFormat, oFormat]] ENDLOOP;
log.PutRope["\n"] };
SortTermList: PUBLIC PROC[
list:  TermList,
bigFirst: BOOLTRUE] = {
size: CardSeq ← NEW[CardSeqRec[list.length]];
temp: Term ← NEW[TermRec];
term: Term ← list.begin;
done: BOOLFALSE;
FOR i: CARDINAL IN [0..list.length) DO
size[i] ← InSize[term]; term ← term.next; ENDLOOP;
WHILE NOT done DO
done ← TRUE;
term ← list.begin;
FOR i: CARDINAL IN [0..list.length-1) DO
IF (IF bigFirst THEN (size[i] < size[i+1]) ELSE (size[i+1] < size[i])) THEN {
s: CARDINAL ← size[i]; size[i] ← size[i+1]; size[i+1] ← s;
done←FALSE;
temp^←term^;
term.use  ← term.next.use;   term.next.use   ← temp.use;
term.old  ← term.next.old;   term.next.old   ← temp.old;
term.best  ← term.next.best;   term.next.best  ← temp.best;
term.kin  ← term.next.kin;   term.next.kin   ← temp.kin;
term.kkin  ← term.next.kkin;  term.next.kkin  ← temp.kkin;
term.in  ← term.next.in;   term.next.in   ← temp.in;
term.out  ← term.next.out;   term.next.out   ← temp.out;
term ← term.next};
ENDLOOP;
ENDLOOP};
CompareTerms: PUBLIC PROC[t0,t1: Term] RETURNS[comp: Basics.Comparison] = {
FOR i: INT IN [0..t0.in.wdSize) DO
SELECT Basics.CompareCard[t0.in[i].m, t1.in[i].m] FROM
less  => RETURN[less];
greater => RETURN[greater];
ENDCASE => LOOP ENDLOOP;
FOR i: INT IN [0..t0.in.wdSize) DO
SELECT Basics.CompareCard[t0.in[i].d, t1.in[i].d] FROM
less  => RETURN[less];
greater => RETURN[greater];
ENDCASE => LOOP ENDLOOP;
FOR i: INT IN [0..t0.out.wdSize) DO
SELECT Basics.CompareCard[t0.out[i].d, t1.out[i].d] FROM
less  => RETURN[less];
greater => RETURN[greater];
ENDCASE => LOOP ENDLOOP;
RETURN[equal]};
FastSortTermList: PUBLIC PROC[list: TermList] RETURNS[new: TermList] = {
TermSzSeqRec: TYPE = RECORD[SEQUENCE size: CARDINAL OF TermSzRec];
TermSzRec:  TYPE = RECORD[sz: INT, term: Term];
TwoTermSzRec: TYPE = RECORD[t0, t1: TermSzRec];
terms: REF TermSzSeqRec ← NEW[TermSzSeqRec[list.length]];
term: Term ← list.begin;
new ← NEW[TermListRec ← [inBits: list.inBits, outBits: list.outBits ]];
FOR i: CARDINAL IN [0..list.length) DO
terms[i].sz ← InSize[term];
terms[i].term ← CopyTerm[term]; term ← term.next; ENDLOOP;
DO
done: BOOLTRUE;
FOR i: CARDINAL IN [0..terms.size-1) DO
SELECT Basics.CompareInt[terms[i].sz, terms[i+1].sz] FROM
less   => LOOP;
equal   => SELECT CompareTerms[terms[i].term, terms[i+1].term] FROM
less    => LOOP;
equal   => LOOP;
ENDCASE;
ENDCASE;
[terms[i], terms[i+1]] ← TwoTermSzRec[terms[i+1], terms[i]];
done ← FALSE ENDLOOP;
IF done THEN EXIT ENDLOOP;
FOR i: CARDINAL IN [0..list.length) DO
AppendTerm[terms[i].term, new]; ENDLOOP};
GetTermVal: PUBLIC PROC[term: Term, list: TermList] = {
Assume that dontcares are only found in the .in fields of list terms
FOR i: CARDINAL IN [0..term.out.wdSize) DO
term.out[i].d ← 0; term.out[i].m ← 177777B; ENDLOOP;
FOR i: CARDINAL IN [0..term.in.wdSize) DO
IF term.in[i].m # 177777B THEN ERROR ENDLOOP; -- supposed to be completely specified
FOR ref: Term ← list.begin, ref.next WHILE ref#NIL DO
FOR i: CARDINAL IN [0..term.in.wdSize) DO
IF BITAND[ref.in[i].m, BITXOR[ref.in[i].d, term.in[i].d]]#0
THEN GOTO Loop; REPEAT Loop => LOOP ENDLOOP;
FOR i: CARDINAL IN [0..ref.out.wdSize) DO
term.out[i].d ← BITOR[ref.out[i].d, term.out[i].d];
IF BITAND[ref.out[i].m, term.out[i].m] # 177777B THEN ERROR; -- no dontcares
ENDLOOP;
ENDLOOP };
ConvertTermListToCompleteSum: PUBLIC PROC[
list:    TermList,
addMerges:  BOOLEAN,
addConsensus: BOOLEAN,
log:    IO.STREAMIO.noWhereStream] RETURNS[unfinished: BOOL] = {
unfinished←FALSE;
ConvertListStartingAt[list.begin, list, addMerges, addConsensus, log];
IF FinishCS THEN {FinishCS←FALSE; unfinished←TRUE} };
UpdateCompleteSumWithTerm: PUBLIC PROC [
sum:    TermList,
term:    Term,
addMerges:  BOOLEAN,
addConsensus: BOOLEAN,
log:    IO.STREAMIO.noWhereStream ]
RETURNS[unfinished: BOOL] = {
unfinished←FALSE;
FOR i: CARDINAL IN [0..term.out.wdSize) DO IF term.out[i].d # 0 THEN EXIT;
REPEAT FINISHED => IF FinishCS
THEN {FinishCS←FALSE; RETURN[TRUE]}
ELSERETURN[FALSE] ENDLOOP;
ACopy[term, sum];
ConvertListStartingAt[sum.end.last, sum, addMerges, addConsensus, log];
IF FinishCS THEN {FinishCS←FALSE; unfinished←TRUE} };
********* PRIVATE **********
VerifyList: PROC[list: TermList] = {
FOR temp: Term ← list.begin, temp.next WHILE temp#NIL DO
IF list.end=temp
THEN {IF temp.next#NIL THEN ERROR} 
ELSE {IF temp.next.last#temp THEN ERROR};
IF list.begin=temp
THEN {IF temp.last#NIL THEN ERROR} 
ELSE {IF temp.last.next#temp THEN ERROR};
ENDLOOP};
ConvertListStartingAt: PROC[
pB:    Term,
list:    TermList,
addMerges:  BOOLEAN,
addConsensus: BOOLEAN,
log:    IO.STREAMIO.noWhereStream] = {
DelA: PROC = INLINE {pA←pA.next; DeleteTerm[pA.last, list]};
DelB:  PROC = INLINE
{pB←pB.last; DeleteTerm[pB.next, list]; pA←list.begin};
pA, pC: Term;
IF pB=NIL THEN RETURN;
pC ← NewTerm[pB.in.wdSize*16, pB.out.wdSize*16];
IF pB # NIL THEN WHILE pB.next # NIL DO
IF Abort THEN EXIT;
pB ← pB.next;
IF Trace THEN {
cntTerm: Term;
doneCount, leftCount: CARDINAL ← 0;
FOR cntTerm ← list.begin, cntTerm.next WHILE cntTerm # pB DO
doneCount ← doneCount+1 ENDLOOP;
FOR cntTerm ← cntTerm, cntTerm.next WHILE cntTerm # NIL DO
leftCount ← leftCount+1 ENDLOOP;
log.PutF["\nSum size = %03g|%03g at %g",
IO.card[doneCount], IO.card[leftCount], IO.time[]]};
FOR pA ← pB.last, pA.last WHILE pA # NIL DO
covered: BOOLFALSE;
p: Term;
SELECT Consensus[pA,pB,pC] FROM
bad  => ERROR;
nop  => {LOOP};
delB  => {DelB[]; LOOP};
delA  => {DelA[]; LOOP};
addC  => {IF ~addConsensus OR FinishCS THEN LOOP};
addM  => {IF ~addMerges  OR FinishCS THEN LOOP};
delBaddC => {DelB[]};
delAaddC => {DelA[]};
del2addC => {DelA[]};
ENDCASE => ERROR;
p ← list.begin;
WHILE p#NIL DO
IF InCrossed[pC, p]  THEN {p←p.next;          LOOP};
IF FstInSecXdIns[pC, p] AND FstInSecXdOuts[pC, p]
THEN       {p←p.next; covered ← TRUE;      LOOP};
IF ~FstInSecXdIns[p, pC] OR ~FstInSecXdOuts[p, pC] THEN {p←p.next;  LOOP};
IF p#pA AND p#pB AND p.next#NIL THEN {p←p.next; DeleteTerm[p.last, list]; LOOP};
IF p#pA AND p#pB      THEN {DeleteTerm[p, list]; p←NIL;  LOOP};
IF p=pA AND p#pB  THEN {p←p.next;  DelA[];      LOOP};
IF p#pA AND p=pB THEN {p←p.next;   DelB[];      LOOP};
IF p.last #  NILTHEN {p←p.next;   DelB[];      LOOP};
IF p.next #  NILTHEN {p←pB←p.next; DeleteTerm[pB.last, list]; pA←list.begin; LOOP};
IF covered THEN ERROR;
ACopy[pC, list];
IF list.length#2 THEN ERROR;
DeleteTerm[list.begin, list];
pA←pB←list.end; EXIT;
REPEAT FINISHED => IF ~covered THEN ACopy[pC, list] ENDLOOP;
ENDLOOP;
ENDLOOP;
SaveTerm[pC]};
ConsensusResult: TYPE = {nop,delB,delA,addC,addM,delBaddC,delAaddC,del2addC,bad};
Consensus: PROC[pA,pB,pC: Term] RETURNS [r: ConsensusResult]
= INLINE {
sel: [0..32) ← 16;
inCrossMask: QWSeq ← InCrossMask[pA, pB];
cnt: CARDINAL ← CountInMaskOnesLmt[inCrossMask];
IF cnt>1 THEN RETURN[nop];
IF OutCrossed[pA,pB] THEN IF cnt = 1
THEN RETURN[nop]
ELSE ERROR; -- Error["Bad Terms"]; RETURN[bad]
ConsensusInputs[pA,pB,pC,inCrossMask];
IF cnt=1
THEN {sel ← 16; IF ~ConsensusOutputs[pA,pB,pC] THEN RETURN[nop]}
ELSE {sel ← 0; MergeOutputs[pA,pB,pC]};
IF FstInSecXdIns  [pB,pA] THEN sel ← sel + 8; -- A>B inputs
IF FstInSecXdIns  [pA,pB] THEN sel ← sel + 4; -- B>A inputs
IF FstInSecXdOuts [pB,pA] THEN sel ← sel + 2; -- A>B outputs
IF FstInSecXdOuts [pA,pB] THEN sel ← sel + 1; -- B>A outputs
r ← SELECT sel FROM
0 => addM, 1 => nop, 2 => nop, 3 => nop,
4 => addM, 5 => delA, 6 => nop, 7 => delA,
8 => addM, 9 => nop, 10 => delB, 11 => delB,
12 => del2addC, 13 => delA, 14 => delB, 15 => delA,
16 => addC, 17 => addC, 18 => addC, 19 => addC,
20 => addC, 21 => delAaddC, 22 => addC, 23 => delAaddC,
24 => addC, 25 => addC, 26 => delBaddC, 27 => delBaddC,
28 => addC, 29 => delAaddC, 30 => delBaddC, 31 => del2addC,
ENDCASE => ERROR;
RETURN[r]};
CountInMaskOnesLmt: PROC [cross: QWSeq] RETURNS[cnt: CARDINAL] = INLINE{
cnt ← 0;
FOR i: CARDINAL IN [0..cross.wdSize) WHILE cnt < 2 DO
word: CARDINAL ← cross[i].m;
word ← BITAND[word,052525B] + BITSHIFT[BITAND[word,125252B], -1];
word ← BITAND[word,031463B] + BITSHIFT[BITAND[word,146314B], -2];
word ← BITAND[word,007417B] + BITSHIFT[BITAND[word,170360B], -4];
word ← BITAND[word,000377B] + BITSHIFT[BITAND[word,177400B], -8];
cnt ← cnt + word;
ENDLOOP};
CountInMaskOnes: PROC [cross: QWSeq] RETURNS[cnt: CARDINAL] = {
cnt ← 0;
FOR i: CARDINAL IN [0..cross.wdSize) DO
word: CARDINAL ← cross[i].m;
word ← BITAND[word,052525B] + BITSHIFT[BITAND[word,125252B], -1];
word ← BITAND[word,031463B] + BITSHIFT[BITAND[word,146314B], -2];
word ← BITAND[word,007417B] + BITSHIFT[BITAND[word,170360B], -4];
word ← BITAND[word,000377B] + BITSHIFT[BITAND[word,177400B], -8];
cnt ← cnt + word;
ENDLOOP};
InSize: PROC [term: Term] RETURNS[cnt: CARDINAL] = {
cnt ← 0;
FOR i: CARDINAL IN [0..term.in.wdSize) DO
word: CARDINAL ← 177777B - term.in[i].m; -- compliment => counting dontcares
word ← BITAND[word,052525B] + BITSHIFT[BITAND[word,125252B], -1];
word ← BITAND[word,031463B] + BITSHIFT[BITAND[word,146314B], -2];
word ← BITAND[word,007417B] + BITSHIFT[BITAND[word,170360B], -4];
word ← BITAND[word,000377B] + BITSHIFT[BITAND[word,177400B], -8];
cnt ← cnt + word;
ENDLOOP};
1 0 => TRUE
InCrossed: PROC[pA, pB: Term] RETURNS[inCrossed: BOOL] = INLINE {
FOR i: CARDINAL IN [0..pA.in.wdSize) DO
IF BITAND[BITAND[pA.in[i].m, pB.in[i].m], BITXOR[pA.in[i].d, pB.in[i].d]]#0
THEN RETURN[TRUE]
ENDLOOP;
RETURN[FALSE]};
1 0 => TRUE
InCrossMask: PROC[pA, pB: Term] RETURNS[QWSeq] = INLINE {
IF incross = NIL OR incross.wdSize#pA.in.wdSize
THEN incross ← NEW[QWSeqRec[pA.in.wdSize]];
FOR i: CARDINAL IN [0..pA.in.wdSize) DO incross[i].m ←
BITAND[BITAND[pA.in[i].m, pB.in[i].m], BITXOR[pA.in[i].d, pB.in[i].d]] ENDLOOP;
RETURN[incross]};
1 * => TRUE
OutCrossed: PROC[pA,pB: Term] RETURNS[crossed: BOOL] = INLINE {
crossed ← FALSE;
FOR i: CARDINAL IN [0..pA.out.wdSize) DO crossed ← crossed OR
(BITAND[BITAND[pA.out[i].d, pB.out[i].d], BITXOR[pA.out[i].m, pB.out[i].m]]) # 0;
ENDLOOP};
IF mask
THEN *
ELSE
0 1 *
0 | 0 1 0
1 | 1 1 1
* | 0 1 *
ConsensusInputs: PROC[pA,pB,pC: Term, mask: QWSeq ← NIL] = INLINE {
IF mask = NIL
THENFOR i: CARDINAL IN [0..pA.in.wdSize) DO
pC.in[i].d  ← BITOR[pA.in[i].d, pB.in[i].d];
pC.in[i].m ← BITOR[pA.in[i].m, pB.in[i].m]
ENDLOOP
ELSEFOR i: CARDINAL IN [0..pA.in.wdSize) DO
pC.in[i].d  ← BITAND[ BITOR[pA.in[i].d, pB.in[i].d], BITNOT[mask[i].m]];
pC.in[i].m ← BITAND[ BITOR[pA.in[i].m, pB.in[i].m], BITNOT[mask[i].m]]
ENDLOOP};
0 1 *
0 | 0 0 0
1 | 0 1 1
* | 0 1 *
ConsensusOutputs: PROC[pA, pB, pC: Term] RETURNS[BOOLEAN] = INLINE {
allZero: BOOLTRUE;
FOR i: CARDINAL IN [0..pA.out.wdSize) DO
pC.out[i].d ← BITAND [pA.out[i].d, pB.out[i].d];
pC.out[i].m ← BITOR  [pA.out[i].m, pB.out[i].m];
allZero ← allZero AND pC.out[i].d = 0;
ENDLOOP;
RETURN[NOT allZero]};
0 1 *
0 | 0 1 0
1 | 1 1 *
* | 0 * *
MergeOutputs: PROC[pA,pB,pC: Term] = INLINE {
FOR i: CARDINAL IN [0..pA.out.wdSize) DO
pC.out[i].d ← BITOR [pA.out[i].d, pB.out[i].d];
pC.out[i].m ← BITAND [pA.out[i].m, pB.out[i].m];
ENDLOOP};
FstInSecXdIns: PROC[aa,AA: Term] RETURNS[result: BOOLEAN] = INLINE {
result ← TRUE;
FOR i: CARDINAL IN [0..aa.in.wdSize) DO
result ← result AND (BITAND[BITNOT[aa.in[i].m], AA.in[i].m]=0) ENDLOOP};
FstInSecXdOuts: PROC[aa,AA: Term] RETURNS[result: BOOLEAN] = INLINE {
result ← TRUE;
FOR i: CARDINAL IN [0..aa.out.wdSize) DO
result ← result AND (BITAND[aa.out[i].d, BITNOT[AA.out[i].d]]=0) ENDLOOP};
SetInQrt: PUBLIC PROC[q: Qrt, t: Term, index: CARDINAL] = {
t.in[index/16].m  ← SetBit[t.in[index/16].m, index MOD 16, q=zero OR q=one];
t.in[index/16].d  ← SetBit[t.in[index/16].d, index MOD 16, q=one]};
GetInQrt: PUBLIC PROC[term:Term, index:CARDINAL] RETURNS[q:Qrt] = {
IF GetBit[term.in[index/16].m, index MOD 16]
THEN IF GetBit[term.in[index/16].d, index MOD 16]
THEN RETURN[one]    ELSE RETURN[zero]
ELSE IF GetBit[term.in[index/16].d, index MOD 16]
THEN ERROR      ELSE RETURN[dontcare]};
SetOutQrt: PUBLIC PROC[q: Qrt, t: Term, index: CARDINAL] = {
t.out[index/16].m ← SetBit[t.out[index/16].m, index MOD 16, q=zero OR q=one];
t.out[index/16].d  ← SetBit[t.out[index/16].d, index MOD 16, q#zero]};
GetOutQrt: PUBLIC PROC[term:Term, index:CARDINAL] RETURNS[q: Qrt] = {
IF GetBit[term.out[index/16].m, index MOD 16]
THEN IF GetBit[term.out[index/16].d, index MOD 16]
THEN RETURN[one]    ELSE RETURN[zero]
ELSE IF GetBit[term.out[index/16].d, index MOD 16]
THEN RETURN[undefined]  ELSE ERROR};
SetBit: PROC[word, index: CARDINAL, val: BOOL] RETURNS[CARDINAL] = {IF val
THENRETURN[Basics.BITOR [word,      Basics.BITSHIFT[1, 15-index]]]
ELSERETURN[Basics.BITAND [word, Basics.BITNOT[ Basics.BITSHIFT[1, 15-index]]] ]};
GetBit: PROC[word: CARDINAL, index:CARDINAL] RETURNS[BOOLEAN] = {
RETURN[ Basics.BITAND[word, Basics.BITSHIFT[1, 15-index]] # 0 ]};
RopeToFormat: PUBLIC PROC [rope: IO.ROPE] RETURNS[iFormat, oFormat: Format] = {
ropeIdx, spaceIndex, bitIndex, startIndex: INT ← 0;
spaceBefore: BOOL;
temp: CardSeq ← NEW[CardSeqRec[rope.Length[]]];
startIndex ← ropeIdx; spaceIndex ← bitIndex ← 0; spaceBefore ← TRUE;
FOR ropeIdx ← startIndex, ropeIdx+1 WHILE ropeIdx < rope.Length[] DO
SELECT rope.Fetch[ropeIdx] FROM
'0, '1, '-, '+, 'x, 'X, '. => {
IF spaceBefore THEN {temp[spaceIndex]𡤋itIndex; spaceIndex←spaceIndex+1};
bitIndex ← bitIndex+1;
spaceBefore ← FALSE };
IO.SP, IO.TAB  => spaceBefore ← TRUE;
'|     => EXIT;
ENDCASE ENDLOOP;
temp[spaceIndex]𡤋itIndex;
iFormat ← NEW[FormatSeq[spaceIndex]];
FOR fldIdx: NAT ← 0, fldIdx+1 WHILE fldIdx < spaceIndex DO
iFormat[fldIdx].firstBit ← temp[fldIdx];
iFormat[fldIdx].bitSize ← temp[fldIdx+1]-temp[fldIdx];
iFormat[fldIdx].name ← "field";
iFormat[fldIdx].name ← iFormat[fldIdx].name.Cat[IO.PutFR["%02g",IO.card[fldIdx]]]
ENDLOOP;
startIndex ← ropeIdx; spaceIndex ← bitIndex ← 0; spaceBefore ← TRUE;
FOR ropeIdx ← startIndex, ropeIdx+1 WHILE ropeIdx < rope.Length[] DO
SELECT rope.Fetch[ropeIdx] FROM
'0, '1, '-, '+, 'x, 'X, '. => {
IF spaceBefore THEN {temp[spaceIndex]𡤋itIndex; spaceIndex←spaceIndex+1};
bitIndex ← bitIndex+1;
spaceBefore ← FALSE };
IO.SP, IO.TAB  => spaceBefore ← TRUE;
ENDCASE ENDLOOP;
temp[spaceIndex]𡤋itIndex;
oFormat ← NEW[FormatSeq[spaceIndex]];
FOR fldIdx: NAT ← 0, fldIdx+1 WHILE fldIdx < spaceIndex DO
oFormat[fldIdx].firstBit ← temp[fldIdx];
oFormat[fldIdx].bitSize ← temp[fldIdx+1]-temp[fldIdx];
oFormat[fldIdx].name ← "field";
oFormat[fldIdx].name ← oFormat[fldIdx].name.Cat[IO.PutFR["%02g",IO.card[fldIdx]] ]
ENDLOOP };
RopeToUse: PROC[rope: IO.ROPE] RETURNS[Use] = {
SELECT rope.Fetch[0] FROM
'A => RETURN[avail];
'U => RETURN[used];
'E => RETURN[ess];
'S => RETURN[skip];
'D => RETURN[del];
ENDCASE => SIGNAL InvalidTermRope[rope];
RETURN[avail] };
UseToRope: PROC[use: Use] RETURNS[IO.ROPE] = {
SELECT use FROM
avail => RETURN["Available"];
used  => RETURN["Used"];
ess => RETURN["Essential"];
skip => RETURN["Skipped"];
del => RETURN["Deleted"];
ENDCASE => ERROR };
ACopy: PUBLIC PROC[ref: Term, list: TermList] = {
allDontCare: BOOLTRUE;
FOR i: CARDINAL IN [0..ref.in.wdSize) DO
IF NOT (allDontCare ← allDontCare AND ref.in[i] = initInQrtWdc) THEN EXIT ;
REPEAT FINISHED => ERROR ENDLOOP;
AppendTerm[CopyTerm[ref], list] };
END.