-- RemoteRopeImpl.mesa -- Russ Atkinson, April 4, 1983 8:27 pm -- Paul Rovner, October 21, 1982 12:45 pm DIRECTORY AMBridge USING [TVToLC, GetWorld], AMTypes USING [Class, Error, 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 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 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 AMTypes.Error[notImplemented, "remote user-defined ropes"]; ENDCASE => ERROR NoRope; ENDCASE => ERROR NoRope; ENDLOOP; }; END. ΚΟ– "Mesa" style˜IprocšΚΟciœΟk œ žœžœ<žœ žœ4žœ žœžœ žœžœ.ž œžœ-žœžœžœ%žœžœžœžœžœžœ žœžœžœžœžœžœžœžœžœ žœ'žœžœ žœ(žœžœ)žœ)žœRžœ žœ(žœ}žœ žœžœ9œžœžœ*žœžœ+žœžœ Οn œžœžœžœžœžœžœ žœžœ žœžœžœžœžœŸ œžœžœžœžœžœžœžœ&žœ žœžœ ž œ$žœfžœžœžœ.žœžœPžœ žœžœ8œžœ žœžœ8žœžœžœ–œ žœžœžœžœŸ œžœžœžœ žœžœžœžœžœ&žœ žœžœ ž œ$žœkžœžœžœ.žœžœUžœ%žœ žœ žœžœKœžœžœžœ!žœžœžœžœžœžœfœ žœ œ+žœžœžœ(žœžœžœβžœžœžœžœžœžœržœžœžœ‚žœžœžœžœžœ@žœožœ<œ žœžœžœžœžœ žœ˜†'—…—ˆ]