-- 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.
(635)