<> <> <> DIRECTORY Basics, BasicTime, CedarProcess, Commander, CommandTool, FS, IO, List, MakeDo, MakeDoPrivate, Process, ProcessProps, RedBlackTree, Rope, UserProfile; MakeDoBasicImpl: CEDAR MONITOR IMPORTS CedarProcess, Commander, CommandTool, IO, List, MakeDo, MakeDoPrivate, Process, ProcessProps, RedBlackTree, Rope, UserProfile EXPORTS MakeDo, MakeDoPrivate <> < some process in Basic monitor.>> <> <> <> <> < node not ready or waiting.>> < node in some queue.>> <> < make nodes inactive regardless of currency.>> < queues not all empty.>> = BEGIN OPEN MakeDo, MakeDoPrivate; NodeRep: PUBLIC TYPE = MakeDoPrivate.NodeRep; ActionRep: PUBLIC TYPE = MakeDoPrivate.ActionRep; NodeClassRep: PUBLIC TYPE = MakeDoPrivate.NodeClassRep; in: BOOL _ FALSE; <> whosIn: UNSAFE PROCESS; whatIn: PROC; monitorChange: CONDITION; entryTimeout: INT _ 60; <> DoIn: PROC [p: PROC] = { CedarProcess.CheckAbort[]; Enter[p]; p[!UNWIND => Exit[]]; Exit[]; }; Enter: ENTRY PROC [p: PROC] = { ENABLE UNWIND => NULL; WHILE in DO WAIT monitorChange ENDLOOP; in _ TRUE; whosIn _ Process.GetCurrent[]; TRUSTED {whatIn _ p}; }; Exit: ENTRY PROC = { ENABLE UNWIND => NULL; in _ FALSE; whosIn _ NIL; whatIn _ NIL; NOTIFY monitorChange; }; processUse: INTEGER _ 0; processAllocation: INTEGER _ 0; forkCmdBase: ROPE = "HelpMakeDo"; fullForkCmd: ROPE = CommandTool.CurrentWorkingDirectory[].Cat[forkCmdBase, " &"]; SetProcessAllocation: PUBLIC --ENTRY-- PROC [n: NAT] = { SPAWork: --INTERNAL-- PROC = { processAllocation _ n; InnerMaybeFork[]; BroadcastQueue[]; }; DoIn[SPAWork]; }; SetProcessAllocationFromProfile: PROC [reason: UserProfile.ProfileChangeReason] --UserProfile.ProfileChangedProc-- = { SELECT reason FROM rollBack, firstTime => { pa: INT _ UserProfile.Number["MakeDo.AuxilliaryProcessAllocation", 2]; SetProcessAllocation[pa]; }; edit => { reason _ reason; }; ENDCASE => ERROR; }; MaybeFork: --ENTRY-- PROC = { MFWork: --INTERNAL-- PROC = { InnerMaybeFork[]; }; DoIn[MFWork]; }; InnerMaybeFork: --INTERNAL-- PROC = { IF processUse < processAllocation AND readyQueue # NIL THEN { ch: Commander.Handle = GetCommanderHandle[]; processUse _ processUse + 1; [] _ CommandTool.DoCommand[fullForkCmd, ch]; }; }; TooManyProcesses: --INTERNAL-- PROC RETURNS [tooMany: BOOL] = { tooMany _ processUse > processAllocation; IF tooMany THEN processUse _ processUse - 1; }; NoteAuxilliaryUnwind: --ENTRY-- PROC = { NAUWork: --INTERNAL-- PROC = { processUse _ processUse - 1; IF readyQueue#NIL OR workCount#0 OR waitQueue.Size[]#0 THEN halt _ TRUE; }; DoIn[NAUWork]; }; HelpMakeDo: PROC [cmd: Commander.Handle] RETURNS [result: REF ANY _ NIL, msg: ROPE _ NIL] --Commander.CommandProc-- = { me: UNSAFE PROCESS = Process.GetCurrent[]; mec: CARDINAL = LOOPHOLE[me]; cmd.out.PutF["Helping MakeDo in PROCESS %xH\n", [cardinal[mec]] ]; [] _ HelpEmptyQueue[auxilliary: TRUE, goalNS: NIL, callingJob: NIL ! Warning => { cmd.out.PutRope[message]; cmd.out.PutChar['\n]; RESUME}; UNWIND => { NoteAuxilliaryUnwind[]; cmd.out.PutRope[" (because UNWINDing) done helping MakeDo\n"]; } ]; cmd.out.PutRope["Done helping MakeDo\n"]; }; halt: BOOL _ FALSE; readyQueue: NodeList _ NIL; workCount: INTEGER _ 0; waitQueue: RefTable _ MakeRefTable[]; queueChange: CONDITION; queueTimeout: INT _ 60; BroadcastQueue: ENTRY PROC = { ENABLE UNWIND => NULL; BROADCAST queueChange; }; NotifyQueue: ENTRY PROC = { ENABLE UNWIND => NULL; NOTIFY queueChange; }; WaitQueue: ENTRY PROC = { ENABLE UNWIND => NULL; WAIT queueChange; }; SetState: --INTERNAL-- PROC [n: Node, new: NodeState] = { ENABLE UNWIND => NULL; SELECT n.state FROM inactive => NULL; ready => readyQueue _ readyQueue.rest; working => workCount _ workCount - 1; waiting => IF DeleteFromRefTable[n, waitQueue] # n THEN ERROR; ENDCASE => ERROR; n.state _ new; SELECT n.state FROM inactive => NULL; ready => { readyQueue _ CONS[n, readyQueue]; }; working => workCount _ workCount + 1; waiting => { waitQueue.Insert[n, n]; }; ENDCASE => ERROR; NotifyQueue[]; }; InnerEnqueue: --INTERNAL-- PROC [job: Job, n: Node, inServiceOf: Node _ NIL] = { IF n.state = inactive THEN { n.someoneWhoCares _ job; SetState[n, ready]; }; IF inServiceOf # NIL THEN { n.waitingOnCurrent _ CONS[inServiceOf, n.waitingOnCurrent]; inServiceOf.waitCount _ inServiceOf.waitCount + 1; SELECT inServiceOf.state FROM inactive, ready => ERROR; working => SetState[inServiceOf, waiting]; waiting => n _ n; ENDCASE => ERROR; }; }; InnerEnsureMembership: --INTERNAL-- PROC [job: Job, ns: NodeSet, n: Node] = { IF ns.nodes.Lookup[n] = NIL THEN { ns.nodes.Insert[n, n]; n.memberships.Insert[ns, ns]; CountNode[ns, n, 1]; IF n.current#true AND n.state = inactive THEN InnerEnqueue[job, n, NIL]; }; }; DestroyNodeSet: --ENTRY-- PROC [ns: NodeSet] = { DNSWork: --INTERNAL-- PROC = { UnMemberize: PROC [data: REF ANY] RETURNS [stop: BOOL _ FALSE] --RedBlackTree.EachNode-- = { n: Node = NARROW[data]; IF n.memberships.Delete[ns] = NIL THEN ERROR; }; StatelessEnumerateRefTable[ns.nodes, UnMemberize]; ns^ _ [nodes: ns.nodes]; ns.nodes.DestroyTable[]; }; DoIn[DNSWork]; }; CountNode: --INTERNAL-- PROC [ns: NodeSet, n: Node, SELECT n.current FROM notComputed, false => ns.nonCurrents _ ns.nonCurrents + true => { ns.currents _ ns.currents + SELECT n.broken FROM FALSE => ns.ok _ ns.ok + TRUE => ns.broken _ ns.broken + ENDCASE => ERROR; }; ENDCASE => ERROR; }; SetCurrency: --INTERNAL-- PROC [n: Node, current: ExpensiveBool] = { Discount: PROC [data: REF ANY] RETURNS [stop: BOOL _ FALSE] --RedBlackTree.EachNode-- = { ns: NodeSet = NARROW[data]; CountNode[ns, n, -1]; }; Count: PROC [data: REF ANY] RETURNS [stop: BOOL _ FALSE] --RedBlackTree.EachNode-- = { ns: NodeSet = NARROW[data]; CountNode[ns, n, 1]; }; IF n.current = current THEN RETURN; StatelessEnumerateRefTable[n.memberships, Discount]; n.current _ current; StatelessEnumerateRefTable[n.memberships, Count]; }; SetBroken: --INTERNAL-- PROC [n: Node, broken: BOOL] = { Discount: PROC [data: REF ANY] RETURNS [stop: BOOL _ FALSE] --RedBlackTree.EachNode-- = { ns: NodeSet = NARROW[data]; CountNode[ns, n, -1]; }; Count: PROC [data: REF ANY] RETURNS [stop: BOOL _ FALSE] --RedBlackTree.EachNode-- = { ns: NodeSet = NARROW[data]; CountNode[ns, n, 1]; }; IF n.broken = broken THEN RETURN; StatelessEnumerateRefTable[n.memberships, Discount]; n.broken _ broken; StatelessEnumerateRefTable[n.memberships, Count]; }; NoteAchievement: --INTERNAL-- PROC [goal: Node] = { SetCurrency[goal, true]; IF goal.state # working THEN ERROR; InnerGiveUp[goal]; }; GiveUp: --ENTRY-- PROC [goal: Node] = { GUWork: --INTERNAL-- PROC = {InnerGiveUp[goal]}; DoIn[GUWork]; }; InnerGiveUp: --INTERNAL-- PROC [goal: Node] = { IF goal.state = working THEN { SetState[goal, inactive]; goal.someoneWhoCares _ NIL; InnerWakeWaiters[goal]; }; IF readyQueue=NIL AND workCount=0 AND waitQueue.Size[]=0 THEN halt _ FALSE; }; InnerWakeWaiters: --INTERNAL-- PROC [n: Node] = { WHILE n.waitingOnCurrent # NIL DO waiter: Node = n.waitingOnCurrent.first; n.waitingOnCurrent _ n.waitingOnCurrent.rest; IF waiter.state # waiting THEN ERROR; waiter.waitCount _ waiter.waitCount - 1; SELECT waiter.waitCount FROM <0 => ERROR; =0 => SetState[waiter, ready]; >0 => NULL; ENDCASE => ERROR; ENDLOOP; }; Ensure: PUBLIC PROC [goals: RefTable, modifiabilitySpec: ModifiabilitySpec] RETURNS [okGoalCount, nonOKGoalCount, nSteps: NAT, failedSteps: ActionList, nonOKGoalList: NodeList] = { job: Job _ NEW [JobRep _ [ wDir: CommandTool.CurrentWorkingDirectory[], goals: goals, otherModifiable: modifiabilitySpec ]]; goalNS: NodeSet = NEW [NodeSetPrivate _ [ nodes: MakeRefTable[] ]]; NoteGoal: PROC [data: REF ANY] RETURNS [stop: BOOL _ FALSE] --RedBlackTree.EachNode-- = { n: Node = NARROW[data]; Work: --INTERNAL-- PROC = { InnerSetModifiability[n, job.goals, job.otherModifiable]; InnerEnsureMembership[job, goalNS, n]; }; DoIn[Work]; }; <> {ENABLE UNWIND => { NoteEnsureUnwind[]; }; StatelessEnumerateRefTable[goals, NoteGoal]; [okGoalCount, nonOKGoalCount, nonOKGoalList] _ HelpEmptyQueue[auxilliary: FALSE, goalNS: goalNS, callingJob: job]; }; nSteps _ job.nSteps; failedSteps _ job.failedSteps; goals.DestroyTable[]; DestroyNodeSet[goalNS]; }; NoteEnsureUnwind: --ENTRY-- PROC = { NEUWork: --INTERNAL-- PROC = { x: BOOL _ FALSE; IF readyQueue#NIL OR workCount#0 OR waitQueue.Size[]#0 THEN { halt _ TRUE; WHILE readyQueue # NIL DO victim: Node = readyQueue.first; SetState[victim, working]; InnerGiveUp[victim]; ENDLOOP; x _ x; }; }; DoIn[NEUWork]; }; HelpEmptyQueue: PROC [auxilliary: BOOL, goalNS: NodeSet _ NIL, callingJob: Job _ NIL] RETURNS [okGoalCount, nonOKGoalCount: NAT, nonOKGoalList: NodeList] = { auxilliary _ auxilliary; DO job: Job _ NIL; goal: Node _ NIL; toExecute: Action _ NIL; consistencyReason: ROPE _ NIL; fails: ExpensiveBool; haveWorkers: BOOL; [job, goal, toExecute, consistencyReason, fails, haveWorkers, okGoalCount, nonOKGoalCount, nonOKGoalList] _ GetActionToExecute[auxilliary, goalNS, callingJob]; IF toExecute = NIL THEN EXIT; <> {ENABLE UNWIND => { ReturnPermission[toExecute]; GiveUp[goal]; }; MaybeFork[]; toExecute.reasonWhyLastDone _ consistencyReason; IF fails = false THEN Warning[IO.PutFR["Retrying %g", [rope[toExecute.cmd]]]]; ExecuteAction[job, toExecute]; CheckIn[goal, toExecute]; }; ENDLOOP; auxilliary _ auxilliary; }; ExecuteAction: PROC [job: Job, a: Action] = { ch: Commander.Handle = GetCommanderHandle[]; failed: BOOL; IF debugging THEN Confirm[a.cmd]; IncrementStepCount[job]; failed _ CommandTool.DoCommand[a.cmd, ch] = $Failure; a.fails _ Expensify[failed]; IF failed THEN AddFailedCmd[job, a]; EnumerateResults[a, InnerSuspectNodeChange]; }; SetModifiability: --ENTRY-- PROC [n: Node, goals: RefTable, ms: ModifiabilitySpec] = { SMWork: --INTERNAL-- PROC = {InnerSetModifiability[n, goals, ms]}; DoIn[SMWork]; }; InnerSetModifiability: --INTERNAL-- PROC [n: Node, goals: RefTable, ms: ModifiabilitySpec] = { new: Modifiability _ SELECT TRUE FROM goals.Lookup[n] = n => yes, ms = NIL => guess, ENDCASE => SELECT ms.Lookup[n] FROM n => yes, NIL => no, ENDCASE => ERROR; IF n.modifiability = new THEN RETURN; n.modifiability _ new; InnerUncurrentNode[n]; n _ n; }; GetActionToExecute: --ENTRY-- PROC [auxilliary: BOOL, goalNS: NodeSet _ NIL, callingJob: Job _ NIL] RETURNS [job: Job, goal: Node, toExecute: Action _ NIL, consistencyReason: ROPE, fails: ExpensiveBool, haveWorkers: BOOL _ FALSE, okGoalCount, nonOKGoalCount: NAT, nonOKGoalList: NodeList] = { <> <> <> <> <> <> <> <<}>> GAEWork: --INTERNAL-- PROC = { auxilliary _ auxilliary; DO a: Action; sourceMissing: BOOL _ FALSE; sourceBroken: BOOL _ FALSE; waits: BOOL _ FALSE; missedList: NodeList _ NIL; CheckSource: --INTERNAL-- PROC [n: Node, which: ActionDep, optional: BOOL] = { CedarProcess.CheckAbort[]; InnerSetModifiability[n, job.goals, job.otherModifiable]; IF (NOT optional) AND n.created = notExistTime THEN { sourceMissing _ TRUE; IF goal.modifiability=yes THEN missedList _ CONS[n, missedList]; }; SELECT n.current FROM true => { IF n.broken THEN SetBroken[goal, sourceBroken _ TRUE]; RETURN; }; false => SetCurrency[goal, false]; notComputed => NULL; ENDCASE => ERROR; InnerEnqueue[job, n, goal]; waits _ TRUE; }; IF goal # NIL AND goal.state = working THEN ERROR; DO CedarProcess.CheckAbort[]; IF auxilliary AND TooManyProcesses[] THEN RETURN; IF (NOT auxilliary) AND goalNS.nonCurrents=0 THEN { SurveyNode: PROC [data: REF ANY] RETURNS [stop: BOOL _ FALSE] --RedBlackTree.EachNode-- = { n: Node = NARROW[data]; IF n.current=true AND NOT n.broken THEN { okGoalCount _ okGoalCount + 1; } ELSE { nonOKGoalCount _ nonOKGoalCount + 1; nonOKGoalList _ CONS[n, nonOKGoalList]; }; }; okGoalCount _ nonOKGoalCount _ 0; nonOKGoalList _ NIL; StatelessEnumerateRefTable[goalNS.nodes, SurveyNode]; RETURN}; IF readyQueue # NIL THEN EXIT; IF workCount = 0 THEN { IF waitQueue.Size[] # 0 THEN { FindCycles[]; LOOP}; IF NOT auxilliary THEN { EnsureQueued: PROC [data: REF ANY] RETURNS [stop: BOOL _ FALSE] --RedBlackTree.EachNode-- = { n: Node = NARROW[data]; IF n.state # inactive THEN ERROR; IF n.current#true THEN InnerEnqueue[callingJob, n, NIL]; }; StatelessEnumerateRefTable[goalNS.nodes, EnsureQueued]; IF readyQueue = NIL THEN ERROR; LOOP; }; }; Exit[]; WaitQueue[ ! <> UNWIND => Enter[GAEWork] <> ]; Enter[GAEWork]; ENDLOOP; goal _ readyQueue.first; IF goal.state # ready THEN ERROR; SetState[goal, working]; IF halt THEN {InnerGiveUp[goal]; LOOP}; <> {ENABLE UNWIND => InnerGiveUp[goal]; IF (job _ goal.someoneWhoCares) = NIL THEN ERROR; IF NOT CommandTool.CurrentWorkingDirectory[].Equal[job.wDir, FALSE] THEN SetWDir[job.wDir]; IF goal.current=true THEN ERROR --shouldn't have current nodes in queue--; IF debugging THEN Log["Examining %g", [rope[goal.name]] ]; SetBroken[goal, goal.modifiability=yes AND goal.created=notExistTime]; IF goal.producer = NIL THEN InnerGetProduced[goal]; IF InnerLeaf[goal] THEN {NoteAchievement[goal]; LOOP}; a _ goal.producer.a; IF a.permissionGranted THEN { a.waitingForPermission _ CONS[goal, a.waitingForPermission]; goal.waitCount _ 1; SetState[goal, waiting]; LOOP}; a.permissionGranted _ TRUE; a.queuedFailsInvalidation _ FALSE; <> {ENABLE UNWIND => InnerReturnPermission[a]; IF debugging THEN Log["Examining %g", [rope[a.cmd]] ]; InnerEnumerateSources[a, cmd, CheckSource]; IF waits THEN {InnerReturnPermission[a]; LOOP}; IF sourceBroken THEN {InnerReturnPermission[a]; NoteAchievement[goal]; LOOP}; SELECT a.derivedFromCurrentDeterminers FROM TRUE => NULL; FALSE => { InnerRederive[a]; a.derivedFromCurrentDeterminers _ TRUE; }; ENDCASE => ERROR; sourceMissing _ FALSE; InnerEnumerateSources[a, data, CheckSource]; IF waits THEN {InnerReturnPermission[a]; LOOP}; IF sourceBroken THEN {InnerReturnPermission[a]; NoteAchievement[goal]; LOOP}; IF sourceMissing THEN { IF goal.modifiability=yes THEN { SetBroken[goal, TRUE]; Warning[IO.PutFR[ "Couldn't %g because %g don't exist", [rope[a.cmd]], [rope[EnglishList[missedList].el]] ]]; }; InnerReturnPermission[a]; NoteAchievement[goal]; LOOP}; SELECT fails _ a.fails FROM true => {SetBroken[goal, TRUE]; InnerReturnPermission[a]; NoteAchievement[goal]; LOOP}; false, notComputed => NULL; ENDCASE => ERROR; IF NOT goal.consistencyAsked THEN { [goal.consistent, goal.consistencyReason] _ a.class.CheckConsistency[a, goal]; goal.consistencyAsked _ TRUE; }; consistencyReason _ goal.consistencyReason; IF goal.consistent THEN {InnerReturnPermission[a]; NoteAchievement[goal]; LOOP}; toExecute _ a; SetCurrency[goal, false]; RETURN; }; }; ENDLOOP; }; goal _ NIL; DoIn[GAEWork]; }; CheckIn: --ENTRY-- PROC [goal: Node, producer: Action] = { CIWork: --INTERNAL-- PROC = { IF goal.state # working THEN ERROR; SetState[goal, ready]; InnerReturnPermission[producer]; }; DoIn[CIWork]; }; ReturnPermission: --ENTRY-- PROC [a: Action] = { RPWork: --INTERNAL-- PROC = {InnerReturnPermission[a]}; DoIn[RPWork]; }; InnerReturnPermission: --INTERNAL-- PROC [a: Action] = { a.permissionGranted _ FALSE; IF a.queuedFailsInvalidation THEN a.fails _ notComputed; a.queuedFailsInvalidation _ FALSE; InnerWakePermissionWaiters[a]; }; InnerWakePermissionWaiters: --INTERNAL-- PROC [a: Action] = { a _ a; WHILE a.waitingForPermission # NIL DO waiter: Node = a.waitingForPermission.first; a.waitingForPermission _ a.waitingForPermission.rest; IF waiter.state # waiting THEN ERROR; IF waiter.waitCount # 1 THEN ERROR; waiter.waitCount _ 0; SetState[waiter, ready]; ENDLOOP; a _ a; }; InnerGetProduced: --INTERNAL-- PROC [n: Node] = { n2: Node; IF n.producer # NIL THEN ERROR; SELECT n.current FROM true, false => ERROR --we shouldn't know that much if we haven't tried to produce yet--; notComputed => NULL; ENDCASE => ERROR; n2 _ TryToProduce[n.name, n.class]; IF n # n2 THEN Warning[IO.PutFR["Disagreement on cannonical name for %g or %g", IO.rope[n.name], IO.rope[n2.name]]]; InnerVolunteerLeaf[n]; }; FindNode: PUBLIC --ENTRY-- PROC [someName: ROPE, class: NodeClass] RETURNS [node: Node] = { FNWork: --INTERNAL-- PROC = { node _ GetNode[someName, class, FALSE]; IF node # NIL THEN RETURN; node _ TryToProduce[someName, class]; InnerVolunteerLeaf[node]; }; DoIn[FNWork]; }; Found: ERROR = CODE; TryToProduce: --INTERNAL-- PROC [resultName: ROPE, class: NodeClass] RETURNS [sought: Node] = BEGIN PerFinder: --INTERNAL-- PROC [f: Finder] = { found: BOOLEAN; makes, cmdFrom: NodeList; from: From; cmd: ROPE; class: ActionClass; foundData: REF ANY; CedarProcess.CheckAbort[]; [found, sought, makes, cmdFrom, from, cmd, class, foundData] _ f.finderProc[resultName: resultName, finderData: f.finderData]; IF found THEN { first: BOOLEAN _ TRUE; soughtIn: BOOL _ FALSE; already: Action _ NIL; FOR ml: NodeList _ makes, ml.rest WHILE ml # NIL DO this: Action _ IF ml.first.producer = NIL THEN NIL ELSE ml.first.producer.a; soughtIn _ soughtIn OR (sought = ml.first); IF first THEN {already _ this; first _ FALSE} ELSE {IF this # already THEN Warning[IO.PutFR[ "Action %g doesn't precisely cover command %g (e.g., at %g)", IO.refAny[cmd], IO.refAny[IF already # NIL THEN already.cmd ELSE NIL], IO.rope[ml.first.name]]]}; ENDLOOP; IF soughtIn THEN { a: Action; IF already # NIL THEN ERROR Found; a _ NEW [ActionRep _ [cmd: cmd, class: class, foundData: foundData]]; InnerAddAction[a, makes, cmdFrom, from]; ERROR Found } ELSE { Warning[Rope.Cat["Finder (", f.name, ") blew it"]]; sought _ NIL; }; } ELSE sought _ NIL; }; sought _ NIL; EnumerateFinders[PerFinder !Found => CONTINUE]; IF sought=NIL THEN sought _ GetNode[resultName, class]; END; InnerAddAction: --INTERNAL-- PROC [a: Action, makes, cmdFrom: NodeList, from: From] = { FOR nl: NodeList _ makes, nl.rest WHILE nl # NIL DO n: Node _ nl.first; peh: EdgeRingHead _ emptyHead; IF n.producer # NIL THEN ERROR; IF n.current # notComputed THEN ERROR; [a.makes, peh] _ Link[a, a.makes, n, peh, FALSE]; n.producer _ peh.first; ENDLOOP; InnerAddConsumption[a, cmdFrom, cmd, TRUE]; InnerAddConsumption[a, from.mustHave, data, FALSE]; InnerAddConsumption[a, from.optional, data, TRUE]; }; VolunteerLeaf: --ENTRY-- PROC [n: Node] = { VLWork: --INTERNAL-- PROC = {InnerVolunteerLeaf[n]}; DoIn[VLWork]; }; InnerVolunteerLeaf: --INTERNAL-- PROC [n: Node] = { IF n.producer = NIL THEN n.producer _ NEW [EdgeRep _ [ a: leaf, n: n, aNext: NIL, aPrev: NIL, nNext: NIL, nPrev: NIL, optional: FALSE ]] ELSE IF n.producer.a = NIL THEN ERROR; }; InnerRederive: --INTERNAL-- PROC [a: Action] = { from: From; InnerRemoveConsumption[a, data]; [from, a.cmd] _ a.class.Rederive[a]; InnerAddConsumption[a, from.mustHave, data, FALSE]; InnerAddConsumption[a, from.optional, data, TRUE]; <> }; AddConsumption: --ENTRY-- PROC [a: Action, nl: NodeList, which: ActionDep, optional: BOOL] = { ACWork: --INTERNAL-- PROC = {InnerAddConsumption[a, nl, which, optional]}; DoIn[ACWork]; }; InnerAddConsumption: --INTERNAL-- PROC [a: Action, nl: NodeList, which: ActionDep, optional: BOOL] = { FOR nl _ nl, nl.rest WHILE nl # NIL DO n: Node _ nl.first; SELECT which FROM data => { [a.from[data], n.to[data]] _ Link[a, a.from[data], n, n.to[data], optional]; }; cmd => { [a.from[cmd], n.to[cmd]] _ Link[a, a.from[cmd], n, n.to[cmd], optional]; }; ENDCASE => ERROR; ENDLOOP; nl _ nl; }; Link: --INTERNAL-- PROC [a: Action, ah: EdgeRingHead, n: Node, nh: EdgeRingHead, optional: BOOL] RETURNS [ahNew, nhNew: EdgeRingHead] = { e: Edge _ NEW [EdgeRep _ [ optional: optional, n: n, a: a, aNext: ah.first, aPrev: NIL, nNext: nh.first, nPrev: NIL ]]; ah.first _ nh.first _ e; IF e.aNext # NIL THEN e.aNext.aPrev _ e ELSE ah.last _ e; IF e.nNext # NIL THEN e.nNext.nPrev _ e ELSE nh.last _ e; ahNew _ ah; nhNew _ nh; }; InnerRemoveConsumption: --INTERNAL-- PROC [a: Action, which: ActionDep] = { ah: EdgeRingHead _ a.from[which]; aNext: Edge; FOR e: Edge _ ah.first, aNext WHILE e # NIL DO n: Node _ e.n; IF e.a # a THEN ERROR; aNext _ e.aNext; e.aNext _ e.aPrev _ NIL; UnlinkToFrom[e, which]; e.a _ NIL; e.n _ NIL; ENDLOOP; a.from[which] _ emptyHead; }; UnlinkToFrom: --INTERNAL-- PROC [e: Edge--on n.to=a.from--, which: ActionDep] = { n: Node = e.n; IF e.nNext # NIL THEN e.nNext.nPrev _ e.nPrev ELSE SELECT which FROM cmd => n.to[cmd].last _ e.nPrev; data => n.to[data].last _ e.nPrev; ENDCASE => ERROR; IF e.nPrev # NIL THEN e.nPrev.nNext _ e.nNext ELSE SELECT which FROM cmd => n.to[cmd].first _ e.nNext; data => n.to[data].first _ e.nNext; ENDCASE => ERROR; e.nNext _ e.nPrev _ NIL; }; InnerRemoveProduction: --INTERNAL-- PROC [a: Action] = { ah: EdgeRingHead _ a.makes; aNext: Edge; FOR e: Edge _ ah.first, aNext WHILE e # NIL DO n: Node _ e.n; IF e.a # a THEN ERROR; aNext _ e.aNext; e.aNext _ e.aPrev _ NIL; e.nNext _ e.nNext _ NIL; n.producer _ NIL; e.a _ NIL; e.n _ NIL; ENDLOOP; a.makes _ emptyHead; }; Explain: PUBLIC PROC [ch: Commander.Handle, nodes: RefTable] = { to: IO.STREAM = ch.out; Work: PROC [data: REF ANY] RETURNS [stop: BOOL _ FALSE] --RedBlackTree.EachNode-- = { n: Node = NARROW[data]; ExplainNode[n, to]; }; StatelessEnumerateRefTable[nodes, Work]; }; ExplainNode: --ENTRY-- PROC [n: Node, to: IO.STREAM] = { ShowConsumer: --INTERNAL-- PROC [a: Action, which: ActionDep] = { to.PutF["\n\t\t%g", [rope[a.cmd]]]; }; ShowDeterminer: --INTERNAL-- PROC [n: Node, which: ActionDep, optional: BOOL] = { nc: BOOL = n.current # true; broken: BOOL = n.current=true AND n.broken; to.PutF["\n%g\t%g\t%g", [rope[IF nc THEN "*" ELSE IF broken THEN "!" ELSE ""]], [rope[SELECT InnerGetCreated[n] FROM notExistTime => "?", unknownTime => "??", ENDCASE => ""]], IO.rope[n.name] ]; }; ShowInput: --INTERNAL-- PROC [n: Node, which: ActionDep, optional: BOOL] = { nc: BOOL = n.current # true; broken: BOOL = n.current=true AND n.broken; to.PutF["\n%g\t%g\t%g%g", [rope[IF nc THEN "*" ELSE IF broken THEN "!" ELSE ""]], [rope[SELECT InnerGetCreated[n] FROM notExistTime => "?", unknownTime => "??", ENDCASE => ""]], IO.rope[n.name], IO.rope[IF optional THEN "?" ELSE ""] ]; }; ShowOutput: PROC [n: Node] = { to.PutF["\n\t\t%g", IO.rope[n.name]]; }; ENWork: --INTERNAL-- PROC = { a: Action _ NIL; to.PutF["%g\n", [rope[n.name]] ]; to.PutF["\tCreated %g.\n", [rope[FmtTime[n.created]]] ]; to.PutF["\t%g\n", [rope[SELECT n.current FROM true => "Is Current", false => "Not Current", notComputed => "Not known if Current", ENDCASE => ERROR]]]; IF n.current=true THEN to.PutF["\t%g.\n", [rope[IF n.broken THEN "Broken" ELSE "Not broken"]] ]; to.PutRope["\tNeeded by {"]; InnerEnumerateConsumers[n, data, ShowConsumer]; to.PutRope["};\n\tdetermines {"]; InnerEnumerateConsumers[n, cmd, ShowConsumer]; to.PutRope["}.\n"]; SELECT TRUE FROM n.producer = NIL => to.PutRope["\tNever tried to determine producer.\n"]; n.producer.a = leaf => to.PutRope["\tNothing knows how to produce it.\n"]; ENDCASE => a _ n.producer.a; SELECT n.modifiability FROM yes => to.PutRope["\tCertainly modifiable.\n"]; no => to.PutRope["\tCertainly NOT modifiable.\n"]; guess => to.PutRope["\tModifiability unspecified.\n"]; uninitialized => to.PutRope["\tModifiability undetermined.\n"]; ENDCASE => ERROR; IF (a = NIL) OR (n.modifiability = no) THEN RETURN; IF NOT n.consistencyAsked THEN to.PutRope["\tConsistency not inquired.\n"] ELSE to.PutF[ "\tCurrently %g consistent with inputs (because %g).\n", [rope[IF n.consistent THEN "is" ELSE "not"]], [rope[n.consistencyReason]] ]; to.PutF["%g\n", [rope[a.cmd]] ]; to.PutRope["\tAccording to {"]; InnerEnumerateSources[a, cmd, ShowDeterminer]; to.PutRope["}\n\tMakes {"]; InnerEnumerateResults[a, ShowOutput]; to.PutRope["}\n\tFrom {"]; InnerEnumerateSources[a, data, ShowInput]; to.PutRope["}.\n"]; to.PutF["\t%g from current determiners.\n", [rope[IF a.derivedFromCurrentDeterminers THEN "Derived" ELSE "Not derived"]] ]; to.PutF["\t%g with current inputs.\n", [rope[SELECT TRUE FROM a.queuedFailsInvalidation OR a.fails=notComputed => "Not tried", a.fails=true => "Fails", a.fails=false => "Succeeds", ENDCASE => ERROR]] ]; IF a.reasonWhyLastDone # NIL THEN to.PutF["\tLast executed because %g.\n", [rope[a.reasonWhyLastDone]]]; }; DoIn[ENWork]; }; GetActions: PUBLIC --ENTRY-- PROC [goals: RefTable, modifiabilitySpec: ModifiabilitySpec] RETURNS [al: ActionList] = { GsWork: --INTERNAL-- PROC = { asTable: RefTable _ MakeRefTable[]; PerNode: INTERNAL PROC [data: REF ANY] RETURNS [stop: BOOL _ FALSE] --RedBlackTree.EachNode-- = { n: Node = NARROW[data]; a: Action; InnerSetModifiability[n, goals, modifiabilitySpec]; IF n.producer = NIL OR n.producer.a = leaf OR n.modifiability=no THEN RETURN; a _ n.producer.a; IF asTable.Lookup[a] = a THEN RETURN; asTable.Insert[a, a]; InnerEnumerateSources[a, cmd, PerSource]; InnerEnumerateSources[a, data, PerSource]; al _ CONS[a, al]; }; PerSource: INTERNAL PROC [n: Node, which: ActionDep, optional: BOOL] = { [] _ PerNode[n]; }; StatelessEnumerateRefTable[goals, PerNode]; asTable.DestroyTable[]; }; DoIn[GsWork]; }; InnerLeaf: --INTERNAL-- PROC [n: Node] RETURNS [isLeaf: BOOL] = { SELECT n.modifiability FROM no => RETURN [TRUE]; yes, guess => NULL; uninitialized => ERROR; ENDCASE => ERROR; isLeaf _ n.producer = NIL OR n.producer.a = leaf; }; SuspectNodeChange: PUBLIC --ENTRY-- PROC [n: Node] = { SNCWork: --INTERNAL-- PROC = {InnerSuspectNodeChange[n]}; DoIn[SNCWork]; }; InnerSuspectNodeChange: --INTERNAL-- PROC [n: Node] = { lastCreated: Time = n.created; n.created _ n.class.GetTime[n]; IF n.created # lastCreated THEN InnerNoteContentChange[n]; }; reasonNotAsked: ROPE = "haven't yet asked if consistent"; InnerNoteContentChange: --INTERNAL-- PROC [n: Node] = { InnerUnaskConsistency: --INTERNAL-- PROC [n: Node] = { n.consistencyAsked _ FALSE; n.consistencyReason _ reasonNotAsked; }; PerDirectConsumer: --INTERNAL-- PROC [a: Action, which: ActionDep] = { SELECT which FROM cmd => { a.derivedFromCurrentDeterminers _ FALSE; }; data => { InnerUnknowFails[a]; InnerEnumerateResults[a, InnerUnaskConsistency]; }; ENDCASE => ERROR; }; InnerUnaskConsistency[n]; InnerEnumerateConsumers[n, data, PerDirectConsumer]; InnerEnumerateConsumers[n, cmd, PerDirectConsumer]; InnerUncurrentNode[n]; n _ n; }; InnerUnknowFails: --INTERNAL-- PROC [a: Action] = { SELECT a.permissionGranted FROM FALSE => a.fails _ notComputed; TRUE => a.queuedFailsInvalidation _ TRUE; ENDCASE => ERROR; }; UncurrentNode: PUBLIC --ENTRY-- PROC [n: Node] = { UNWork: --INTERNAL-- PROC = {InnerUncurrentNode[n]}; DoIn[UNWork]; }; InnerUncurrentNode: --INTERNAL-- PROC [n: Node] = { PerConsumer: --INTERNAL-- PROC [a: Action, which: ActionDep] = { InnerEnumerateResults[a, InnerUncurrentNode]; }; IF n.current = notComputed THEN RETURN; SetCurrency[n, notComputed]; InnerEnumerateConsumers[n, data, PerConsumer]; InnerEnumerateConsumers[n, cmd, PerConsumer]; n _ n; }; UncurrentProducer: PUBLIC --ENTRY-- PROC [n: Node] = { UPWork: --INTERNAL-- PROC = {InnerUncurrentProducer[n]}; DoIn[UPWork]; }; InnerUncurrentProducer: --INTERNAL-- PROC [n: Node] = { IF n.producer = NIL OR n.producer.a = leaf THEN InnerUncurrentNode[n] ELSE { a: Action = n.producer.a; InnerUnknowFails[a]; InnerEnumerateResults[a, InnerUncurrentNode]; }; }; EnumerateConsumers: PUBLIC --ENTRY-- PROC [n: Node, which: ActionDep, to: PROC [Action, ActionDep]] = { ECWork: --INTERNAL-- PROC = {InnerEnumerateConsumers[n, which, to]}; DoIn[ECWork]; }; InnerEnumerateConsumers: --INTERNAL-- PROC [n: Node, which: ActionDep, to: PROC [Action, ActionDep]] = { x: BOOL _ FALSE; x _ x; FOR e: Edge _ n.to[which].first, e.nNext WHILE e # NIL DO to[e.a, which]; ENDLOOP; x _ x; }; EnumerateResults: PUBLIC --ENTRY-- PROC [a: Action, to: PROC [Node]] = { ERWork: --INTERNAL-- PROC = {InnerEnumerateResults[a, to]}; DoIn[ERWork]; }; InnerEnumerateResults: --INTERNAL-- PROC [a: Action, to: PROC [Node]] = { x: BOOL _ FALSE; x _ x; FOR e: Edge _ a.makes.first, e.aNext WHILE e # NIL DO to[e.n]; ENDLOOP; x _ x; }; EnumerateSources: PUBLIC --ENTRY-- PROC [a: Action, which: ActionDep, to: PROC [n: Node, which: ActionDep, optional: BOOL]] = { ESWork: --INTERNAL-- PROC = {InnerEnumerateSources[a, which, to]}; DoIn[ESWork]; }; InnerEnumerateSources: PUBLIC --INTERNAL-- PROC [a: Action, which: ActionDep, to: PROC [n: Node, which: ActionDep, optional: BOOL]] = { which _ which; FOR e: Edge _ a.from[which].first, e.aNext WHILE e # NIL DO IF e.a # a THEN ERROR; to[e.n, which, e.optional]; ENDLOOP; which _ which; }; GetCreated: PUBLIC --ENTRY-- PROC [n: Node] RETURNS [t: Time] = { GCWork: --INTERNAL-- PROC = {t _ n.created}; DoIn[GCWork]; }; InnerGetCreated: PUBLIC --INTERNAL-- PROC [n: Node] RETURNS [t: Time] = { t _ n.created; }; StartTime: PUBLIC PROC [n: Node] = { n.created _ n.class.GetTime[n]; }; DestroyGraph: PUBLIC --ENTRY-- PROC = { DGWork: --INTERNAL-- PROC = { DestroyNode: --INTERNAL-- PROC [n: Node] = { IF n.producer # NIL AND n.producer.a # leaf THEN { a: Action = n.producer.a; a.class _ NIL; a.foundData _ NIL; InnerRemoveConsumption[a, cmd]; InnerRemoveConsumption[a, data]; InnerRemoveProduction[a]; }; }; IF workCount > 0 THEN Warning["Hope no other processes in MakeDo..."]; EnumerateNodes[to: DestroyNode, andDestroy: TRUE]; readyQueue _ NIL; workCount _ 0; waitQueue.DestroyTable[]; halt _ FALSE; }; DoIn[DGWork]; }; ForAll: PUBLIC --ENTRY-- PROC [suspectChange, uncurrent: BOOL] = { FAWork: --INTERNAL-- PROC = { PerNode: INTERNAL PROC [n: Node] = { IF suspectChange THEN InnerSuspectNodeChange[n]; IF uncurrent THEN InnerUncurrentProducer[n]; }; EnumerateNodes[to: PerNode, andDestroy: FALSE]; }; DoIn[FAWork]; }; RetryToProduce: PUBLIC --ENTRY-- PROC [n: Node] = { RPWork: --INTERNAL-- PROC = { n2: Node; IF n.producer # NIL AND n.producer.a # leaf THEN RETURN; IF n.producer # NIL AND n.producer.a = leaf THEN { e: Edge = n.producer; IF e.aNext # NIL OR e.aPrev # NIL THEN ERROR; IF e.nNext # NIL OR e.nPrev # NIL THEN ERROR; n.producer.a _ NIL; n.producer _ NIL; InnerUncurrentNode[n]; }; n2 _ TryToProduce[n.name, n.class]; IF n # n2 THEN Warning[IO.PutFR["Disagreement on cannonical name for %g or %g", IO.rope[n.name], IO.rope[n2.name]]]; InnerVolunteerLeaf[n]; }; DoIn[RPWork]; }; SetWDir: PROC [wDir: ROPE] = { props: List.AList _ ProcessProps.GetPropList[]; ch: Commander.Handle = GetCommanderHandle[]; ch.out.PutF["Changing working directory to %g.\n", [rope[wDir]] ]; IF List.PutAssoc[$WorkingDirectory, wDir, props] # props THEN ERROR; }; FindCycles: --INTERNAL-- PROC = { out: IO.STREAM = GetCommanderHandle[].out; explored: RefTable _ MakeRefTable[]; inStack: RefTable _ MakeRefTable[]; stack: NodeList _ NIL; cycleCount: INTEGER _ 0; PerElement: PROC [n: Node] = { out.PutF["\t%g\n", [rope[n.name]] ]; InnerWakeWaiters[n]; IF n.producer#NIL AND n.producer.a#leaf THEN InnerWakePermissionWaiters[n.producer.a]; }; NoteNode: --INTERNAL-- PROC [n: Node] = { IF explored.Lookup[n] # NIL THEN RETURN; IF inStack.Lookup[n] # NIL THEN { cycleCount _ cycleCount + 1; out.PutRope["Found cycle:\n"]; PerElement[n]; FOR nl: NodeList _ stack, nl.rest WHILE nl.first # n DO PerElement[nl.first]; ENDLOOP; out.PutRope["\n"]; RETURN; }; inStack.Insert[n, n]; stack _ CONS[n, stack]; FOR wl: NodeList _ n.waitingOnCurrent, wl.rest WHILE wl # NIL DO [] _ NoteNode[wl.first]; ENDLOOP; IF n.producer # NIL AND n.producer.a # leaf THEN { a: Action = n.producer.a; FOR wl: NodeList _ a.waitingForPermission, wl.rest WHILE wl # NIL DO [] _ NoteNode[wl.first]; ENDLOOP; }; stack _ stack.rest; IF DeleteFromRefTable[n, inStack] # n THEN ERROR; explored.Insert[n, n]; }; halt _ TRUE; Warning["MakeDo deadlocked... hang on while I look for dependency cycles... "]; FOR n: Node _ NARROW[waitQueue.LookupSmallest[]], NARROW[waitQueue.LookupNextLarger[n]] WHILE n # NIL DO NoteNode[n]; ENDLOOP; Warning[IO.PutFR["... found %g cycle(s) ... halting", [integer[cycleCount]] ]]; }; StatelessEnumerateRefTable: PROC [table: RefTable, EachNode: RedBlackTree.EachNode] = { table _ table; FOR ref: REF ANY _ table.LookupSmallest[], table.LookupNextLarger[ref] WHILE ref # NIL DO IF EachNode[ref] THEN ERROR; ENDLOOP; table _ table; }; Start: PROC = { TRUSTED { mcp: Process.ConditionPointer = @monitorChange; qcp: Process.ConditionPointer = @queueChange; Process.InitializeCondition[mcp, Process.SecondsToTicks[entryTimeout]]; Process.EnableAborts[mcp]; Process.InitializeCondition[qcp, Process.SecondsToTicks[queueTimeout]]; Process.EnableAborts[qcp]; }; UserProfile.CallWhenProfileChanges[SetProcessAllocationFromProfile]; Commander.Register[key: forkCmdBase, proc: HelpMakeDo, doc: "not for public use"]; }; Start[]; END.