<<>> <> <> <> <> <> <> <> DIRECTORY Atoms, CCTypes, CedarCode, CedarOtherPureTypes, CirioMemory, CirioNubAccess, CirioTargets, CirioTypes, DeferringTypes, IO, LoadStateAccess, MobAccess, MobObjectFiles, NewRMTW, ObjectFiles, PFS, PointerTypes, Procedures, RefTypes, RMTWPrivate, Rope, Symbols, SystemInterface; RMTWPointers: CEDAR PROGRAM IMPORTS Atoms, CCTypes, CedarCode, CedarOtherPureTypes, CirioMemory, CirioNubAccess, CirioTypes, DeferringTypes, IO, LoadStateAccess, MobAccess, MobObjectFiles, NewRMTW, ObjectFiles, PFS, PointerTypes, Procedures, RefTypes, RMTWPrivate, Rope, SystemInterface EXPORTS NewRMTW, RMTWPrivate SHARES Rope = BEGIN OPEN LSA:LoadStateAccess, ObjF:ObjectFiles, MA:MobAccess, MOF:MobObjectFiles, RMTWPrivate; <> Operator: TYPE = CedarCode.Operator; CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE _ NIL] _ CCTypes.CCError; RemoteMimosaTargetWorld: TYPE = REF RemoteMimosaTargetWorldBody; RemoteMimosaTargetWorldBody: PUBLIC TYPE = RMTWPrivate.RemoteMimosaTargetWorldBody; TargetBitsPerWord: CARD = 32; <> <<>> <> <<>> AnalyzedRefSEH: TYPE = REF AnalyzedRefSEHBody; AnalyzedRefSEHBody: TYPE = RECORD[ rmtw: RemoteMimosaTargetWorld, directRefType: Type, size: CARD, clientTargetType: Type, isRA: BOOL ]; AnalyzeRefSEH: PUBLIC PROC[dft: Type, seh: SEH, ser: SER, cons: REF cons MA.BodySE, ti: REF ref MA.TypeInfoConsSE, rmtw: RemoteMimosaTargetWorld, sk: SehKnowledge] RETURNS[Type] = { sei: Symbols.SEIndex ~ MA.GetSeiForSEH[seh]; clientTargetType, refType, ropeType: Type; private: AnalyzedRefSEH _ NIL; ropeBti: BasicTypeInfo _ NIL; bti: BasicTypeInfo _ NEW[BasicTypeInfoPrivate _ [CreateIndirectRefNode, RefBitSize, NIL]]; isRA: BOOL _ FALSE; IF MA.GetSeiForSEH[ti.refType] = LOOPHOLE[stopSei] THEN skAtStopSei _ sk; IF sk=none AND rmtw.atomSei#Symbols.SENull AND sei=rmtw.atomSei THEN sk _ ATOM; IF ti.ordered AND ti.basing THEN { refType _ AnalyzedUnknownSEH[seh, rmtw, "ORDERED BASE POINTER (you don't want to look closely)", bitsPerPtr]; DeferringTypes.SetUndertype[dft, refType]; RETURN [refType]}; IF sk=ROPE THEN { ropeBti _ NEW [BasicTypeInfoPrivate _ [RopeCreateIndirect, RefBitSize, NIL]]; DeferringTypes.SetUndertype[dft, ropeType _ CedarOtherPureTypes.CreateRopeType[rmtw.cc, ropeBti]]}; IF sk=ATOM THEN { DeferringTypes.SetUndertype[dft, refType _ Atoms.CreateAtomType[rmtw.cc, bti]]; IF rmtw.atomSei=Symbols.SENull THEN rmtw.atomSei _ sei; IF rmtw.atomRecRT=NIL THEN rmtw.atomRecRT _ AnalyzeSEH[rmtw.atomRecSeh, rmtw, notSpecial]; clientTargetType _ rmtw.atomRecRT} ELSE { underTargetSeh: SEH _ UnderTypeSEH[ti.refType, rmtw]; targetSer: SER _ MA.FetchSER[underTargetSeh]; WITH targetSer.body SELECT FROM x: REF cons MA.BodySE => isRA _ x.typeInfo.typeTag=any; x: REF id MA.BodySE => CCE[cirioError, "UnderTypeSEH returned an id seh"]; ENDCASE => ERROR; IF isRA THEN refType _ RefTypes.CreateRefAnyType[rmtw.cc, bti] ELSE refType _ RefTypes.CreateRefType[rmtw.cc, bti]; IF sk#ROPE THEN DeferringTypes.SetUndertype[dft, refType]; IF NOT isRA THEN clientTargetType _ AnalyzeSEH[ ti.refType, rmtw, SELECT sk FROM none, notSpecial => none, ROPE => RopeRep, ATOM => notSpecial, RopeRep => CCE[cirioError, IO.PutFR1["Implausible SehKnowledge for REF SEH %g", [rope[FmtSeh[seh, ""]]] ]], ENDCASE => ERROR ]; }; private _ NEW[AnalyzedRefSEHBody_[ rmtw: rmtw, directRefType: refType, size: ti.length, clientTargetType: clientTargetType, isRA: isRA]]; bti.btiData _ private; IF sk=ATOM THEN Atoms.SetAtomRecType[refType, clientTargetType, rmtw.cc] ELSE IF NOT isRA THEN RefTypes.SetReferent[refType, clientTargetType, 0, rmtw.cc]; IF sk = ROPE THEN {ropeBti.btiData _ private; RETURN[ropeType]} ELSE RETURN[private.directRefType]; }; stopSei: CARD _ 1; skAtStopSei: SehKnowledge _ notSpecial; RefBitSize: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type] RETURNS[CARD] = { private: AnalyzedRefSEH _ NARROW[bti.btiData]; RETURN[private.size]}; CreateIndirectRefNode: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type, mem: Mem] RETURNS[Node] = { private: AnalyzedRefSEH _ NARROW[bti.btiData]; nodeData: REF RefNodeData _ NEW[RefNodeData _ [private, mem]]; RETURN[CedarCode.CreateCedarNode[RefOps, indirectType, nodeData]]}; RefNodeData: TYPE = RECORD[private: AnalyzedRefSEH, mem: Mem]; RefOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ unaryOp: RefUnaryOp, store: RefStore, load: RefLoad]]; RefUnaryOp: PROC[op: Operator, type: Type, node: Node, cc: CC] RETURNS[Node] = { IF op # $address THEN CCE[cirioError, "address is the only supported unary operation on REFs"] ELSE { nodeData: REF RefNodeData _ NARROW[CedarCode.GetDataFromNode[node]]; RETURN[ConvertFromIndirectToPointer[node, nodeData.mem, nodeData.private.rmtw]]; }; }; RefStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] = { nodeData: REF RefNodeData ~ NARROW[CedarCode.GetDataFromNode[indirectNode]]; rmtw: RemoteMimosaTargetWorld ~ nodeData.private.rmtw; mem: Mem ~ nodeData.mem; refSize: CARD ~ nodeData.private.size; via: REF ANY ~ CedarCode.GetNodeRepresentation[valNode, cc]; rc: REF CARD ~ IF via=NIL THEN NIL ELSE WITH via SELECT FROM ani: Atoms.AtomNodeInfo => WITH ani.data SELECT FROM x: REF CARD => x, ENDCASE => CCE[cirioError, "storing atom with useless AtomNodeInfo.data"], rni: RefTypes.RefNodeInfo => WITH rni.data SELECT FROM x: REF CARD => x, ENDCASE => CCE[cirioError, "storing REF with useless RefNodeInfo.data"], ENDCASE => CCE[cirioError, "storing REF with unexpected node rep"]; IF rc=NIL THEN mem.MemWrite[0, bitsPerPtr, zeroBA] ELSE { mem.MemWrite[rc^, bitsPerPtr, zeroBA]}; RETURN}; RefLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = { nodeData: REF RefNodeData ~ NARROW[CedarCode.GetDataFromNode[indirectNode]]; rmtw: RemoteMimosaTargetWorld ~ nodeData.private.rmtw; mem: Mem ~ nodeData.mem; refSize: CARD ~ nodeData.private.size; errMsg: Rope.ROPE _ NIL; isRA: BOOL ~ nodeData.private.isRA; isAtom: BOOL _ CCTypes.GetTypeClass[indirectType] = $atom; addrBits: CARD; referentSize: BitAddr _ unspecdBA; referentOffset: BitAddr _ zeroBA; targetDirectType: Type _ nodeData.private.clientTargetType; targetIndirectType: Type _ NIL; <> { ENABLE { CirioNubAccess.RemoteAddrFault => {errMsg _ IO.PutFR["CirioNubAccess.RemoteAddrFault[byteAddress: %x, valid: %g]", [integer[addr.byteAddress]], [boolean[addr.valid]] ]; GOTO unknownAddress}; CCE => {errMsg _ msg; GOTO unknownAddress}; }; IF NOT isRA THEN targetIndirectType _ CCTypes.GetIndirectType[targetDirectType]; addrBits _ mem.MemRead[bitsPerPtr, zeroBA]; IF addrBits IN [0..8) THEN RETURN[IF isAtom THEN Atoms.CreateNilAtomNode[nodeData.private.clientTargetType, cc] ELSE RefTypes.CreateNilRefNode[cc]] ELSE { referentOffset _ CirioTypes.PtrToBa[addrBits]; IF isRA THEN { typeAddr: CirioNubAccess.RemoteAddress _ NewRMTW.BaToCnra[rmtw.nub, CirioMemory.PtrToBa[addrBits-4]]; typeCode: CARD _ CirioNubAccess.Read32BitsAsCard[typeAddr]; targetDirectType _ AnalyzeTc[rmtw, typeCode]; isAtom _ targetDirectType = rmtw.atomRecRT; targetIndirectType _ CCTypes.GetIndirectType[targetDirectType]}; --Compute target size-- { ENABLE CCE => CONTINUE; --MJS August 21, 1990: have to allow for REF RECORD [..SEQUENCE..], which refuses to compute a bitSize (which obviously should take some more parameters) bareReferentSize: CARD ~ CCTypes.GetBitSize[targetIndirectType, cc]; IF bareReferentSize RETURN[UnimplementedTypeNode[indirectType, rmtw, errMsg]]; }}; bitsPerTargetWord: NAT = 32; GetAtomPointer: PROC [data: REF ANY, cc: CC] RETURNS[CirioTypes.Node] ~ {CCE[unimplemented, "RMTWPointers.GetAtomPointer was thought (by MJS on 13-Dec-90) to be unneeded"]}; <<>> <> AnalyzedProcSEH: TYPE ~ REF AnalyzedProcSEHBody; AnalyzedProcSEHBody: TYPE ~ RECORD [ rmtw: RemoteMimosaTargetWorld, type: Type _ NIL, typeIn, typeOut: Type]; AnalyzeProcedureSEH: PUBLIC PROC[ti: REF transfer MA.TypeInfoConsSE, cons: REF cons MA.BodySE, ser: SER, seh: SEH, rmtw: RemoteMimosaTargetWorld] RETURNS[Type] = { private: AnalyzedProcSEH ~ NEW [AnalyzedProcSEHBody _ [ rmtw: rmtw, typeIn: IF ti.typeIn#NIL THEN AnalyzeSEH[ti.typeIn, rmtw, none] ELSE NIL, typeOut: IF ti.typeOut#NIL THEN AnalyzeSEH[ti.typeOut, rmtw, none] ELSE NIL]]; bti: BasicTypeInfo ~ NEW[BasicTypeInfoPrivate _ [ProcCreateIndirect, ProcBitSize, private]]; IF ti.typeIn=NIL OR ti.typeOut=NIL THEN { empty: Type ~ AnalyzeRecordSEH[seh: NIL, ser: NIL, cons: NIL, ti: NIL, rmtw: rmtw, isRopeRep: FALSE]; IF ti.typeIn=NIL THEN private.typeIn _ empty; IF ti.typeOut=NIL THEN private.typeOut _ empty}; private.type _ Procedures.CreateProcedureType[private.typeIn, private.typeOut, rmtw.cc, bti]; RETURN[private.type]}; AnalProcTs: PUBLIC PROC [rmtw: RemoteMimosaTargetWorld, tsd: TsDict, i: INT, opts: TsOptions] RETURNS [Type, INT] ~ { i2, i3: INT; argType, retType: Type; [argType, i2] _ AnalyzeTs[rmtw, tsd, i]; [retType, i3] _ AnalyzeTs[rmtw, tsd, i2]; {private: AnalyzedProcSEH ~ NEW [AnalyzedProcSEHBody _ [ rmtw, NIL, argType, retType]]; bti: BasicTypeInfo ~ NEW[BasicTypeInfoPrivate _ [ProcCreateIndirect, ProcBitSize, private]]; private.type _ Procedures.CreateProcedureType[private.typeIn, private.typeOut, rmtw.cc, bti]; RETURN[private.type, i3]}}; ProcBitSize: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type] RETURNS[CARD] ~ { private: AnalyzedProcSEH ~ NARROW[bti.btiData]; RETURN [TargetBitsPerWord]}; ProcCreateIndirect: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type, mem: Mem] RETURNS[Node] ~ { private: AnalyzedProcSEH ~ NARROW[bti.btiData]; procIndirect: ProcIndirect ~ NEW [ProcIndirectBody _ [private, mem]]; RETURN CedarCode.CreateCedarNode[ProcOps, indirectType, procIndirect]}; ProcIndirect: TYPE ~ REF ProcIndirectBody; ProcIndirectBody: TYPE ~ RECORD [private: AnalyzedProcSEH, mem: Mem]; ProcOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ unaryOp: ProcUnaryOp, store: ProcStore, load: ProcLoad]]; ProcUnaryOp: PROC[op: Operator, type: Type, node: Node, cc: CC] RETURNS[Node] ~ { IF op # $address THEN CCE[cirioError, "Procedure indirects only implement $address"]; {procIndirect: ProcIndirect ~ NARROW[CedarCode.GetDataFromNode[node]]; RETURN ConvertFromIndirectToPointer[node, procIndirect.mem, procIndirect.private.rmtw]}}; ProcStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] ~ { procIndirect: ProcIndirect ~ NARROW[CedarCode.GetDataFromNode[indirectNode]]; rmtw: RemoteMimosaTargetWorld ~ procIndirect.private.rmtw; procInfo: Procedures.ProcedureNodeInfo ~ NARROW[CedarCode.GetNodeRepresentation[valNode, cc]]; procDirect: ProcDirect ~ NARROW[procInfo.data]; procIndirect.mem.MemWrite[bits: LOOPHOLE[procDirect.repAddr.byteAddress], bitSize: bitsPerPtr, offset: zeroBA]; RETURN}; ProcLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] ~ { procIndirect: ProcIndirect ~ NARROW[CedarCode.GetDataFromNode[indirectNode]]; rmtw: RemoteMimosaTargetWorld ~ procIndirect.private.rmtw; mem: Mem ~ procIndirect.mem; {ENABLE CirioNubAccess.RemoteAddrFault, CCE => GOTO unknownAddress; repBits: CARD ~ procIndirect.mem.MemRead[bitsPerPtr, zeroBA]; repAddr: CirioNubAccess.RemoteAddress ~ NewRMTW.BaToCnra[rmtw.nub, [aus: repBits, bits: 0]]; analProcSEH: AnalyzedProcSEH _ procIndirect.private; procDirect: ProcDirect ~ NEW [ProcDirectBody _ [rmtw, analProcSEH, repAddr, [h: NIL, byteAddress: 0, bitOffset: 0, nil: FALSE, valid: FALSE], 0]]; procInfo: Procedures.ProcedureNodeInfo ~ NEW [Procedures.ProcedureNodeInfoBody _ [CallProc, DescribeProc, procDirect]]; IF repAddr.valid AND NOT repAddr.nil THEN { ENABLE CirioNubAccess.RemoteNilFault, CirioNubAccess.RemoteAddrFault => CONTINUE; procDirect.pc _ [h: repAddr.h, byteAddress: CirioNubAccess.Read32BitsAsCard[repAddr], bitOffset: 0, nil: FALSE, valid: TRUE]; procDirect.pcCard _ LOOPHOLE[procDirect.pc.byteAddress]; procDirect.pc.nil _ procDirect.pc.byteAddress = 0; }; RETURN Procedures.CreateProcedureNode[procIndirect.private.type, procInfo]; EXITS unknownAddress => RETURN[UnimplementedTypeNode[indirectType, rmtw, "proc at bad address"]]; }}; ProcDirect: TYPE ~ REF ProcDirectBody; ProcDirectBody: TYPE ~ RECORD [ rmtw: RemoteMimosaTargetWorld, analProcSEH: AnalyzedProcSEH, repAddr, pc: CirioNubAccess.RemoteAddress, pcCard: CARD]; CreateProcConstant: PUBLIC PROC [rmtw: RemoteMimosaTargetWorld, jmpi: MobObjectFiles.JointMobParsedInfo, searchMem: Mem, textBase: CARD, bth: MobAccess.BTH] RETURNS [ans: Node] ~ { MakeBroken: PROC [explanation: Rope.ROPE] RETURNS [Node] ~ { ukt: Type ~ CedarOtherPureTypes.CreateUnknownType[rmtw.cc, explanation]; RETURN CedarOtherPureTypes.CreateUnknownTypeNode[ukt, explanation, rmtw.cc]}; IF bth = NIL THEN -- can happen for MACHINE CODE procedures ans _ MakeBroken["broken procedure constant (because of NIL BTH --- MACHINE CODE?)"] ELSE BEGIN ENABLE CCE => { ans _ MakeBroken[IO.PutFR["broken procedure constant (for %g, reason=%g)", [rope[DescribeBth[bth]]], [rope[msg]] ]]; CONTINUE}; relPC: CARD ~ MOF.GetEntryPCofCallableBTH[bth, jmpi]; absPC: CARD ~ relPC + textBase; frameStart: BitAddr ~ searchMem.MemGetStart[]; frameLen: BitAddr ~ searchMem.MemGetSize[]; btr: MA.BTR ~ MA.FetchBTR[bth]; flag: CARD ~ SELECT btr.level FROM >Symbols.lL => 1, =Symbols.lL => 0, ERROR, ENDCASE => ERROR; repAddr: CirioNubAccess.RemoteAddress ~ SeekDescr[absPC, flag, frameStart.aus, frameLen.aus, rmtw.nub]; IF NOT repAddr.valid THEN RETURN [MakeBroken[IO.PutFR["broken procedure constant (unable to find cell describing pc=%xH, flg=%g for %g)", [cardinal[absPC]], [cardinal[flag]], [rope[DescribeBth[bth]]] ]]]; {procType: Type ~ WITH btr.extension SELECT FROM x: REF Callable MA.BTRExtension => AnalyzeSEH[x.ioType, rmtw, none], ENDCASE => CCE[cirioError, "body not callable"]; procPrivate: REF ANY ~ CCTypes.GetTypeRepresentation[procType, rmtw.cc]; analProcSEH: AnalyzedProcSEH ~ WITH procPrivate SELECT FROM procBTI: BasicTypeInfo => WITH procBTI.btiData SELECT FROM x: AnalyzedProcSEH => x, ENDCASE => CCE[cirioError, "analysis of callable body's IO type fails (way 1)"], ENDCASE => CCE[cirioError, "analysis of callable body's IO type fails (way 2)"]; procDirect: ProcDirect ~ NEW [ProcDirectBody _ [rmtw, analProcSEH, repAddr, [rmtw.nub, LOOPHOLE[absPC], 0, FALSE, TRUE], absPC]]; procInfo: Procedures.ProcedureNodeInfo ~ NEW [Procedures.ProcedureNodeInfoBody _ [CallProc, DescribeProc, procDirect]]; RETURN Procedures.CreateProcedureNode[procType, procInfo]} END; RETURN}; DescribeBth: PROC [bth: MobAccess.BTH] RETURNS [Rope.ROPE] ~ { mob: MobAccess.MobCookie; bti: Symbols.BTIndex; [mob, bti] _ MobAccess.BTHDetails[bth]; RETURN IO.PutFR["", [rope[PFS.RopeFromPath[SystemInterface.GetNameOfFile[MobAccess.GetFileForMobCookie[mob]]]]], [cardinal[LOOPHOLE[bti]]] ]}; SeekDescr: PROC [pc, link: CARD, base, bytes: CARD, nub: CirioNubAccess.Handle] RETURNS [da: CirioNubAccess.RemoteAddress _ [NIL, 0, 0, FALSE, FALSE]] ~ { ENABLE CirioNubAccess.RemoteNilFault, CirioNubAccess.RemoteAddrFault => CONTINUE; limit: CARD ~ base+bytes; target: CirioTargets.Target ~ NARROW[nub.target]; pcBA: CirioMemory.BitAddr _ CirioMemory.PtrToBa[pc]; fDescrBA: CirioMemory.BitAddr ~ target.DescriptorFromPC[target, pcBA]; fDescr: CARD ~ CirioMemory.BaToPtr[fDescrBA]; ans: CARD _ 0; found: BOOL _ FALSE; da _ [nub, base, 0, FALSE, TRUE]; WHILE da.byteAddress < limit DO fDescrCand: CARD ~ CirioNubAccess.Read32BitsAsCard[da]; da.byteAddress _ da.byteAddress + 4; IF fDescrCand=fDescr THEN { linkCand: CARD ~ CirioNubAccess.Read32BitsAsCard[da]; IF linkCand=link THEN { ans _ da.byteAddress - 4; IF found THEN RETURN [[NIL, 0, 0, FALSE, FALSE]]; found _ TRUE}; }; ENDLOOP; IF found THEN da.byteAddress _ ans ELSE da.valid _ FALSE; RETURN}; CallProc: PROC[args: Node, cc: CC, data: REF ANY] RETURNS[Node] ~ { procDirect: ProcDirect _ NARROW[data]; nub: CirioNubAccess.Handle _ procDirect.rmtw.nub; analProcSEH: AnalyzedProcSEH _ procDirect.analProcSEH; argType: Type _ analProcSEH.typeIn; argIndirectType: Type _ CCTypes.GetIndirectType[analProcSEH.typeIn]; argBitSize: CARD _ CCTypes.GetBitSize[argIndirectType, cc]; argByteSize: CARD _ (argBitSize+7)/8; argArea: CirioNubAccess.AllocatedBytes _ CirioNubAccess.AllocateBytes[nub, argByteSize]; argMem: Mem _ CreateSimpleMem[addr: argArea.bytes, size: [aus: argByteSize, bits: 0]]; argAreaNode: Node _ CCTypes.CreateIndirectNode[argIndirectType, argMem, cc]; resultType: Type _ analProcSEH.typeOut; resultIndirectType: Type _ CCTypes.GetIndirectType[resultType]; resultBitSize: CARD _ CCTypes.GetBitSize[resultIndirectType, cc]; resultByteSize: CARD _ (resultBitSize+7)/8; resultArea: CirioNubAccess.AllocatedBytes _ CirioNubAccess.AllocateBytes[nub, resultByteSize]; resultMem: Mem _ CreateSimpleMem[addr: resultArea.bytes, size: [aus: resultByteSize, bits: 0]]; resultAreaNode: Node _ CCTypes.CreateIndirectNode[resultIndirectType, resultMem, cc]; formalArgSizes, formalRetSizes: CirioNubAccess.SizeList; actualArgs, actualRets: CirioNubAccess.Fields; [formalArgSizes, actualArgs] _ AnalyzeArgRet[argType, cc, argArea]; [formalRetSizes, actualRets] _ AnalyzeArgRet[resultType, cc, resultArea]; CedarCode.StoreThroughIndirectNode[CedarCode.GetTypeOfNode[args], args, CedarCode.GetTypeOfNode[argAreaNode], argAreaNode, cc]; TRUSTED {CirioNubAccess.Call[nub, LOOPHOLE[procDirect.repAddr.byteAddress], formalArgSizes, formalRetSizes, actualArgs, actualRets]}; <> IF TRUE THEN BEGIN resultDeferedLoad: Node _ CedarCode.LoadThroughIndirectNode[CedarCode.GetTypeOfNode[resultAreaNode], resultAreaNode, cc]; result: Node _ CedarCode.ForceNodeIn[CedarCode.GetTypeOfNode[resultDeferedLoad], resultDeferedLoad, cc]; CirioNubAccess.ReleaseAllocatedBytes[argArea.allocHandle]; CirioNubAccess.ReleaseAllocatedBytes[resultArea.allocHandle]; RETURN[result]; END; CCTypes.CCError[unimplemented, "Can't call procedures yet"]; }; AnalyzeArgRet: PROC [recType: Type, cc: CC, area: CirioNubAccess.AllocatedBytes] RETURNS [formalSizes: CirioNubAccess.SizeList, actuals: CirioNubAccess.Fields] ~ { formalTail: CirioNubAccess.SizeList _ formalSizes _ LIST[0]; TakeN: PROC [length: CARD] ~ {actuals _ NEW [CirioNubAccess.FieldSeq[length]]}; TakeField: PROC [index: CARD, byteOffset: INT, bitOffset: INT, bitSize: CARD] ~ { addr: INT ~ area.bytes.byteAddress + byteOffset; f: CirioNubAccess.SizeList ~ LIST[bitSize]; actuals[index] _ [LOOPHOLE[addr], bitOffset, bitSize]; formalTail.rest _ f; formalTail _ f; RETURN}; GenRecordFields[recType, cc, TakeN, TakeField]; formalSizes _ formalSizes.rest; RETURN}; DescribeProc: PROC[to: IO.STREAM, data: REF ANY, depth, width: INT] ~ { procDirect: ProcDirect ~ NARROW[data]; rmtw: RemoteMimosaTargetWorld ~ procDirect.rmtw; sourceIndex: CARD _ 0; descr: ROPE _ ""; Basic: PROC RETURNS [d: Rope.ROPE] ~ { d _ IO.PutFR["pc=%g, descr at %g", [rope[FmtRemoteAddr[procDirect.pc]]], [rope[FmtRemoteAddr[procDirect.repAddr]]] ]; IF sourceIndex#0 THEN d _ d.Concat[IO.PutFR1[", src=%g", [cardinal[sourceIndex]] ]]; RETURN}; IF NOT procDirect.repAddr.valid THEN {to.PutRope["(invalid proc descriptor address)"]; RETURN}; IF procDirect.repAddr.nil THEN {to.PutRope["NIL"]; RETURN}; {ENABLE CCE => { descr _ Rope.Cat["(Proc, ", Basic[], ")"]; CONTINUE}; ledo: REF LSA.LoadedModuleInfo ~ IF procDirect.pc.valid THEN LSA.GetLoadedModuleInfoFromAbsPC[rmtw.lsh, procDirect.pcCard] ELSE CCE[cirioError]; relPC: CARD ~ IF ledo = NIL THEN 0 ELSE IF procDirect.pcCard >= ledo.lsi[text].base THEN procDirect.pcCard-ledo.lsi[text].base ELSE CCE[cirioError]; vs: REF ObjF.VersionStampInfo ~ IF ledo = NIL THEN NIL ELSE ObjF.FindVersionStamp[ledo.module]; IF ledo=NIL OR vs=NIL THEN { pci: CirioNubAccess.PCInfo ~ CirioNubAccess.PCtoInfo[rmtw.nub, procDirect.pcCard]; IF pci#NIL THEN { descr _ Rope.Cat[ IF pci.guessedEmbeddedFileName#NIL THEN PFS.RopeFromPath[pci.guessedEmbeddedFileName] ELSE "??", ".", pci.procName ]; IF depth>2 THEN descr _ Rope.Cat[ IF pci.fileName#NIL THEN PFS.RopeFromPath[pci.fileName] ELSE "??", ".", descr]; to.PutRope[descr]; RETURN}; }; IF ledo = NIL THEN { to.PutF1["(Proc at absPC=%xh without symbols)", [cardinal[procDirect.pcCard]] ]; RETURN}; IF vs=NIL THEN { to.PutF["(Proc at relPC=%xh in symbolless %g)", [cardinal[relPC]], [rope[PFS.RopeFromPath[ledo.loadedFile.GetNameOfFile]]] ]; RETURN}; {lmi: REF NewRMTW.LoadedModuleInfo ~ NewRMTW.GetLoadedModuleInfo[rmtw.cedarModules, ledo]; jmpi: MOF.JointMobParsedInfo ~ lmi.jmpi; bthList: LIST OF MA.BTH _ MOF.FindNearBTHAncestorsForPC[relPC, jmpi]; FOR bthList _ bthList, bthList.rest WHILE bthList#NIL DO btr: MA.BTR ~ MA.FetchBTR[bthList.first]; WITH btr.extension SELECT FROM x: REF Callable MA.BTRExtension => { ToName: PROC [btr: MA.BTR] RETURNS [Rope.ROPE] ~ { WITH btr.extension SELECT FROM y: REF Callable MA.BTRExtension => IF y.id#NIL THEN { id: REF id MA.BodySE ~ NARROW[MA.FetchSER[y.id].body]; RETURN [id.hash]}; ENDCASE => btr _ btr; RETURN[NIL]}; lastName: Rope.ROPE ~ ToName[btr]; sourceIndex _ btr.sourceIndex; descr _ IF lastName#NIL THEN lastName ELSE "(no name)"; IF depth>2 THEN descr _ descr.Cat["(", Basic[], ")"]; FOR parent: MA.BTR _ BTParent[btr], BTParent[parent] UNTIL parent=NIL DO thisName: Rope.ROPE ~ ToName[parent]; IF thisName#NIL THEN descr _ thisName.Cat[".", descr]; ENDLOOP; to.PutRope[descr]; RETURN}; ENDCASE => data _ data; ENDLOOP; }}; to.PutRope[descr]; RETURN}; BTParent: PROC [btr: MA.BTR] RETURNS [MA.BTR] ~ { btr _ btr; DO next: MA.BTR ~ MA.FetchBTR[btr.link.index]; SELECT btr.link.which FROM sibling => btr _ next; parent => RETURN [next]; ENDCASE => ERROR; ENDLOOP}; FmtRemoteAddr: PROC [ra: CirioNubAccess.RemoteAddress] RETURNS [Rope.ROPE] ~ { SELECT TRUE FROM ~ra.valid => RETURN ["(invalid address)"]; ra.nil => RETURN ["NIL"]; ra.bitOffset=0 => RETURN IO.PutFR1["%xh", [cardinal[ra.byteAddress]]]; ENDCASE => RETURN IO.PutFR["%xh[%xh]", [cardinal[ra.byteAddress]], [cardinal[ra.bitOffset]]]}; <> <<>> <> <> <> <<>> <> <<>> RopeNodeData: TYPE = RECORD[ style: RopeStyle, analyzedRefSeh: AnalyzedRefSEH, mem: Mem]; RopeStyle: TYPE ~ {pcedar2, cedar10}; RopeCreateIndirect: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type, mem: Mem] RETURNS[Node] = { analyzedRefSeh: AnalyzedRefSEH _ NARROW[bti.btiData]; directRepType: Type _ analyzedRefSeh.clientTargetType; indirectRepType: Type _ CCTypes.GetIndirectType[directRepType]; nodeData: REF RopeNodeData _ NEW[RopeNodeData _ [pcedar2, analyzedRefSeh, mem]]; {ENABLE CCE => GOTO Not; [] _ CCTypes.SelectIdField["v", indirectRepType, cc]; nodeData.style _ cedar10; EXITS Not => nodeData.style _ pcedar2}; RETURN[CedarCode.CreateCedarNode[RopeOps, indirectType, nodeData]]}; RopeOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ unaryOp: RopeUnaryOp, store: RopeStore, load: RopeLoad]]; RopeUnaryOp: PROC[op: Operator, type: Type, node: Node, cc: CC] RETURNS[Node] = { IF op # $address THEN CCE[cirioError, "address is the only supported unary operation on ROPEs"] ELSE { nodeData: REF RopeNodeData _ NARROW[CedarCode.GetDataFromNode[node]]; mem: Mem _ nodeData.mem; rmtw: RemoteMimosaTargetWorld _ nodeData.analyzedRefSeh.rmtw; RETURN[ConvertFromIndirectToPointer[node, mem, rmtw]]; }; }; RopeStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] = { nodeData: REF RopeNodeData _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; mem: Mem _ nodeData.mem; rmtw: RemoteMimosaTargetWorld _ nodeData.analyzedRefSeh.rmtw; info: REF CedarOtherPureTypes.RopeInfo _ NARROW[CedarCode.GetNodeRepresentation[valNode, cc]]; ra: REF CARD ~ WITH info.addr SELECT FROM x: REF CARD => x, ENDCASE => NIL; <<>> IF ra=NIL THEN CCE[cirioError, "source ROPE not in target world (and creation there not yet implemented)."]; mem.MemWrite[ra^, bitsPerPtr, zeroBA]; RETURN}; <> RopeLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = BEGIN nodeData: REF RopeNodeData _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; mem: Mem _ nodeData.mem; rmtw: RemoteMimosaTargetWorld _ nodeData.analyzedRefSeh.rmtw; ropeAddr: CirioTypes.CirioAddress _ MakeCirioAddress[mem, rmtw]; <> ropeRepAddr: CirioTypes.CirioAddress _ ropeAddr.followPointer[0, ropeAddr]; IF ropeRepAddr.isNil[ropeRepAddr] THEN RETURN[CedarOtherPureTypes.CreateRopeNode[NIL, cc, NEW [CARD _ 0]]]; {rraCard: CARD ~ mem.MemRead[bitsPerPtr, zeroBA]; repMem: Mem ~ mem.MemIndirect[]; rope: ROPE ~ ReadRope[repMem, nodeData.style, rmtw.nub]; RETURN[CedarOtherPureTypes.CreateRopeNode[rope, cc, NEW [CARD _ rraCard]]]; }END; <<>> rfo: ARRAY RopeStyle OF RECORD [size, case: INT] ~ [pcedar2: [ 01, 62 ], cedar10: [ 32, 30 ] ]; ReadRope: PROC [repMem: Mem, style: RopeStyle, nub: CirioNubAccess.Handle, start: INT _ 0, len: INT _ INT.LAST] RETURNS [ROPE] ~ { tag: CARD _ repMem.MemRead[1, zeroBA]; case: CARD; size: INT; IF len<=0 THEN RETURN [""]; IF style=cedar10 THEN { IF tag#0 THEN RETURN ["!!a wide rope!!"]; tag _ repMem.MemRead[1, CirioMemory.BitsToBa[16]]}; IF tag=0 THEN { length: INT ~ repMem.MemRead[15, CirioMemory.BitsToBa[1]]; limitedLen: INT ~ MIN[len, MIN[length-start, 500]]; charsBS: BitAddr; charsRA: CirioNubAccess.RemoteAddress; chars: REF TEXT; IF limitedLen<=0 THEN RETURN [""]; charsBS _ repMem.MemGetStart[].BaAdd[CirioMemory.BaCons[start, 32]]; charsRA _ [nub, charsBS.aus, charsBS.bits, FALSE, TRUE]; chars _ CirioNubAccess.ReadBytes[charsRA, limitedLen]; RETURN Rope.FromRefText[chars]}; case _ repMem.MemRead[2, CirioMemory.BitsToBa[rfo[style].case]]; size _ repMem.MemRead[IF style=cedar10 THEN 32 ELSE 31, CirioMemory.BitsToBa[rfo[style].size]]; IF start >= size THEN RETURN [""]; len _ MIN[size-start, len]; SELECT case FROM 0 => {--substr baseMem: Mem ~ repMem.MemSubfield[[CirioMemory.BitsToBa[64], CirioMemory.BitsToBa[32]]].MemIndirect[]; istart: INT ~ repMem.MemRead[32, CirioMemory.BitsToBa[96]]; RETURN ReadRope[baseMem, style, nub, start+istart, len]}; 1 => {--concat baseMem: Mem ~ repMem.MemSubfield[[CirioMemory.BitsToBa[64], CirioMemory.BitsToBa[32]]].MemIndirect[]; restMem: Mem ~ repMem.MemSubfield[[CirioMemory.BitsToBa[96], CirioMemory.BitsToBa[32]]].MemIndirect[]; pos: INT ~ repMem.MemRead[32, CirioMemory.BitsToBa[128]]; base, rest: ROPE; IF start>=pos THEN RETURN ReadRope[restMem, style, nub, start-pos, len]; IF start+len <= pos THEN RETURN ReadRope[baseMem, style, nub, start, len]; base _ ReadRope[baseMem, style, nub, start, pos-start]; rest _ ReadRope[restMem, style, nub, 0, start+len-pos]; RETURN base.Concat[rest]}; 2 => {--replace baseMem: Mem ~ repMem.MemSubfield[[CirioMemory.BitsToBa[64], CirioMemory.BitsToBa[32]]].MemIndirect[]; replaceMem: Mem ~ repMem.MemSubfield[[CirioMemory.BitsToBa[96], CirioMemory.BitsToBa[32]]].MemIndirect[]; istart: INT ~ repMem.MemRead[32, CirioMemory.BitsToBa[128]]; oldPos: INT ~ repMem.MemRead[32, CirioMemory.BitsToBa[160]]; newPos: INT ~ repMem.MemRead[32, CirioMemory.BitsToBa[192]]; b1, rr, b2: ROPE _ NIL; IF start0 THEN {n: INT ~ MIN[len, newPos-start]; rr _ ReadRope[replaceMem, style, nub, start-istart, n]; len _ len - n; start _ newPos}; IF len>0 THEN {n: INT ~ MIN[len, size-newPos]; b2 _ ReadRope[baseMem, style, nub, start-newPos+oldPos, len]}; RETURN b1.Cat[rr, b2]}; 3 => RETURN ["!!object-oriented ROPE!!"]; ENDCASE => ERROR}; <> TransparentTypeInfo: TYPE ~ CedarOtherPureTypes.TransparentTypeInfo; AnalyzedUnknownSEH: PUBLIC PROC[seh: SEH, rmtw: RemoteMimosaTargetWorld, explanation: Rope.ROPE, bits: INT] RETURNS[Type] = {RETURN MakeBrokenType[rmtw, explanation, bits]}; MakeBrokenType: PUBLIC PROC[rmtw: RemoteMimosaTargetWorld, explanation: Rope.ROPE, bits: INT] RETURNS[Type] = { IF bits<0 THEN { targetType: Type _ CedarOtherPureTypes.CreateUnknownType[rmtw.cc, explanation]; RETURN[targetType]} ELSE { tti: TransparentTypeInfo ~ NEW [CedarOtherPureTypes.TransparentTypeInfoBody _ [TransparentCreateIndirect, explanation, bits, rmtw]]; targetType: Type _ CedarOtherPureTypes.CreateTransparentType[rmtw.cc, tti]; RETURN[targetType]}; }; UnimplementedTypeNode: PUBLIC PROC[targetType: Type, rmtw: RemoteMimosaTargetWorld, explanation: Rope.ROPE] RETURNS[CirioTypes.Node] = { unknownType: Type _ CedarOtherPureTypes.CreateUnknownType[rmtw.cc, explanation]; RETURN[CedarOtherPureTypes.CreateIndirectToAnUnknownType[unknownType, explanation, rmtw.cc]]; }; TransparentCreateIndirect: PROC[tti: TransparentTypeInfo, cc: CC, indirectType, targetType: Type, mem: Mem] RETURNS[Node] = { tnd: REF TransparentNodeData ~ NEW [TransparentNodeData _ [targetType, indirectType, mem, tti]]; RETURN[CedarCode.CreateCedarNode[TransparentOps, indirectType, tnd]]}; TransparentNodeData: TYPE ~ RECORD [ targetType, indirectType: Type, mem: Mem, tti: TransparentTypeInfo]; TransparentOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ unaryOp: TransparentUnaryOp, store: TransparentStore, load: TransparentLoad]]; TransparentUnaryOp: PROC[op: Operator, type: Type, node: Node, cc: CC] RETURNS[Node] = BEGIN IF op # $address THEN CCE[cirioError, "address is the only supported unary operation on Transparents"] ELSE BEGIN nodeData: REF TransparentNodeData _ NARROW[CedarCode.GetDataFromNode[node]]; rmtw: RemoteMimosaTargetWorld _ NARROW[nodeData.tti.data]; mem: Mem _ nodeData.mem; RETURN[ConvertFromIndirectToPointer[node, mem, rmtw]]; END; END; TransparentStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] = { tnd: REF TransparentNodeData _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; tni: CedarOtherPureTypes.TransparentNodeInfo ~ NARROW[CedarCode.GetNodeRepresentation[valNode, cc]]; mem: Mem _ tnd.mem; rmtw: RemoteMimosaTargetWorld _ NARROW[tnd.tti.data]; tti: TransparentTypeInfo _ tnd.tti; bytes: INT ~ (tti.bits+7)/8; rpad: INT ~ bytes*8 - tti.bits; srcBits: INT ~ tni.val.Length*8-(tni.lpad+tni.rpad); GetBits: PROC [i: INT] RETURNS [bits: BYTE] ~ { bits _ tni.val.InlineFetch[i].ORD; IF tni.lpad#0 THEN { bits _ (bits * (2**tni.lpad)) MOD 256; bits _ bits + (CARDINAL[tni.val.InlineFetch[i.SUCC].ORD] * (2**tni.lpad))/256; bits _ bits+0}; IF i.SUCC=bytes AND tni.rpad#0 THEN bits _ bits/(2**tni.rpad); RETURN}; IF tti.bits # srcBits THEN CCE[operation, IO.PutFR["Trying to store %g transparent bits into %g-bit container", [integer[srcBits]], [integer[tti.bits]] ]]; FOR i: INT IN [0..bytes) DO mem.MemWrite[bits: GetBits[i], bitSize: 8-(IF i=bytes THEN rpad ELSE 0), offset: [aus: i, bits: 0]]; ENDLOOP; RETURN}; TransparentLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = { tnd: REF TransparentNodeData _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; mem: Mem _ tnd.mem; rmtw: RemoteMimosaTargetWorld _ NARROW[tnd.tti.data]; tti: TransparentTypeInfo _ tnd.tti; bytes: INT ~ (tti.bits+7)/8; rpad: INT ~ bytes*8 - tti.bits; i: INT _ 0; val: Rope.ROPE; NextByte: PROC RETURNS [CHAR] ~ { byte: BYTE _ mem.MemRead[bitSize: 8-(IF i=bytes THEN rpad ELSE 0), offset: [aus: i, bits: 0]]; IF (i _ i.SUCC)=bytes THEN byte _ byte*(2**rpad); RETURN [VAL[byte]]}; val _ Rope.FromProc[bytes, NextByte]; RETURN CedarOtherPureTypes.CreateTransparentTypeNode [CCTypes.GetTargetTypeOfIndirect [indirectType], NEW [CedarOtherPureTypes.TransparentNodeInfoBody _ [val, 0, rpad]], cc]}; <> <<(If a general mechanism is possible, I am not sure)>> <<(for the moment, we supply an unimplemented error)>> DummyGetPointer: PUBLIC PROC[data: REF ANY, cc: CC] RETURNS[CirioTypes.Node] = BEGIN CCE[unimplemented]; END; <> <<>> PointerCreateIndirect: PROC [bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type, mem: Mem] RETURNS [Node] ~ { rmtw: RemoteMimosaTargetWorld ~ NARROW[bti.btiData]; referentIndirectType: Type ~ PointerTypes.GetReferentType[targetType]; pi: PointerIndirect ~ NEW [PointerIndirectPrivate _ [rmtw, indirectType, targetType, referentIndirectType, mem]]; RETURN CedarCode.CreateCedarNode[PointerOps, indirectType, pi]}; PointerBitSize: PROC[bti: BasicTypeInfo, cc: CC, indirectType, targetType: Type] RETURNS[CARD] ~ { rmtw: RemoteMimosaTargetWorld ~ NARROW[bti.btiData]; RETURN[bitsPerPtr]}; PointerOps: REF CedarCode.OperationsBody _ NEW[CedarCode.OperationsBody_[ unaryOp: PointerUnaryOp, store: PointerStore, load: PointerLoad]]; PointerIndirect: TYPE ~ REF PointerIndirectPrivate; PointerIndirectPrivate: TYPE = RECORD[ rmtw: RemoteMimosaTargetWorld, ptrIndirectType, ptrDirectType, referentIndirectType: Type, mem: Mem]; PointerUnaryOp: PROC[op: Operator, type: Type, node: Node, cc: CC] RETURNS[Node] = { IF op # $address THEN CCE[cirioError, "address is the only supported unary operation on POINTERs"] ELSE { nodeData: PointerIndirect _ NARROW[CedarCode.GetDataFromNode[node]]; RETURN[ConvertFromIndirectToPointer[node, nodeData.mem, nodeData.rmtw]]; }; }; PointerStore: PROC[valType: Type, valNode: Node, indirectType: Type, indirectNode: Node, cc: CC] = { nodeData: REF RefNodeData ~ NARROW[CedarCode.GetDataFromNode[indirectNode]]; rmtw: RemoteMimosaTargetWorld ~ nodeData.private.rmtw; mem: Mem ~ nodeData.mem; refSize: CARD ~ nodeData.private.size; valInfo: PointerTypes.PointerNodeInfo ~ NARROW[CedarCode.GetNodeRepresentation[valNode, cc]]; IF valInfo=NIL THEN mem.MemWrite[0, bitsPerPtr, zeroBA] ELSE { pointerData: PointerDirect ~ NARROW[valInfo.data]; mem.MemWrite[pointerData.ptrVal, bitsPerPtr, zeroBA]}; RETURN}; PointerLoad: PROC[indirectType: Type, indirectNode: Node, cc: CC] RETURNS[Node] = { nodeData: PointerIndirect _ NARROW[CedarCode.GetDataFromNode[indirectNode]]; rmtw: RemoteMimosaTargetWorld _ nodeData.rmtw; mem: Mem _ nodeData.mem; errMsg: Rope.ROPE _ NIL; referentIndirectType: Type _ nodeData.referentIndirectType; referentDirectType: Type _ CCTypes.GetTargetTypeOfIndirect[referentIndirectType]; <> BEGIN ENABLE { CirioNubAccess.RemoteAddrFault => {errMsg _ IO.PutFR["CirioNubAccess.RemoteAddrFault[byteAddress: %x, valid: %g]", [integer[addr.byteAddress]], [boolean[addr.valid]] ]; GOTO unknownAddress}; CCE => {errMsg _ msg; GOTO unknownAddress}; }; addrBits: CARD ~ mem.MemRead[bitsPerPtr, CirioTypes.zeroBA]; IF addrBits IN [0..8) THEN RETURN[PointerTypes.CreateNilPointerNode[cc]] ELSE BEGIN referentSize: BitAddr _ unspecdBA; {ENABLE CCE => CONTINUE; --MJS August 21, 1990: have to allow for REF RECORD [..SEQUENCE..], which refuses to compute a bitSize (which obviously should take some more parameters) bareReferentSize: CARD ~ CCTypes.GetBitSize[referentIndirectType, cc]; rounded: CARD ~ ((bareReferentSize+(bitsPerTargetWord-1))/bitsPerTargetWord) * bitsPerTargetWord; referentSize _ [aus: rounded/bitsPerAu, bits: rounded MOD bitsPerAu]; }; { targetMem: Mem ~ CreateSimpleMem[addr: NewRMTW.BaToCnra[rmtw.nub, [aus: addrBits, bits: 0]], size: referentSize]; --numeric load cares about the size referentIndirect: Node ~ CCTypes.CreateIndirectNode[referentIndirectType, targetMem, cc]; RETURN ConvertFromIndirectToPointer[referentIndirect, targetMem, rmtw]; }END; EXITS unknownAddress => RETURN[UnimplementedTypeNode[indirectType, rmtw, errMsg]]; END; }; PointerDirect: TYPE ~ REF PointerData; PointerData: TYPE = RECORD[ rmtw: RemoteMimosaTargetWorld, clientTargetType: Type, mem: Mem, ptrVal: CARD]; ConvertFromIndirectToPointer: PUBLIC PROC[indirect: CirioTypes.Node, mem: Mem, rmtw: RemoteMimosaTargetWorld] RETURNS[CirioTypes.Node] = { indirectType: Type _ CedarCode.GetTypeOfNode[indirect]; clientTargetType: Type _ CCTypes.GetTargetTypeOfIndirect[indirectType]; pointerBTI: BasicTypeInfo _ NEW[BasicTypeInfoPrivate _ [PointerCreateIndirect, PointerBitSize, rmtw]]; pointerType: Type _ PointerTypes.CreatePointerType[clientTargetType, rmtw.cc, pointerBTI]; referentStart: BitAddr _ mem.MemGetStart[]; pointerData: PointerDirect _ NEW[PointerData_[ rmtw: rmtw, clientTargetType: clientTargetType, mem: mem, ptrVal: LOOPHOLE[referentStart.aus] ]]; info: PointerTypes.PointerNodeInfo _ NEW[PointerTypes.PointerNodeInfoBody_[ clientTargetType: clientTargetType, indirectToClientTarget: indirect, getAddress: PointerGetAddress, pointerAdd: PointerAdd, pointerCardValue: PointerCardValue, data: pointerData]]; IF referentStart.bits#0 THEN CCE[cirioError, "trying to make a pointer to a non-AU-aligned address"]; RETURN PointerTypes.CreatePointerNode[pointerType, info, rmtw.cc]}; PointerGetAddress: PROC[data: REF ANY, cc: CC] RETURNS[CirioTypes.CirioAddress] = { pointerData: PointerDirect _ NARROW[data]; RETURN[MakeCirioAddress[pointerData.mem, pointerData.rmtw]]}; PointerAdd: PROC[offset: INT, data: REF ANY, cc: CC] RETURNS [CirioTypes.Node] = { oldPointerData: PointerDirect _ NARROW[data]; translatedMem: Mem _ oldPointerData.mem.MemShift[[aus: offset, bits: 0]]; indirectTargetType: Type _ CCTypes.GetIndirectType[oldPointerData.clientTargetType]; in: Node _ CCTypes.CreateIndirectNode[indirectTargetType, translatedMem, cc]; n: Node _ ConvertFromIndirectToPointer[in, translatedMem, oldPointerData.rmtw]; RETURN [n]}; PointerCardValue: PROC[data: REF ANY] RETURNS [CARD] = { pointerData: PointerDirect _ NARROW[data]; ba: BitAddr _ pointerData.mem.MemGetStart[]; IF ba.bits#0 THEN CCE[cirioError, "pointer not byte-aligned!"]; RETURN[LOOPHOLE[ba.aus]]}; <> <<>> MakeCirioAddress: PROC[mem: Mem, rmtw: RemoteMimosaTargetWorld] RETURNS[CirioTypes.CirioAddress] = BEGIN addressData: REF AddressData _ NEW[AddressData_[rmtw, mem, FALSE]]; RETURN[NEW [CirioTypes.CirioAddressBody _ [CirioAddressIsNil, ReadBitsForCirioAddress, WriteBitsForCirioAddress, FollowPointerForCirioAddress, AsCardForCirioAddress, addressData]]]; END; <<>> AddressData: TYPE = RECORD[ rmtw: RemoteMimosaTargetWorld, mem: Mem, nil: BOOL]; CirioAddressIsNil: PROC [data: CirioTypes.CirioAddress] RETURNS [BOOL] ~ { addressData: REF AddressData _ NARROW[data.data]; RETURN [addressData.nil]}; ReadBitsForCirioAddress: PROC [byteOffset: INT _ 0, bitOffset: INT _ 0, bitSize: CARD, data: CirioTypes.CirioAddress] RETURNS [CARD] = { addressData: REF AddressData _ NARROW[data.data]; IF addressData.nil THEN CCE[operation, "Dereferencing NIL in debuggee (CirioAddress)"]; {fullOffset: INT _ byteOffset + bitOffset/8; remainingBitOffset: INT _ bitOffset MOD 8; RETURN addressData.mem.MemRead[bitSize: bitSize, offset: [aus: fullOffset, bits: remainingBitOffset]]}}; WriteBitsForCirioAddress: PROC [byteOffset: INT _ 0, bitOffset: INT _ 0, bitSize: CARD, data: CirioTypes.CirioAddress, bits: CARD] = { addressData: REF AddressData _ NARROW[data.data]; CCE[unimplemented, "write bits through a CirioTypes.CirioAddress impl'd in RMTWPointers"]}; <> FollowPointerForCirioAddress: PROC[byteOffset: INT _ 0, data: CirioTypes.CirioAddress] RETURNS[CirioTypes.CirioAddress] = BEGIN addressData: REF AddressData ~ NARROW[data.data]; IF addressData.nil THEN CCE[operation, "Dereferencing NIL in debuggee (CirioAddress)"]; {mem: Mem ~ addressData.mem; newPointerVal: CARD _ ReadBitsForCirioAddress[byteOffset, 0, 32, data]; newAddr: CirioNubAccess.RemoteAddress _ [ addressData.rmtw.nub, newPointerVal, 0, newPointerVal = 0, TRUE]; newAddressData: REF AddressData _ NEW[AddressData_[ rmtw: addressData.rmtw, mem: noMem, nil: newAddr.nil ]]; IF NOT newAddr.nil THEN { newAddressData.mem _ CreateSimpleMem[newAddr, unspecdBA]}; RETURN[NEW [CirioTypes.CirioAddressBody _ [CirioAddressIsNil, ReadBitsForCirioAddress, WriteBitsForCirioAddress, FollowPointerForCirioAddress, AsCardForCirioAddress, newAddressData]]]; }END; <<>> AsCardForCirioAddress: PROC[data: CirioTypes.CirioAddress] RETURNS[CARD] = { addressData: REF AddressData _ NARROW[data.data]; mem: Mem _ addressData.mem; start: BitAddr _ mem.MemGetStart[]; IF start.bits#0 THEN CCE[cirioError, "asking for non-AU-aligned address as CARD"]; RETURN[LOOPHOLE[start.aus]]}; BaToCnra: PUBLIC PROC [nub: CirioNubAccess.Handle, ba: CirioTypes.BitAddr] RETURNS [CirioNubAccess.RemoteAddress] ~ { RETURN [[nub, ba.aus, ba.bits, ba.aus=0, ba.aus#INT.LAST]]}; END.