-- RemoteRopeImpl.mesa
-- Russ Atkinson, April 4, 1983 8:27 pm
-- Paul Rovner, June 29, 1983 5:19 pm

DIRECTORY
AMBridge USING [TVToLC, GetWorld],
AMTypes USING [Class, Error, TVType, TypeClass, UnderType, TV],
RemoteRope USING [],
Rope USING [MakeRope, MapType, FetchType, NoRope, PieceMapType, ROPE],
RuntimeError USING [BoundsFault],
WorldVM USING [Address, CopyRead, World];

RemoteRopeImpl: CEDAR PROGRAM
IMPORTS AMBridge, AMTypes, Rope, RuntimeError, WorldVM
EXPORTS RemoteRope
= BEGIN OPEN Rope, WorldVM;

TV: TYPE = AMTypes.TV;

RemRope: TYPE = LONG POINTER TO RemRopeRep;
RemRopeRep: TYPE =
RECORD
[SELECT tag: * FROM
text => [length: NAT, text: PACKED SEQUENCE max: CARDINAL OF CHAR],
node => [SELECT case: * FROM
substr => [size: INT, base: Address, start: INT, depth: INTEGER],
concat => [size: INT, base, rest: Address, pos: INT,
depth: INTEGER],
replace => [size: INT, base, replace: Address,
start, oldPos, newPos: INT, depth: INTEGER],
object => [size: INT, base: Address, fetch: FetchType,
map: MapType, pieceMap: PieceMapType]
ENDCASE]
ENDCASE];

InitSize: NAT = 3; -- enough to get the tag and the length for all variants

SubstrSize: NAT = SIZE[RemRopeRep[node][substr]];
ConcatSize: NAT = SIZE[RemRopeRep[node][concat]];
ReplaceSize: NAT = SIZE[RemRopeRep[node][replace]];

RopeFromTV: PUBLIC PROC [tv: TV] RETURNS [ROPE] = TRUSTED {
size: INT ← RemoteLength[tv];
IF size = 0 THEN RETURN [NIL];
RETURN [Rope.MakeRope[tv, size, LOOPHOLE[RemoteFetch]]];
};

RemoteLength: PUBLIC PROC [tv: TV] RETURNS [len: INT] = TRUSTED {
world: WorldVM.World ← NIL;
addr: Address ← 0;
scratch: ARRAY [0..16) OF CARDINAL;
ptr: LONG POINTER ← @scratch;
remrope: RemRope ← LOOPHOLE[ptr];
class: AMTypes.Class ←
AMTypes.TypeClass[AMTypes.UnderType[AMTypes.TVType[tv]]];
SELECT class FROM
nil => ERROR RuntimeError.BoundsFault;
rope => {};
ENDCASE => ERROR NoRope;
world ← AMBridge.GetWorld[tv];
addr ← AMBridge.TVToLC[tv];
IF addr = 0 THEN RETURN [0];
WorldVM.CopyRead[world, addr, InitSize, ptr]; -- get tag & size
WITH x: remrope SELECT FROM
text => len ← x.length;
node =>
WITH x: x SELECT FROM
substr => len ← x.size;
concat => len ← x.size;
replace => len ← x.size;
object => len ← x.size;
ENDCASE => ERROR NoRope;
ENDCASE => ERROR NoRope;
};

RemoteFetch: PUBLIC PROC [tv: TV, index: INT] RETURNS [CHAR] = TRUSTED {
world: WorldVM.World ← NIL;
addr: Address ← 0;
scratch: ARRAY [0..16) OF CARDINAL;
ptr: LONG POINTER ← @scratch;
remrope: RemRope ← LOOPHOLE[ptr];
class: AMTypes.Class ←
AMTypes.TypeClass[AMTypes.UnderType[AMTypes.TVType[tv]]];
SELECT class FROM
nil => ERROR RuntimeError.BoundsFault;
rope => {};
ENDCASE => ERROR Rope.NoRope;
world ← AMBridge.GetWorld[tv];
addr ← AMBridge.TVToLC[tv];
DO
x: RemRope ← remrope;
IF index < 0 OR addr = 0 THEN ERROR RuntimeError.BoundsFault;
WorldVM.CopyRead[world, addr, InitSize, ptr]; -- get tag & size
WITH x: x SELECT FROM
text =>
{i: NAT ← index;
odd: NAT ← i MOD 2;
IF index >= x.length THEN ERROR RuntimeError.BoundsFault;
i ← i / 2;
WorldVM.CopyRead[world, addr+2+i, 1, ptr+2]; -- get word containing char
RETURN[x[odd]]; -- get the exact character
};
node =>
WITH x: x SELECT FROM
substr =>
{IF index >= x.size THEN ERROR RuntimeError.BoundsFault;
WorldVM.CopyRead[world, addr+InitSize, SubstrSize-InitSize, ptr+InitSize];
addr ← x.base;
index ← index + x.start};
concat =>
{IF index >= x.size THEN ERROR RuntimeError.BoundsFault;
WorldVM.CopyRead[world, addr+InitSize, ConcatSize-InitSize, ptr+InitSize];
IF index < x.pos THEN {addr ← x.base; LOOP};
addr ← x.rest;
index ← index - x.pos};
replace =>
{IF index >= x.size THEN ERROR RuntimeError.BoundsFault;
WorldVM.CopyRead[world, addr+InitSize, ReplaceSize-InitSize, ptr+InitSize];
IF index < x.start THEN {addr ← x.base; LOOP};
IF index < x.newPos THEN
{addr ← x.replace; index ← index - x.start; LOOP};
addr ← x.base;
index ← index - x.newPos + x.oldPos};
object => ERROR AMTypes.Error[notImplemented, "remote user-defined ropes"];
ENDCASE => ERROR NoRope;
ENDCASE => ERROR NoRope;
ENDLOOP;
};

END.