DIRECTORY
AmpersandContext USING[MakeNodeFromNode],
Basics USING[BITAND, BITLSHIFT, BITNOT, BITOR, BITRSHIFT],
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,
NewAmpersandProcs USING[Handle],
PFS USING [RopeFromPath],
Rope,
SystemInterface USING[ShowReport];

NewAmpersandProcsImpl: CEDAR PROGRAM IMPORTS AmpersandContext, Basics, CCTypes, CedarCode, CirioNubAccess, Convert, IO, PFS, Rope, SystemInterface EXPORTS NewAmpersandProcs =

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.PutRope[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.PutF1[handle.out, "%g:", IO.card[addr]];
FOR I: CARD IN [0..count) DO
word: CARD ฌ CirioNubAccess.Read32BitsAsCard[[handle.nub, byteAddr, 0, FALSE, TRUE]];
IO.PutF1[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.PutF1[handle.out, "%l", [rope["f"]]];
{ENABLE UNWIND => IO.PutF1[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.PutF1[handle.out, "%08x:", [cardinal[addr]]];
10 =>IO.PutF1[handle.out, "%08x:", [cardinal[addr]]];
16 =>IO.PutF1[handle.out, "%08x:", [cardinal[addr]]];
ENDCASE => {
IO.PutF1[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.PutFL[handle.out, "%lReadBytes[%08x, %g] returned %g bytes.\n", LIST[[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.PutF1["%011bB", [cardinal[tmpVal]]];
10 => handle.out.PutF1["%010dD", [cardinal[tmpVal]]];
16 => handle.out.PutF1["%08xH", [cardinal[tmpVal]]];
ENDCASE => ERROR
ELSE IF i # 0 THEN
SELECT base FROM
8 => handle.out.PutRope["            "];
10 => handle.out.PutRope["           "];
16 => handle.out.PutRope["         "];
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;
};
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.PutF1[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 ~ Basics.BITNOT[mask];
rem: CARD ~ Basics.BITAND[old, maskBar];
delt: CARD ~ Basics.BITAND[val, mask];
new: CARD ~ Basics.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};


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.Concat[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
handle: Handle ฌ GetHandle[];
ropeVarAddr: CirioTypes.CirioAddress ฌ CreateLCAFromCard[a, handle.nub];
rope: Rope.ROPE ฌ "  ";
SeeOneChar: PROC[c: CHAR] =
{rope ฌ Rope.Concat[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]};


GetHandle: PUBLIC SIGNAL RETURNS[Handle] = CODE;


Field: TYPE = RECORD[offset: INT, size: CARD];


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.PutFR1["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];
END;

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;




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];

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[Basics.BITRSHIFT[Basics.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..
ถ
NewAmpersandProcsImpl.mesa
Copyright ำ 1990, 1991, 1992 by Xerox Corporation.  All rights reserved.
Sturgis, April 3, 1990 11:17 am PDT
Spreitze, May 31, 1990 8:55 am PDT
Last tweaked by Mike Spreitzer on December 23, 1991 10:19 am PST
Laurie Horton, January 28, 1992 2:51 pm PST
Philip James, March 6, 1992 11:21 am PST
Willie-s, May 15, 1992 2:42 pm PDT
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;
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.
ropeBodyAddr: CirioTypes.CirioAddress _ a.followPointer[0, a];
ropeBodyContents: CARD _ ropeBodyAddr.readBits[0, 0, 32, ropeBodyAddr];
support
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.
Local CirioAddress impl (for RdRope, since we can't at the moment define RdRope to take a CirioAddress as an argument, for unknown reasons)
only works for fields that do not cross word boundaries
adapted from RMTWFrames.UBFReadBits
สฒ•NewlineDelimiter

–
(cedarcode) style™
codeš
œ™Kšœ
ฯe
œ=™HKš
œ#™#K™"K™@K™+K™(K™"—K˜š
ฯk	˜	Kšœžœ˜)Kš
œžœ
žœž	œžœžœž	œ˜:Kšœžœ/˜<Kšœ
žœn˜}Kšœžœ๎
˜‚Kšœžœ>˜NKšœžœ˜Kšžœ
˜Kšœžœ	˜ Kšžœ
žœ˜Kš
œ˜Kšœžœ
˜"K˜—Kšฯnœžœ
žœ
žœHžœžœžœ˜ฎ
˜Kš
ž˜Kšžœžœ˜&Kšžœžœ&žœžœ˜NK˜Kšœžœ˜(K˜šœžœžœ
˜!Kšœžœ
˜
Kšœ
žœ
˜Kšœžœ
˜Kšœ	žœ
˜Kšœžœ
˜
Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜
Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kšœžœ
˜Kšœ
žœ
˜Kšœžœ
˜Kšœ
žœ
˜Kšœ
žœ
˜Kšœ	žœ
˜Kšœ
žœ
˜Kšœžœ˜—K˜šŸœžœ
žœ8žœ˜VKš
ž˜K˜KK˜UK˜vK˜NK˜Š
K˜[K˜ˆ
K˜YK˜sK˜IK˜RK˜šŸœžœžœžœ˜=Kš
ž˜K˜nK˜BK˜VK˜Kš
œ˜Kšžœ
˜—K˜šŸœžœžœžœ˜BKš
ž˜K˜K˜DK˜jK˜Kš
œ˜Kšžœ
˜—K˜K˜šŸ
œžœžœ˜=Kš
ž˜K˜yK˜XK˜PK˜NKš
œy˜yKšžœ
˜—K˜K˜Kš
œ(˜(Kš
œ&˜&Kš
œ6˜6Kš
œ"˜"Kš
œ2˜2Kš
œ(˜(Kš
œ%˜%Kš
œJ˜JKš
œ@˜@Kš
œS˜SKš
œU˜UKš
œ0˜0Kš
œ$˜$Kš
œ$˜$Kš
œ*˜*Kš
œ2˜2Kš
œ(˜(Kš
œ4˜4Kš
œ6˜6Kš
œ6˜6Kš
œ0˜0Kš
œ6˜6Kš
œ2˜2Kš
œ>˜>Kšžœ
˜—K˜šŸœžœ˜Kš
ž˜K˜Kšžœ3˜5Kšžœ
˜—K˜š
Ÿœžœ
žœžœžœ
˜/Kšœžœ˜—K˜šŸœžœ
žœžœžœžœ˜=K˜Kšœžœžœžœ˜&Kšžœ˜—K˜Kšœžœ
˜Kšœžœ˜K˜KšŸœžœ˜šŸœžœžœ	žœ˜0Kš
ž˜K˜Kšœ
žœ$˜2Kšžœžœ
˜+š	žœ
Ÿ
œžœ
žœž˜Kšœžœ=žœžœ˜UKšžœžœ
˜+K˜#Kšžœ
˜—Kšžœ
˜—K˜Kšœ
žœžœ
žœD˜eK˜š
Ÿœžœžœ	žœ
žœ˜>Kšœžœ	˜*K˜—š
Ÿ
œžœžœ	žœ
žœ˜FKšœžœ	˜)K˜—šŸœžœžœ	žœ˜/Kšœžœ˜(—K˜šŸœžœžœ	žœ˜7Kšœžœ˜'—K˜šŸœžœžœ	žœžœžœ˜NK˜(Kšœžœžœ˜Kšœžœ˜K˜šžœ
žœ
žœ
žœžœ
žœ
žœžœ˜BKšžœp˜rKšžœ˜—šžœ
žœžœ˜"Kšœ=žœžœ˜Kšžœžœžœ˜%Kšžœk˜mKšžœ˜—K˜—Kšžœ&˜(Kšœ
žœ
žœžœ6žœ
žœ˜`šžœ	ž˜K˜K˜šžœž˜Kšœžœ.˜5Kšœžœ.˜5Kšœžœ.˜5š
œ˜KšžœU˜WKšžœ˜——Kšœžœžœ˜Kšœžœ
žœ)žœžœžœ	˜\šžœžœ˜KšžœAžœI˜
Kšžœ˜—Kš
œ
˜
Kšœžœžœ
˜Kšœžœ˜šžœžœ
žœž˜šžœžœžœ˜šžœž˜šžœž˜K˜4K˜5K˜4Kšžœž˜——šžœ
žœž˜šžœž˜K˜(K˜(K˜&Kšžœžœ
˜——K˜Kšœ	žœ
˜Kš
œ˜K˜—šžœ	žœžœ˜Kšœžœ	žœ
˜Kšœžœ˜#Kšœ	žœ
˜K˜
—šžœ
žœ	žœž˜K˜—Kšžœ
˜K˜—šžœžœ
žœž™Kšžœžœžœ™+šžœ
žœžœ™0Kšœžœ	žœ
™Kšœžœ™Kšœžœžœ™K™ K™!—Kšžœ
™—K˜šžœžœ
žœž˜Kšžœžœžœ˜+Kšžœ
žœ˜(šžœ
žœž˜K˜#Kšžœ˜%—Kšžœ
˜—K˜K˜K˜Kšœ
žœ
˜	—Kš
œ˜Kšžœ(˜*—K˜šŸœžœ
žœžœ˜=K˜K˜(Kšœžœ9žœžœ˜QKšœ	žœ
žœ˜$Kšœžœ
žœ˜(Kšœžœ
žœ˜&Kšœžœ
žœ˜$Kšœ7žœžœ˜JKšžœ˜	—K˜š
Ÿ
œžœžœžœžœ˜HK˜K˜DKšžœ˜K˜—šŸœžœ
žœžœžœžœ˜XK˜K˜PKšžœ˜K˜—šŸœžœžœ
žœžœ
žœ!žœ˜ˆ
K˜K˜hKš
žœžœ
žœ
žœžœ˜(Kšžœ7˜=—K˜šŸœžœžœžœžœ
žœžœ
žœ!žœ˜ซ
K˜K˜yKš
žœžœ
žœ
žœžœ˜(Kšžœ7˜=—K˜šŸœžœžœžœžœžœžœ
žœžœ˜น
Kš
ž˜K˜Kšžœ€
˜†
Kšžœ
˜—K˜šŸ œžœžœžœžœžœ
žœžœ˜™
Kš
ž˜K˜Kšžœn˜tKšžœ
˜—K˜šŸœžœ
žœžœžœžœ˜PK˜Kš
œO˜Ošžœžœ
žœžœ˜/Kš
œ˜Kš
œ˜Kšœ
žœ˜(Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ"˜"Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜—Kšžœ˜K˜Kš
œบ
™บ
K™Q—K˜šŸ	œžœžœ
žœ	˜.Kš
ž˜K˜K˜KK˜^šžœ3ž˜9K˜U—Kš
œE˜EKšžœ
˜K˜—šŸ
œžœžœ
žœ	˜2Kš
ž˜K˜K˜OKšœžœžœ
˜šŸ
œžœžœ˜K˜-—Kšœ2žœ˜EK˜*Kšžœ
˜K˜—šŸœžœ$žœ
žœ	žœžœ
žœ˜rKš
ž˜K˜K˜K˜K˜K˜K˜Kšœžœ:˜JKšœ
žœ<˜MKšœžœ2˜>Kšœžœ0˜;Kšœžœ2˜>Kšœžœ0˜;Kšœžœ˜K˜K˜K˜KKšœžœžœžœžœ
žœ˜Cš
Ÿ
œžœžœžœžœ˜/Kšœ	žœ
žœ˜—K˜š	žœ
Ÿ
œžœ
žœž˜Kšœžœ"˜,Kšœžœ
žœ	˜Kšžœ
˜—Kšžœ
˜K˜—šŸœžœžœ˜Kš
ž˜K˜K˜HK˜QK˜UKšœ=žœ˜DKšžœ
˜K˜—šŸ
œžœžœ
žœžœžœ˜GKš
ž˜Kš
œ>™>Kšœžœ1™GK˜K˜HKšœžœžœ
˜šŸ
œžœžœ˜K˜-—Kš
œY˜YK˜*Kšžœ
˜K˜—šŸœžœžœ
žœ%˜GK˜—š
Ÿœžœžœ
žœ"žœ˜OK˜—š
Ÿœžœžœžœžœ˜LKšœžœžœ
žœ˜/Kšœžœ˜KšŸœžœ
žœžœžœ
žœ˜8Kšœžœ˜)Kšžœ"˜(—K˜š
Ÿœžœ+žœžœžœ˜bKšœžœ	žœ
žœ-˜EKšœžœ˜KšŸœžœ
žœžœžœ
žœ˜8Kšœžœ˜*Kšžœ"˜(—K˜š
Ÿœžœžœžœžœ
˜AKšœžœ˜#—K˜šŸœžœžœžœžœžœ
˜LKšœžœ˜(—K˜šŸœžœ
žœ	žœžœžœ
žœžœžœ
˜`Kšœžœ ˜)—K˜Kš
œ™K˜Kš
Ÿ	œžœ
žœ
žœžœ
˜0K˜K˜Kš	œžœžœ	žœžœ˜.˜Kš
œ„
™„
—˜Kš
œ<™<—šŸœžœ$žœ
žœ	žœžœ
žœ˜oKš
ž˜K˜Kšœžœ,˜5š
Ÿ
œžœžœžœžœ˜/Kšœ	žœ
žœ˜K˜—Kšžœžœžœžœ/˜qšžœž˜šœฯc˜ Kš
ž˜K˜K˜Kšœžœ2˜>Kšœžœ,˜5Kšœžœžœžœžœ
žœ˜CK˜š	žœ
Ÿ
œžœ
žœž˜Kšœžœ"˜,Kšœžœ
žœ	˜Kšžœ
˜—Kšžœ
˜—šœ ˜ Kš
ž˜K˜K˜K˜Kšœžœ.˜8Kšœžœ0˜;Kšœžœ0˜;Kšœžœžœžœžœ
žœ˜?šžœž˜
šžœž˜šœ 	˜Kš
ž˜Kš
œ˜Kš
œ˜K˜CKšœžœ0˜;Kšžœžœ7˜DK˜,Kšžœ
˜—šœ 	˜Kš
ž˜Kš
œ˜Kš
œ˜Kš
œ˜K˜CK˜CKšœžœ,˜5Kšžœžœ7˜Dšžœ
ž˜Kš
ž˜Kšœžœ˜<Kšžœžœ3˜HKš
ž˜—šœ
ž˜K˜0—Kšžœ
˜—š
œ˜Kš
ž˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜K˜CK˜IKšœžœ1˜<Kšœžœ3˜?Kšœžœ3˜?Kšžœžœ8˜EK˜šžœžœž˜Kš
ž˜Kšœžœ˜>K˜Kšœžœ˜šžœ
˜K˜——šžœžœž˜ Kš
ž˜Kšœ&žœ˜HK˜Kšœžœ˜Kšžœ
˜—K˜šžœžœž˜Kš
œ:˜:K˜—Kšžœ
˜—K˜?Kšžœžœ
˜——Kšžœ
˜—Kšžœžœ
˜—Kšžœ
˜—K˜K˜K˜™‹
K˜šŸœžœžœžœ˜bKš
ž˜šžœ
žœ˜(Kš
œ˜Kš
œ˜Kš
œ ˜ Kš
œ˜Kšœžœ˜(—Kšžœ
˜—K˜K˜Kšœ	žœžœ
˜ šœ
žœžœ
˜K˜Kšœ
žœ˜—˜K™7Kš
œ#™#—šŸœžœ
žœžœžœ!žœ
žœ˜xKš
ž˜Kšœžœ˜%Kšœžœ˜/Kšœžœ#˜4Kšœžœ˜(Kšœžœžœžœ˜EKšœ	žœBžœžœ˜]šžœž	œž	œ˜FKš
œ
˜
—Kšžœ
˜—K˜šŸœžœ
žœžœžœ'žœ˜wKš
ž˜Kš
ž˜Kšžœ
˜—K˜šŸœžœ
žœ%žœ˜mKš
ž˜Kšœžœ˜%Kšœ	žœ*˜7Kšžœ*˜0Kšžœ
˜—K˜šŸ	œžœ žœ
žœ˜>Kš
ž˜Kšœžœ˜%Kšžœ˜Kšžœ
˜—K˜—Kšžœ˜——…—Qpmุ