-- CardAddrsImpl.Mesa
-- written by Paxton. March 1981
-- last written by Paxton. April 9, 1981 9:11 AM

-- **** Persistent addressing ****

DIRECTORY
SafeStorage,
CardAddrs;

CardAddrsImpl: PROGRAM
IMPORTS SafeStorage
EXPORTS CardAddrs =
BEGIN OPEN CardAddrs;

Ref: TYPE = REF Body;
Body: PUBLIC TYPE = RECORD [addrs: Pair];

Pair: TYPE = REF PairBody;
PairBody: TYPE = RECORD [next: Pair, addr: REF, location: Card];

qZone: ZONE ← SafeStorage.NewZone[quantized];

Create: PUBLIC PROC RETURNS [Ref] = { RETURN [qZone.NEW[Body]] };

FindPair: PROC [ref: Ref, addr: REF] RETURNS [Pair] = INLINE {
IF ref#NIL THEN
FOR p: Pair ← ref.addrs, p.next UNTIL p=NIL DO
IF p.addr = addr THEN RETURN [p]; ENDLOOP;
RETURN [NIL] };

PutAddr: PUBLIC PROC [ref: Ref, addr: REF, location: Card] = {
-- assigns addr to location in ref
-- ok if addr was previously assigned elsewhere
p: Pair;
IF (p ← FindPair[ref, addr])=NIL THEN
ref.addrs ← qZone.NEW[PairBody ← [ref.addrs, addr, location]]
ELSE p.location ← location };

RemAddr: PUBLIC PROC [ref: Ref, addr: REF] = {
-- removes the given addr
p, prev: Pair;
IF ref=NIL OR (p ← ref.addrs)=NIL THEN RETURN;
IF p.addr=addr THEN { ref.addrs ← p.next; RETURN };
DO
prev ← p; p ← p.next;
IF p=NIL THEN RETURN;
IF p.addr=addr THEN { prev.next ← p.next; RETURN };
ENDLOOP };

GetAddr: PUBLIC PROC [ref: Ref, addr: REF] RETURNS [location: Card] = {
-- generates ERROR AddrNotFound if the addr is not in the mapping
p: Pair;
IF (p ← FindPair[ref, addr])=NIL THEN ERROR AddrNotFound;
RETURN [p.location] };

TryGetAddr: PUBLIC PROC [ref: Ref, addr: REF]
RETURNS [found: BOOLEAN, location: Card] = {
p: Pair;
IF (p ← FindPair[ref, addr])=NIL THEN RETURN [FALSE, 0];
RETURN [TRUE, p.location] };

AddrNotFound: PUBLIC ERROR = CODE;

MapAddrs: PUBLIC PROC [ref: Ref, action: MapAddrsAction]
RETURNS [BOOLEAN] = {
-- apply the action to each addr&location pair for the ref
-- returns true if&when an action returns true
IF ref#NIL THEN {
p: Pair ← ref.addrs;
UNTIL p=NIL DO
next: Pair ← p.next;
IF action[p.addr, p.location] THEN RETURN [TRUE];
p ← next;
ENDLOOP};
RETURN [FALSE] };

-- **** Editing Operations for persistent addrs ****

BadMove: PUBLIC ERROR = CODE;
BadTranspose: PUBLIC ERROR = CODE;

Replace: PUBLIC PROC [ref: Ref, start, len, newlen: Card] = {
-- replace chars in [start..start+len) by newlen chars
-- addrs that are in the replaced section move to start
-- add (newlen-len) to locations that are after the replaced section
end: Card ← start+len;
IF ref=NIL THEN RETURN;
FOR p: Pair ← ref.addrs, p.next UNTIL p=NIL DO
SELECT p.location FROM
>= end => p.location ← p.location-len+newlen;
>= start => p.location ← start;
ENDCASE;
ENDLOOP};

AfterReplace: PUBLIC PROC [initLoc, start, len, newlen: Card]
RETURNS [newLoc: Card] = {
newLoc ← SELECT initLoc FROM
>= start+len => initLoc-len+newlen,
>= start => start,
ENDCASE => initLoc};

Move: PUBLIC PROC [ref: Ref, dest, start, len: Card] = {
-- dest must not be in (start..start+len)
p: Pair;
end: Card ← start+len;
IF ref=NIL OR (p ← ref.addrs)=NIL THEN RETURN;
SELECT dest FROM
< start => DO
SELECT p.location FROM
>= end => NULL;
>= start => p.location ← p.location+dest-start;
>= dest => p.location ← p.location+len;
ENDCASE;
IF (p ← p.next)=NIL THEN EXIT;
ENDLOOP;
>= end => DO
SELECT p.location FROM
>= dest => NULL;
>= end => p.location ← p.location-len;
>= start => p.location ← p.location+dest-end;
ENDCASE;
IF (p ← p.next)=NIL THEN EXIT;
ENDLOOP;
= start => NULL;
ENDCASE => ERROR BadMove};

AfterMove: PUBLIC PROC [initLoc, dest, start, len: Card]
RETURNS [newLoc: Card] = {
end: Card ← start+len;
newLoc ← SELECT dest FROM
< start => SELECT initLoc FROM
>= end => initLoc,
>= start => initLoc+dest-start,
>= dest => initLoc+len,
ENDCASE => initLoc,
>= end => SELECT initLoc FROM
>= dest => initLoc,
>= end => initLoc-len,
>= start => initLoc+dest-end,
ENDCASE => initLoc,
= start => initLoc,
ENDCASE => ERROR BadMove};

Transpose: PUBLIC PROC [ref: Ref, astart, alen, bstart, blen: Card] = {
-- [astart..astart+alen) must not intersect [bstart..bstart+blen)
p: Pair;
aend, bend: Card;
IF ref=NIL OR (p ← ref.addrs)=NIL THEN RETURN;
IF astart > bstart THEN { -- switch them
start: Card ← astart;
len: Card ← alen;
astart ← bstart; bstart ← start;
alen ← blen; blen ← len };
IF (aend ← astart+alen) > bstart THEN ERROR BadTranspose;
bend ← bstart+blen;
DO SELECT p.location FROM
< astart => NULL;
< aend => p.location ← p.location+bend-aend;
< bstart => p.location ← p.location+blen-alen;
< bend => p.location ← p.location+astart-bstart;
ENDCASE;
IF (p ← p.next)=NIL THEN EXIT;
ENDLOOP};

AfterTranspose: PUBLIC PROC [initLoc, astart, alen, bstart, blen: Card]
RETURNS [newLoc: Card] = {
aend, bend: Card;
IF astart > bstart THEN { -- switch them
start: Card ← astart;
len: Card ← alen;
astart ← bstart; bstart ← start;
alen ← blen; blen ← len };
IF (aend ← astart+alen) > bstart THEN ERROR BadTranspose;
bend ← bstart+blen;
newLoc ← SELECT initLoc FROM
< astart => initLoc,
< aend => initLoc+bend-aend,
< bstart => initLoc+blen-alen,
< bend => initLoc+astart-bstart,
ENDCASE => initLoc};

Start: PUBLIC PROC = {
};

END.