<<>> <> <> <> <> <> <> <> <<>> <> <> <> <> <> DIRECTORY Arrays USING[ArrayIndirectNodeInfo, ArrayIndirectNodeInfoBody, ArrayTypeProcs, CreateArrayType, CreateArrayIndirectNode], CCTypes USING[CCError, CCErrorCase, CreateIndirectNode, GetBitSize, GetNElements, GetIndirectCreateNode, GetIndirectType, GetTypeRepresentation], CedarCode USING[GetTypeOfNode, Operator, LoadThroughIndirectNode, NodeAsIndex], CedarNumericTypes USING[NumericDescriptor], CedarOtherPureTypes USING[CreateUnknownType, CreateUnknownTypeNode], CirioMemory, CirioTypes, IO, MobAccess USING[BlockDesc, BodySE, BTH, ConstVal, CTXH, CTXR, FetchCTXR, FetchMDR, FetchSER, FieldDesc, GetCtxForCTXH, GetMobForCTXH, IncludedCTXR, MakeCTXH, MDR, MobCookie, SEH, SER, TypeDesc, TypeInfoConsSE], MobObjectFiles USING[GetLocalFrameExtensionVar, GetVarLoc, JointMobParsedInfo, VarLoc, VarLocBody], MorePfsNames, NewRMTW USING[], RMTWPrivate, PBasics USING[LowHalf], PFS USING [PathFromRope], PFSNames USING [PATH, Component, ShortName], Records USING[CreateIndirectRecordNode, CreateFieldListType, CreateRecordType, FieldCase, IndirectRecordNodeProcs, RecordTypeProcs], Rope, RopeSequence USING [RopePart, RopeSeq, ParsePartToSeq, Fetch], Sequences USING[CreateIndirectSequenceNode, CreateSequenceRecordType, IndirectSRProcs, SequenceTypeProcs], Symbols USING[CTXNull], TypeStrings, VariantRecords USING [CreateIndirectVariantRecordNode, CreateVariantRecordType, GetVRVariant, IndirectVRNodeProcs, VariantRecordTypeDetails, VariantRecordTypeDetailsRec]; <<>> RMTWCompounds: CEDAR PROGRAM IMPORTS Arrays, CCTypes, CedarCode, CedarOtherPureTypes, CirioMemory, CirioTypes, IO, MobAccess, MobObjectFiles, MorePfsNames, RMTWPrivate, PFS, PFSNames, PBasics, Records, Rope, RopeSequence, Sequences, VariantRecords EXPORTS RMTWPrivate SHARES Rope = BEGIN OPEN MA:MobAccess, MOF:MobObjectFiles, MPN:MorePfsNames, RS:RopeSequence, RMTWPrivate, TS:TypeStrings; Operator: TYPE = CedarCode.Operator; CNTD: TYPE = CedarNumericTypes.NumericDescriptor; CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE _ NIL] _ CCTypes.CCError; <<>> <<>> <> <SymbolOpsImpl and [PCedar2.0]SparcParms.mesa.>> <<(the later from [PCedar2.0]MachineParms-Source.df)>> TargetBitsPerWord: CARD = 32; TargetUnitFill: CARD = bitsPerAu-1; TargetBitsPerLongWord: CARD = 32; TargetPackedBitCount: TYPE = [1..TargetBitsPerLongWord]; TargetPackedFieldSize: ARRAY TargetPackedBitCount OF NAT = [ 01, 02, 04, 04, 08, 08, 08, 08, 16, 16, 16, 16, 16, 16, 16, 16, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32, 32]; <<>> <<>> <> <<>> <<(to be used both by array types and sequence types)>> <<>> BasicArrayInfo: TYPE = REF BasicArrayInfoBody; BasicArrayInfoBody: TYPE = RECORD[ nElements: CARD, -- LAST[CARD] for sequences entryType: Type, packed: BOOLEAN, bitSizeValid: BOOLEAN, -- and pitch bitSize: CARD, elementSize: CARD, pitch: CARD]; GetBasicArrayBitSize: PROC[basicInfo: BasicArrayInfo, rmtw: RemoteMimosaTargetWorld] RETURNS[CARD] = { IF NOT basicInfo.bitSizeValid THEN { <> <> <SymbolOpsImpl.BitsPerElement and [PCedar2.0]SymbolOpsImpl.BitsForType.>> <> indirectEntryType: Type _ CCTypes.GetIndirectType[basicInfo.entryType]; bitsPerItem: CARD _ CCTypes.GetBitSize[indirectEntryType, rmtw.cc]; mod: NAT _ PBasics.LowHalf[bitsPerItem] MOD TargetBitsPerWord; pitch: CARD _ IF basicInfo.packed AND bitsPerItem # 0 AND bitsPerItem <= TargetPackedBitCount.LAST THEN TargetPackedFieldSize[bitsPerItem] ELSE IF mod # 0 THEN (bitsPerItem+(TargetBitsPerWord-mod)) ELSE bitsPerItem; tentativeBodySize: CARD _ pitch*basicInfo.nElements; bodySize: CARD _ IF basicInfo.nElements = LAST[CARD] THEN LAST[CARD] ELSE IF tentativeBodySize > bitsPerAu THEN ((tentativeBodySize+TargetUnitFill)/bitsPerAu)*bitsPerAu ELSE tentativeBodySize; basicInfo.bitSize _ bodySize; basicInfo.elementSize _ bitsPerItem; basicInfo.pitch _ pitch; basicInfo.bitSizeValid _ TRUE; }; RETURN[basicInfo.bitSize]}; GetBasicArrayElementPitch: PROC[basicInfo: BasicArrayInfo, rmtw: RemoteMimosaTargetWorld] RETURNS[CARD] = { IF NOT basicInfo.bitSizeValid THEN [] _ GetBasicArrayBitSize[basicInfo, rmtw]; RETURN[basicInfo.pitch]}; SelectBasicArrayEntry: PROC[index, arrayBitOffset: INT, basicInfo: BasicArrayInfo, arrayMem: Mem, rmtw: RemoteMimosaTargetWorld] RETURNS[Node] = { pitch: INT _ GetBasicArrayElementPitch[basicInfo, rmtw]; nominalBitOffset: INT _ arrayBitOffset + pitch*index; elementSize: INT _ basicInfo.elementSize; --legal because previous call to GetArrayElementPitch forced this value to be valid also. eltBS: BitStretch _ [ start: CirioTypes.BitsToBa[nominalBitOffset + (pitch-elementSize)], size: CirioTypes.BitsToBa[elementSize] ]; subMem: Mem _ arrayMem.MemSubfield[eltBS]; indirectEltType: Type _ CCTypes.GetIndirectType[basicInfo.entryType]; RETURN CCTypes.CreateIndirectNode[indirectEltType, subMem, rmtw.cc]}; <<>> <<>> <> <<>> AnalyzedArraySEH: TYPE = REF AnalyzedArraySEHBody; AnalyzedArraySEHBody: TYPE = RECORD[ rmtw: RemoteMimosaTargetWorld, indexType: Type, basicInfo: BasicArrayInfo, type: Type]; <> AnalyzeArraySEH: PUBLIC PROC[seh: SEH, ser: SER, cons: REF cons MA.BodySE, ti: REF array MA.TypeInfoConsSE, rmtw: RemoteMimosaTargetWorld] RETURNS[Type] = { indexType: Type _ AnalyzeSEH[ti.indexType, rmtw, none]; nElements: CARD; {nElements _ CCTypes.GetNElements[indexType, rmtw.cc !CCE => GOTO Blowit]; {basicInfo: BasicArrayInfo _ NEW[BasicArrayInfoBody_[ nElements: nElements, entryType: AnalyzeSEH[ti.componentType, rmtw, none], packed: ti.packed, bitSizeValid: FALSE, bitSize: 0, elementSize: 0, pitch: 0]]; private: AnalyzedArraySEH _ NEW[AnalyzedArraySEHBody_[ rmtw: rmtw, indexType: indexType, basicInfo: basicInfo, type: NIL]]; private.type _ Arrays.CreateArrayType[private.indexType, RMTWArrayTypeProcs, rmtw.cc, private]; RETURN[private.type]}; EXITS Blowit => RETURN AnalyzedUnknownSEH[seh, rmtw, "an array whose index Type can't GetNElements", -1]; }}; AnalArrayTs: PUBLIC PROC [rmtw: RemoteMimosaTargetWorld, tsd: TsDict, i: INT, opts: TsOptions] RETURNS [Type, INT] ~ { i2, i3: INT; idxType, eltType: Type; nElements: CARD; [idxType, i2] _ AnalyzeTs[rmtw, tsd, i]; [eltType, i3] _ AnalyzeTs[rmtw, tsd, i2]; {nElements _ CCTypes.GetNElements[idxType, rmtw.cc !CCE => GOTO Blowit]; {basicInfo: BasicArrayInfo _ NEW[BasicArrayInfoBody_[ nElements: nElements, entryType: eltType, packed: opts[packed], bitSizeValid: FALSE, bitSize: 0, elementSize: 0, pitch: 0]]; private: AnalyzedArraySEH _ NEW[AnalyzedArraySEHBody_[ rmtw: rmtw, indexType: idxType, basicInfo: basicInfo, type: NIL]]; private.type _ Arrays.CreateArrayType[private.indexType, RMTWArrayTypeProcs, rmtw.cc, private]; RETURN[private.type, i3]}; EXITS Blowit => RETURN [MakeBrokenType[rmtw, "an array whose index Type can't GetNElements", -1], i3]; }}; RMTWArrayTypeProcs: REF Arrays.ArrayTypeProcs _ NEW[Arrays.ArrayTypeProcs_[ createIndirectNode: ArrayCreateIndirect, getBitSize: ArrayBitSize, getEntryType: RMTWArrayGetEntryType]]; ArrayBitSize: PROC[indirectType: Type, cc: CC, data: REF ANY] RETURNS[CARD] = { aa: AnalyzedArraySEH _ NARROW[data]; IF aa.basicInfo.bitSizeValid THEN RETURN[aa.basicInfo.bitSize] ELSE { RETURN[GetBasicArrayBitSize[aa.basicInfo, aa.rmtw]]}; }; RMTWArrayGetEntryType: PROC[cc: CC, data: REF ANY] RETURNS[Type] = { aa: AnalyzedArraySEH _ NARROW[data]; rmtw: RemoteMimosaTargetWorld _ aa.rmtw; RETURN[aa.basicInfo.entryType]}; ArrayNodeData: TYPE = RECORD[ aa: AnalyzedArraySEH, mem: Mem, indirectToArray: Node]; ArrayCreateIndirect: PROC[cc: CC, data: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] = { aa: AnalyzedArraySEH _ NARROW[data]; nodeData: REF ArrayNodeData _ NEW[ArrayNodeData _ [aa, mem, NIL]]; info: Arrays.ArrayIndirectNodeInfo _ NEW[Arrays.ArrayIndirectNodeInfoBody _ [ selectEntry: SelectArrayEntry, getPointer: GetArrayPointer, data: nodeData]]; nodeData.indirectToArray _ Arrays.CreateArrayIndirectNode[indirectType, info]; RETURN[nodeData.indirectToArray]}; SelectArrayEntry: PROC[index: CARD, cc: CC, data: REF ANY] RETURNS[Node] = { nodeData: REF ArrayNodeData _ NARROW[data]; rmtw: RemoteMimosaTargetWorld _ nodeData.aa.rmtw; <> [] _ RMTWArrayGetEntryType[cc, nodeData.aa]; RETURN[SelectBasicArrayEntry[index, 0, nodeData.aa.basicInfo, nodeData.mem, rmtw]]}; GetArrayPointer: PROC[data: REF ANY, cc: CC] RETURNS[Node] = { nodeData: REF ArrayNodeData _ NARROW[data]; RETURN ConvertFromIndirectToPointer[nodeData.indirectToArray, nodeData.mem, nodeData.aa.rmtw]}; <> <<>> <> <<[preamble: FieldList, tag: Type, tail: Array].>> <> <<>> <> <<>> AnalyzedSequenceSEHPrivate: TYPE = REF AnalyzedSequenceSEHPrivateBody; AnalyzedSequenceSEHPrivateBody: TYPE = RECORD[ rmtw: RemoteMimosaTargetWorld, type: Type, preambleType: Type, tagIdSeh: REF id MA.BodySE, tagFD: REF MA.FieldDesc, arrayOffset: INT, tailTi: REF sequence MA.TypeInfoConsSE, packed: BOOLEAN, valid: BOOLEAN, -- following entries valid only when valid = TRUE tagType: Type, componentType: Type, basicInfo: BasicArrayInfo]; <> <<>> <> AnalyzeSequenceSEH: PROC[preambleType: Type, tailName: Rope.ROPE, tailOffset: INT, tailSeh: SEH, tailSer: SER, tailCons: REF cons MA.BodySE, tailTi: REF sequence MA.TypeInfoConsSE, rmtw: RemoteMimosaTargetWorld] RETURNS[Type] = { basicInfo: BasicArrayInfo _ NEW[BasicArrayInfoBody_[ nElements: LAST[CARD], entryType: NIL, -- will be filled in by first call in RMTWGetEntryType packed: tailTi.packed, bitSizeValid: FALSE, bitSize: 0, elementSize: 0, pitch: 0]]; private: AnalyzedSequenceSEHPrivate _ NEW[AnalyzedSequenceSEHPrivateBody_[ rmtw: rmtw, type: NIL, preambleType: preambleType, tagIdSeh: NIL, tagFD: NIL, arrayOffset: 0, tailTi: tailTi, packed: tailTi.packed, valid: FALSE, <> tagType: NIL, componentType: NIL, -- will be filled in by first call in RMTWGetEntryType basicInfo: basicInfo]]; tagSer: SER _ MA.FetchSER[tailTi.tagSei]; WITH tagSer.body SELECT FROM idTag: REF id MA.BodySE => -- we are expecting the tag to be an id sei BEGIN private.tagIdSeh _ idTag; WITH idTag.idInfoAndValue SELECT FROM fd: REF MA.FieldDesc => {private.tagFD _ fd}; ENDCASE => CCE[cirioError]; END; ENDCASE => CCE[cirioError]; private.tagType _ AnalyzeSEH[private.tagIdSeh.idType, rmtw, none]; private.arrayOffset _ tailOffset+private.tagFD.bitSize; <> private.type _ Sequences.CreateSequenceRecordType[preambleType, tailName, private.tagIdSeh.hash, private.tagType, RMTWSequenceTypeProcs, rmtw.cc, private]; RETURN[private.type]}; RMTWSequenceTypeProcs: REF Sequences.SequenceTypeProcs _ NEW[Sequences.SequenceTypeProcs _ [ createIndirectNode: SequenceCreateIndirect, getBitSize: SequenceBitSize, getEntryType: RMTWGetEntryType, getNominalArrayType: RMTWGetNominalArrayType]]; SequenceCreateIndirect: PROC [cc: CC, data: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ { private: AnalyzedSequenceSEHPrivate _ NARROW[data]; rmtw: RemoteMimosaTargetWorld _ private.rmtw; tagMem: Mem _ mem.MemSubfield[[CirioTypes.BitsToBa[private.tagFD.bitOffset], CirioTypes.BitsToBa[private.tagFD.bitSize]]]; entryType: Type _ RMTWGetEntryType[rmtw.cc, private]; <> tailBitSize: CARD _ GetBasicArrayBitSize[private.basicInfo, rmtw]; <> nodeData: REF SequenceNodeData _ NEW[SequenceNodeData_[private, mem, tagMem, NIL]]; nodeData.indirectToSequence _ Sequences.CreateIndirectSequenceNode[targetType, IndirectSRProcs, nodeData, cc]; RETURN[nodeData.indirectToSequence]}; <> RMTWGetEntryType: PROC[cc: CC, data: REF ANY] RETURNS[Type] = { private: AnalyzedSequenceSEHPrivate _ NARROW[data]; rmtw: RemoteMimosaTargetWorld _ private.rmtw; IF private.componentType = NIL THEN { private.componentType _ AnalyzeSEH[private.tailTi.componentType, rmtw, none]; [] _ CCTypes.GetIndirectType[private.componentType]; --check private.basicInfo.entryType _ private.componentType}; RETURN[private.basicInfo.entryType]}; << Remark: the following code would best be done "on the left side of the line". Before the entry type became "lazy", this was done at SequencesImpl.CreateUnionTailType, with the following construction>> <> <> <> RMTWGetNominalArrayType: PROC[cc: CC, data: REF ANY] RETURNS[Type] = { private: AnalyzedSequenceSEHPrivate _ NARROW[data]; RETURN[Arrays.CreateArrayType[private.tagType, NominalArrayTypeProcs, cc, private]]}; NominalArrayTypeProcs: REF Arrays.ArrayTypeProcs _ NEW[Arrays.ArrayTypeProcs_[ getEntryType: RMTWGetEntryType]]; <> <> SequenceBitSize: PROC[indirectType: Type, cc: CC, data: REF ANY] RETURNS[CARD] = {CCE[cirioError, "asking for size of a sequence TYPE"]}; IndirectSRProcs: REF Sequences.IndirectSRProcs _ NEW[Sequences.IndirectSRProcs_[ selectPreamble: SequenceSelectPreamble, selectTag: SequenceSelectTag, selectTailEntry: SequenceSelectTailEntry, getPointer: SequenceGetPointer]]; SequenceNodeData: TYPE = RECORD[ private: AnalyzedSequenceSEHPrivate, mem, tagMem: Mem, indirectToSequence: Node]; SequenceSelectPreamble: PROC[procsData: REF ANY, cc: CC] RETURNS[Node] = { nodeData: REF SequenceNodeData _ NARROW[procsData]; RETURN CCTypes.GetIndirectCreateNode[nodeData.private.preambleType, nodeData.mem, cc]}; SequenceSelectTag: PROC[procsData: REF ANY, cc: CC] RETURNS[Node] = { nodeData: REF SequenceNodeData _ NARROW[procsData]; RETURN CCTypes.GetIndirectCreateNode[nodeData.private.tagType, nodeData.tagMem, cc]}; SequenceSelectTailEntry: PROC[index: CARD, procsData: REF ANY, cc: CC] RETURNS[Node] = { nodeData: REF SequenceNodeData _ NARROW[procsData]; rmtw: RemoteMimosaTargetWorld _ nodeData.private.rmtw; <<>> [] _ RMTWGetEntryType[cc, nodeData.private]; <> RETURN[SelectBasicArrayEntry[index, nodeData.private.arrayOffset, nodeData.private.basicInfo, nodeData.mem, rmtw]]}; SequenceGetPointer: PROC[data: REF ANY, cc: CC] RETURNS[Node] = { nodeData: REF SequenceNodeData _ NARROW[data]; RETURN ConvertFromIndirectToPointer[nodeData.indirectToSequence, nodeData.mem, nodeData.private.rmtw]}; <> <<>> <> <<[preamble: FieldList, tag: Type, tail: Union Type].>> <> <<>> <> <<>> AnalyzedVariantRecordSEHPrivate: TYPE = REF AnalyzedVariantRecordSEHPrivateBody; AnalyzedVariantRecordSEHPrivateBody: TYPE = RECORD[ rmtw: RemoteMimosaTargetWorld, type: Type, preambleType: Type, tagIdSeh: REF id MA.BodySE, tagFD: REF MA.FieldDesc, startOffset: INT, tailOffset: INT, tailLength: INT, tailTi: REF union MA.TypeInfoConsSE, tagType: Type, nTailTypes: INT, tailTypes: AnalyzedCTX]; <<>> <> AnalyzeVariantRecordSEH: PROC[preambleType: Type, tailName: Rope.ROPE, startOffset: INT, tailSeh: SEH, tailSer: SER, tailCons: REF cons MA.BodySE, tailTi: REF union MA.TypeInfoConsSE, vrLength: INT, rmtw: RemoteMimosaTargetWorld] RETURNS[Type] = { private: AnalyzedVariantRecordSEHPrivate _ NEW[AnalyzedVariantRecordSEHPrivateBody_[ rmtw: rmtw, type: NIL, preambleType: preambleType, tagIdSeh: NIL, tagFD: NIL, startOffset: 0, tailOffset: 0, tailLength: 0, tailTi: tailTi, tagType: NIL, nTailTypes: 0, tailTypes: AnalyzeCTX[tailTi.caseCtx, NIL, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, TRUE, rmtw, unspecdBA, NIL].ctxInfo --we can give an incorrect bitSize because we're not going to use it later. ]]; tagSer: SER _ MA.FetchSER[tailTi.tagSei]; WITH tagSer.body SELECT FROM idTag: REF id MA.BodySE => -- we are expecting the tag to be an id sei BEGIN private.tagIdSeh _ idTag; WITH idTag.idInfoAndValue SELECT FROM fd: REF MA.FieldDesc => {private.tagFD _ fd}; ENDCASE => CCE[cirioError]; END; ENDCASE => CCE[cirioError]; private.tagType _ AnalyzeSEH[private.tagIdSeh.idType, rmtw, none]; private.startOffset _ startOffset; private.tailOffset _ private.tagFD.bitOffset + private.tagFD.bitSize - startOffset; private.tailLength _ vrLength - (private.tagFD.bitOffset + private.tagFD.bitSize); private.nTailTypes _ CCTypes.GetNElements[private.tagType, rmtw.cc]; private.type _ VariantRecords.CreateVariantRecordType[preambleType, tailName, private.tagIdSeh.hash, private.tagType, private.nTailTypes, tailTi.controlled, vrTypeDetails, rmtw.cc, private]; RETURN[private.type]}; vrTypeDetails: VariantRecords.VariantRecordTypeDetails _ NEW [VariantRecords.VariantRecordTypeDetailsRec _ [VariantRecordCreateIndirect, VariantRecordBitSize, GetVariantRecordTailInfo]]; GetVariantRecordTailInfo: PROC [index: INT, procData: REF ANY] RETURNS [Type] = { private: AnalyzedVariantRecordSEHPrivate _ NARROW[procData]; rmtw: RemoteMimosaTargetWorld _ private.rmtw; enumType: Type _ private.tagType; variantName: Rope.ROPE _ EnumeratedTypeIndexToName[enumType, index, rmtw.cc]; FOR variants: LIST OF FieldInfo _ private.tailTypes.typeFields, variants.rest WHILE variants # NIL DO IF Rope.Equal[variantName, variants.first.name] THEN RETURN[variants.first.unionAnalysis]; ENDLOOP; RETURN [NIL]}; <> VariantRecordBitSize: PROC[indirectType: Type, cc: CC, procData: REF ANY] RETURNS[CARD] = { private: AnalyzedVariantRecordSEHPrivate _ NARROW[procData]; RETURN[private.tailOffset+private.tailLength]}; <> VariantRecordCreateIndirect: PROC[cc: CC, procData: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS[Node] = { private: AnalyzedVariantRecordSEHPrivate _ NARROW[procData]; tagMem: Mem _ IF private.tailTi.controlled THEN mem.MemSubfield[[CirioTypes.BitsToBa[private.tagFD.bitOffset], CirioTypes.BitsToBa[private.tagFD.bitSize]]] ELSE noMem; nodeData: REF VariantRecordNodeData _ NEW[VariantRecordNodeData_[ private, mem, tagMem, NIL]]; nodeData.indirectToVariantRecord _ VariantRecords.CreateIndirectVariantRecordNode[private.type, IndirectVRProcs, nodeData, cc]; RETURN[nodeData.indirectToVariantRecord]}; IndirectVRProcs: REF VariantRecords.IndirectVRNodeProcs _ NEW[VariantRecords.IndirectVRNodeProcs_[ selectPreamble: VariantRecordSelectPreamble, readVariantIndex: VariantRecordReadVariantIndex, selectTag: VariantRecordSelectTag, selectTailBody: VariantRecordSelectTailBody, getPointer: VariantRecordGetPointer]]; VariantRecordNodeData: TYPE = RECORD[ private: AnalyzedVariantRecordSEHPrivate, mem, tagMem: Mem, indirectToVariantRecord: Node]; VariantRecordSelectPreamble: PROC[procsData: REF ANY, cc: CC] RETURNS[Node] = { nodeData: REF VariantRecordNodeData _ NARROW[procsData]; RETURN CCTypes.GetIndirectCreateNode[nodeData.private.preambleType, nodeData.mem, cc]}; VariantRecordReadVariantIndex: PROC[procsData: REF ANY, cc: CC] RETURNS[INT] = { tagIndirectNode: Node _ VariantRecordSelectTag[procsData, cc]; tagEnumNode: Node _ CedarCode.LoadThroughIndirectNode[CedarCode.GetTypeOfNode[tagIndirectNode], tagIndirectNode, cc]; tagIndex: CARD _ CedarCode.NodeAsIndex[CedarCode.GetTypeOfNode[tagEnumNode], tagEnumNode, cc]; RETURN [tagIndex]}; VariantRecordSelectTag: PROC[procsData: REF ANY, cc: CC] RETURNS[Node] = { nodeData: REF VariantRecordNodeData _ NARROW[procsData]; RETURN CCTypes.GetIndirectCreateNode[nodeData.private.tagType, nodeData.tagMem, cc]}; VariantRecordSelectTailBody: PROC[procsData: REF ANY, cc: CC] RETURNS[Node] = { nodeData: REF VariantRecordNodeData _ NARROW[procsData]; index: INT _ VariantRecordReadVariantIndex[procsData, cc]; tail: Type _ GetVariantRecordTailInfo[index, nodeData.private]; RETURN CCTypes.GetIndirectCreateNode[tail, nodeData.mem, cc]}; VariantRecordGetPointer: PROC[procsData: REF ANY, cc: CC] RETURNS[Node] = { nodeData: REF VariantRecordNodeData _ NARROW[procsData]; RETURN ConvertFromIndirectToPointer[nodeData.indirectToVariantRecord, nodeData.mem, nodeData.private.rmtw]}; <> AnalyzeUnionRecordSEH: PROC [seh: SEH, rmtw: RemoteMimosaTargetWorld] RETURNS [Type] = { ser: MA.SER _ MA.FetchSER[seh]; WITH ser.body SELECT FROM id: REF id MA.BodySE => WITH id.idInfoAndValue SELECT FROM idInfo: REF MobAccess.TypeDesc => { ser: MA.SER _ MA.FetchSER[idInfo.seh]; WITH ser.body SELECT FROM cons: REF cons MA.BodySE => WITH cons.typeInfo SELECT FROM ti: REF record MA.TypeInfoConsSE => RETURN [AnalyzeCTX[ti.fieldCtx, NIL, ti.painted, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, rmtw, CirioTypes.BitsToBa[ti.length], NIL].recType]; ENDCASE => CCE[cirioError, "AnalyzeUnionRecordSEH 4"]; ENDCASE => CCE[cirioError, "AnalyzeUnionRecordSEH 3"]; }; ENDCASE => CCE[cirioError, "AnalyzeUnionRecordSEH 2"]; ENDCASE => CCE[cirioError, "AnalyzeUnionRecordSEH 1"]; }; <<>> AnalyzeRecordSEH: PUBLIC PROC[seh: SEH, ser: SER, cons: REF cons MA.BodySE, ti: REF record MA.TypeInfoConsSE, rmtw: RemoteMimosaTargetWorld, isRopeRep: BOOL] RETURNS[Type] = { ctxInfo: AnalyzedCTX; IF ti#NIL THEN { <> <> vrSeh: SEH _ FollowLinksToTopVariantRecord[ti.linkPart, rmtw]; RETURN AnalyzeSEH[vrSeh, rmtw, IF isRopeRep THEN RopeRep ELSE none]};>> RETURN [AnalyzeCTX[ti.fieldCtx, IF ti.linkPart#NIL THEN seh ELSE NIL, ti.painted, (NOT ti.packed) AND ti.argument, FALSE--this is only reached when analyzing types for procedures-as-data - frames analyze their args and results in RMTWFrames by calling AnalyzeCTX directly--, TRUE, FALSE, FALSE, TRUE, rmtw, CirioTypes.BitsToBa[ti.length], NIL].recType]; } ELSE RETURN [AnalyzeCTX[NIL, NIL, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE, rmtw, zeroBA, NIL].recType]}; FollowLinksToTopVariantRecord: PROC [seh: SEH, rmtw: RemoteMimosaTargetWorld] RETURNS [SEH] = { ser: MA.SER _ MA.FetchSER[seh]; WITH ser.body SELECT FROM id: REF id MA.BodySE => WITH id.idInfoAndValue SELECT FROM idInfo: REF MobAccess.TypeDesc => BEGIN ser: MA.SER _ MA.FetchSER[idInfo.seh]; WITH ser.body SELECT FROM cons: REF cons MA.BodySE => WITH cons.typeInfo SELECT FROM ti: REF record MA.TypeInfoConsSE => BEGIN IF ti.linkPart # NIL THEN RETURN FollowLinksToTopVariantRecord[ti.linkPart, rmtw] ELSE RETURN [idInfo.seh]; END; ENDCASE => CCE[cirioError, "FollowLinksToTopVariantRecord 4"]; ENDCASE => CCE[cirioError, "FollowLinksToTopVariantRecord 3"]; END; ENDCASE => CCE[cirioError, "FollowLinksToTopVariantRecord 2"]; ENDCASE => CCE[cirioError, "FollowLinksToTopVariantRecord 1"]; }; RecordNode: TYPE ~ REF RecordNodeData; RecordNodeData: TYPE = RECORD[ ac: AnalyzedCTX, targetType: Type, mem: Mem, indirectToRecord: Node]; <> RecordFetchFieldLoc: PROC[ctxInfo: AnalyzedCTX, index: CARD] RETURNS[REF BitStretch] = { fieldLoc: REF BitStretch _ ctxInfo.fields[index].fieldLoc; RETURN[fieldLoc]}; <> PrefillAndCorrectFieldLocs: PROC[ctxInfo: AnalyzedCTX] = BEGIN runningBitOffset: INT _ 0; FOR index: CARD IN [0..ctxInfo.nFields) DO fieldLoc: REF BitStretch _ RecordFetchFieldLoc[ctxInfo, index]; <> IF fieldLoc # NIL THEN BEGIN -- here is where we check, then fix if necessary <> bitSize: INT ~ fieldLoc.size.BaToBits[]; BitsPerWord: INT = 32; BitsPerByte: INT = 8; BytesPerWord: INT = 4; neededFillBits: INT _ BitsPerWord.PRED - ((bitSize+BitsPerWord.PRED) MOD BitsPerWord); expectedTotalBitOffset: INT _ runningBitOffset + (IF bitSize> runningBitOffset _ runningBitOffset + neededFillBits + bitSize; IF runningBitOffset MOD BitsPerWord # 0 THEN ERROR; END; ENDLOOP; END; RecordProcs: REF Records.IndirectRecordNodeProcs _ NEW[Records.IndirectRecordNodeProcs_[ selectField: RecordSelectField, fieldIndexToNodeTimeConstantValue: RecordIndexToNTConstant, getPointer: RecordGetPointer]]; <> <> <> <> <<>> <> <<>> <> <> <<(This is a preliminary description.) We have two jobs here. The first is to find (or build and record) a NodeSchema for the named field. The second is to call the createIndirectNode routine in the schema with an appropriate Mem. The NodeSchema should be recorded in the AnalyzedBTH.>> <<>> <> << The Mem should be supplied from the frameData. However, there may be assorted Mems for the different parts of the frame? Also, the NodeSchema should also be dependent on where the field is sitting. The construction of the NodeSchema reflects the various issues about where the field sits within the frame.]]>> <> <> RecordSelectField: PROC[index: INT, indirectFieldType: Type, data: REF ANY, cc: CC] RETURNS[Node] = { nodeData: RecordNode _ NARROW[data]; ctxInfo: AnalyzedCTX _ nodeData.ac; rmtw: RemoteMimosaTargetWorld _ ctxInfo.rmtw; mem: Mem _ nodeData.mem; fieldDirectType: Type _ ctxInfo.fields[index].fieldDirectType; subMem: Mem _ noMem; IF NOT ctxInfo.fields[index].analysisValid THEN CCE[cirioError]; <> IF ctxInfo.blockRecord THEN { whyNot: ROPE _ NIL; fieldSize: CARD _ 32; fieldSize _ CCTypes.GetBitSize[indirectFieldType, cc !CCE => CONTINUE]; IF ctxInfo.fields[index].varLoc=NIL THEN RETURN UnimplementedTypeNode[fieldDirectType, rmtw, IO.PutFR["block record field (index %g) with NIL location", [integer[index]] ]]; WITH ctxInfo.fields[index].varLoc SELECT FROM u: REF unknown MOF.VarLocBody => RETURN UnimplementedTypeNode[fieldDirectType, rmtw, IO.PutFR["block record field (index %g) with unknown location (because %g)", [integer[index]], [rope[u.why]] ]]; ENDCASE => NULL; subMem _ SelectVarLoc[rmtw.nub, mem, ctxInfo.fields[index].varLoc !CCE => {whyNot _ msg; CONTINUE}]; IF subMem=noMem THEN RETURN UnimplementedTypeNode[fieldDirectType, rmtw, IO.PutFR["block record field (index %g) at broken location (because %g)", [integer[index]], [rope[whyNot]] ]]; IF fieldSize=32 OR NOT richtigSelect THEN NULL ELSE IF fieldSize<32 THEN subMem _ subMem.MemSubfield[[start: CirioTypes.BitsToBa[32-fieldSize], size: CirioTypes.BitsToBa[fieldSize]]] ELSE NULL--padded on right, indirect taken care of--; RETURN CCTypes.CreateIndirectNode[indirectFieldType, subMem, rmtw.cc]} ELSE { fieldLoc: REF BitStretch _ RecordFetchFieldLoc[ctxInfo, index]; IF fieldLoc = NIL THEN -- unknownOrUnimplementedField RETURN UnimplementedTypeNode[fieldDirectType, rmtw, IO.PutFR["ordinary record field (index %g) with unknown location", [integer[index]] ]]; subMem _ mem.MemSubfield[fieldLoc^]; RETURN CCTypes.CreateIndirectNode[indirectFieldType, subMem, rmtw.cc]}; }; richtigSelect: BOOL _ TRUE; RecordIndexToNTConstant: PROC[index: INT, fieldType: Type, data: REF ANY, cc: CC] RETURNS[Node] ~ { nodeData: RecordNode ~ NARROW[data]; ctxInfo: AnalyzedCTX ~ nodeData.ac; rmtw: RemoteMimosaTargetWorld ~ ctxInfo.rmtw; mem: Mem ~ nodeData.mem; mcr: MobCtxRep ~ WITH ctxInfo.repData SELECT FROM x: MobCtxRep => x, ENDCASE => CCE[cirioError, "RecordIndexToNTConstant applied to non-mob context"]; mfr: MobFieldRep ~ WITH ctxInfo[index].repData SELECT FROM x: MobFieldRep => x, ENDCASE => CCE[cirioError, "RecordIndexToNTConstant applied to non-mob context field"]; procId: REF id MA.BodySE ~ mfr.serBody; procBd: REF MA.BlockDesc ~ WITH procId.idInfoAndValue SELECT FROM x: REF MA.BlockDesc => x, ENDCASE => CCE[cirioError, "encountered node-time constant whose idInfoAndValue isn't a MA.BlockDesc"]; textBS: BitStretch ~ mem.MemReadSegReg["text", 0]; IF textBS.start.bits#0 THEN CCE[cirioError, "non-AU-aligned text segment found"]; IF NOT ctxInfo.fields[index].analysisValid THEN CCE[cirioError, "accessing non-valid ctxInfo field"]; <> IF ctxInfo.blockRecord AND procBd.bth # NIL THEN { feSEH: SEH ~ MOF.GetLocalFrameExtensionVar[mcr.bth, mcr.jmpi]; feSER: REF id MA.BodySE ~ NARROW[MA.FetchSER[feSEH].body]; feFD: REF MA.FieldDesc ~ NARROW[feSER.idInfoAndValue]; feVL: MOF.VarLoc ~ NEW [MOF.VarLocBody _ [ bitSize: feFD.bitSize, where: frameExtension[0] ]]; feMem: Mem _ noMem; whyNot: ROPE _ NIL; feMem _ SelectVarLoc[rmtw.nub, mem, feVL !CCE => {whyNot _ msg; CONTINUE}]; IF feMem=noMem THEN RETURN UnimplementedTypeNode[fieldType, rmtw, IO.PutFR["a block record's node-time constant field (index %g) at broken location (because %g)", [integer[index]], [rope[whyNot]] ]]; RETURN CreateProcConstant[rmtw, mcr.jmpi, feMem, textBS.start.BaToPtr, procBd.bth]} ELSE { RETURN CreateProcConstant[rmtw, mcr.jmpi, mem, textBS.start.BaToPtr, procBd.bth]}}; RecordGetPointer: PROC[data: REF ANY, cc: CC] RETURNS[Node] = { nodeData: RecordNode _ NARROW[data]; IF nodeData.ac.blockRecord THEN CCE[cirioError, "trying to extract pointer to a block record"]; RETURN ConvertFromIndirectToPointer[nodeData.indirectToRecord, nodeData.mem, nodeData.ac.rmtw]}; <> GenRecordFields: PUBLIC PROC[type: Type, cc: CC, nFields: PROC[CARD], eachField: PROC[index: CARD, byteOffset: INT, bitOffset: INT, bitSize: CARD] ] = BEGIN typeRep: REF ANY _ CCTypes.GetTypeRepresentation[type, cc]; ctxInfo: AnalyzedCTX _ NARROW[typeRep]; nFields[ctxInfo.nFields]; FOR I: CARD IN [0..ctxInfo.nFields) DO fieldLoc: REF BitStretch _ RecordFetchFieldLoc[ctxInfo, I]; <> <> <> IF fieldLoc = NIL THEN CCE[cirioError, "formal procedure parameter is of an unknown type"]; eachField[I, fieldLoc.start.aus, fieldLoc.start.bits, fieldLoc.size.BaToBits[] ]; ENDLOOP; END; <> GetChar: PROC [ts: ROPE, i: INT] RETURNS [c: CHAR] ~ { WITH ts SELECT FROM text: Rope.Text => IF i IN [0..text.length) THEN RETURN [text[i]]; ENDCASE => IF i IN [0..Rope.Length[ts]) THEN RETURN [Rope.Fetch[ts, i]]; ERROR CCE[cirioError, "ran off end of typestring"]; }; GetName: PROC [ts: ROPE, i: INT] RETURNS [name: ROPE, j: INT] ~ { len: INT ~ GetChar[ts, i].ORD; GenChar: PROC RETURNS [CHAR] ~ {j _ j.SUCC; RETURN [GetChar[ts, j]]}; IF len=0 THEN RETURN ["null name", i.SUCC]; IF len >= 200B THEN CCE[cirioError, "implausible name in typestring"]; j _ i; name _ Rope.FromProc[len, GenChar]; j _ j.SUCC; IF name.Fetch[0].ORD = len-1 THEN name _ name.Substr[start: 1]; }; AnalyzeTsRecord: PUBLIC PROC [rmtw: RemoteMimosaTargetWorld, tsd: TsDict, i: INT] RETURNS [Type, INT] ~ { fieldFis: FiHt _ []; fieldStart, fieldSize: BitAddr _ zeroBA; ctxInfo: AnalyzedCTX; WHILE GetChar[tsd.ts, i].ORD # TS.Code.rightParen.ORD DO name: ROPE; type, indType: Type; i2, i3: INT; bits: CARD _ 32; [name, i2] _ GetName[tsd.ts, i]; [type, i3] _ AnalyzeTs[rmtw, tsd, i2]; indType _ CCTypes.GetIndirectType[type]; bits _ CCTypes.GetBitSize[indType, rmtw.cc]; bits _ ((bits+31)/32)*32; fieldSize _ CirioMemory.BitsToBa[bits]; fieldFis _ FilAppend[fieldFis, LIST[[ name: name, rmtw: rmtw, fieldCase: nodeTimeReadWrite, analysisValid: TRUE, fieldDirectType: type, fieldLoc: NEW [BitStretch _ [fieldStart, fieldSize]] ]]]; i _ i3; fieldStart _ fieldStart.BaAdd[fieldSize]; ENDLOOP; ctxInfo _ NEW[AnalyzedCTXBody[fieldFis.n]]; FOR cell: RECORD[I: CARDINAL, fields: LIST OF FieldInfo] _ [0, fieldFis.head], [cell.I+1, cell.fields.rest] WHILE cell.fields # NIL DO ctxInfo.fields[cell.I] _ cell.fields.first; ENDLOOP; ctxInfo.painted _ FALSE; ctxInfo.blockRecord _ FALSE; ctxInfo.hasNtConst _ FALSE; ctxInfo.recordType _ Records.CreateRecordType[CTXRecordTypeProcs, rmtw.cc, ctxInfo]; ctxInfo.fieldListType _ Records.CreateFieldListType[CTXFieldTypeProcs, rmtw.cc, ctxInfo]; ctxInfo.ampersandFields _ NIL; ctxInfo.typeFields _ NIL; ctxInfo.rmtw _ rmtw; ctxInfo.bitSize _ fieldStart; ctxInfo.repData _ NIL; RETURN [ctxInfo.recordType, i.SUCC]}; <> <> <> <> <> AnalyzeCTX: PUBLIC PROC[ctxh: CTXH, bindSeh: SEH, painted, unpackedArgResultRecord, blockRecord, maybeVariant, variantCases, isHelper, defer: BOOL, rmtw: RemoteMimosaTargetWorld, bitSize: BitAddr, jmpi: MOF.JointMobParsedInfo _ NIL, bth: MA.BTH _ NIL] RETURNS[ctxInfo: AnalyzedCTX, recType: Type] = { mob: MA.MobCookie; ctxr: CTXR; fieldFis: FiHt _ []; amperFis: FiHt _ []; typeFis: FiHt _ []; hasNtConst, isVnt, isSeq: BOOL _ FALSE; fieldSeh, nextSeh, fieldTypeSeh: SEH; fieldIdBody: REF id MobAccess.BodySE; fieldSer, fieldTypeSer: SER; fieldCons: REF cons MA.BodySE _ NIL; startOffset, tailOffset, tailSize: INT _ 0; IF blockRecord AND bth=NIL THEN CCE[cirioError, "some fool is trying to analyze a block record type without giving the BTH"]; IF ctxh = NIL THEN {-- ctxh is NIL, special case for arg/result records in procedure frames IF bindSeh#NIL THEN CCE[cirioError, "can't bind a NIL context"]; ctxInfo _ NEW[AnalyzedCTXBody[0]]; ctxInfo.painted _ painted; ctxInfo.blockRecord _ blockRecord; ctxInfo.hasNtConst _ FALSE; ctxInfo.recordType _ Records.CreateRecordType[CTXRecordTypeProcs, rmtw.cc, ctxInfo]; ctxInfo.fieldListType _ Records.CreateFieldListType[CTXFieldTypeProcs, rmtw.cc, ctxInfo]; ctxInfo.ampersandFields _ NIL; ctxInfo.typeFields _ NIL; ctxInfo.rmtw _ rmtw; ctxInfo.bitSize _ bitSize; ctxInfo.AnalyzeField _ AnalyzeMobField; ctxInfo.repData _ NEW [MobCtxRepPrivate _ [mob, jmpi, bth]]; RETURN[ctxInfo, ctxInfo.recordType]}; mob _ MA.GetMobForCTXH[ctxh]; [ctxh, ctxr] _ GetCompleteContext[ctxh, rmtw]; <> FOR fieldSeh _ ctxr.seList, nextSeh WHILE fieldSeh#NIL DO fieldSer _ MA.FetchSER[fieldSeh]; WITH fieldSer.body SELECT FROM id: REF id MA.BodySE => { <> <> <<(type declarations will occur in the ctxr.seLists occurring for body table entries.)>> thisFil: LIST OF FieldInfo; sk: SehKnowledge _ SELECT TRUE FROM NOT isHelper => none, id.hash.Equal["aRope"] => ROPE, id.hash.Equal["aText"] => ROPE, id.hash.Equal["anAtom"] => ATOM, ENDCASE => none; nextSeh _ id.ctxLink; IF id.idCtx # ctxh THEN LOOP -- not visible--; fieldIdBody _ id; fieldTypeSeh _ id.idType; fieldTypeSer _ MA.FetchSER[fieldTypeSeh]; thisFil _ LIST[[ name: id.hash, fieldCase: nodeTimeReadWrite, repData: NEW[MobFieldRepPrivate _ [fieldSeh, fieldSer, id, sk]] ]]; WITH id.idInfoAndValue SELECT FROM x: REF MA.FieldDesc => thisFil.first.fieldCase _ IF id.immutable THEN nodeTimeReadOnly ELSE nodeTimeReadWrite; x: REF MA.TypeDesc => thisFil.first.fieldCase _ typeTimeConstant; x: REF MA.BlockDesc => thisFil.first.fieldCase _ nodeTimeConstant; x: REF MA.ConstVal => thisFil.first.fieldCase _ typeTimeConstant; ENDCASE => thisFil.first.fieldCase _ nodeTimeReadWrite; IF IsATypeDecl[fieldTypeSer] THEN { thisFil.first.fieldCase _ typeTimeConstant; typeFis _ FilAppend[typeFis, thisFil]; IF variantCases THEN thisFil.first.unionAnalysis _ AnalyzeUnionRecordSEH[fieldSeh, rmtw]; } ELSE IF Rope.Length[id.hash] > 0 AND Rope.Fetch[id.hash, 0] = '& THEN { amperFis _ FilAppend[amperFis, thisFil]; } ELSE { fieldFis _ FilAppend[fieldFis, thisFil]; hasNtConst _ hasNtConst OR thisFil.first.fieldCase=nodeTimeConstant; WITH id.idInfoAndValue SELECT FROM x: REF MA.FieldDesc => { tailOffset _ x.bitOffset; tailSize _ x.bitSize; IF fieldFis.head=NIL THEN startOffset _ tailOffset}; ENDCASE => NULL; WITH fieldTypeSer.body SELECT FROM fc: REF cons MA.BodySE => { fieldCons _ fc; WITH fc.typeInfo SELECT FROM seqTi: REF sequence MA.TypeInfoConsSE => { IF nextSeh#NIL OR NOT maybeVariant THEN CCE[cirioError, "sequence found in implausible place"]; isSeq _ TRUE; GOTO NoDetails}; unTi: REF union MA.TypeInfoConsSE => { IF nextSeh#NIL OR NOT maybeVariant THEN CCE[cirioError, "union found in implausible place"]; isVnt _ TRUE; GOTO NoDetails}; ENDCASE => NULL}; ENDCASE => NULL; IF defer THEN { thisFil.first.fieldDirectType _ NIL; thisFil.first.analysisValid _ FALSE} ELSE { thisFil.first.fieldDirectType _ AnalyzeSEH[id.idType, rmtw, sk]; thisFil.first.analysisValid _ TRUE}; IF blockRecord THEN thisFil.first.varLoc _ MOF.GetVarLoc[fieldSeh, bth, jmpi] ELSE IF id.idInfoAndValue=NIL THEN <> thisFil.first.fieldLoc _ NIL <> ELSE WITH id.idInfoAndValue SELECT FROM fd: REF MA.FieldDesc => { thisFil.first.fieldLoc _ NEW[BitStretch _ [ start: CirioTypes.BitsToBa[fd.bitOffset], size: CirioTypes.BitsToBa[fd.bitSize] ]] }; ENDCASE => thisFil.first.fieldLoc _ NIL; EXITS NoDetails => thisFil.first.analysisValid _ FALSE; }; }; ENDCASE => CCE[cirioError, "found non-id SE in a Context"]; ENDLOOP; <> { ctxInfo _ NEW[AnalyzedCTXBody[fieldFis.n]]; FOR cell: RECORD[I: CARDINAL, fields: LIST OF FieldInfo] _ [0, fieldFis.head], [cell.I+1, cell.fields.rest] WHILE cell.fields # NIL DO ctxInfo.fields[cell.I] _ cell.fields.first; ENDLOOP; ctxInfo.painted _ painted; ctxInfo.blockRecord _ blockRecord; ctxInfo.hasNtConst _ hasNtConst; ctxInfo.recordType _ Records.CreateRecordType[CTXRecordTypeProcs, rmtw.cc, ctxInfo]; ctxInfo.fieldListType _ Records.CreateFieldListType[CTXFieldTypeProcs, rmtw.cc, ctxInfo]; ctxInfo.ampersandFields _ amperFis.head; ctxInfo.typeFields _ typeFis.head; ctxInfo.rmtw _ rmtw; ctxInfo.bitSize _ IF bitSize#unspecdBA THEN bitSize ELSE CirioMemory.BitsToBa[tailOffset+tailSize]; ctxInfo.AnalyzeField _ AnalyzeMobField; ctxInfo.repData _ NEW [MobCtxRepPrivate _ [mob, jmpi, bth]]; IF unpackedArgResultRecord THEN PrefillAndCorrectFieldLocs[ctxInfo]; IF isSeq THEN RETURN [NIL, AnalyzeSequenceSEH[ctxInfo.fieldListType, fieldIdBody.hash, tailOffset, fieldTypeSeh, fieldTypeSer, fieldCons, NARROW[fieldCons.typeInfo], rmtw]]; IF isVnt THEN { t: Type _ AnalyzeVariantRecordSEH[ctxInfo.fieldListType, fieldIdBody.hash, startOffset, fieldTypeSeh, fieldTypeSer, fieldCons, NARROW[fieldCons.typeInfo], ctxInfo.bitSize.BaToBits[], rmtw]; IF bindSeh#NIL THEN { idx: INT _ FindVntIdx[NARROW[fieldCons.typeInfo], bindSeh]; IF idx>=0 THEN t _ VariantRecords.GetVRVariant[t, idx, rmtw.cc]}; RETURN [NIL, t]}; RETURN[ctxInfo, ctxInfo.recordType]} }; FindVntIdx: PROC [uni: REF union MA.TypeInfoConsSE, bindSeh: SEH] RETURNS [INT] ~ { caseCtxr: CTXR _ MA.FetchCTXR[uni.caseCtx]; idSeh: SEH _ caseCtxr.seList; WHILE idSeh#NIL DO idSer: SER _ MA.FetchSER[idSeh]; WITH idSer.body SELECT FROM x: REF id MA.BodySE => { WITH x.idInfoAndValue SELECT FROM td: REF MA.TypeDesc => IF td.seh = bindSeh THEN RETURN [td.data]; ENDCASE => CCE[cirioError, "found non-TYPE variant record case"]; idSeh _ x.ctxLink}; ENDCASE => CCE[cirioError, "found non-id variant record case"]; ENDLOOP; RETURN[-1]}; FiList: TYPE ~ LIST OF FieldInfo; FiHt: TYPE ~ RECORD [head, tail: FiList _ NIL, n: INT _ 0]; FilAppend: PROC [fl: FiHt, elt: FiList] RETURNS [FiHt] ~ { IF fl.tail=NIL THEN fl.head _ elt ELSE fl.tail.rest _ elt; fl.tail _ elt; fl.n _ fl.n+1; RETURN [fl]}; AnalyzeMobField: PROC [ctxInfo: AnalyzedCTX, index: CARDINAL, fi: FieldInfo] RETURNS [FieldInfo] ~ { fieldTypeSeh: SEH _ fi.repData.serBody.idType; fi.fieldDirectType _ AnalyzeSEH[fieldTypeSeh, ctxInfo.rmtw, fi.repData.sk]; fi.analysisValid _ TRUE; RETURN [fi]}; <> GetCompleteContext: PUBLIC PROC[ctxh: CTXH, rmtw: RemoteMimosaTargetWorld] RETURNS[CTXH, CTXR] = BEGIN ctxr: MA.CTXR _ MA.FetchCTXR[ctxh]; DO WITH ctxr SELECT FROM x: MA.IncludedCTXR => IF x.seList=NIL OR NOT x.complete THEN { mdr: MA.MDR ~ MA.FetchMDR[x.module]; mobFrom: MA.MobCookie ~ GetDefinitionMob[rmtw.cedarModules, mdr.stamp, MPN.Cons1[MPN.ConsComponent[StemPart[PFS.PathFromRope[mdr.fileId]]]] ]; IF mobFrom=NIL THEN CCE[cirioError, IO.PutFR["Couldn't find %g for %g", [rope[mdr.fileId]], [rope[mdr.moduleId]] ]]; IF x.map=Symbols.CTXNull THEN CCE[cirioError, IO.PutFR["No map given for ctx%xx into %g", [cardinal[LOOPHOLE[MA.GetCtxForCTXH[ctxh]]]], [rope[mdr.moduleId]] ]]; ctxh _ MA.MakeCTXH[mobFrom, x.map]; ctxr _ MA.FetchCTXR[ctxh]; } ELSE EXIT; ENDCASE => EXIT; ENDLOOP; RETURN [ctxh, ctxr]; END; <<>> FindSeh: PUBLIC PROC [ctxh: CTXH, name: ROPE, rmtw: RemoteMimosaTargetWorld] RETURNS [n, t: SEH] ~ { ctxr: CTXR; fieldSeh, nextSeh: SEH; fieldSer: SER; [ctxh, ctxr] _ GetCompleteContext[ctxh, rmtw]; FOR fieldSeh _ ctxr.seList, nextSeh WHILE fieldSeh#NIL DO fieldSer _ MA.FetchSER[fieldSeh]; WITH fieldSer.body SELECT FROM id: REF id MA.BodySE => { nextSeh _ id.ctxLink; IF id.idCtx # ctxh THEN LOOP -- not visible--; IF id.hash.Equal[name] THEN RETURN [fieldSeh, id.idType]; }; ENDCASE => CCE[cirioError, "found non-id SE in the helper context"]; ENDLOOP; RETURN [NIL, NIL]}; FindHelpingSehs: PUBLIC PROC [ctxh: CTXH, rmtw: RemoteMimosaTargetWorld] RETURNS [atomRecSeh: SEH _ NIL] ~ { [,atomRecSeh] _ FindSeh[ctxh, "anAtomRep", rmtw]; IF atomRecSeh=NIL THEN CCE[cirioError, "didn't find `anAtomRep' in the helper context"]; RETURN}; <> StemPart: PROC[whole: PFSNames.PATH] RETURNS[RS.RopePart] = BEGIN baseSeq: RS.RopeSeq _ RS.ParsePartToSeq[MPN.ComponentName[whole.ShortName], '.]; IF baseSeq # NIL THEN RETURN[baseSeq.Fetch[0]] ELSE RETURN[[NIL,0,0]]; END; <<>> <> IsATypeDecl: PROC[ser: MA.SER] RETURNS[BOOLEAN] = BEGIN WITH ser.body SELECT FROM id: REF id MA.BodySE => RETURN[FALSE]; cons: REF cons MA.BodySE => WITH cons.typeInfo SELECT FROM isAType: REF mode MA.TypeInfoConsSE => RETURN[TRUE]; ENDCASE => RETURN[FALSE]; ENDCASE => ERROR; END; <<>> CTXRecordTypeProcs: REF Records.RecordTypeProcs _ NEW[Records.RecordTypeProcs_[ createIndirectNode: CTXRecordCreateIndirect, getBitSize: CTXRecordBitSize, getPaint: CTXRecordsGetPaint, comparePaint: CTXRecordsComparePaint, nFields: CTXRecordsNFields, fieldIndexToName: CTXRecordsFieldIndexToName, nameToFieldIndex: CTXRecordsNameToFieldIndex, fieldIndexToType: CTXRecordsFieldIndexToType, fieldIndexToFieldCase: CTXRecordsFieldIndexToFieldCase, fieldIndexToCompileTimeConstantValue: FieldIndexToUnknown]]; <<>> <> CTXFieldTypeProcs: REF Records.RecordTypeProcs _ NEW[Records.RecordTypeProcs_[ createIndirectNode: CTXRecordCreateIndirect, getPaint: CTXRecordsGetPaint, comparePaint: CTXRecordsComparePaint, nFields: CTXFieldsNFields, fieldIndexToName: CTXRecordsFieldIndexToName, nameToFieldIndex: CTXRecordsNameToFieldIndex, fieldIndexToType: CTXRecordsFieldIndexToType, fieldIndexToFieldCase: CTXRecordsFieldIndexToFieldCase, fieldIndexToCompileTimeConstantValue: FieldIndexToUnknown]]; CTXRecordCreateIndirect: PROC [cc: CC, data: REF ANY, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ { ac: AnalyzedCTX _ NARROW[data]; nodeData: RecordNode _ NEW[RecordNodeData _ [ac, targetType, mem, NIL]]; IF ac.hasNtConst THEN [] _ mem.MemReadSegReg["text", 0]; --make sure we've got a Frame Mem nodeData.indirectToRecord _ Records.CreateIndirectRecordNode[targetType, RecordProcs, nodeData, ac.rmtw.cc]; RETURN[nodeData.indirectToRecord]}; <> CTXRecordBitSize: PROC[indirectType: Type, cc: CC, data: REF ANY] RETURNS[CARD] ={ ac: AnalyzedCTX _ NARROW[data]; bits: INT _ ac.bitSize.BaToBits; RETURN[bits]}; <> <<>> < because reconstructed types after a flush of the unknown symbol cache should not agree with previously cnstructed types, even if they have the same .>> CTXRecordsGetPaint: PROC[data: REF ANY] RETURNS[REF ANY] = BEGIN ac: AnalyzedCTX _ NARROW[data]; IF ac.painted THEN RETURN[ac] ELSE RETURN[NIL]; END; <<>> CTXRecordsComparePaint: PROC[data: REF ANY, otherPaint: REF ANY] RETURNS[BOOLEAN] = BEGIN ac: AnalyzedCTX _ NARROW[data]; IF otherPaint = NIL THEN CCE[cirioError]; -- we shouldn't be called in this situation WITH otherPaint SELECT FROM other: AnalyzedCTX => RETURN[ac = other]; ENDCASE => RETURN[FALSE]; END; <<>> CTXRecordsNFields: PROC[data: REF ANY] RETURNS[INT] = BEGIN ac: AnalyzedCTX _ NARROW[data]; RETURN[ac.nFields]; END; <<>> <> CTXFieldsNFields: PROC[data: REF ANY] RETURNS[INT] = BEGIN ac: AnalyzedCTX _ NARROW[data]; RETURN[ac.nFields-1]; END; <<>> CTXRecordsFieldIndexToName: PROC[index: INT, data: REF ANY] RETURNS[Rope.ROPE] = BEGIN ac: AnalyzedCTX _ NARROW[data]; RETURN[ac.fields[index].name]; END; <<>> <> CTXRecordsNameToFieldIndex: PROC[name: Rope.ROPE, data: REF ANY] RETURNS[INT] = BEGIN ac: AnalyzedCTX _ NARROW[data]; FOR I: INT IN [0..ac.nFields) DO IF Rope.Equal[name, ac.fields[I].name] THEN RETURN[I]; ENDLOOP; RETURN[-1]; END; <<>> CTXRecordsFieldIndexToType: PROC[index: INT, cc: CC, data: REF ANY] RETURNS[Type] = { ac: AnalyzedCTX _ NARROW[data]; <> IF NOT ac.fields[index].analysisValid THEN ac.fields[index] _ ac.AnalyzeField[ac, index, ac.fields[index]]; RETURN[ac.fields[index].fieldDirectType]}; <<>> CTXRecordsFieldIndexToFieldCase: PROC[index: INT, cc: CC, data: REF ANY] RETURNS[Records.FieldCase] = { ac: AnalyzedCTX _ NARROW[data]; RETURN [ac[index].fieldCase]}; <<>> FieldIndexToUnknown: PROC[index: INT, cc: CC, data: REF ANY] RETURNS[Node] ~ { explanation: Rope.ROPE ~ IO.PutFR["unknown constant field, index=%g", [integer[index]] ]; ukt: Type ~ CedarOtherPureTypes.CreateUnknownType[cc, explanation]; RETURN CedarOtherPureTypes.CreateUnknownTypeNode[ukt, explanation, cc]}; UnknownConstField: TYPE ~ RECORD [index: INT, cc: CC, data: REF ANY]; END.