IPStackImpl.mesa
Copyright © 1984 Xerox Corporation. All rights reserved.
Doug Wyatt, November 13, 1984 5:38:47 pm PST
DIRECTORY
IPInterpreter;
IPStackImpl: CEDAR PROGRAM
IMPORTS IPInterpreter
EXPORTS IPInterpreter
~ BEGIN OPEN IPInterpreter;
Stack: TYPE ~ REF StackRep;
StackRep: PUBLIC TYPE ~ RECORD[
count: Integer ← 0, -- number of stack elements above the top mark
maxCount: Integer ← 0, -- maximum count permitted above the top mark
top: Element ← NIL, -- the top element on the stack
topMark: MarkItem ← NIL -- the top mark on the stack
];
Element: TYPE ~ REF ElementRep; -- an element on the stack
ElementRep: TYPE ~ RECORD[
below: Element ← NIL, -- element below this one on the stack
above: Element ← NIL, -- element above this one on the stack
type: {integer, int, real, ref} ← $integer, -- what type of element
int: INT ← 0, -- value, if type is $integer or $int
real: REAL ← 0, -- value, if type is $real
ref: REF ← NIL -- value, if type is $ref
];
MarkItem: TYPE ~ REF MarkItemRep; -- a mark on the stack
MarkItemRep: TYPE ~ RECORD[
below: MarkItem ← NIL, -- mark below this one on the stack
marker: Marker ← nullMarker, -- marker for context that pushed the mark
under: INT ← 0 -- number of stack elements hidden by this mark
];
NewStack: PUBLIC PROC[maxLength: Integer] RETURNS[Stack] ~ {
stack: Stack ~ NEW[StackRep ← []];
stack.top ← NEW[ElementRep ← []]; -- dummy element, so stack.top.above always works
stack.count ← 0;
stack.maxCount ← CheckInteger[maxLength];
stack.topMark ← NIL;
RETURN[stack];
};
PushElement: PROC[stack: Stack] RETURNS[Element] ~ {
count: Integer ~ stack.count;
IF count<stack.maxCount THEN {
e: Element ~ stack.top;
new: Element ← e.above;
IF new=NIL THEN {
new ← NEW[ElementRep ← []];
e.above ← new; new.below ← e;
};
IF new.ref#NIL THEN ERROR;
stack.count ← count+1;
RETURN[stack.top ← new];
}
ELSE {
MasterError[$stackOverflow, "Too many elements on the stack."];
ERROR Error;
};
};
PopElement: PROC[stack: Stack] RETURNS[Element] ~ {
count: Integer ~ stack.count;
IF count>0 THEN {
e: Element ~ stack.top;
stack.top ← e.below;
stack.count ← count-1;
RETURN[e];
}
ELSE {
MasterError[$stackUnderflow, "Tried to pop an element from an empty stack."];
ERROR Error;
};
};
PushAny: PUBLIC PROC[self: State, x: Any] ~ {
e: Element ~ PushElement[self.stack];
e.type ← $ref; e.ref ← x;
};
PushInteger: PUBLIC PROC[self: State, i: Integer] ~ {
e: Element ~ PushElement[self.stack];
e.type ← $integer; e.int ← CheckInteger[i];
};
PushBool: PUBLIC PROC[self: State, b: BOOL] ~ { PushInteger[self, IF b THEN 1 ELSE 0] };
PushInt: PUBLIC PROC[self: State, i: INT] ~ {
e: Element ~ PushElement[self.stack];
e.type ← $int; e.int ← i;
};
PushReal: PUBLIC PROC[self: State, r: REAL] ~ {
e: Element ~ PushElement[self.stack];
e.type ← $real; e.real ← r;
};
PushVec: PUBLIC PROC[self: State, p: VEC] ~ {
PushReal[self, p.x]; PushReal[self, p.y];
};
NilFault: PROC ~ {
MasterError[$nilFault, "Cannot push a NIL value."];
};
PushIdentifier: PUBLIC PROC[self: State, x: Identifier] ~ {
IF x=NIL THEN { NilFault[]; ERROR Error }
ELSE { e: Element ~ PushElement[self.stack]; e.type ← $ref; e.ref ← x };
};
PushVector: PUBLIC PROC[self: State, x: Vector] ~ {
IF x=NIL THEN { NilFault[]; ERROR Error }
ELSE { e: Element ~ PushElement[self.stack]; e.type ← $ref; e.ref ← x };
};
PushOperator: PUBLIC PROC[self: State, x: Operator] ~ {
IF x=NIL THEN { NilFault[]; ERROR Error }
ELSE { e: Element ~ PushElement[self.stack]; e.type ← $ref; e.ref ← x };
};
PushTransformation: PUBLIC PROC[self: State, x: Transformation] ~ {
IF x=NIL THEN { NilFault[]; ERROR Error }
ELSE { e: Element ~ PushElement[self.stack]; e.type ← $ref; e.ref ← x };
};
PushPixelArray: PUBLIC PROC[self: State, x: PixelArray] ~ {
IF x=NIL THEN { NilFault[]; ERROR Error }
ELSE { e: Element ~ PushElement[self.stack]; e.type ← $ref; e.ref ← x };
};
PushColor: PUBLIC PROC[self: State, x: Color] ~ {
IF x=NIL THEN { NilFault[]; ERROR Error }
ELSE { e: Element ~ PushElement[self.stack]; e.type ← $ref; e.ref ← x };
};
PushTrajectory: PUBLIC PROC[self: State, x: Trajectory] ~ {
IF x=NIL THEN { NilFault[]; ERROR Error }
ELSE { e: Element ~ PushElement[self.stack]; e.type ← $ref; e.ref ← x };
};
PushOutline: PUBLIC PROC[self: State, x: Outline] ~ {
IF x=NIL THEN { NilFault[]; ERROR Error }
ELSE { e: Element ~ PushElement[self.stack]; e.type ← $ref; e.ref ← x };
};
PopAny: PUBLIC PROC[self: State] RETURNS[Any] ~ {
e: Element ~ PopElement[self.stack];
SELECT e.type FROM
$integer, $int => RETURN[NumberFromInt[e.int]];
$real => RETURN[NumberFromReal[e.real]];
$ref => { x: REF ~ e.ref; e.ref ← NIL; RETURN[x] };
ENDCASE => ERROR;
};
PopInteger: PUBLIC PROC[self: State] RETURNS[Integer] ~ {
e: Element ~ PopElement[self.stack];
SELECT e.type FROM
$integer => RETURN[CheckInteger[e.int]];
$int => RETURN[IF IsInteger[e.int] THEN e.int ELSE IntegerFromInt[e.int]];
$real => RETURN[IntegerFromReal[e.real]];
$ref => { x: REF ~ e.ref; e.ref ← NIL; RETURN[IntegerFromAny[x]] };
ENDCASE => ERROR;
};
PopBool: PUBLIC PROC[self: State] RETURNS[BOOL] ~ { RETURN[PopInteger[self]#0] };
PopInt: PUBLIC PROC[self: State] RETURNS[INT] ~ {
e: Element ~ PopElement[self.stack];
SELECT e.type FROM
$integer, $int => RETURN[e.int];
$real => RETURN[IntFromReal[e.real]];
$ref => { x: REF ~ e.ref; e.ref ← NIL; RETURN[IntFromAny[x]] };
ENDCASE => ERROR;
};
PopReal: PUBLIC PROC[self: State] RETURNS[REAL] ~ {
e: Element ~ PopElement[self.stack];
SELECT e.type FROM
$integer, $int => RETURN[REAL[e.int]];
$real => RETURN[e.real];
$ref => { x: REF ~ e.ref; e.ref ← NIL; RETURN[RealFromAny[x]] };
ENDCASE => ERROR;
};
PopVec: PUBLIC PROC[self: State] RETURNS[p: VEC] ~ {
p.y ← PopReal[self]; p.x ← PopReal[self];
};
PopIdentifier: PUBLIC PROC[self: State] RETURNS[Identifier] ~ {
e: Element ~ PopElement[self.stack]; x: REF ← NIL;
IF e.type=$ref THEN { x ← e.ref; e.ref ← NIL };
WITH x SELECT FROM x: Identifier => RETURN[x]; ENDCASE;
RETURN[IdentifierFromAny[x]];
};
PopVector: PUBLIC PROC[self: State] RETURNS[Vector] ~ {
e: Element ~ PopElement[self.stack]; x: REF ← NIL;
IF e.type=$ref THEN { x ← e.ref; e.ref ← NIL };
WITH x SELECT FROM x: Vector => RETURN[x]; ENDCASE;
RETURN[VectorFromAny[x]];
};
PopOperator: PUBLIC PROC[self: State] RETURNS[Operator] ~ {
e: Element ~ PopElement[self.stack]; x: REF ← NIL;
IF e.type=$ref THEN { x ← e.ref; e.ref ← NIL };
WITH x SELECT FROM x: Operator => RETURN[x]; ENDCASE;
RETURN[OperatorFromAny[x]];
};
PopTransformation: PUBLIC PROC[self: State] RETURNS[Transformation] ~ {
e: Element ~ PopElement[self.stack]; x: REF ← NIL;
IF e.type=$ref THEN { x ← e.ref; e.ref ← NIL };
WITH x SELECT FROM x: Transformation => RETURN[x]; ENDCASE;
RETURN[TransformationFromAny[x]];
};
PopPixelArray: PUBLIC PROC[self: State] RETURNS[PixelArray] ~ {
e: Element ~ PopElement[self.stack]; x: REF ← NIL;
IF e.type=$ref THEN { x ← e.ref; e.ref ← NIL };
WITH x SELECT FROM x: PixelArray => RETURN[x]; ENDCASE;
RETURN[PixelArrayFromAny[x]];
};
PopColor: PUBLIC PROC[self: State] RETURNS[Color] ~ {
e: Element ~ PopElement[self.stack]; x: REF ← NIL;
IF e.type=$ref THEN { x ← e.ref; e.ref ← NIL };
WITH x SELECT FROM x: Color => RETURN[x]; ENDCASE;
RETURN[ColorFromAny[x]];
};
PopTrajectory: PUBLIC PROC[self: State] RETURNS[Trajectory] ~ {
e: Element ~ PopElement[self.stack]; x: REF ← NIL;
IF e.type=$ref THEN { x ← e.ref; e.ref ← NIL };
WITH x SELECT FROM x: Trajectory => RETURN[x]; ENDCASE;
RETURN[TrajectoryFromAny[x]];
};
PopOutline: PUBLIC PROC[self: State] RETURNS[Outline] ~ {
e: Element ~ PopElement[self.stack]; x: REF ← NIL;
IF e.type=$ref THEN { x ← e.ref; e.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.
stack: Stack ~ self.stack;
e: Element ~ stack.top;
IF stack.count>0 THEN SELECT e.type FROM
$integer, $int, $real => RETURN[$number];
$ref => RETURN[Type[e.ref]];
ENDCASE => ERROR
ELSE {
MasterError[$stackUnderflow, "Tried to pop an element from an empty stack."];
ERROR Error;
};
};
Pop: PUBLIC PROC[self: State] ~ {
Equivalent to [] ← PopAny[stack], but avoids useless NEW.
e: Element ~ PopElement[self.stack];
SELECT e.type FROM
$integer, $int, $real => NULL;
$ref => e.ref ← NIL;
ENDCASE => ERROR;
};
Copy: PUBLIC PROC[self: State, depth: Integer] ~ {
stack: Stack ~ self.stack;
IF CheckInteger[depth]>stack.count THEN {
MasterError[$stackUnderflow, "Too few elements on stack to COPY."];
ERROR Error;
};
IF depth#0 THEN {
this: Element ← stack.top;
THROUGH [0..depth) DO this ← this.below ENDLOOP;
THROUGH [0..depth) DO
new: Element ~ PushElement[stack];
this ← this.above;
SELECT (new.type ← this.type) FROM
$integer, $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] ~ {
stack: Stack ~ self.stack;
IF CheckInteger[moveFirst]>CheckInteger[depth] THEN {
MasterError[$invalidArgs, "ROLL: moveFirst exceeds depth."];
ERROR Error;
};
IF stack.count<depth THEN {
MasterError[$stackUnderflow, "Too few elements on stack to ROLL."];
ERROR Error;
};
IF depth#0 AND moveFirst#0 AND moveFirst#depth THEN {
k: INT ~ depth-moveFirst;
e: Element ~ stack.top; -- top of stack
above: Element ~ e.above; -- free element above top of stack, if any
new, kth, nth: Element ← NIL;
bot: Element ← e; -- 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 ← e; e.above ← nth;
kth.below ← bot; bot.above ← kth;
stack.top ← new;
};
};
Mark: PUBLIC PROC[self: State, n: Integer] ~ {
stack: Stack ~ self.stack;
IF CheckInteger[n]>stack.count THEN {
MasterError[$stackUnderflow, "Too few elements on the stack to MARK."];
ERROR Error;
}
ELSE {
newMark: MarkItem ~ NEW[MarkItemRep ← [
below: stack.topMark, marker: self.context.marker, under: stack.count-n]];
stack.topMark ← newMark;
stack.count ← stack.count-newMark.under;
stack.maxCount ← stack.maxCount-newMark.under;
};
};
MarkMismatch: PROC ~ {
MasterError[$markMismatch, "Top mark on stack does not match current context."];
};
Unmark: PUBLIC PROC[self: State, n: Integer] ~ {
stack: Stack ~ self.stack;
topMark: MarkItem ~ stack.topMark;
IF topMark.marker#self.context.marker THEN { MarkMismatch[]; ERROR Error };
IF CheckInteger[n]=stack.count THEN {
stack.count ← stack.count+topMark.under;
stack.maxCount ← stack.maxCount+topMark.under;
stack.topMark ← topMark.below;
}
ELSE IF n>stack.count THEN {
MasterError[$stackUnderflow, "Too few elements on the stack to UNMARK."];
ERROR Error;
}
ELSE {
MasterError[$unmarkFailed, "Too many elements on the stack to UNMARK."];
ERROR Error;
};
};
Unmark0: PUBLIC PROC[self: State] ~ {
stack: Stack ~ self.stack;
topMark: MarkItem ~ stack.topMark;
IF topMark.marker#self.context.marker THEN { MarkMismatch[]; ERROR Error };
IF stack.count>0 THEN {
MasterError[$unmarkFailed, "UNMARK0 found a nonempty stack."];
WHILE stack.count>0 DO Pop[self] ENDLOOP; -- do mark recovery right here
};
stack.count ← stack.count+topMark.under;
stack.maxCount ← stack.maxCount+topMark.under;
stack.topMark ← topMark.below;
};
Count: PUBLIC PROC[self: State] RETURNS[Integer] ~ {
stack: Stack ~ self.stack;
topMark: MarkItem ~ stack.topMark;
IF topMark.marker#self.context.marker THEN { MarkMismatch[]; ERROR Error };
RETURN[CheckInteger[stack.count]];
};
PopToMark: PUBLIC PROC[self: State] RETURNS[Marker] ~ {
stack: Stack ~ self.stack;
WHILE stack.count>0 DO Pop[self] ENDLOOP;
RETURN[stack.topMark.marker];
};
RemoveMark: PUBLIC PROC[self: State, marker: Marker] ~ {
stack: Stack ~ self.stack;
topMark: MarkItem ~ stack.topMark;
IF marker#topMark.marker OR stack.count#0 THEN ERROR Bug;
stack.count ← stack.count+topMark.under;
stack.maxCount ← stack.maxCount+topMark.under;
stack.topMark ← topMark.below;
};
END.