IPStackImpl.mesa
Last edited by:
Doug Wyatt, March 3, 1984 3:58:25 pm PST
DIRECTORY
IP USING [Any, AnyFromInt, AnyFromReal, CheckInteger, Color, ColorFromAny, Element, ElementRep, GetMarker, Identifier, IdentifierFromAny, Integer, IntegerFromAny, IntegerFromInt, IntegerFromReal, Marker, MarkItem, MarkItemRep, MasterError, maxInteger, Operator, OperatorFromAny, Outline, OutlineFromAny, Pair, PixelArray, PixelArrayFromAny, RealFromAny, RealFromInt, State, Trajectory, TrajectoryFromAny, Transformation, TransformationFromAny, Type, TypeCode, Vector, VectorFromAny],
IPBase USING [];
IPStackImpl: CEDAR PROGRAM
IMPORTS IP
EXPORTS IP, IPBase
= BEGIN OPEN IP;
NewElement:
PROC
RETURNS[Element] ~ {
RETURN[NEW[ElementRep ← []]];
};
InitializeStack:
PUBLIC
PROC[self: State, maxLength: Integer] ~ {
self.stack ← NewElement[]; -- dummy element at base of stack, so self.stack.above always works
self.count ← 0;
self.maxCount ← CheckInteger[maxLength];
self.mark ← NIL;
};
StackUnderflow:
PROC[self: State] ~ {
MasterError[$stackUnderflow, "Stack underflow."];
};
PushElement:
PROC[self: State]
RETURNS[Element] ~ {
old: Element ~ self.stack; new: Element ← old.above; count: Integer ~ self.count;
IF
NOT count<self.maxCount
THEN
MasterError[$stackOverflow, "Tried to push too many elements onto the stack."];
IF new=NIL THEN { new ← NewElement[]; old.above ← new; new.below ← old };
IF new.ref#NIL THEN ERROR;
self.count ← count+1; RETURN[self.stack ← new];
};
PopElement:
PROC[self: State]
RETURNS[Element] ~ {
old: Element ~ self.stack; count: Integer ~ self.count;
IF
NOT count>0
THEN
MasterError[$stackUnderflow, "Tried to pop an element from an empty stack."];
self.count ← count-1; self.stack ← old.below; RETURN[old];
};
Push:
PUBLIC
PROC[self: State, x: Any] ~ {
new: Element ~ PushElement[self];
new.type ← $ref; new.ref ← x;
};
PushInteger:
PUBLIC
PROC[self: State, i: Integer] ~ {
new: Element ~ PushElement[self];
new.type ← $int; new.int ← CheckInteger[i];
};
PushInt:
PUBLIC
PROC[self: State, i:
INT] ~ {
new: Element ~ PushElement[self];
new.type ← $int; new.int ← i;
};
PushReal:
PUBLIC
PROC[self: State, r:
REAL] ~ {
new: Element ~ PushElement[self];
new.type ← $real; new.real ← r;
};
PushPair:
PUBLIC
PROC[self: State, p: Pair] ~ {
PushReal[self, p.x]; PushReal[self, p.y];
};
PushIdentifier:
PUBLIC
PROC[self: State, x: Identifier] ~ {
IF x=NIL THEN MasterError[$nilFault, "Identifier must not be NIL."]
ELSE { new: Element ~ PushElement[self]; new.type ← $ref; new.ref ← x };
};
PushVector:
PUBLIC
PROC[self: State, x: Vector] ~ {
IF x=NIL THEN MasterError[$nilFault, "Vector must not be NIL."]
ELSE { new: Element ~ PushElement[self]; new.type ← $ref; new.ref ← x };
};
PushOperator:
PUBLIC
PROC[self: State, x: Operator] ~ {
IF x=NIL THEN MasterError[$nilFault, "Operator must not be NIL."]
ELSE { new: Element ~ PushElement[self]; new.type ← $ref; new.ref ← x };
};
PushTransformation:
PUBLIC
PROC[self: State, x: Transformation] ~ {
IF x=NIL THEN MasterError[$nilFault, "Transformation must not be NIL."]
ELSE { new: Element ~ PushElement[self]; new.type ← $ref; new.ref ← x };
};
PushPixelArray:
PUBLIC
PROC[self: State, x: PixelArray] ~ {
IF x=NIL THEN MasterError[$nilFault, "PixelArray must not be NIL."]
ELSE { new: Element ~ PushElement[self]; new.type ← $ref; new.ref ← x };
};
PushColor:
PUBLIC
PROC[self: State, x: Color] ~ {
IF x=NIL THEN MasterError[$nilFault, "Color must not be NIL."]
ELSE { new: Element ~ PushElement[self]; new.type ← $ref; new.ref ← x };
};
PushTrajectory:
PUBLIC
PROC[self: State, x: Trajectory] ~ {
IF x=NIL THEN MasterError[$nilFault, "Trajectory must not be NIL."]
ELSE { new: Element ~ PushElement[self]; new.type ← $ref; new.ref ← x };
};
PushOutline:
PUBLIC
PROC[self: State, x: Outline] ~ {
IF x=NIL THEN MasterError[$nilFault, "Outline must not be NIL."]
ELSE { new: Element ~ PushElement[self]; new.type ← $ref; new.ref ← x };
};
Pop:
PUBLIC
PROC[self: State]
RETURNS[Any] ~ {
old: Element ~ PopElement[self];
SELECT old.type
FROM
$ref => { x: REF ~ old.ref; old.ref ← NIL; RETURN[x] };
$int => RETURN[AnyFromInt[old.int]];
$real => RETURN[AnyFromReal[old.real]];
ENDCASE => ERROR;
};
PopInteger:
PUBLIC
PROC[self: State]
RETURNS[Integer] ~ {
old: Element ~ PopElement[self];
SELECT old.type
FROM
$ref => { x: REF ~ old.ref; old.ref ← NIL; RETURN[IntegerFromAny[x]] };
$int => RETURN[IF old.int IN[0..maxInteger] THEN old.int ELSE IntegerFromInt[old.int]];
$real => RETURN[IntegerFromReal[old.real]];
ENDCASE => ERROR;
};
PopReal:
PUBLIC
PROC[self: State]
RETURNS[
REAL] ~ {
old: Element ~ PopElement[self];
SELECT old.type
FROM
$ref => { x: REF ~ old.ref; old.ref ← NIL; RETURN[RealFromAny[x]] };
$int => RETURN[RealFromInt[old.int]];
$real => RETURN[old.real];
ENDCASE => ERROR;
};
PopPair:
PUBLIC
PROC[self: State]
RETURNS[p: Pair] ~ {
p.y ← PopReal[self]; p.x ← PopReal[self];
};
PopIdentifier:
PUBLIC
PROC[self: State]
RETURNS[Identifier] ~ {
old: Element ~ PopElement[self]; x: REF ← NIL;
IF old.type=$ref THEN { x ← old.ref; old.ref ← NIL };
WITH x SELECT FROM x: Identifier => RETURN[x]; ENDCASE;
RETURN[IdentifierFromAny[x]];
};
PopVector:
PUBLIC
PROC[self: State]
RETURNS[Vector] ~ {
old: Element ~ PopElement[self]; x: REF ← NIL;
IF old.type=$ref THEN { x ← old.ref; old.ref ← NIL };
WITH x SELECT FROM x: Vector => RETURN[x]; ENDCASE;
RETURN[VectorFromAny[x]];
};
PopOperator:
PUBLIC
PROC[self: State]
RETURNS[Operator] ~ {
old: Element ~ PopElement[self]; x: REF ← NIL;
IF old.type=$ref THEN { x ← old.ref; old.ref ← NIL };
WITH x SELECT FROM x: Operator => RETURN[x]; ENDCASE;
RETURN[OperatorFromAny[x]];
};
PopTransformation:
PUBLIC
PROC[self: State]
RETURNS[Transformation] ~ {
old: Element ~ PopElement[self]; x: REF ← NIL;
IF old.type=$ref THEN { x ← old.ref; old.ref ← NIL };
WITH x SELECT FROM x: Transformation => RETURN[x]; ENDCASE;
RETURN[TransformationFromAny[x]];
};
PopPixelArray:
PUBLIC
PROC[self: State]
RETURNS[PixelArray] ~ {
old: Element ~ PopElement[self]; x: REF ← NIL;
IF old.type=$ref THEN { x ← old.ref; old.ref ← NIL };
WITH x SELECT FROM x: PixelArray => RETURN[x]; ENDCASE;
RETURN[PixelArrayFromAny[x]];
};
PopColor:
PUBLIC
PROC[self: State]
RETURNS[Color] ~ {
old: Element ~ PopElement[self]; x: REF ← NIL;
IF old.type=$ref THEN { x ← old.ref; old.ref ← NIL };
WITH x SELECT FROM x: Color => RETURN[x]; ENDCASE;
RETURN[ColorFromAny[x]];
};
PopTrajectory:
PUBLIC
PROC[self: State]
RETURNS[Trajectory] ~ {
old: Element ~ PopElement[self]; x: REF ← NIL;
IF old.type=$ref THEN { x ← old.ref; old.ref ← NIL };
WITH x SELECT FROM x: Trajectory => RETURN[x]; ENDCASE;
RETURN[TrajectoryFromAny[x]];
};
PopOutline:
PUBLIC
PROC[self: State]
RETURNS[Outline] ~ {
old: Element ~ PopElement[self]; x: REF ← NIL;
IF old.type=$ref THEN { x ← old.ref; old.ref ← NIL };
WITH x SELECT FROM x: Outline => RETURN[x]; ENDCASE;
RETURN[OutlineFromAny[x]];
};
TopType:
PUBLIC
PROC[self: State]
RETURNS[TypeCode] ~ {
Return the type of the top element.
top: Element ~ self.stack; count: Integer ~ self.count;
IF
NOT count>0
THEN
MasterError[$stackUnderflow, "Tried to pop an element from an empty stack."];
SELECT top.type
FROM
$ref => RETURN[Type[top.ref]];
$int, $real => RETURN[$Number];
ENDCASE => ERROR;
};
Discard:
PUBLIC
PROC[self: State] ~ {
Equivalent to [] ← Pop[self], but avoids useless NEW.
old: Element ~ PopElement[self];
SELECT old.type
FROM
$ref => old.ref ← NIL;
$int, $real => NULL;
ENDCASE => ERROR;
};
Copy:
PUBLIC
PROC[self: State, depth: Integer] ~ {
IF CheckInteger[depth]=0 THEN NULL
ELSE
IF self.count<depth
THEN
MasterError[$stackUnderflow, "Too few elements on stack to COPY."]
ELSE {
this: Element ← self.stack;
THROUGH [0..depth) DO this ← this.below ENDLOOP;
THROUGH [0..depth)
DO
new: Element ~ PushElement[self];
this ← this.above;
SELECT (new.type ← this.type)
FROM
$int => new.int ← this.int;
$real => new.real ← this.real;
$ref => new.ref ← this.ref;
ENDCASE => ERROR;
ENDLOOP;
};
};
Roll:
PUBLIC
PROC[self: State, depth, moveFirst: Integer] ~ {
IF CheckInteger[moveFirst]>CheckInteger[depth]
THEN
MasterError[$invalidArgs, "ROLL: moveFirst exceeds depth."]
ELSE
IF self.count<depth
THEN
MasterError[$stackUnderflow, "Too few elements on stack to ROLL."]
ELSE IF depth=0 OR moveFirst=0 OR moveFirst=depth THEN NULL
ELSE {
k: INT ~ depth-moveFirst;
old: Element ~ self.stack; -- the old top of stack
above: Element ~ old.above; -- free element above top of stack, if any
new, kth, nth: Element ← NIL;
bot: Element ← old; -- will become the element below the top depth elements
THROUGH [0..k) DO kth ← bot; bot ← bot.below ENDLOOP;
new ← bot; -- this will be the new top of stack
THROUGH [k..depth)
DO nth ← bot; bot ← bot.below
ENDLOOP;
Since there is a dummy element at the base of the stack, bot cannot be NIL.
new.above ← above; IF above#NIL THEN above.below ← new;
nth.below ← old; old.above ← nth;
kth.below ← bot; bot.above ← kth;
self.stack ← new;
};
};
Mark:
PUBLIC
PROC[self: State, n: Integer] ~ {
marker: Marker ~ GetMarker[self];
IF self.count<CheckInteger[n]
THEN
MasterError[$stackUnderflow, "Too few elements on the stack to MARK."]
ELSE {
mark: MarkItem ~ NEW[MarkItemRep ← [marker: marker, under: self.count-n]];
self.count ← self.count-mark.under;
self.maxCount ← self.maxCount-mark.under;
mark.below ← self.mark; self.mark ← mark;
};
};
RemoveMark:
PUBLIC
PROC[self: State, marker: Marker] ~ {
mark: MarkItem ~ self.mark;
IF mark.marker#marker THEN ERROR;
self.count ← self.count+mark.under;
self.maxCount ← self.maxCount+mark.under;
self.mark ← mark.below;
};
MarkMismatch:
PROC ~ {
MasterError[$markMismatch, "The top mark on the stack does not match the current context."]
};
Unmark:
PUBLIC
PROC[self: State, n: Integer] ~ {
marker: Marker ~ GetMarker[self];
mark: MarkItem ~ self.mark;
IF mark.marker#marker THEN MarkMismatch[];
IF self.count<CheckInteger[n]
THEN
MasterError[$stackUnderflow, "Too few elements on the stack to UNMARK."]
ELSE IF self.count=n THEN RemoveMark[self, marker]
ELSE MasterError[$unmarkFailed, "UNMARK found too many elements above the top mark."];
};
Unmark0:
PUBLIC
PROC[self: State] ~ {
marker: Marker ~ GetMarker[self];
mark: MarkItem ~ self.mark;
IF mark.marker#marker THEN MarkMismatch[];
IF self.count>0
THEN {
MasterError[$unmarkFailed, "UNMARK0 found one or more elements above the top mark.",
FALSE]; -- don't raise Error
WHILE self.count>0 DO Discard[self] ENDLOOP; -- do mark recovery
};
RemoveMark[self, marker];
};
Count:
PUBLIC
PROC[self: State]
RETURNS[Integer] ~ {
marker: Marker ~ GetMarker[self];
mark: MarkItem ~ self.mark;
IF mark.marker#marker THEN MarkMismatch[];
RETURN[CheckInteger[self.count]];
};
PopToMark:
PUBLIC
PROC[self: State]
RETURNS[Marker] ~ {
mark: MarkItem ~ self.mark;
WHILE self.count>0 DO Discard[self] ENDLOOP;
RETURN[mark.marker];
};
ReserveChars: PROC [to: String, nChars: NAT] RETURNS [String] = {
newMinLength: NAT = to.length + nChars; -- may raise PointerFault or BoundsFault
IF newMinLength <= to.maxLength THEN RETURN [to];
{ expandBy: NAT = MAX[16, to.maxLength, nChars];
newLength: NAT =
IF expandBy > NAT.LAST-to.maxLength THEN NAT.LAST ELSE expandBy+to.maxLength;
newString: String = NEW[StringRep[newLength]];
FOR i: NAT IN [0..to.length) DO newText[i] ← to[i] ENDLOOP;
newText.length ← to.length;
RETURN [newText];
}
};
AppendChar: PROC[to: String, from: CARDINAL] RETURNS[String] ~ {
IF to.length>=to.maxLength THEN to ← ReserveChars[to, 1];
to[to.length] ← from;
to.length ← to.length+1;
RETURN[to];
};
InlineAppendChar: PROC[to: String, from: CARDINAL] RETURNS[String] ~ INLINE {
IF to.length>=to.maxLength THEN RETURN[AppendChar[to, from]];
to[to.length] ← from;
to.length ← to.length+1;
RETURN[to];
};
PushString: PUBLIC PROC[self: State, text: REF TEXT] ~ {
offset: CARDINAL ← 0;
state: {run, escape, escape2, extended, extended2} ← run;
FOR i: NAT IN[0..text.length) DO
b: BYTE ~ LOOPHOLE[text[i]];
SELECT state FROM
run => IF b#255 THEN Append[offset+b] ELSE state ← escape;
escape => IF b#255 THEN { offset ← b*256; state ← run } ELSE state ← escape2;
escape2 => IF b=0 THEN state ← extended ELSE ERROR;
extended => IF b#255 THEN { offset ← b*256; state ← extended2 } ELSE state ← escape;
extended2 => { Append[offset+b]; state ← extended };
ENDCASE;
ENDLOOP;
IF NOT(state=run OR state=extended) THEN ERROR;
};
PopString: PUBLIC PROC[self: State, buffer: String] RETURNS[String] ~ {
};
ApplyPOP:
PUBLIC
PROC[self: State] ~ {
Discard[self];
};
ApplyCOPY:
PUBLIC
PROC[self: State] ~ {
n: Integer ~ PopInteger[self];
Copy[self: self, depth: n];
};
ApplyDUP:
PUBLIC
PROC[self: State] ~ {
Copy[self: self, depth: 1];
};
ApplyROLL:
PUBLIC
PROC[self: State] ~ {
moveFirst: Integer ~ PopInteger[self];
depth: Integer ~ PopInteger[self];
Roll[self: self, depth: depth, moveFirst: moveFirst];
};
ApplyEXCH:
PUBLIC
PROC[self: State] ~ {
Roll[self: self, depth: 2, moveFirst: 1];
};
ApplyMARK:
PUBLIC
PROC[self: State] ~ {
n: Integer ~ PopInteger[self];
Mark[self, n];
};
ApplyUNMARK:
PUBLIC
PROC[self: State] ~ {
n: Integer ~ PopInteger[self];
Unmark[self, n];
};
ApplyUNMARK0:
PUBLIC
PROC[self: State] ~ {
Unmark0[self];
};
ApplyCOUNT:
PUBLIC
PROC[self: State] ~ {
n: Integer ~ Count[self];
PushInteger[self, n];
};
ApplyNOP:
PUBLIC
PROC[self: State] ~ {
};
END.