-- RemoteRopeImpl.mesa
-- Russ Atkinson, September 10, 1982 2:24 pm
-- last modified on October 21, 1982 12:45 pm by Paul Rovner

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

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

  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 Runtime.BoundsFault;
      rope => {};
      ENDCASE => ERROR Rope.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 => ERROR NoRope; -- we don't support remote user ropes
             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 Runtime.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 Runtime.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 Runtime.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 Runtime.BoundsFault;
                WorldVM.CopyRead[world, addr+InitSize, SubstrSize-InitSize, ptr+InitSize];
                addr _ x.base;
                index _ index + x.start};
             concat  =>
               {IF index >= x.size THEN ERROR Runtime.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 Runtime.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 NoRope; -- temporarily ignore user ropes
             ENDCASE => ERROR NoRope;
         ENDCASE => ERROR NoRope;
      ENDLOOP;
    };

  END.