[_CD4_]<datools7.0>PLAOps>PLAOpsImplB.mesa!1

PLAOpsImplB.mesa

Last edited by Curry, September 24, 1984 5:01:52 am PDT

DIRECTORY

PLAOps,

Process,

IO,

Rope,

Basics USING[BITAND, BITOR, BITXOR];

PLAOpsImplB: CEDAR PROGRAM

IMPORTS Basics, IO, PLAOps, Process, Rope EXPORTS PLAOps =

BEGIN OPEN Basics, PLAOps;

c: ARRAY Use OF CARDINAL;

essInterList: TermList ← NEW[TermListRec ← [ ]];

delInterList: TermList ← NEW[TermListRec ← [ ]];

FindAMinimalCover: PUBLIC PROC[

list: TermList,

time: CARDINAL,

log: IO.STREAM ← IO.noWhereStream]

RETURNS[initEss, initDel, bestCov: CARDINAL, unfinished: BOOL] = {

intersection: Term ← CopyTerm[list.begin];

interList: TermList ← NEW[TermListRec ← [inBits: list.inBits, outBits: list.outBits]];

c ← ALL[0];

SavedTerms ← NIL;

Initialize kin lists with all other terms which intersect

log.PutRope["\n\nInitialize kin lists"];

FOR t1: Term ← list.begin, t1.next WHILE t1#NIL DO

t1.kin ← NIL;

FOR t2: Term ← list.begin, t2.next WHILE t2#NIL DO

IF t1=t2 THEN LOOP;

IF Intersection[t1, t2, intersection] THEN t1.kin ← CONS[t2, t1.kin] ENDLOOP;

ENDLOOP;

Initialize essentials

log.PutRope["\nFind essential terms"];

FOR t1: Term ← list.begin, t1.next WHILE t1#NIL DO

IF ~Abort AND TermCoveredByUsedEssKin[availToo, t1, intersection, interList]

THEN IF ~Abort THEN

{t1.old←t1.best←used;t1.use𡤊vail;c[avail]𡤌[avail]+1; SaveListTerms[interList];LOOP};

t1.old←t1.best←t1.use𡤎ss; c[ess]𡤌[ess]+1; SaveListTerms[interList];

ENDLOOP;

log.PutF[" - %g of %g were essential", IO.card[c[ess]], IO.card[list.length]];

Initialize deletes

log.PutRope["\nFind initial deleted terms"];

FOR t1: Term ← list.begin, t1.next WHILE t1#NIL AND ~Abort DO

IF t1.use = ess THEN LOOP;

IF TermCoveredByUsedEssKin[notAvail, t1, intersection, interList] THEN

IF ~Abort THEN

{t1.best ← t1.old ← t1.use ← del; c[del]𡤌[del]+1; c[avail]𡤌[avail]-1};

SaveListTerms[interList];

ENDLOOP;

log.PutF[" - %g of %g were deleted", IO.card[c[del]], IO.card[c[del]+c[avail]]];

SaveTerm[intersection];

initDel𡤌[del]; initEss𡤌[ess]; bestCov𡤌[avail]+c[ess]; unfinished←TRUE;

IF Abort THEN RETURN;

PutUseAtEndOfList[use: del, atTop: TRUE, list: list];

PutUseAtEndOfList[use: avail, atTop: FALSE, list: list]; -- essentials in middle

[bestCov, unfinished] ← SearchIndependentAvailSets[list, time, log];

FOR t1: Term ← list.begin, t1.next WHILE t1#NIL DO t1.use ← t1.best ENDLOOP;

WHILE list.begin.use=del DO DeleteTerm[list.begin, list] ENDLOOP;

FOR t1: Term ← list.begin, t1.next WHILE t1.next#NIL DO

WHILE t1.next.use=del DO DeleteTerm[t1.next, list]; IF t1.next=NIL THEN GOTO Exit

REPEAT Exit => EXIT ENDLOOP;

ENDLOOP };

SearchIndependentAvailSets: PROC[

list: TermList,

time: CARDINAL,

log: IO.STREAM]

RETURNS[nextBest: CARDINAL, unfinished: BOOL] = {

timer: PROCESS;

index: CARDINAL 𡤁

nofSets: CARDINAL;

listTList: LIST OF TList;

firstA: Term ← NIL;

FOR firstA ← list.begin, firstA.next WHILE firstA#NIL AND firstA.use#avail DO ENDLOOP;

nextBest ← 0;

unfinished ← FALSE;

Get Avail lists

[nofSets, listTList] ← GetSetList[list];

IF nofSets=0 THEN RETURN[c[ess], FALSE];

Try to find better cover

FOR setList: LIST OF TList ← listTList, setList.rest WHILE setList#NIL DO

minCover: CARDINAL;

quit: BOOL;

setRope: IO.ROPE;

FOR tList: TList ← setList.first, tList.rest WHILE tList#NIL DO

c[del]𡤌[del]-1; c[avail]𡤌[avail]+1;

tList.first.use ← avail;

ENDLOOP;

IF Size[setList.first]#c[avail] THEN ERROR;

setRope ← IO.PutFR["Set%2g of%2g size:%3g +%3g(ess) =%3g",

IO.card[index],IO.card[nofSets],IO.card[c[avail]],IO.card[c[ess]],IO.card[c[avail]+c[ess]]];

IF Trace THEN log.PutRope[setRope];

IF Abort

THEN {minCover ← c[ess]+c[avail]; quit←TRUE}

ELSE {

timer ← FORK TimeOut[time];

[minCover, quit] ← CoverAvails[list, setRope, firstA, log];

TimeOutQuit[]; TRUSTED{JOIN timer} };

nextBest ← nextBest + minCover - c[ess]; -- sum of ind avails which must be used

unfinished ← unfinished OR quit; FinishMin ← FALSE;

FOR tList: TList ← setList.first, tList.rest WHILE tList#NIL DO

tList.first.old ← tList.first.best; -- should be safe here until restoration in next section

tList.first.use ← del;

c[del] ← c[del]+1;

c[avail] ← c[avail]-1

ENDLOOP;

index ← index+1;

ENDLOOP;

nextBest ← nextBest + c[ess];

Restore best state

FOR setList: LIST OF TList ← listTList, setList.rest WHILE setList#NIL DO

FOR tList: TList ← setList.first, tList.rest WHILE tList#NIL DO

c[tList.first.use] ← c[tList.first.use] -1;

c[tList.first.old] ← c[tList.first.old] +1;

tList.first.use ← tList.first.best ← tList.first.old

ENDLOOP

ENDLOOP };

CoverAvails: PROC[

list: TermList,

setRope: IO.ROPE,

firstA: Term,

log: IO.STREAM]

RETURNS[nextBest: CARDINAL, unfinished: BOOL] = {

nAvail,top: Term ← NIL;

stack: REF TermSeqRec ← NEW[TermSeqRec [list.length]];

stackTop: CARDINAL ← 0;

aCnt, sCnt: CARDINAL ← 0;

initEss: CARDINAL ← c[ess];

yieldCnt: CARDINAL ← 0;

nextBest ← c[avail]+c[ess];

FOR nAvail ← firstA, nAvail.next WHILE nAvail#NIL AND nAvail.use#avail DO ENDLOOP;

DO

ENABLE UNWIND => EXIT;

instack: BOOL;

IF (yieldCnt ← ((yieldCnt+1) MOD 20))=0 THEN Process.Yield[];

IF Trace THEN {

log.PutF["\nBest:%3g ", IO.card[nextBest]];

instack ← stackTop>0;

FOR t: Term𡤏irstA, t.next WHILE t#NIL DO

SELECT t.use FROM

avail => log.PutRope["A"];

used => log.PutRope["u"];

ess => log.PutRope["e"];

skip => log.PutRope["S"];

ENDCASE => log.PutRope["."];

IF stackTop>0 THEN instack ← instack AND stack[stackTop-1]#t

ENDLOOP;

log.PutRope[" "]};

IF nAvail # NIL AND (c[skip]+c[avail])>0 AND (c[ess]+c[used]+1) < nextBest THEN {

ok: BOOL;

stack[stackTop] ← nAvail; stackTop ← stackTop+1; top ← stack[stackTop-1];

top.use ← skip;

c[avail] ← c[avail] - 1;

c[skip] ← c[skip] + 1;

[ok, aCnt] ← MarkEssentialAvails -- check new skip's kin to see if essential

[list: list, kkin: top, lim: nextBest-c[ess]-c[used]-1];

c[avail] ← c[avail] - aCnt;

c[ess] ← c[ess] + aCnt;

IF ~ok THEN {nAvail ← NIL; RestoreKin[top, ess]; LOOP}; -- can't help

IF aCnt>0 THEN FOR ref: TList ← top.kin, ref.rest WHILE ref#NIL DO -- for each new ess

IF ref.first.kkin #top THEN LOOP;

IF ref.first.use #ess THEN ERROR;

[aCnt, sCnt] ← DeleteCoveredAvailSkips[list, ref.first];

c[del] ← c[del] + aCnt + sCnt;

c[avail] ← c[avail] - aCnt;

c[skip] ← c[skip] - sCnt;

ENDLOOP;

IF (c[ess]+c[used]+1) >= nextBest OR (c[skip]+c[avail])=0 OR FinishMin

THEN nAvail ← NIL -- => POP again

ELSE FOR nAvail ← top.next, nAvail.next WHILE nAvail#NIL AND nAvail.use#avail

DO ENDLOOP;

LOOP};

IF (c[skip]+c[avail])=0 AND (c[ess]+c[used]) < nextBest THEN {

nextBest ← c[ess]+c[used];

log.PutF["\n%g -> Cover:%3g +%3g(ess) =%3g %g",

IO.rope[setRope], IO.card[nextBest-initEss], IO.card[initEss], IO.card[nextBest], TOD[]];

TimeOutReset[];

FOR t: Term ← list.begin, t.next WHILE t#NIL DO t.best ← t.use ENDLOOP };

IF stackTop=0 THEN EXIT;

top ← stack[stackTop-1];

SELECT stack[stackTop-1].use FROM

skip, del => { -- del only when skip => essentials => self coverage

FOR essByTop: TList←top.kin, essByTop.rest WHILE essByTop # NIL DO

IF essByTop.first.kkin#top THEN LOOP; essByTop.first.kkin ← NIL;

IF essByTop.first.use # ess THEN ERROR;

IF essByTop.first.old # avail THEN ERROR;

essByTop.first.use ← essByTop.first.old;

c[ess] ← c[ess] - 1;

c[avail] ← c[avail] + 1;

RestoreKin[kkin: essByTop.first, curUse: del] ENDLOOP;

IF top.use#skip THEN ERROR; -- del should have been fixed

top.use ← used;

c[skip] ← c[skip] - 1;

c[used] ← c[used] + 1;

[aCnt, sCnt] ← DeleteCoveredAvailSkips[list: list, kkin: top];

c[del] ← c[del] + aCnt + sCnt;

c[avail] ← c[avail] - aCnt;

c[skip] ← c[skip] - sCnt;

IF (c[ess]+c[used]+1) >= nextBest OR (c[skip]+c[avail])=0 OR FinishMin

THEN nAvail ← NIL -- => POP again

ELSE FOR nAvail ← top.next, nAvail.next WHILE nAvail#NIL AND nAvail.use#avail

DO ENDLOOP;

LOOP };

used => {

stackTop ← stackTop-1;

RestoreKin[kkin: top, curUse: del];

top.use ← avail; -- reset all stacked up skips to avail

c[used] ← c[used] - 1;

c[avail] ← c[avail] + 1;

nAvail ← NIL; -- backup until top.use = skip;

LOOP};

ENDCASE => ERROR;

ENDLOOP;

IF (unfinished ← FinishMin) THEN log.PutF[" <<incomplete search>> %g",TOD[]] };

Size: PROC [tList: TList] RETURNS[size: CARDINAL] =

{size𡤀 FOR t1: TList ← tList, t1.rest WHILE t1#NIL DO size ← size +1 ENDLOOP};

GetSetList: PROC[

list: TermList]

RETURNS[count: CARDINAL, listTList: LIST OF TList] = {

listTList ← NIL;

count ← 0;

FOR t1: Term ← list.begin, t1.next WHILE t1#NIL DO

tList: TList ← NIL;

MarkAvailKinDeleted: PROC[ref: Term] = {

FOR t2: TList ← ref.kin, t2.rest WHILE t2#NIL DO

IF t2.first.use # avail THEN LOOP;

c[del]𡤌[del]+1; c[avail]𡤌[avail]-1;

t2.first.use ← del;

tList ← CONS[t2.first, tList];

MarkAvailKinDeleted[t2.first]; ENDLOOP};

IF t1.use # avail THEN LOOP;

c[del]𡤌[del]+1; c[avail]𡤌[avail]-1;

t1.use�l; tList←CONS[t1, tList];

MarkAvailKinDeleted[t1];

listTList ← CONS[tList, listTList]; count ← count+1;

ENDLOOP;

DO

OrderList: PROC [sList: LIST OF TList] RETURNS[LIST OF TList] = {

IF sList=NIL THEN RETURN[NIL];

IF sList.rest=NIL THEN RETURN[sList];

IF Size[sList.first] > Size[sList.rest.first] THEN {

ok ← FALSE;

sList ← CONS[sList.rest.first, CONS[sList.first, sList.rest.rest]] };

sList.rest ← OrderList[sList.rest]; RETURN[sList]};

ok: BOOL ← TRUE;

listTList ← OrderList[listTList];

IF ok THEN EXIT ENDLOOP };

RestoreKin: PROC[kkin: Term, curUse: Use] = INLINE {

FOR kin: TList ← kkin.kin, kin.rest WHILE kin#NIL DO

IF kin.first.kkin # kkin THEN LOOP; kin.first.kkin ← NIL;

IF kin.first.use # curUse THEN ERROR; kin.first.use ← kin.first.old;

SELECT kin.first.old FROM

avail => {c[curUse] ← c[curUse] - 1; c[avail] ← c[avail] + 1};

skip => {c[curUse] ← c[curUse] - 1; c[skip] ← c[skip] + 1};

ENDCASE => ERROR ENDLOOP };

TOD: PROC RETURNS[IO.Value] = {

time: IO.ROPE ← IO.PutFR["%g", IO.time[]];

time ← time.Substr[time.Index[s2:"198"]+5];

time ← time.Substr[len: time.Index[s2:" "]];

IF time.Length[] = 7 THEN time ← Rope.Cat[" ", time];

RETURN[IO.rope[time]]};

PutUseAtEndOfList: PROC[use: Use, atTop: BOOL, list: TermList] = {

top: Term ← list.begin;

bot: Term ← list.end;

temp: Term ← NIL;

DO -- swaps links to preserve lists

FOR top←top, top.next WHILE top#bot AND (top.use = use)=atTop DO ENDLOOP;

FOR bot𡤋ot, bot.last WHILE bot#top AND (bot.use # use)=atTop DO ENDLOOP;

IF bot=top THEN RETURN;

temp←top.next; top.next𡤋ot.next; bot.next←temp; bot.next.last𡤋ot;

IF top.next=NIL THEN list.end←top ELSE top.next.last←top;

temp←top.last; top.last𡤋ot.last; bot.last←temp; top.last.next←top;

IF bot.last=NIL THEN list.begin𡤋ot ELSE bot.last.next𡤋ot;

temp←top; top𡤋ot; bot←temp; ENDLOOP};

MarkEssentialAvails: PROC[ -- Not covered by [esss, used or avail ~(del or skip)]

list: TermList,

kkin: Term, -- This term contains the kin list to be checked (all avails are below it)

lim: INT]

RETURNS[ok: BOOL, aCnt: CARDINAL] = {

intersection: Term ← CopyTerm[list.begin];

essInterList^ ← [inBits: list.inBits, outBits: list.outBits];

aCnt ← 0;

ok ← TRUE;

FOR ref: TList ← kkin.kin, ref.rest WHILE ref#NIL DO

IF (lim-aCnt) <= 0 THEN {ok←FALSE; EXIT};

IF ~(ref.first.use IN [avail..skip]) THEN LOOP;

IF ~TermCoveredByUsedEssKin[availToo, ref.first, intersection, essInterList]

THEN {

IF ref.first.use=skip THEN {ok←FALSE; IF aCnt#0 THEN ERROR; EXIT};

ref.first.kkin←kkin; ref.first.old←ref.first.use; ref.first.use𡤎ss; aCnt�nt+1};

SaveListTerms[essInterList]; ENDLOOP;

SaveListTerms[essInterList]; SaveTerm[intersection] };

DeleteCoveredAvailSkips: PROC[ -- Covered by [E U but not (D S A)]

list: TermList,

kkin: Term] -- This term's kin must be checked

RETURNS[aCnt, sCnt: CARDINAL] = INLINE {

intersection: Term ← CopyTerm[list.begin];

delInterList^ ← [inBits: list.inBits, outBits: list.outBits];

aCnt ← sCnt ← 0;

FOR ref: TList ← kkin.kin, ref.rest WHILE ref#NIL DO

IF ~(ref.first.use IN [avail..skip]) THEN LOOP;

IF TermCoveredByUsedEssKin[notAvail, ref.first, intersection, delInterList]

THEN {

IF ref.first.use=skip THEN sCnt ← sCnt+1 ELSE aCnt ← aCnt+1;

ref.first.kkin←kkin; ref.first.old←ref.first.use; ref.first.use�l};

SaveListTerms[delInterList]; ENDLOOP;

SaveListTerms[delInterList]; SaveTerm[intersection] };

TermCoveredByUsedEssKin: PROC[

mode: {availToo, notAvail}, -- availToo for ess test, notAvail for delete test

ref: Term,

intersection: Term, -- Passed in to prevent repetitive NEW's

interList: TermList] -- Passed in to prevent repetitive NEW's

RETURNS[BOOL] = INLINE {

FOR test: TList ← ref.kin, test.rest WHILE test#NIL DO

SELECT test.first.use FROM

avail => IF mode=notAvail THEN LOOP;

skip => LOOP;

used => { };

ess => { };

del => LOOP;

ENDCASE => ERROR;

IF Intersection[ref, test.first, intersection] THEN DO -- Will repeat if FinishCS set

IF ~UpdateCompleteSumWithTerm[interList, intersection, TRUE, TRUE] THEN EXIT;

ENDLOOP;

RETURN[(interList.length=1 AND SameTerm[ref, interList.begin])] };

Intersection: PUBLIC PROC[ref, test, intersection: Term] RETURNS[valid: BOOL] = --INLINE-- {

valid ← FALSE;

FOR i: CARDINAL IN [0..ref.in.wdSize) DO

IF BITAND[BITAND[ref.in[i].m, test.in[i].m], BITXOR[ref.in[i].d, test.in[i].d]]#0

THEN RETURN[FALSE]; -- FALSE if inputs crossed

intersection.in[i].d ← BITOR[ref.in[i].d, test.in[i].d];

intersection.in[i].m ← BITOR[ref.in[i].m, test.in[i].m] ENDLOOP;

FOR i: CARDINAL IN [0..ref.out.wdSize) DO

intersection.out[i].d ← BITAND [ref.out[i].d, test.out[i].d];

intersection.out[i].m ← BITOR [ref.out[i].m, test.out[i].m];

valid ← valid OR intersection.out[i].d#0;

ENDLOOP };

SameTerm: PROC[ref, test: Term] RETURNS[same: BOOL] = INLINE {

same ← TRUE;

FOR i: CARDINAL IN [0..ref.in.wdSize) WHILE same DO

same ← same AND

(BITXOR[ref.in[i].m, test.in[i].m]=0) AND

(BITXOR[ref.in[i].d, test.in[i].d]=0) ENDLOOP;

FOR i: CARDINAL IN [0..ref.out.wdSize) WHILE same DO

same ← same AND

(BITXOR[ref.out[i].m, test.out[i].m]=0) AND

(BITXOR[ref.out[i].d, test.out[i].d]=0) ENDLOOP };

END.