<> <> <> DIRECTORY IO USING [int, PutFR1], IPInterpreter; IPStackImpl: CEDAR PROGRAM IMPORTS IO, IPInterpreter EXPORTS IPInterpreter ~ BEGIN OPEN IPInterpreter; FlushStackArray: PROC[self: Ref] ~ { FOR i: NAT IN[0..self.stackArrayCount) DO val: Number ~ NEW[NumberRep _ self.stackArray[i]]; self.stackList _ CONS[val, self.stackList]; ENDLOOP; self.stackArrayCount _ 0; }; StackOverflow: PROC [self: Ref] ~ { MasterError[code: $stackOverflow, explanation: IO.PutFR1[ "Stack overflow (maxStackLength=%g)", IO.int[self.stackCountMax]]]; }; StackUnderflow: PROC [self: Ref] ~ { MasterError[code: $stackUnderflow, explanation: "Stack underflow"]; }; MarkMismatch: PROC [self: Ref] ~ { MasterError[code: $markMismatch, explanation: "Mark on stack does not match current context."]; }; PushAny: PUBLIC PROC[self: Ref, val: Any] ~ { IF NOT self.stackCount0 THEN StackUnderflow[self]; self.stackCount _ self.stackCount-1; IF self.stackArrayCount>0 THEN { n: NumberRep ~ self.stackArray[self.stackArrayCount _ self.stackArrayCount-1]; RETURN[NEW[NumberRep _ n]]; } ELSE { top: StackList ~ self.stackList; self.stackList _ top.rest; RETURN[top.first] }; }; PopNum: PUBLIC PROC[self: Ref] RETURNS[NumberRep] ~ { IF self.stackCount>0 AND self.stackArrayCount>0 THEN { n: NumberRep ~ self.stackArray[self.stackArrayCount _ self.stackArrayCount-1]; self.stackCount _ self.stackCount-1; RETURN[n]; } ELSE RETURN[NumberFromAny[PopAny[self]]^]; }; PopBool: PUBLIC PROC[self: Ref] RETURNS[BOOL] ~ { RETURN[PopCardinal[self]#0]; }; PopCardinal: PUBLIC PROC[self: Ref] RETURNS[Cardinal] ~ { IF self.stackCount>0 AND self.stackArrayCount>0 THEN { n: NumberRep ~ self.stackArray[self.stackArrayCount _ self.stackArrayCount-1]; self.stackCount _ self.stackCount-1; WITH n: n SELECT FROM int => IF n.int IN[0..maxCardinal] THEN RETURN[n.int]; ENDCASE; RETURN[CardinalFromNum[n]]; } ELSE RETURN[CardinalFromAny[PopAny[self]]]; }; PopReal: PUBLIC PROC[self: Ref] RETURNS[REAL] ~ { IF self.stackCount>0 AND self.stackArrayCount>0 THEN { n: NumberRep ~ self.stackArray[self.stackArrayCount _ self.stackArrayCount-1]; self.stackCount _ self.stackCount-1; WITH n: n SELECT FROM int => RETURN[REAL[n.int]]; real => RETURN[n.real]; ENDCASE; RETURN[RealFromNum[n]]; } ELSE RETURN[RealFromAny[PopAny[self]]]; }; PopIdentifier: PUBLIC PROC[self: Ref] RETURNS[Identifier] ~ { x: Any ~ PopAny[self]; WITH x SELECT FROM x: Identifier => RETURN[x]; ENDCASE; RETURN[IdentifierFromAny[x]]; }; PopVector: PUBLIC PROC[self: Ref] RETURNS[Vector] ~ { x: Any ~ PopAny[self]; WITH x SELECT FROM x: Vector => RETURN[x]; ENDCASE; RETURN[VectorFromAny[x]]; }; PopOperator: PUBLIC PROC[self: Ref] RETURNS[Operator] ~ { x: Any ~ PopAny[self]; WITH x SELECT FROM x: Operator => RETURN[x]; ENDCASE; RETURN[OperatorFromAny[x]]; }; <> <0 THEN MasterError[stackUnderflow];>> <0 THEN>> <> <> <<};>> <<>> TopType: PUBLIC PROC[self: Ref] RETURNS[TypeCode] ~ { IF NOT self.stackCount>0 THEN StackUnderflow[self]; IF self.stackArrayCount>0 THEN RETURN[number] ELSE RETURN[Type[self.stackList.first]]; }; Pop: PUBLIC PROC[self: Ref] ~ { IF self.stackCount>0 AND self.stackArrayCount>0 THEN { <<-- Avoid useless NEW[NumberRep].>> self.stackCount _ self.stackCount-1; self.stackArrayCount _ self.stackArrayCount-1; } ELSE [] _ PopAny[self]; }; Copy: PUBLIC PROC[self: Ref, depth: Cardinal] ~ { IF NOT self.stackCount>=BoundsCheckCardinal[depth] THEN StackUnderflow[self]; IF NOT (self.stackCountMax-self.stackCount)>=depth THEN StackOverflow[self]; IF depth=0 THEN RETURN; IF self.stackArrayCount>=depth AND (stackArraySize-self.stackArrayCount)>=depth THEN { n: NAT ~ depth; b: NAT ~ self.stackArrayCount-n; array: StackArray ~ self.stackArray; FOR i: NAT IN[b..b+n) DO TRUSTED{ array[i+n] _ array[i] }; ENDLOOP; self.stackArrayCount _ self.stackArrayCount+n; } ELSE { head, tail, each: StackList _ NIL; IF NOT self.stackArrayCount=0 THEN FlushStackArray[self]; each _ self.stackList; THROUGH [0..depth) DO copy: StackList ~ CONS[each.first, NIL]; IF tail=NIL THEN head _ copy ELSE tail.rest _ copy; tail _ copy; each _ each.rest; ENDLOOP; tail.rest _ self.stackList; self.stackList _ head; }; self.stackCount _ self.stackCount+depth; }; Roll: PUBLIC PROC[self: Ref, depth, moveFirst: Cardinal] ~ { IF NOT BoundsCheckCardinal[depth]>=BoundsCheckCardinal[moveFirst] THEN MasterError[$invalidArgs, "ROLL: moveFirst exceeds depth"]; IF NOT self.stackCount>=depth THEN StackUnderflow[self]; IF depth=0 OR moveFirst=0 OR moveFirst=depth THEN RETURN; IF self.stackArrayCount>=depth THEN { n: NAT ~ depth; m: NAT ~ moveFirst; b: NAT ~ self.stackArrayCount-n; a: StackArray ~ self.stackArray; Reverse: PROC[bot, top: NAT] ~ { -- reverse a[bot..top) FOR x: NAT IN[0..NAT[top-bot]/2) DO i: NAT ~ bot+x; j: NAT ~ top-1-x; temp: NumberRep ~ a[i]; TRUSTED{ a[i] _ a[j] }; TRUSTED{ a[j] _ temp }; ENDLOOP; }; Reverse[b, b+m]; Reverse[b+m, b+n]; Reverse[b, b+n]; } ELSE { k: Cardinal ~ depth-moveFirst; top, kth, nth, each: StackList _ NIL; IF NOT self.stackArrayCount=0 THEN FlushStackArray[self]; each _ top _ self.stackList; THROUGH [0..k) DO kth _ each; each _ each.rest ENDLOOP; self.stackList _ each; -- new top of stack THROUGH [k..depth) DO nth _ each; each _ each.rest ENDLOOP; kth.rest _ each; nth.rest _ top; }; }; stackMarkFreeCountMax: INT _ 8; AllocStackMark: PROC [self: Ref] RETURNS [mark: StackMark] ~ { IF self.stackMarkFreeCount>0 THEN { mark _ self.stackMarkFree; self.stackMarkFree _ mark.rest; self.stackMarkFreeCount _ self.stackMarkFreeCount-1; } ELSE mark _ NEW [StackMarkRep]; }; FreeStackMark: PROC [self: Ref, mark: StackMark] ~ { IF self.stackMarkFreeCount=BoundsCheckCardinal[n] THEN StackUnderflow[self]; mark.count _ self.stackCount-n; -- number of elements hidden by the mark mark.marker _ contextMarker; -- marker for current context self.stackCount _ self.stackCount-mark.count; -- = n self.stackCountMax _ self.stackCountMax-mark.count; mark.rest _ self.stackMark; self.stackMark _ mark; }; Unmark: PUBLIC PROC[self: Ref, n: Cardinal] ~ { contextMarker: Marker ~ IF self.context=NIL THEN nullMarker ELSE self.context.marker; mark: StackMark ~ self.stackMark; IF NOT mark.marker=contextMarker THEN MarkMismatch[self]; IF NOT self.stackCount>=BoundsCheckCardinal[n] THEN StackUnderflow[self]; IF NOT self.stackCount=n THEN MasterError[$unmarkFailed, "UNMARK found no mark at the specified depth"]; self.stackCount _ self.stackCount+mark.count; self.stackCountMax _ self.stackCountMax+mark.count; self.stackMark _ mark.rest; FreeStackMark[self, mark]; }; Count: PUBLIC PROC[self: Ref] RETURNS[Cardinal] ~ { contextMarker: Marker ~ IF self.context=NIL THEN nullMarker ELSE self.context.marker; mark: StackMark ~ self.stackMark; IF NOT mark.marker=contextMarker THEN MarkMismatch[self]; RETURN[BoundsCheckCardinal[self.stackCount]]; }; PopToActiveMark: PUBLIC PROC [self: Ref] RETURNS [Marker] ~ { DO mark: StackMark ~ self.stackMark; WHILE self.stackCount>0 DO Pop[self] ENDLOOP; IF mark.marker=nullMarker THEN RETURN[mark.marker]; FOR context: Context _ self.context, context.caller UNTIL context=NIL DO IF context.marker=mark.marker THEN RETURN[mark.marker]; -- context still exists ENDLOOP; self.stackCount _ self.stackCount+mark.count; self.stackCountMax _ self.stackCountMax+mark.count; self.stackMark _ mark.rest; FreeStackMark[self, mark]; ENDLOOP; }; <<>> END.