DIRECTORY AMBridge USING [FHFromTV, GetWorld, Loophole, RemoteFHFromTV, TVToLC], AMMiniModel USING [GetInterfaceRecordFromType], AMTypes USING [Argument, Class, Domain, EnclosingBody, Error, GlobalParent, Globals, IndexToDefaultInitialValue, IndexToName, IndexToTV, IndexToType, IsComputed, IsInterface, IsOverlaid, Locals, NameToIndex, NComponents, New, NValues, Procedure, Range, Referent, Result, Signal, Tag, TV, TVSize, TVToType, TVType, TypeClass, UnderClass, UnderType, Variant], InterpreterPrivate USING [], Rope USING [Equal, ROPE, Size], SafeStorage USING [nullType, Type], WorldVM USING [LocalWorld, World]; RecordSearchImpl: CEDAR PROGRAM IMPORTS AMBridge, AMMiniModel, AMTypes, Rope, WorldVM EXPORTS InterpreterPrivate = BEGIN OPEN AMTypes, Rope, SafeStorage; World: TYPE = WorldVM.World; RecordSearch: PUBLIC PROC [record: TV, name: ROPE] RETURNS [tv: TV _ NIL] = TRUSTED { lastFrame: TV _ NIL; -- indicate that we have not encountered any frames DO type: Type; IF record = NIL THEN RETURN[NIL]; type _ AMTypes.UnderType[AMTypes.TVType[record]]; SELECT AMTypes.TypeClass[type] FROM ref, list, pointer, longPointer, basePointer => { record _ AMTypes.Referent[record]; LOOP}; type => { ENABLE AMTypes.Error => EXIT; typeValue: Type _ AMTypes.TVToType[record]; index: NAT _ AMTypes.NameToIndex[typeValue, name]; IF index = 0 THEN RETURN[NIL] -- no such component ELSE { world: WorldVM.World = AMBridge.GetWorld[record]; instance: TV _ NIL; IF AMTypes.IsInterface[typeValue] THEN instance _ AMMiniModel.GetInterfaceRecordFromType[typeValue, world ! AMTypes.Error => CONTINUE]; IF instance # NIL THEN tv _ AMTypes.IndexToTV[instance, index] -- use the instance ELSE tv _ AMTypes.IndexToDefaultInitialValue[typeValue, index]; IF tv = NIL THEN { record _ AMTypes.New[type: typeValue, world: world]; tv _ AMTypes.IndexToTV[record, index]; }; IF AMTypes.TVSize[tv] <= 2 AND AMBridge.TVToLC[tv] = 0 THEN { elemType: Type _ AMTypes.IndexToType[typeValue, index]; SELECT AMTypes.UnderClass[elemType] FROM procedure, error, signal, program, port => RETURN[NIL]; ENDCASE; }; RETURN[tv]; }; }; record, structure => { n: NAT _ AMTypes.NComponents[type]; lastType, domain: Type _ nullType; lastClass: Class _ nil; overlaid: BOOL _ FALSE; index: NAT _ 0; IF n = 0 THEN EXIT; {ENABLE AMTypes.Error => GOTO dontWorry; lastType _ AMTypes.IndexToType[type, n]; lastType _ AMTypes.UnderType[lastType]; lastClass _ AMTypes.TypeClass[lastType]; EXITS dontWorry => {} }; IF n = 1 AND AMTypes.IndexToName[type, 1].Size[] = 0 AND lastClass # union THEN {record _ AMTypes.IndexToTV[record, 1]; LOOP}; index _ AMTypes.NameToIndex[type, name ! AMTypes.Error => CONTINUE]; IF index # 0 THEN RETURN[AMTypes.IndexToTV[record, index]]; SELECT lastClass FROM union => { domain _ AMTypes.UnderType[AMTypes.Domain[lastType]]; IF AMTypes.TypeClass[domain] # enumerated THEN RETURN[NIL]; overlaid _ AMTypes.IsOverlaid[lastType] OR AMTypes.IsComputed[lastType]; }; sequence => IF AMTypes.IsComputed[lastType] THEN RETURN[NIL]; ENDCASE => RETURN[NIL]; IF NOT overlaid AND name.Equal[AMTypes.IndexToName[lastType, 0]] THEN RETURN[AMTypes.Tag[AMTypes.IndexToTV[record, n]]]; IF lastClass = sequence THEN RETURN[NIL]; IF overlaid THEN { found: BOOL _ FALSE; FOR armIndex: INT IN [1..AMTypes.NValues[domain]] DO armType: Type _ AMTypes.UnderType[AMTypes.IndexToType[lastType, armIndex ! AMTypes.Error => LOOP]]; tag: TV _ NIL; index: NAT _ 0; index _ AMTypes.NameToIndex[armType, name ! AMTypes.Error => CONTINUE]; IF index # 0 THEN { record _ AMBridge.Loophole[record, armType]; found _ TRUE; EXIT; }; ENDLOOP; IF found THEN LOOP ELSE RETURN[NIL]; } ELSE { record _ AMTypes.Variant[AMTypes.IndexToTV[record, n]]; -- get last element LOOP; }; }; globalFrame => {record _ AMTypes.Globals[lastFrame _ record]; LOOP}; localFrame => RETURN[LocalFrameSearch[record, name]]; ENDCASE => RETURN[NIL]; ENDLOOP; RETURN[NIL]; }; SearchArgsAndRtns: PROC [lf: TV, name: ROPE] RETURNS [tv: TV _ NIL] = TRUSTED { procType, recType: Type; class: Class; procTV: TV _ NIL; n: CARDINAL _ 0; index: CARDINAL _ 0; IF AMTypes.UnderClass[AMTypes.TVType[lf]] # localFrame THEN ERROR; procTV _ AMTypes.Procedure[lf ! AMTypes.Error => IF reason = typeFault THEN CONTINUE]; IF procTV = NIL THEN procTV _ AMTypes.Signal[lf]; procType _ AMTypes.UnderType[TVType[procTV]]; class _ AMTypes.TypeClass[procType]; SELECT class FROM procedure, signal, error, program, port => { recType _ AMTypes.UnderType[AMTypes.Domain[procType]]; IF recType # nullType AND (n _ AMTypes.NComponents[recType]) # 0 THEN { index _ AMTypes.NameToIndex[recType, name ! AMTypes.Error => IF reason = badName THEN CONTINUE]; IF index # 0 THEN {tv _ AMTypes.Argument[lf, index]; RETURN}; }; SELECT class FROM procedure, signal => { recType _ AMTypes.UnderType[AMTypes.Range[procType]]; IF recType # nullType AND (n _ AMTypes.NComponents[recType]) # 0 THEN { index _ AMTypes.NameToIndex[recType, name ! AMTypes.Error => IF reason = badName THEN CONTINUE]; IF index # 0 THEN {tv _ AMTypes.Result[lf, index]; RETURN}; }; }; ENDCASE; }; ENDCASE; }; LocalFrameSearch: PROC [lf: TV, name: ROPE] RETURNS [tv: TV _ NIL] = TRUSTED { lastFH: TV _ NIL; IF lf # NIL THEN DO rec: TV _ NIL; tv _ RecordSearch[AMTypes.Locals[lf], name]; IF tv # NIL THEN RETURN[tv]; rec _ AMTypes.EnclosingBody[lf]; SELECT TRUE FROM rec = NIL => { IF NOT EqualLocalFrames[lf, lastFH] THEN tv _ SearchArgsAndRtns[lf, name]; IF tv # NIL THEN RETURN; rec _ AMTypes.GlobalParent[lf]; IF rec = NIL THEN RETURN [NIL]; RETURN[RecordSearch[rec, name]]; }; NOT EqualLocalFrames[lf, rec] => { lastFH _ lf; tv _ SearchArgsAndRtns[lf, name]; IF tv # NIL THEN RETURN[tv]; }; ENDCASE; lf _ rec; ENDLOOP; }; EqualLocalFrames: PROC [lf1,lf2: TV] RETURNS [BOOL] = TRUSTED { IF lf1 = lf2 THEN RETURN [TRUE]; IF lf1 # NIL AND lf2 # NIL THEN { w1: WorldVM.World _ AMBridge.GetWorld[lf1]; IF w1 # AMBridge.GetWorld[lf2] THEN RETURN [FALSE]; IF w1 = WorldVM.LocalWorld[] THEN RETURN [AMBridge.FHFromTV[lf1] = AMBridge.FHFromTV[lf2]] ELSE RETURN [AMBridge.RemoteFHFromTV[lf1] = AMBridge.RemoteFHFromTV[lf2]]; }; RETURN [FALSE]; }; END. tRecordSearchImpl.mesa Copyright c 1985, 1986 by Xerox Corporation. All rights reserved. Russ Atkinson (RRA) March 11, 1986 7:20:34 am PST record represents a tv from which (somehow) one can get to a record type or instance. automatic dereferencing of refs to records If this thing is a type, then we try to get the value associated with its named component. Of course, this only works for record and structure types, but that is good enough. Other classes of type will get an AMTypes.Error somewhere, and we will exit, behaving as though there were no such component. There is a component of this name, so try to get its value... First, try to get an IR using the Runtime Model... There is no instance, so use the default value for the component Last chance: try to instantiate the type and pull out the value this way... This could be an unbound procedure. If so, then we return NIL, which should result in it being undefined. I wish that we could do something else here. This case usually results from not having the implementing module loaded or from not having the interface exported to the top level. We now have a valid TV in hand, so return it... an unnamed record component gets auto-selected IF it is not a union if name does not match this could be a variant record that needs the variant bound maybe want named tag oh, we want the tag! we have to treat overlaid variant records as somewhat funny beasts we found it! force AMTypes to assume the "right" type this routine searches args and rtns for the given frame ... searches the given local frame for the given name. The search will include all levels of variables, including those in statically enclosing local frames and the global frame. ... search all of the enclosing bodies No more enclosing bodies. So we try for the arguments, then the global frame. level change! need to search args & rtns of the frame we are leaving Êì˜codešœ™Kšœ Ïmœ7™BK™1—˜šÏk ˜ Kšœ žœ8˜FKšœ žœ˜/KšœžœžœG˜åKšœžœ˜Kšœžœ žœ˜Kšœ žœ˜#Kšœžœ˜"——K˜šÏbœžœž˜Kšžœ.˜5Kšžœ˜Kšœžœžœ˜(—˜Kšœžœ˜K˜šÏn œžœžœ žœžœžœžœžœžœ˜UKšœV™VKšœ žœžœÏc3˜Hšž˜K˜ Kš žœ žœžœžœžœ˜!K˜1šžœž˜#šœ1˜1Kšœ*™*Kšœ"˜"Kšžœ˜—˜ Kšœ®™®Kšžœžœ˜K˜+Kšœžœ(˜2š žœ žœžœžœ¡˜3šžœ˜Kšœ=™=K˜1Kšœ žœžœ˜Kšœ2™2Kšžœ˜!šžœC˜GKšœžœ˜—šžœ ž˜Kšžœ*¡˜Ašžœ;˜?Kšœ@™@——šžœžœžœ˜KšœK™KKšœ4˜4Kšœ&˜&K˜—šžœžœžœ˜=Kšœž™žKšœ7˜7šžœž˜(Kšœ+žœžœ˜7Kšžœ˜—K˜—Kšœ/™/Kšžœ˜ Kšœ˜——Kšœ˜—šœ˜Kšœžœ˜#K˜"K˜Kšœ ž œ˜Kšœžœ˜Kšžœžœžœ˜šœžœžœ ˜(K˜(K˜'K˜(Kšžœ˜Kšœ˜—šžœžœ)žœ˜JKšžœ)žœ˜3KšœC™C—Kšœ:žœ˜DKšžœ žœžœ#˜;K™KšœR™Ršžœ ž˜˜ K˜5Kšžœ(žœžœžœ˜;Kšœ(žœ˜HK˜—š œ žœžœžœžœ˜=Kšœ™—Kšžœžœžœ˜—šžœžœ žœ-˜@Kšœ™Kšžœžœ,˜7—Kšžœžœžœžœ˜)šžœ ˜ šžœ˜KšœB™BKšœžœžœ˜šžœ žœžœž˜4šœ ˜ šœ:˜:Kšœžœ˜——Kšœžœžœ˜Kšœžœ˜šœ)˜)Kšœžœ˜—šžœ žœ˜Kšœ6™6K˜,Kšœžœ˜ Kšžœ˜K˜—Kšžœ˜—Kš žœžœžœžœžœžœ˜$K˜—šžœ˜Kšœ8¡˜KKšžœ˜K˜——Kšœ˜—Kšœ>žœ˜DKšœžœ!˜5Kšžœžœžœ˜—Kšžœ˜—Kšžœžœ˜ Kšœ˜—K˜š œžœžœžœžœžœžœžœ˜OKšœ7™7K˜K˜ Kšœžœžœ˜Kšœžœ˜Kšœžœ˜K˜Kšžœ5žœžœ˜Bšœ˜Kšœžœžœžœ˜8—Kšžœ žœžœ˜1K˜-K˜$šžœž˜˜,K˜6šžœžœ'˜@šžœ˜šœ)˜)Kšœžœžœžœ˜6—Kšžœ žœ$žœ˜=Kšœ˜——šžœž˜˜Kšœ5˜5šžœžœ'˜@šžœ˜šœ)˜)Kšœžœžœžœ˜6—Kšžœ žœ"žœ˜;Kšœ˜——K˜—Kšžœ˜—K˜—Kšžœ˜—Kšœ˜K˜—š œžœžœžœžœžœžœžœ˜NKšœ´™´Kšœžœžœ˜Kšœ&™&šžœžœžœž˜Kšœžœžœ˜Kšœ,˜,Kšžœžœžœžœ˜Kšœ ˜ šžœžœž˜šœžœ˜KšœN™NKšžœžœžœ"˜JKšžœžœžœžœ˜Kšœ˜Kš žœžœžœžœžœ˜Kšžœ˜ Kšœ˜—šžœ˜"KšœD™DKšœ ˜ Kšœ!˜!Kšžœžœžœžœ˜Kšœ˜—Kšžœ˜—Kšœ ˜ Kšžœ˜K˜—K˜K˜—š  œžœ žœžœžœžœ˜?Kšžœ žœžœžœ˜ š žœžœžœžœžœ˜!Kšœ+˜+Kšžœžœžœžœ˜3šžœ˜Kšžœžœ2˜=Kšžœžœ?˜J—K˜—Kšžœžœ˜K˜K˜—Kšžœ˜—˜K˜——…—Ú(: