<> <> <> 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 count0 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] ~ { <> 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] ~ { <> 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> 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.