DIRECTORY
AmpersandContext USING[MakeNodeFromNode],
CCTypes USING[CCError, CCErrorCase, CreateFrameNodeForSelf],
CedarCode USING[ExtractFieldFromNode, GetTypeOfNode, LoadThroughIndirectNode, SelectFieldFromNode, StoreThroughIndirectNode],
CirioNubAccess USING[FileEntry, GetConcreteTypecode, GetFileEntry, GetTypestring, Handle, LookupFileEntryByStemName, LookupMatchingSymEntryByName, LookupMatchingSymEntryByValue, LookupSymEntryByName, ReadBytes, Read32BitsAsCard, SymEntry, WriteCardAs32Bits],
CirioTypes USING[CirioAddress, CirioAddressBody, CompilerContext, Node, Type],
Convert USING[RopeFromCard],
IO USING[card, Error, PutChar, PutF, PutFR, PutRope, rope, STREAM],
NewAmpersandProcs USING[Handle],
PBasics USING[BITAND, BITLSHIFT, BITNOT, BITOR, BITRSHIFT],
PFS USING [RopeFromPath],
Rope,
SystemInterface USING[ShowReport];
BEGIN
CC: TYPE = CirioTypes.CompilerContext;
CCE: ERROR[case: CCTypes.CCErrorCase, msg: Rope.ROPE ← NIL] ← CCTypes.CCError;
Handle: TYPE = NewAmpersandProcs.Handle;
FriendlyFileEntry:
TYPE ~
RECORD[
seqNum: CARD,
commitPoint: BOOL,
fileName: Rope.ROPE,
fOffset: CARD,
fmagic: CARD,
size: CARD,
mtime: CARD,
smagic: CARD,
stamp: Rope.ROPE,
readerData: CARD,
readerDataSize: CARD,
patchReloc: CARD,
patchSize: CARD,
textReloc: CARD,
textSize: CARD,
dataReloc: CARD,
dataSize: CARD,
bssReloc: CARD,
bssSize: CARD,
commonReloc: CARD,
commonSize: CARD];
InstallItems:
PUBLIC
PROC[ampersandContext: CirioTypes.Node, handle: Handle, cc:
CC] =
BEGIN
indirectFrameForSelf: CirioTypes.Node ← CCTypes.CreateFrameNodeForSelf[cc];
indirectTypeForSelf: CirioTypes.Type ← CedarCode.GetTypeOfNode[indirectFrameForSelf];
indirectArgs: CirioTypes.Node ← CedarCode.SelectFieldFromNode["&args", indirectTypeForSelf, indirectFrameForSelf, cc];
indirectTypeForArgs: CirioTypes.Type ← CedarCode.GetTypeOfNode[indirectArgs];
indirectGlobalFrame: CirioTypes.Node ← CedarCode.ExtractFieldFromNode["&enclosingContext", indirectTypeForSelf, indirectFrameForSelf, cc];
indirectTypeForGlobalFrame: CirioTypes.Type ← CedarCode.GetTypeOfNode[indirectGlobalFrame];
indirectGlobalVars: CirioTypes.Node ← CedarCode.SelectFieldFromNode["&globalVars", indirectTypeForGlobalFrame, indirectGlobalFrame, cc];
indirectTypeForGlobalVars: CirioTypes.Type ← CedarCode.GetTypeOfNode[indirectGlobalVars];
globalVars: CirioTypes.Node ← CedarCode.LoadThroughIndirectNode[indirectTypeForGlobalVars, indirectGlobalVars, cc];
typeForGlobalvars: CirioTypes.Type ← CedarCode.GetTypeOfNode[globalVars];
ampersandContextType: CirioTypes.Type ← CedarCode.GetTypeOfNode[ampersandContext];
InstallAnArg:
PROC[name: Rope.
ROPE, argItemName: Rope.
ROPE] =
BEGIN
indirect: CirioTypes.Node ← CedarCode.SelectFieldFromNode[argItemName, indirectTypeForArgs, indirectArgs, cc];
indirectType: CirioTypes.Type ← CedarCode.GetTypeOfNode[indirect];
item: CirioTypes.Node ← CedarCode.LoadThroughIndirectNode[indirectType, indirect, cc];
FinishInstall[name, item];
END;
InstallAGlobal:
PROC[name: Rope.
ROPE, globalItemName: Rope.
ROPE] =
BEGIN
<<indirect: CirioTypes.Node ← CedarCode.SelectFieldFromNode[globalItemName, indirectTypeForGlobalVars, indirectGlobalVars, cc];
indirectType: CirioTypes.Type ← CedarCode.GetTypeOfNode[indirect];>>
item: CirioTypes.Node ← CedarCode.ExtractFieldFromNode[globalItemName, typeForGlobalvars, globalVars, cc];
FinishInstall[name, item];
END;
FinishInstall:
PROC[name: Rope.
ROPE, item: CirioTypes.Node] =
BEGIN
indirectAmpersandNode: CirioTypes.Node ← CedarCode.SelectFieldFromNode[name, ampersandContextType, ampersandContext, cc];
indirectAmpersandType: CirioTypes.Type ← CedarCode.GetTypeOfNode[indirectAmpersandNode];
encapsulatedItem: CirioTypes.Node ← AmpersandContext.MakeNodeFromNode[item, cc];
encapsulatedType: CirioTypes.Type ← CedarCode.GetTypeOfNode[encapsulatedItem];
CedarCode.StoreThroughIndirectNode[encapsulatedType, encapsulatedItem, indirectAmpersandType, indirectAmpersandNode, cc];
END;
InstallAnArg["&&H", "handle"];
InstallAGlobal["&TestProc", "TestProc"];
InstallAGlobal["&MemDump", "MemDump"];
InstallAGlobal["&IndirectMemDump", "IndirectMemDump"];
InstallAGlobal["&RdMem", "RdMem"];
InstallAGlobal["&IndirectRdMem", "IndirectRdMem"];
InstallAGlobal["&PokeCard", "PokeCard"];
InstallAGlobal["&dr", "DecimalRead"];
InstallAGlobal["&LookupFileEntryByStemName", "LookupFileEntryByStemName"];
InstallAGlobal["&LookupSymEntryByName", "LookupSymEntryByName"];
InstallAGlobal["&LookupMatchingSymEntryByName", "NubLookupMatchingSymEntryByName"];
InstallAGlobal["&LookupMatchingSymEntryByValue", "NubLookupMatchingSymEntryByValue"];
InstallAGlobal["&GetFileEntry", "GetFileEntry"];
InstallAGlobal["&RdPath", "RdPath"];
InstallAGlobal["&RdRope", "RdRope"];
InstallAGlobal["&RdXString", "RdXString"];
InstallAGlobal["&RdXStringBody", "RdXStringBody"];
InstallAGlobal["&RdRopeDB", "RdRopeDB"];
InstallAGlobal["&MakeLocalRope5", "MakeLocalRope5"];
InstallAGlobal["&MakeLocalRope10", "MakeLocalRope10"];
InstallAGlobal["&LocalRopeConcat", "LocalRopeConcat"];
InstallAGlobal["&LocalRopeCat", "LocalRopeCat"];
InstallAGlobal["&LocalRopeSubstr", "LocalRopeSubstr"];
InstallAGlobal["&GetTypestring", "GetTypestring"];
InstallAGlobal["&GetConcreteTypecode", "GetConcreteTypecode"];
END;
TestProc:
PROC =
BEGIN
handle: Handle ← GetHandle[];
IO.PutF[handle.out, "hi, ampersand procs here\N"];
END;
Double:
PROC [a: Rope.
ROPE]
RETURNS [Rope.
ROPE]
~ {RETURN a.Concat[a]};
AnaRope:
PROC [a: Rope.
ROPE]
RETURNS [len:
INT, c0:
CHAR] ~ {
len ← a.Length[];
c0 ← IF len>0 THEN a.Fetch[0] ELSE '?;
RETURN};
rgv1: Rope.ROPE ← "rgv1";
rgv2: Rope.ROPE ← "rgv2!";
BytesPerWord: CARD = 4;
DecimalRead:
PROC[addr:
CARD, count:
CARD ← 4] =
BEGIN
handle: Handle ← GetHandle[];
byteAddr: CARD ← (addr/BytesPerWord)*BytesPerWord;
IO.PutF[handle.out, "%g:", IO.card[addr]];
FOR
I:
CARD
IN [0..count)
DO
word: CARD ← CirioNubAccess.Read32BitsAsCard[[handle.nub, byteAddr, 0, FALSE, TRUE]];
IO.PutF[handle.out, " %g", IO.card[word]];
byteAddr ← byteAddr + BytesPerWord;
ENDLOOP;
END;
hexChars: ARRAY [0 .. 15] OF CHAR = ['0, '1, '2, '3, '4, '5, '6, '7, '8, '9, 'A, 'B, 'C, 'D, 'E, 'F];
RdMem:
PROC [addr:
CARD, bytes:
INTEGER ← 16, base:
CARD ← 16]
~ {FullMemDump[addr, bytes, FALSE, base]};
IndirectRdMem:
PROC [addr:
CARD, bytes:
INTEGER ← 16, base:
CARD ← 16]
~ {FullMemDump[addr, bytes, TRUE, base]};
MemDump:
PROC [addr:
CARD, bytes:
INTEGER ← 16]
~ {FullMemDump[addr, bytes, FALSE, 16]};
IndirectMemDump:
PROC [addr:
CARD, bytes:
INTEGER ← 16]
~ {FullMemDump[addr, bytes, TRUE, 16]};
FullMemDump:
PROC [addr:
CARD, bytes:
INTEGER, indirect:
BOOL, base:
CARD] ~ {
addr ← (addr/BytesPerWord)*BytesPerWord;
{len: CARD ~ CARD[bytes];
afterLast: CARD ~ addr + len;
handle: Handle ← GetHandle[];
IF (addr <=
CARD[
INT.
LAST]) # (afterLast <=
CARD[
INT.
LAST])
THEN {
IO.PutF[handle.out, "Can't dump across address sign change (%08x + %08x).\n", [cardinal[addr]], [cardinal[len]] ];
RETURN};
IF indirect
THEN {ur:
CARD ~ addr;
addr ← CirioNubAccess.Read32BitsAsCard[[handle.nub, addr, 0, FALSE, TRUE]];
IF (addr
MOD BytesPerWord) # 0
THEN {
IO.PutF[handle.out, "%08x contains a non-word-aligned pointer (%08x).\n", [cardinal[ur]], [cardinal[addr]] ];
RETURN};
};
IO.PutF[handle.out, "%l", [rope["f"]]];
{ENABLE UNWIND => IO.PutF[handle.out, "%l(dump aborted)\n", [rope["F"]] !IO.Error => CONTINUE];
WHILE bytes>0
DO
bytes ← bytes + 3;
bytes ← bytes - (bytes MOD 4);
SELECT base
FROM
8 => IO.PutF[handle.out, "%08x:", [cardinal[addr]]];
10 =>IO.PutF[handle.out, "%08x:", [cardinal[addr]]];
16 =>IO.PutF[handle.out, "%08x:", [cardinal[addr]]];
ENDCASE => {
IO.PutF[handle.out, "%g is not a valid base. Try 8, 10, or 16.\n", [cardinal[base]]];
RETURN};
{nAsk: NAT ~ MIN[16, bytes];
lb: REF TEXT ~ CirioNubAccess.ReadBytes[[handle.nub, LOOPHOLE[addr], 0, FALSE, TRUE], nAsk];
IF lb.length # nAsk
THEN {
IO.PutF[handle.out, "%lReadBytes[%08x, %g] returned %g bytes.\n", [rope["F"]], [cardinal[addr]], [integer[nAsk]], [integer[lb.length]] ];
RETURN};
{
didVal: BOOLEAN ← FALSE;
tmpVal: CARD ← 0;
FOR i:
NAT
IN [0 .. 16]
DO
IF (i
MOD 4)=0
THEN {
IF didVal
THEN
SELECT base
FROM
8 => handle.out.PutF["%011bB", [cardinal[tmpVal]]];
10 => handle.out.PutF["%010dD", [cardinal[tmpVal]]];
16 => handle.out.PutF["%08xH", [cardinal[tmpVal]]];
ENDCASE => ERROR
ELSE
IF i # 0
THEN
SELECT base
FROM
8 => handle.out.PutF[" "];
10 => handle.out.PutF[" "];
16 => handle.out.PutF[" "];
ENDCASE => ERROR;
tmpVal ← 0;
didVal ← FALSE;
handle.out.PutChar[' ];
};
IF i<bytes
AND i # 16
THEN {
b: BYTE ~ lb[i].ORD;
tmpVal ← tmpVal * 16 * 16 + VAL[b];
didVal ← TRUE;
}
ELSE
IF i # 16
AND didVal
THEN
tmpVal ← tmpVal * 16 * 16;
ENDLOOP;
};
FOR i: NAT IN [0 .. 15] DO
IF (i MOD 4)=0 THEN handle.out.PutChar[' ];
IF i>=bytes THEN handle.out.PutRope[" "] ELSE {
b: BYTE ~ lb[i].ORD;
h: CARDINAL ~ b/16;
l: CARDINAL ~ b MOD 16;
handle.out.PutChar[hexChars[h]];
handle.out.PutChar[hexChars[l]]};
ENDLOOP;
handle.out.PutRope[" - "];
FOR i:
NAT
IN [0 .. 15]
DO
IF (i MOD 8)=0 THEN handle.out.PutChar[' ];
IF i>=bytes THEN handle.out.PutRope[" "]
ELSE
SELECT lb[i]
FROM
<' , >'~ => handle.out.PutChar['.];
ENDCASE => handle.out.PutChar[lb[i]];
ENDLOOP;
handle.out.PutRope["\n"];
addr ← addr + 16;
bytes ← bytes - 16;
}ENDLOOP;
};
IO.PutF[handle.out, "%l", [rope["F"]]]}};
PokeCard:
PROC [addr, val:
CARD, mask:
CARD ← 0FFFFFFFFH] ~ {
handle: Handle ← GetHandle[];
addr ← (addr/BytesPerWord)*BytesPerWord;
{old: CARD ~ CirioNubAccess.Read32BitsAsCard[[handle.nub, addr, 0, FALSE, TRUE]];
maskBar: CARD ~ PBasics.BITNOT[mask];
rem: CARD ~ PBasics.BITAND[old, maskBar];
delt: CARD ~ PBasics.BITAND[val, mask];
new: CARD ~ PBasics.BITOR[rem, delt];
CirioNubAccess.WriteCardAs32Bits[[handle.nub, addr, 0, FALSE, TRUE], new];
RETURN}};
GetTypestring:
PROC [code:
CARD]
RETURNS [string, whyNot: Rope.
ROPE] ~ {
handle: Handle ← GetHandle[];
[string, whyNot] ← CirioNubAccess.GetTypestring[handle.nub, [code]];
RETURN};
GetConcreteTypecode:
PROC [opaque:
CARD]
RETURNS [concrete:
CARD, whyNot: Rope.
ROPE] ~ {
handle: Handle ← GetHandle[];
[[concrete], whyNot] ← CirioNubAccess.GetConcreteTypecode[handle.nub, [opaque]];
RETURN};
LookupFileEntryByStemName:
PROC [stemName: Rope.
ROPE, numToSkip:
INT]
RETURNS [name: Rope.
ROPE, type, value, size, fileSeqNum:
CARD] ~ {
handle: Handle ← GetHandle[];
se: CirioNubAccess.SymEntry ← CirioNubAccess.LookupFileEntryByStemName[handle.nub, stemName, numToSkip];
IF se=NIL THEN RETURN [NIL, 0, 0, 0, 0];
RETURN [se.name, se.type, se.value, se.size, se.fileSeqNum]};
LookupSymEntryByName:
PROC [sym: Rope.
ROPE, caseSensitive:
BOOLEAN, externOnly:
BOOLEAN, numToSkip:
INT]
RETURNS [name: Rope.
ROPE, type, value, size, fileSeqNum:
CARD] ~ {
handle: Handle ← GetHandle[];
se: CirioNubAccess.SymEntry ← CirioNubAccess.LookupSymEntryByName[handle.nub, sym, caseSensitive, externOnly, numToSkip];
IF se=NIL THEN RETURN [NIL, 0, 0, 0, 0];
RETURN [se.name, se.type, se.value, se.size, se.fileSeqNum]};
NubLookupMatchingSymEntryByName:
PROC[symID:
CARD, pattern: Rope.
ROPE, caseSensitive:
BOOLEAN, wantedTypes:
CARD, ignoreClasses:
CARD, numToSkip:
INT]
RETURNS[CirioNubAccess.SymEntry] =
BEGIN
handle: Handle ← GetHandle[];
RETURN[CirioNubAccess.LookupMatchingSymEntryByName[handle.nub, symID, pattern, caseSensitive, wantedTypes, ignoreClasses, numToSkip]];
END;
NubLookupMatchingSymEntryByValue:
PROC[symID:
CARD, val:
CARD, wantedTypes:
CARD, ignoreClasses:
CARD, numToSkip:
INT]
RETURNS[CirioNubAccess.SymEntry] =
BEGIN
handle: Handle ← GetHandle[];
RETURN[CirioNubAccess.LookupMatchingSymEntryByValue[handle.nub, symID, val, wantedTypes, ignoreClasses, numToSkip]];
END;
GetFileEntry:
PROC [seqNum:
CARD]
RETURNS [ffe:
REF FriendlyFileEntry ←
NIL] ~ {
handle: Handle ← GetHandle[];
fe: CirioNubAccess.FileEntry ~ CirioNubAccess.GetFileEntry[handle.nub, seqNum];
IF fe#
NIL
THEN ffe ←
NEW [FriendlyFileEntry ← [
seqNum: fe.seqNum,
commitPoint: fe.commitPoint,
fileName: PFS.RopeFromPath[fe.fileName],
fOffset: fe.fOffset,
fmagic: fe.fmagic,
size: fe.size,
mtime: fe.mtime,
smagic: fe.smagic,
stamp: fe.stamp,
readerData: fe.readerData,
readerDataSize: fe.readerDataSize,
patchReloc: fe.patchReloc,
patchSize: fe.patchSize,
textReloc: fe.textReloc,
textSize: fe.textSize,
dataReloc: fe.dataReloc,
dataSize: fe.dataSize,
bssReloc: fe.bssReloc,
bssSize: fe.bssSize,
commonReloc: fe.commonReloc,
commonSize: fe.commonSize]];
RETURN};
The original version of this procedure took "a: CirioTypes.CirioAddress", which works in the Dorado world, but fails with an internal Cirio error in the Sun world. I should investigate.
"a" is intended to be the numerical byte address of a variable of type Rope.ROPE.
RdXString:
PROC[a:
CARD, nChars:
CARD ← 100] =
BEGIN
handle: Handle ← GetHandle[];
xStringVarAddr: CirioTypes.CirioAddress ← CreateLCAFromCard[a, handle.nub];
xStringBodyVarAddr: CirioTypes.CirioAddress ← xStringVarAddr.followPointer[0, xStringVarAddr];
IF xStringBodyVarAddr.asCard[xStringBodyVarAddr] = 0
THEN
SystemInterface.ShowReport["XString is NIL, maybe this is an XStringBody.", $urgent];
RdXStringBody[xStringBodyVarAddr.asCard[xStringBodyVarAddr], nChars];
END;
RdXStringBody:
PROC[a:
CARD, nChars:
CARD ← 100] =
BEGIN
handle: Handle ← GetHandle[];
xStringBodyVarAddr: CirioTypes.CirioAddress ← CreateLCAFromCard[a, handle.nub];
rope: Rope.ROPE ← " ";
SeeOneChar:
PROC[c:
CHAR] =
{rope ← Rope.Cat[rope, Rope.FromChar[c]]};
GenCharsForXString[xStringBodyVarAddr, 0, nChars, FALSE, SeeOneChar];
SystemInterface.ShowReport[rope, $urgent];
END;
GenCharsForXString:
PROC[a: CirioTypes.CirioAddress, first:
CARD, nChars:
CARD, debug:
BOOLEAN, for:
PROC[
CHAR]] =
BEGIN
suffixSizeF: Field = [0, 16];
homogeneousF: Field = [16, 8];
prefixF: Field = [24, 8];
limitF: Field = [32, 32];
offsetF: Field = [64, 32];
charsF: Field = [96, 32];
siffixSize: CARD ← a.readBits[0, suffixSizeF.offset, suffixSizeF.size, a];
homogeneous: CARD ← a.readBits[0, homogeneousF.offset, homogeneousF.size, a];
prefix: CARD ← a.readBits[0, prefixF.offset, prefixF.size, a];
limit: CARD ← a.readBits[0, limitF.offset, limitF.size, a];
offset: CARD ← a.readBits[0, offsetF.offset, offsetF.size, a];
chars: CARD ← a.readBits[0, charsF.offset, charsF.size, a];
length: CARD ← limit - offset;
handle: Handle ← GetHandle[];
b: CirioTypes.CirioAddress ← CreateLCAFromCard[chars + offset, handle.nub];
n: CARD ← IF first >= length THEN 0 ELSE MIN[length-first, nChars];
ShowClient:
PROC[c:
CHAR]
RETURNS[quit:
BOOL] =
{for[c]; RETURN[FALSE]};
FOR
I:
CARD
IN [0..n)
DO
byte: CARD ← b.readBits[first + I, 0, 8, b];
for[VAL[BYTE[byte]]];
ENDLOOP;
END;
RdPath:
PROC[a:
CARD] =
BEGIN
handle: Handle ← GetHandle[];
pathVarAddr: CirioTypes.CirioAddress ← CreateLCAFromCard[a, handle.nub];
pathObjAddr: CirioTypes.CirioAddress ← pathVarAddr.followPointer[0, pathVarAddr];
privPathObjAddr: CirioTypes.CirioAddress ← pathObjAddr.followPointer[0, pathObjAddr];
RdRopeMain[privPathObjAddr.asCard[privPathObjAddr] + 4, 500, FALSE];
END;
RdRopeMain:
PROC[a:
CARD, nChars:
CARD ← 100, debug:
BOOLEAN ←
FALSE] =
BEGIN
ropeBodyAddr: CirioTypes.CirioAddress ← a.followPointer[0, a];
ropeBodyContents: CARD ← ropeBodyAddr.readBits[0, 0, 32, ropeBodyAddr];
handle: Handle ← GetHandle[];
ropeVarAddr: CirioTypes.CirioAddress ← CreateLCAFromCard[a, handle.nub];
rope: Rope.ROPE ← " ";
SeeOneChar:
PROC[c:
CHAR] =
{rope ← Rope.Cat[rope, Rope.FromChar[c]]};
GenCharsForRope[ropeVarAddr.followPointer[0, ropeVarAddr], 0, nChars, debug, SeeOneChar];
SystemInterface.ShowReport[rope, $urgent];
END;
RdRope:
PROC[a:
CARD, nChars:
CARD ← 100] = { RdRopeMain[a, nChars]; };
RdRopeDB:
PROC[a:
CARD, nChars:
CARD ← 100] = { RdRopeMain[a, nChars,
TRUE]; };
MakeLocalRope5:
PROC [c1, c2, c3, c4, c5:
CHAR ← ' ]
RETURNS [Rope.
ROPE] ~ {
a: ARRAY [1..5] OF CHAR ~ [c1, c2, c3, c4, c5];
i: INT ← 0;
GetChar: PROC RETURNS [CHAR] ~ {RETURN [a[i ← i.SUCC]]};
r: Rope.ROPE ← Rope.FromProc[5, GetChar];
RETURN r.Substr[len: r.Index[s2: " "]]};
MakeLocalRope10:
PROC [c1, c2, c3, c4, c5, c6, c7, c8, c9, c10:
CHAR ← ' ]
RETURNS [Rope.
ROPE] ~ {
a: ARRAY [1..10] OF CHAR ~ [c1, c2, c3, c4, c5, c6, c7, c8, c9, c10];
i: INT ← 0;
GetChar: PROC RETURNS [CHAR] ~ {RETURN [a[i ← i.SUCC]]};
r: Rope.ROPE ← Rope.FromProc[10, GetChar];
RETURN r.Substr[len: r.Index[s2: " "]]};
LocalRopeConcat:
PROC [base, rest: Rope.
ROPE]
RETURNS [Rope.
ROPE]
~ {RETURN Rope.Concat[base, rest]};
LocalRopeCat:
PROC [r1, r2, r3, r4, r5: Rope.
ROPE ←
NIL]
RETURNS [Rope.
ROPE]
~ {RETURN Rope.Cat[r1, r2, r3, r4, r5]};
LocalRopeSubstr:
PROC [base: Rope.
ROPE, start:
INT ← 0, len:
INT ←
INT.
LAST]
RETURNS [Rope.
ROPE]
~ {RETURN Rope.Substr[base, start, len]};
support
GetHandle: PUBLIC SIGNAL RETURNS[Handle] = CODE;
Field: TYPE = RECORD[offset: INT, size: CARD];
The field declarations in the following procedures must agree with Rope.RopeRep in the PCedar world (see [PCedar2.0]<Rope>Rope.mesa)
This procedure assumes that a is the address of a rope body.
GenCharsForRope:
PROC[a: CirioTypes.CirioAddress, first:
CARD, nChars:
CARD, debug:
BOOLEAN, for:
PROC[
CHAR]] =
BEGIN
tagF: Field = [0, 1];
tag: CARD ← a.readBits[tagF.offset, 0, tagF.size, a];
ShowClient:
PROC[c:
CHAR]
RETURNS[quit:
BOOL] =
{for[c]; RETURN[FALSE]};
IF debug THEN SystemInterface.ShowReport[IO.PutFR["tag = %g", IO.rope[Convert.RopeFromCard[tag, 16]]], $debug];
SELECT tag
FROM
0 =>
-- we are looking at a text
BEGIN
lengthF: Field = [1, 15];
maxF: Field = [16, 16];
length: CARD ← a.readBits[0, lengthF.offset, lengthF.size, a];
max: CARD ← a.readBits[0, maxF.offset, maxF.size, a];
n: CARD ← IF first >= length THEN 0 ELSE MIN[length-first, nChars];
FOR
I:
CARD
IN [0..n)
DO
byte: CARD ← a.readBits[4+first+I, 0, 8, a];
for[VAL[BYTE[byte]]];
ENDLOOP;
END;
1 =>
-- we are looking at a node
BEGIN
sizeF: Field = [1, 31];
depthF: Field = [32, 30];
casesF: Field = [62, 2];
size: CARD ← a.readBits[0, sizeF.offset, sizeF.size, a];
depth: CARD ← a.readBits[0, depthF.offset, depthF.size, a];
cases: CARD ← a.readBits[0, casesF.offset, casesF.size, a];
n: CARD ← IF first >= size THEN 0 ELSE MIN[size-first, nChars];
IF n > 0
THEN
SELECT cases
FROM
0 =>
-- substr
BEGIN
baseF: Field = [64, 32];
startF: Field = [96, 32];
base: CirioTypes.CirioAddress ← a.followPointer[baseF.offset/8, a];
start: CARD ← a.readBits[0, startF.offset, startF.size, a];
IF debug THEN [] ← Rope.Map[base: "??substr??", action: ShowClient];
GenCharsForRope[base, start, n, debug, for];
END;
1 =>
-- concat
BEGIN
baseF: Field = [64, 32];
restF: Field = [96, 32];
posF: Field = [128, 32];
base: CirioTypes.CirioAddress ← a.followPointer[baseF.offset/8, a];
rest: CirioTypes.CirioAddress ← a.followPointer[restF.offset/8, a];
pos: CARD ← a.readBits[0, posF.offset, posF.size, a];
IF debug THEN [] ← Rope.Map[base: "??concat??", action: ShowClient];
IF first < pos
THEN
BEGIN
GenCharsForRope[base, first, MIN[pos-first, n], debug, for];
IF n > pos-first THEN GenCharsForRope[rest, 0, n-pos+first, debug, for];
END
ELSE
GenCharsForRope[rest, first-pos, n, debug, for];
END;
2 =>
BEGIN
baseF: Field = [64, 32];
replaceF: Field = [96, 32];
startF: Field = [128, 32];
oldPosF: Field = [160, 32];
newPosF: Field = [192, 32];
base: CirioTypes.CirioAddress ← a.followPointer[baseF.offset/8, a];
replace: CirioTypes.CirioAddress ← a.followPointer[replaceF.offset/8, a];
start: CARD ← a.readBits[0, startF.offset, startF.size, a];
oldPos: CARD ← a.readBits[0, oldPosF.offset, oldPosF.size, a];
newPos: CARD ← a.readBits[0, newPosF.offset, newPosF.size, a];
IF debug THEN [] ← Rope.Map[base: "??replace??", action: ShowClient];
IF n > 0
AND first < start
THEN
BEGIN
GenCharsForRope[base, first, MIN[n, start-first], debug, for];
first ← start;
n ← n-MIN[n, start-first];
IF n > 0
AND first < newPos
THEN
BEGIN
GenCharsForRope[replace, first-start, MIN[n, newPos-first], debug, for];
first ← newPos;
n ← n - MIN[n, newPos-first];
END;
IF n > 0
AND first < size
THEN
GenCharsForRope[base, first-newPos+oldPos, n, debug, for];
END;
3 => [] ← Rope.Map[base: "??ObjectRope??", action: ShowClient];
ENDCASE => CCE[cirioError];
END;
ENDCASE => CCE[cirioError];
END;
Local CirioAddress impl (for RdRope, since we can't at the moment define RdRope to take a CirioAddress as an argument, for unknown reasons)
CreateLCAFromCard:
PROC[addr:
CARD, nub: CirioNubAccess.Handle]
RETURNS[CirioTypes.CirioAddress] =
BEGIN
RETURN[
NEW[CirioTypes.CirioAddressBody←[
readBits: LCAReadBits,
writeBits: LCAWriteBits,
followPointer: LCAFollowPointer,
asCard: LCAAsCard,
data: NEW[LCADataBody ← [nub, addr]]]]];
END;
LCAData: TYPE = REF LCADataBody;
LCADataBody:
TYPE =
RECORD[
nub: CirioNubAccess.Handle,
byteAddr: CARD];
only works for fields that do not cross word boundaries
adapted from RMTWFrames.UBFReadBits
LCAReadBits:
PROC[byteOffset:
INT ← 0, bitOffset:
INT ← 0, bitSize:
CARD, data: CirioTypes.CirioAddress]
RETURNS[
CARD] =
BEGIN
lcaData: LCAData ← NARROW[data.data];
fullByteOffset: INT ← byteOffset + bitOffset/8;
fullByteAddr: INT ← lcaData.byteAddr+fullByteOffset;
cardByteAddr: CARD ← (fullByteAddr/4)*4;
remainingBitOffset: INT ← (fullByteAddr MOD 4)*8 + (bitOffset MOD 8);
cardVal: CARD ← CirioNubAccess.Read32BitsAsCard[[lcaData.nub, cardByteAddr, 0, FALSE, TRUE]];
RETURN[PBasics.
BITRSHIFT[PBasics.
BITLSHIFT[cardVal, remainingBitOffset],
32-bitSize]];
END;
LCAWriteBits:
PROC[byteOffset:
INT ← 0, bitOffset:
INT ← 0, bitSize:
CARD, data: CirioTypes.CirioAddress, bits:
CARD] =
BEGIN
ERROR
END;
LCAFollowPointer:
PROC[byteOffset:
INT ← 0, data: CirioTypes.CirioAddress]
RETURNS[CirioTypes.CirioAddress] =
BEGIN
lcaData: LCAData ← NARROW[data.data];
pointer: CARD ← data.readBits[byteOffset, 0, 32, data];
RETURN[CreateLCAFromCard[pointer, lcaData.nub]];
END;
LCAAsCard:
PROC[data: CirioTypes.CirioAddress]
RETURNS[
CARD] =
BEGIN
lcaData: LCAData ← NARROW[data.data];
RETURN[lcaData.byteAddr];
END;
END..