DIRECTORY AMBridge USING[TVForGFHReferent, TVForRemoteGFHReferent], AMMiniModel USING[], -- exports only AMTypes USING[TVType, IndexToTV, NameToIndex, TypeClass, UnderType, TVToName, GlobalParent, Error, TypedVariable], Atom USING[GetProp, MapAtoms, MakeAtom, PutProp, GetPName], BcdDefs USING[VersionStamp, NullVersion], LoaderOps USING[IR, GetIR, IRRecord], LoadState USING[ConfigID, ModuleIndex, CopiesList, local, ModuleInfo, Acquire, EnumerateAllModules, Release], PrincOps USING[GlobalFrameHandle], Rope USING[ROPE, Concat, Find, Substr, Index], RTCommon USING[ShortenLongPointer], RTSymbolDefs USING[SymbolTableBase, SymbolTableHandle, nullHandle, SymbolIdIndex, SymbolIndex], RTSymbolOps USING[EnumerateCtxIseis, AcquireType, ISEPublic, ISEType, STBDirectoryCTX], RTSymbols USING[AcquireSTB, ReleaseSTB, GetSTHForModule], RTTypesBasicPrivate USING[MapTiTd], RTTypesPrivate USING[TypedVariableRec], SafeStorage USING[Type], WorldVM USING[World, LocalWorld]; AMModelInterfaceImpl: PROGRAM IMPORTS AMBridge, AMTypes, Atom, LoaderOps, LoadState, Rope, RTCommon, RTSymbolOps, RTSymbols, RTTypesBasicPrivate, WorldVM EXPORTS AMMiniModel = BEGIN OPEN AMBridge, AMTypes, Rope, SafeStorage, RTSymbolDefs, RTSymbolOps, RTSymbols, RTTypesPrivate, WorldVM; ImplementorName: PUBLIC SAFE PROC[defsName, itemName: ROPE, world: World _ LocalWorld[]] RETURNS[ROPE] = TRUSTED { inst: TypedVariable; type: Type; item: TypedVariable; inst _ GetInterfaceRecord[defsName, world ! ANY => GOTO returnNil]; type _ TVType[inst ! ANY => GOTO returnNil]; item _ IndexToTV[inst, NameToIndex[type, itemName ! ANY => GOTO returnNil] ! ANY => GOTO returnNil]; IF item = NIL THEN GOTO returnNil; SELECT TypeClass[UnderType[TVType[item]]] FROM procedure, signal, error => RETURN[TVToName[GlobalParent[item]]]; program => RETURN[TVToName[item]]; type, opaque => RETURN[defsName]; -- opaque types: not yet NOTE nil => RETURN[defsName]; -- may be an INLINE ENDCASE => WITH item SELECT FROM rtr: REF TypedVariableRec => WITH h: rtr.head SELECT FROM gfh => RETURN[TVToName[TVForGFHReferent[h.gfh]]]; remoteGFH => RETURN[TVToName[TVForRemoteGFHReferent[h.remoteGlobalFrameHandle]]]; pointer => { FindEnclosingGFH: PROC[p: POINTER] RETURNS[gfh: PrincOps.GlobalFrameHandle _ NIL] = { pInt: INT = LOOPHOLE[LONG[p], INT]; minDel: INT _ 200000B; -- some large number proc: PROC [ci: LoadState.ConfigID, mx: LoadState.ModuleIndex] RETURNS [stop: BOOL _ FALSE] = { tgfh: PrincOps.GlobalFrameHandle; copies: LoadState.CopiesList; del, gfhInt: INT; [gfh: tgfh, copies: copies] _ LoadState.local.ModuleInfo[ci, mx]; gfhInt _ LOOPHOLE[LONG[tgfh], INT]; del _ pInt-gfhInt; IF del >= 0 AND del < minDel THEN {gfh _ tgfh; minDel _ del}; FOR c: LoadState.CopiesList _ copies, c.rest UNTIL c = NIL DO gfhInt _ LOOPHOLE[LONG[c.first], INT]; del _ pInt-gfhInt; IF del >= 0 AND del < minDel THEN {gfh _ c.first; minDel _ del}; ENDLOOP; }; IF p = NIL THEN RETURN[NIL]; LoadState.local.Acquire[]; [] _ LoadState.local.EnumerateAllModules[newestFirst, proc ! UNWIND => LoadState.local.Release[]]; LoadState.local.Release[]; }; gfh: PrincOps.GlobalFrameHandle = FindEnclosingGFH[RTCommon.ShortenLongPointer[h.ptr]]; IF gfh # NIL THEN RETURN[TVToName[TVForGFHReferent[gfh]]] ELSE RETURN[NIL]; }; ENDCASE; ENDCASE; RETURN[NIL]; EXITS returnNil => RETURN[NIL]; }; GetInterfaceRecord: PUBLIC SAFE PROC[defsName: ROPE, world: World _ LocalWorld[]] RETURNS[tv: TypedVariable _ NIL] = TRUSTED { ir: LoaderOps.IR; irType: REF Type; atom: ATOM = Atom.MakeAtom[defsName]; version: BcdDefs.VersionStamp; IF world # LocalWorld[] THEN ERROR Error[reason: notImplemented, msg: "access to remote IRs"]; [interface: ir, versionStamp: version] _ LoaderOps.GetIR[atom: atom]; IF ir = NIL THEN RETURN; irType _ NARROW[Atom.GetProp[atom, $IRType]]; IF irType = NIL THEN { irType _ NEW[Type _ AcquireIRType[defsName, version]]; Atom.PutProp[atom, $IRType, irType]; }; tv _ NEW[TypedVariableRec _ [referentType: [type: irType^], head: [reference[ref: ir]], field: embedded[fd: [wordOffset: SIZE[LoaderOps.IRRecord], extent: large[size: ir.size]]]]]; }; GetInterfaceRecordFromType: PUBLIC SAFE PROC[type: Type, world: World _ LocalWorld[]] RETURNS[tv: TypedVariable _ NIL] = TRUSTED { ir: LoaderOps.IR; atom: ATOM; IF world # LocalWorld[] THEN ERROR Error[reason: notImplemented, msg: "access to remote IRs"]; [name: atom, interface: ir] _ LoaderOps.GetIR[version: RTTypesBasicPrivate.MapTiTd[type].utf.umid]; IF ir = NIL THEN RETURN; IF NARROW[Atom.GetProp[atom, $IRType], REF Type] = NIL THEN { Atom.PutProp[atom, $IRType, NEW[Type _ type]]; }; tv _ NEW[TypedVariableRec _ [referentType: [type: type], head: [reference[ref: ir]], field: embedded[fd: [wordOffset: SIZE[LoaderOps.IRRecord], extent: large[size: ir.size]]]]]; }; GetInterfaceRecordNames: PUBLIC SAFE PROC[world: World _ LocalWorld[]] RETURNS[l: LIST OF ROPE _ NIL] = TRUSTED { p: SAFE PROC[atom: ATOM] = TRUSTED {IF Atom.GetProp[atom, $IR] # NIL THEN l _ CONS[Atom.GetPName[atom], l]}; IF world # LocalWorld[] THEN ERROR Error[reason: notImplemented, msg: "access to remote IRs"]; Atom.MapAtoms[p]; }; AcquireIRType: PUBLIC SAFE PROC [defsName: ROPE, version: BcdDefs.VersionStamp _ BcdDefs.NullVersion] RETURNS[type: Type] = TRUSTED { irType: REF Type; irVersion: REF BcdDefs.VersionStamp; atom: ATOM = Atom.MakeAtom[defsName]; stb: SymbolTableBase; seIndex: SymbolIndex; p: PROC[stb: SymbolTableBase, isei: SymbolIdIndex] RETURNS[stop: BOOL] = { IF ISEPublic[stb, isei] THEN {seIndex _ ISEType[stb, isei]; RETURN[TRUE]} ELSE RETURN[FALSE]; }; irType _ NARROW[Atom.GetProp[atom, $IRType]]; irVersion _ NARROW[Atom.GetProp[atom, $version]]; IF irType # NIL AND irVersion # NIL AND (version = BcdDefs.NullVersion OR version = irVersion^) THEN RETURN[irType^]; IF version = BcdDefs.NullVersion AND irVersion # NIL THEN version _ irVersion^; stb _ AcquireSTBForDefs[defsName, version]; { ENABLE UNWIND => ReleaseSTB[stb]; IF NOT EnumerateCtxIseis[stb: stb, ctx: STBDirectoryCTX[stb], proc: p] THEN ERROR; type _ AcquireType[stb: stb, seIndex: seIndex]; }; -- end ENABLE UNWIND => ReleaseSTB[stb]; ReleaseSTB[stb]; }; AcquireSTBForDefs: PROC[fileName: ROPE, version: BcdDefs.VersionStamp _ BcdDefs.NullVersion] RETURNS[stb: SymbolTableBase] = { sth: SymbolTableHandle _ nullHandle; IF fileName.Find["."] = -1 THEN fileName _ fileName.Concat[".bcd"]; sth _ GetSTHForModule[ stamp: version, fileName: fileName, moduleName: fileName.Substr[start: 0, len: fileName.Index[pos1: 0, s2: "."]] ]; stb _ AcquireSTB[sth]; IF NOT (WITH stb SELECT FROM t: SymbolTableBase.x => t.e.stHandle.definitionsFile, t: SymbolTableBase.y => t.e.stHandle.definitionsFile, ENDCASE => ERROR) THEN { ReleaseSTB[stb]; ERROR AMTypes.Error[ reason: noSymbols, msg: Rope.Concat[fileName, " not a defs module"] ]; }; }; END. \AMModelInterfaceImpl.mesa Last Modified By Paul Rovner On December 13, 1983 11:59 am Э╩ЪЦ "cedar" styleШIprocЪЬЩKЪЬ:Щ:KШЪ╧k Ш KЪЬ ЭЬ+Ш9KЪЬЭЬ╧cШ%KЪЬЭЬeШrKЪЬЭЬ1Ш;KЪЬЭЬШ)KЪЬ ЭЬЭЬШ%KЪЬ ЭЬ ЭЬЭЬ ЭЬЭЬ ЭЬЭЬЭЬ ШmKЪЬ ЭЬШ"KЪЬЭЬЭЬШ.KЪЬ ЭЬШ#KЪЬ ЭЬMШ_KЪЬЭЬFШWKЪЬ ЭЬ*Ш9KЪЬЭЬ Ш#KЪЬЭЬШ'KЪЬЭЬШKЪЬЭЬШ!ЧKШЪЬЭШKЪЭЬtШ{KЪЭЬШЧKШKЪЬЭЬЭЬeШqKШЪ ╧nЬЭЬЭЬЭЬЭЬШXKЪЭЬЭЬЭЬШKЪЬШKЪЬШKЪЬШKЪЬ,ЭЬЭЬШCKЪЬЭЬЭЬШ,ЪЬ4ЭЬЭЬШJKЪЬЭЬЭЬШЧKЪЭЬЭЬЭЬЭЬШ"ЪЭЬ$ЭШ.KЪЬЭЬШAKЪЬЭЬШ"KЪЬЭЬЮШ?KЪЬЭЬ ЮШ-ЪЭЬШ ЪЭЬЭЬЭШЪЬЭЬШЪЭЬ ЭЬЭШKЪЬЭЬ$Ш1ЪЬШKЪЭЬ>ШDЧЪЬШЪЯЬЭЬЭЬШ"KЪЭЬ#ЭЬШ2KЪ ЬЭЬЭЬЭЬЭЬШ#KЪЬЭЬ ЮШ,ЪЬЭЬ4Ш>KЪЭЬЭЬЭЬШ KЪЬ ЭШ!KЪЬШKЪЬ ЭЬШKЪЬAШAKЪЬ ЭЬЭЬЭЬШ#KЪЬШKЪЭЬ ЭЬЭЬШ=ЪЭЬ*ЭЬЭШ:ЪЭШKЪЬ ЭЬЭЬЭЬШ&KЪЬШKЪЭЬ ЭЬЭЬШ@ЧKЪЭЬШЧKЪЬШЧKЪ ЭЬЭЬЭЬЭЬЭЬШKЪЬШЪЬ:Ш:KЪЬЭЬШ'ЧKЪЬШKЪЬШЧЪЬШKЪЬ7Ш7ЧЪЭЬЭШKЪЭЬЭЬ!Ш,KЪЭЬЭЬЭЬШЧKЪЬШЧKЪЭЬШЧЧЧKЪЭЬШЧЧKЪЭЬЭЬШKЪЭЬЭЬЭЬШKЪЬШЧKШЪ ЯЬЭЬЭЬЭЬЭЬШQKЪЭЬЭЬЭЬШ,KЪЬЭЬШKЪЬШKЪЬЭЬШ%JШЪЭЬШKЪЭЬЭЬ<ШFЧKЪЬEШEKЪЭЬЭЬЭЬЭЬШJЪЬ ЭЬШ-ЪЭЬ ЭЬЭЬШKЪЬ ЭЬ*Ш6JЪЬ$Ш$KЪЬШЧЪЬЭЬШЪЬ!Ш!KЪЬШKЪЬ"ЭЬШ;KЪЬ"Ш"ЧЧKЪЬШKШЧЪЯЬЭЬЭЬЭЬ)ШUKЪЭЬЭЬЭЬШ,KЪЬЭЬШKЪЬЭЬШЪЭЬШKЪЭЬЭЬ<ШFЧЪЬШKЪЬGШGЧKЪЭЬЭЬЭЬЭЬШЪЭЬЭЬ*ЭЬЭЬШ=JЪЬЭЬШ.KЪЬШЧЪЬЭЬШЪЬШKЪЬШKЪЬ"ЭЬШ;KЪЬ"Ш"ЧЧKЪЬШЧKШЪЯЬЭЬЭЬЭЬШFKЪЭЬЭЬЭЬЭЬЭЬЭЬШ*ЪЬЭЬЭЬЭЬЭШ"KЪ ЬЭЬЭЬЭЬЭЬШIЧЪЭЬШKЪЭЬЭЬ<ШFЧKЪЬШKЪЬШЧKШЪЯ ЬЭЬЭЬЭШKЪЬЭЬ6ШEKЪЭЬЭЬШKЪЬЭЬШKЪЬЭЬШ$KЪЬЭЬШ%KЪЬШKЪЬШЪЬЭЬ,ЭЬЭЬШJKЪЭЬЭЬ ЭЬЭЬШIKЪЭЬЭЬЭЬШKЪЬШЧJЪЬ ЭЬШ-JЪЬЭЬШ1ЪЭЬ ЭЬЭЬ ЭШ#KЪЭЬ ЭЬШ;KЪЭЬЭЬ ШЧKЪЭЬЭЬ ЭЬЭЬШOKЪЬ+Ш+ЪЬЭЬЭЬШ#KЪЭЬЭЬAЭЬЭЬШRKЪЬ/Ш/ЧKЪЬЮ)Ш-KЪЬШKЪЬШЧKШЪЯЬШJЪЭЬЭЮЬЭЬШIЪЭЬШ!JЪЬ#ЭШ$KЪЭЬЭЬ$ШCЪЬШJЪЬШJШJЪЬNШNJЪЬШЧJЪЬШЪ ЭЬЭЬЭЬЭЬЭШJШ5JШ5JЪЭЬЭЬШЪЭЬШJЪЬШЪЭЬШJЪЬШJШ0JШЧJШЧЧЧJШJШЧKЪЭЬШKШЧЕЧЪ#Р