<> <<>> <> <> 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 count0 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] ~ { <> 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] ~ { <> 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 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> 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.count0 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]; }; <<>> <> <> <> <<{ expandBy: NAT = MAX[16, to.maxLength, nChars];>> <> < NAT.LAST-to.maxLength THEN NAT.LAST ELSE expandBy+to.maxLength;>> <> <> <> <> <<}>> <<};>> <<>> <> <=to.maxLength THEN to _ ReserveChars[to, 1];>> <> <> <> <<};>> <<>> <> <=to.maxLength THEN RETURN[AppendChar[to, from]];>> <> <> <> <<};>> <<>> <> <> <> <> <> <> < IF b#255 THEN Append[offset+b] ELSE state _ escape;>> < IF b#255 THEN { offset _ b*256; state _ run } ELSE state _ escape2;>> < IF b=0 THEN state _ extended ELSE ERROR;>> < IF b#255 THEN { offset _ b*256; state _ extended2 } ELSE state _ escape;>> < { Append[offset+b]; state _ extended };>> <> <> <> <<};>> <<>> <> <<};>> <<>> 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.