<> <> <> <> <> DIRECTORY AMBridge, AMModel, AMTypes, Basics USING [bytesPerWord], BcdDefs USING [VersionStamp], CD, CDApplications, CDConditions, CDDirectory, CDIO, CDOps, CDValue, FileNames, FS, Interpreter USING [Evaluate], IO, Loader USING [Instantiate, IRItem], PrincOps USING [ControlModule], Rope, TerminalIO, TokenIO, WorldVM USING [LocalWorld]; CDConditionsImpl: CEDAR PROGRAM IMPORTS AMBridge, AMModel, AMTypes, CD, CDApplications, CDDirectory, CDIO, CDOps, CDValue, FileNames, FS, Interpreter, IO, Loader, Rope, TerminalIO, TokenIO, WorldVM EXPORTS CDConditions SHARES CDDirectory = BEGIN ConditionProc: TYPE = CDConditions.ConditionProc; CondPtr: TYPE = CDConditions.CondPtr; CondRec: TYPE = CDConditions.CondRec; pForConditions: REF CD.ObjectProcs ~ CD.RegisterObjectType[$Cond]; ConditionList: TYPE = LIST OF CD.ObPtr; DrawMe: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN ENABLE UNWIND => IF pr.nesting.table[pr.nestDepth_1]=aptr THEN pr.nestDepth _ pr.nestDepth-1; cptr: CondPtr = NARROW[aptr.ob.specificRef]; IF cptr.condition=NIL OR cptr.condition[aptr, pr] THEN { pr.nesting.table[pr.nestDepth] _ aptr; pr.nestDepth _ pr.nestDepth+1; pr.drawChild[cptr.app, pos, orient, pr]; pr.nestDepth _ pr.nestDepth-1; } END; QuickDrawMe: PROC [aptr: CD.ApplicationPtr, pos: CD.DesignPosition, orient: CD.Orientation, pr: CD.DrawRef] = BEGIN ENABLE UNWIND => IF pr.nesting.table[pr.nestDepth_1]=aptr THEN pr.nestDepth _ pr.nestDepth-1; cptr: CondPtr = NARROW[aptr.ob.specificRef]; IF cptr.condition=NIL OR cptr.condition[aptr, pr] THEN { pr.nesting.table[pr.nestDepth] _ aptr; pr.nestDepth _ pr.nestDepth+1; cptr.app.ob.p.quickDrawMe[cptr.app, pos, orient, pr]; pr.nestDepth _ pr.nestDepth-1; } END; DescribeCond: PROC[me: CD.ObPtr] RETURNS [Rope.ROPE] = BEGIN cptr: CondPtr = NARROW[me.specificRef]; RETURN [Rope.Cat["conditional ", CDOps.Info[cptr.app.ob], " [", CDDirectory.Name[me], "]"]] END; GetConditionList: PROC[design: CD.Design] RETURNS [REF ConditionList] = BEGIN x: REF _ CDValue.Fetch[design, $ConditionList]; IF x=NIL OR ~ISTYPE[x, REF ConditionList] THEN { x _ NEW[ConditionList_NIL]; CDValue.Store[design, $ConditionList, x]; }; RETURN [NARROW[x, REF ConditionList]]; END; Another: PROC [me: CD.ObPtr, from, to: CD.Design] RETURNS [CD.ObPtr] = BEGIN cp: CondPtr = NARROW[me.specificRef]; RETURN [CreateCondition[to, cp.app.ob, cp.condition, cp.data]] END; InternalCreateCondOb: PROC [design: CD.Design, ob: CD.ObPtr, condition: ConditionProc, data: REF] RETURNS [CD.ObPtr] = BEGIN refcl: REF ConditionList = GetConditionList[design]; cOb: CD.ObPtr = NEW[CD.ObjectDefinition]; cp: CondPtr = NEW[CondRec]; cOb.p _ pForConditions; cOb.size _ ob.size; cOb.layer _ ob.layer; cOb.specificRef _ cp; cp.app _ CDApplications.NewApplicationI[ob: ob]; cp.condition _ condition; cp.data _ data; refcl^ _ CONS[cOb, refcl^]; RETURN [cOb]; END; CreateCondition: PUBLIC PROC [design: CD.Design, ob: CD.ObPtr, condition: ConditionProc_NIL, data: REF_NIL] RETURNS [CD.ObPtr] = <<--there are restrictions on the type of data; (because of IO!)>> BEGIN cOb: CD.ObPtr = InternalCreateCondOb[design, ob, condition, data]; [] _ CDDirectory.Include[design, cOb]; RETURN [cOb]; END; ChangeCondition: PUBLIC PROC [design: CD.Design, ob: CD.ObPtr, fileName, procName: Rope.ROPE_NIL, data: REF_NIL, condition: ConditionProc_NIL] RETURNS [done: BOOL_FALSE] = <<--if condition is nil, tries to evaluate fileName, procName>> <<--redraws the complete design>> <<--there are restrictions on the type of data>> BEGIN WriteNames: PROC [r: Rope.ROPE_NIL] = { TerminalIO.WriteRope[" Condition proc "]; TerminalIO.WriteRope[procName]; TerminalIO.WriteRope[" on file "]; TerminalIO.WriteRope[fileName]; TerminalIO.WriteRope["; "]; IF ~Rope.IsEmpty[r] THEN TerminalIO.WriteRope[r]; }; cptr: CondPtr = NARROW[ob.specificRef]; cptr.data _ data; cptr.fileName _ fileName; cptr.procName _ procName; IF condition#NIL THEN { cptr.condition _ condition; done _ TRUE; } ELSE IF Rope.IsEmpty[procName] THEN { cptr.condition _ NIL; done _ TRUE; } ELSE { procAlone, modName: Rope.ROPE_NIL; cptr.condition _ NIL; cptr.data _ data; cptr.fileName _ fileName; cptr.procName _ procName; BEGIN -- determine procAlone, modName procDot: INT = TrailingDot[procName]; IF procDot < Rope.Length[procName] THEN { procAlone _ Rope.Flatten[procName, procDot+1]; modName _ Rope.Flatten[procName, 0, procDot] } ELSE procAlone _ procName; IF Rope.IsEmpty[modName] THEN modName _ SuggestedModule[fileName]; IF Rope.IsEmpty[procAlone] THEN procAlone _ "Condition"; END; [] _ CDIO.UseWorkingDirectory[design]; TRUSTED BEGIN -- compare the file with the wanted module; load the file root: AMModel.Context = AMModel.RootContext[WorldVM.LocalWorld[]]; ctxVersion, fileVersion: BcdDefs.VersionStamp; modCtx: AMModel.Context; fileStream: IO.STREAM; <<--Read the version stamp of the file>> fileStream _ FS.StreamOpen[CDIO.MakeName[fileName, "bcd"] ! FS.Error => IF error.group # bug THEN { WriteNames[]; TerminalIO.WriteRope["Could not open "]; TerminalIO.WriteRope[fileName]; TerminalIO.WriteRope[" "]; TerminalIO.WriteRope[error.explanation]; TerminalIO.WriteLn[]; GOTO NotDone }]; IO.SetIndex[fileStream, SIZE[CARDINAL]*Basics.bytesPerWord]; [] _ IO.UnsafeGetBlock[fileStream, [ base: LOOPHOLE[LONG[@fileVersion]], startIndex: 0, count: SIZE[BcdDefs.VersionStamp]*Basics.bytesPerWord]]; <<--Get the version stamp of the loaded bcd.>> modCtx _ AMModel.MostRecentNamedContext[modName, root]; IF modCtx # NIL THEN ctxVersion _ AMModel.SectionVersion[AMModel.ContextSection[modCtx]]; IF modCtx = NIL OR ctxVersion # fileVersion THEN { <<--We must try to load this file dynamically >> msg: Rope.ROPE _ NIL; unboundImports: LIST OF Loader.IRItem _ NIL; cm: PrincOps.ControlModule; file: FS.OpenFile = FS.OpenFileFromStream[fileStream]; fullName: Rope.ROPE = FS.GetName[file].fullFName; TerminalIO.WriteRope["Loading "]; TerminalIO.WriteRope[fullName]; TerminalIO.WriteLn[]; [cm, unboundImports] _ Loader.Instantiate[file]; IF unboundImports # NIL THEN { TerminalIO.WriteRope["Warning! Unbound imports:"]; FOR eachIR: LIST OF Loader.IRItem _ unboundImports, eachIR.rest WHILE eachIR # NIL DO TerminalIO.WriteRope[eachIR.first.interfaceName]; TerminalIO.WriteRope["#"]; TerminalIO.WriteInt[eachIR.first.index]; ENDLOOP; TerminalIO.WriteLn[]; }; }; IO.Close[fileStream]; <<--At this point we have found the named module, and we want to find the named procedure in the module, if there is one. If one was not specified, default to "Condition".>> END; TRUSTED BEGIN -- get the procedure we want errorRope: Rope.ROPE; noResult: BOOL; tv: AMTypes.TV _ NIL; type: AMTypes.Type; [tv, errorRope, noResult] _ Interpreter.Evaluate[Rope.Cat[modName, ".", procAlone]]; IF noResult OR tv=NIL OR ~Rope.IsEmpty[errorRope] THEN { WriteNames[]; TerminalIO.WriteRope[" no condition procedure: "]; TerminalIO.WriteRope[errorRope]; TerminalIO.WriteLn[]; RETURN }; type _ AMTypes.TVType[tv]; WHILE AMTypes.TypeClass[type]=definition DO tv _ AMTypes.Coerce[tv, AMTypes.UnderType[type]]; type _ AMTypes.TVType[tv]; ENDLOOP; IF AMTypes.TypeClass[type]=ref THEN { WITH AMBridge.SomeRefFromTV[tv] SELECT FROM cond: REF ConditionProc => { cptr.condition _ cond^; done _ TRUE }; ENDCASE => NULL; } ELSE IF AMTypes.TypeClass[type]=procedure THEN { p: PROC ANY RETURNS ANY _ LOOPHOLE[AMBridge.TVToProc[tv]]; WITH p SELECT FROM cond: ConditionProc => { cptr.condition _ cond; done _ TRUE }; ENDCASE => NULL; }; IF ~done THEN WriteNames[" has wrong type; not done\n"]; END; }; IF done THEN CDOps.DelayedRedraw[design] EXITS NotDone => NULL; END; SuggestedModule: PROC [base: Rope.ROPE] RETURNS [Rope.ROPE] = { <<--given a filename, suggests a modulename>> len, dot: INT; base _ FileNames.GetShortName[base]; len _ Rope.Length[base]; dot _ TrailingDot[base]; IF len>dot AND Rope.Equal[Rope.Substr[base, dot+1], "bcd", FALSE] THEN base _ Rope.Flatten[base, 0, dot]; RETURN [base] }; TrailingDot: PROC [base: Rope.ROPE] RETURNS [INT] = { <<--position of last dot>> len: INT _ Rope.Length[base]; pos: INT _ len; WHILE pos > 0 DO SELECT Rope.Fetch[base, pos _ pos - 1] FROM '. => RETURN [pos]; '!, '], '>, '/ => EXIT; ENDCASE; ENDLOOP; RETURN [len]; }; EnumerateCondOb: PROC [me: CD.ObPtr, p: CDDirectory.EnumerateObjectsProc, x: REF] = BEGIN cptr: CondPtr = NARROW[me.specificRef]; p[cptr.app.ob, x]; END; ReadCondOb: CD.InternalReadProc --PROC [] RETURNS [ObPtr]-- = BEGIN ob: CD.ObPtr = CDIO.ReadObject[]; procName: Rope.ROPE = TokenIO.ReadRope[]; fileName: Rope.ROPE = TokenIO.ReadRope[]; cOb: CD.ObPtr = InternalCreateCondOb[CDIO.DesignInReadOperation[], ob, NIL, NIL]; [] _ ChangeCondition[design: CDIO.DesignInReadOperation[], ob: cOb, procName: procName, fileName: fileName]; RETURN [cOb] END; WriteCondOb: CD.InternalWriteProc -- PROC [me: ObPtr] -- = BEGIN specific: CondPtr = NARROW[me.specificRef]; CDIO.WriteObject[specific.app.ob]; TokenIO.WriteRope[specific.procName]; TokenIO.WriteRope[specific.fileName]; END; UpdateConditions: PUBLIC PROC [design: CD.Design, doAll: BOOL_TRUE] RETURNS [done: BOOL_FALSE] = <<--checks if any conditions have been recompiled and reloads them>> <<--doAll TRUE: checks all, including already loded conditions>> <<--doAll FALSE: checks the conditions which are not already loded>> BEGIN doneSoFar: BOOL_TRUE; cl: ConditionList _ GetConditionList[design]^; FOR l: ConditionList _ cl, l.rest WHILE l#NIL DO WITH l.first.specificRef SELECT FROM cptr: CondPtr => IF doAll OR cptr.condition=NIL THEN { doneSoFar _ doneSoFar AND ChangeCondition[design, l.first, cptr.fileName, cptr.procName, cptr.data] }; ENDCASE => doneSoFar_FALSE; ENDLOOP; RETURN [doneSoFar] END; ReplaceDirectChildForConds: CDDirectory.ReplaceDChildsProc = BEGIN cp: CDConditions.CondPtr = NARROW[me.specificRef]; FOR rl: CDDirectory.ReplaceList _ replace, rl.rest WHILE rl#NIL DO rep: REF CDDirectory.ReplaceRec = rl.first; IF rep.old=cp.app.ob THEN { oldSize: CD.DesignPosition _ me.size; off: CD.DesignPosition _ rep.off; cp.cache _ NIL; cp.app.ob _ rep.new; me.size _ rep.new.size; IF design#NIL THEN CDDirectory.RepositionObject[ design: design, ob: me, oldSize: oldSize, baseOff: off ]; EXIT }; ENDLOOP END; InitConditions: PROC [] = BEGIN cp: REF CDDirectory.DirectoryProcs ~ CDDirectory.InstallDirectoryProcs[pForConditions]; cp.enumerateChildObjects _ EnumerateCondOb; cp.replaceDirectChilds _ ReplaceDirectChildForConds; cp.another _ Another; pForConditions.drawMe _ DrawMe; pForConditions.quickDrawMe _ QuickDrawMe; pForConditions.internalRead _ ReadCondOb; pForConditions.internalWrite _ WriteCondOb; pForConditions.describe _ DescribeCond; CDValue.EnregisterKey[$ConditionList]; END; InitConditions[]; END.