Ref Types
For the moment we can not handle ref any. This will require help from the nub to find text strings. Moreover, we can not deliver the code at type time until we get help from the nub. So, I deliver 0.
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;
we nest a block to handle unknown address, allowing nodeData to be visible
{
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<bitsPerTargetWord
THEN {
referentOffset ← CirioTypes.BaCons[addrBits, bitsPerTargetWord - bareReferentSize];
referentSize ← CirioTypes.BitsToBa[bareReferentSize];
}
ELSE {
rounded: CARD ~ ((bareReferentSize+(bitsPerTargetWord-1))/bitsPerTargetWord) * bitsPerTargetWord;
referentSize ← CirioTypes.BitsToBa[rounded]};
};
{
targetMem: Mem ~ CreateSimpleMem[addr: NewRMTW.BaToCnra[rmtw.nub, referentOffset], size: referentSize];
referentIndirect: Node ~ CCTypes.CreateIndirectNode[targetIndirectType, targetMem, cc];
IF isAtom
THEN {
ani: Atoms.AtomNodeInfo ~
NEW [Atoms.AtomNodeInfoBody ← [
atomRecType: targetDirectType,
atomRecNode: referentIndirect,
getPointer: GetAtomPointer,
data: NEW [CARD ← addrBits]]];
RETURN Atoms.CreateAtomNode[targetDirectType, ani, cc];
}
ELSE {
info: RefTypes.RefNodeInfo ~
NEW[RefTypes.RefNodeInfoBody ← [
clientTargetType: targetDirectType, -- this is the predicted target type
codeForClientTargetType: 0, -- actually, I could read this from memory, perhaps I should and check it against the predicted value, once I am able to predict.
indirectToClientTarget: referentIndirect,
data: NEW [CARD ← addrBits]]];
RETURN[RefTypes.CreateRefNode[nodeData.private.directRefType, info, cc]];
};
}};
EXITS
unknownAddress => 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"]};
Procedures
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,
<Symbols.lL => 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["<BTH: mob=%g, bti=%xH>", [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]};
now lets pick up the results, clean up, and return
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]]]};
exploratory code
a major issue is how we recognize a rope, must catch all REF Rope.RopeRep??
intercepting Rope.RopeRep is not good enough, because we have to catch all stores of rope literals to a REF Rope.RopeRep.
The following procedures follow the pattern of ordinary types
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};
this routine collects up to 500 chars of the rope. Perhaps we should change CedarOtherPureTypes interface to allow for a late collection of the chars, so we only need to collect as many as are needed. (further, we could collect more than 500 if the client wanted.)
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];
perhaps we should work in terms of the typed rep, instead of working in terms of the bits
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 start<istart
THEN {n:
INT ~
MIN[istart-start, len];
b1 ← ReadRope[baseMem, style, nub, start, n];
len ← len - n;
start ← istart};
IF start<newPos
AND len>0
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};
unimplemented types etc
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]};
Get Pointer mechanism
(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;
Now we get down to business. (more or less, still basically unimplemented because pointers are now (September 1, 1989 10:19:36 am PDT) confused in my mind.)
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];
we nest a block to handle unknown address, allowing nodeData to be visible
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]]};
Cirio Address
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]]};