<> <> <> DIRECTORY IO USING [int, PutFR1], IPInterpreter USING [Any, BoundsCheckCardinal, Cardinal, CardinalFromAny, CardinalFromNum, Context, Identifier, IdentifierFromAny, MarkArray, MarkArrayRep, Marker, MarkItem, MasterError, maxCardinal, nullMarker, Number, NumberFromAny, NumberRep, Operator, OperatorFromAny, RealFromAny, RealFromNum, Ref, StackArray, stackArraySize, StackList, Type, TypeCode, Vector, VectorFromAny]; 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[atom: $stackOverflow, message: IO.PutFR1[ "Stack overflow (maxStackLength=%g)", IO.int[self.stackCountMax]]]; }; StackUnderflow: PROC [self: Ref] ~ { MasterError[atom: $stackUnderflow, message: "Stack underflow"]; }; MarkMismatch: PROC [self: Ref] ~ { MasterError[atom: $markMismatch, message: "Mark on stack does not match current context."]; }; MarkUnderflow: PROC [self: Ref] ~ { MasterError[atom: $markUnderflow, message: "Unmark with no marks on the stack."]; }; 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; }; }; GrowMarkArray: PROC [self: Ref] ~ { old: MarkArray ~ self.markArray; oldMax: NAT ~ old.max; newMax: NAT ~ oldMax*2; new: MarkArray ~ NEW[MarkArrayRep[newMax]]; FOR i: NAT IN[0..old.size) DO new[i] _ old[i] ENDLOOP; new.size _ old.size; self.markArray _ new; }; PushMark: PROC [self: Ref, mark: MarkItem] ~ { IF NOT self.markArray.size0 THEN MarkUnderflow[self]; RETURN[self.markArray[self.markArray.size-1].marker]; }; PopMark: PROC [self: Ref] ~ { mark: MarkItem ~ self.markArray[self.markArray.size _ self.markArray.size-1]; self.stackCount _ self.stackCount+mark.count; self.stackCountMax _ self.stackCountMax+mark.count; }; Mark: PUBLIC PROC [self: Ref, n: Cardinal] ~ { contextMarker: Marker ~ IF self.context=NIL THEN nullMarker ELSE self.context.marker; IF NOT self.stackCount>=BoundsCheckCardinal[n] THEN StackUnderflow[self]; PushMark[self, [count: self.stackCount-n, marker: contextMarker]]; }; Unmark: PUBLIC PROC [self: Ref, n: Cardinal] ~ { contextMarker: Marker ~ IF self.context=NIL THEN nullMarker ELSE self.context.marker; IF NOT TopMarker[self]=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"]; PopMark[self]; }; Count: PUBLIC PROC [self: Ref] RETURNS [Cardinal] ~ { contextMarker: Marker ~ IF self.context=NIL THEN nullMarker ELSE self.context.marker; IF NOT TopMarker[self]=contextMarker THEN MarkMismatch[self]; RETURN[BoundsCheckCardinal[self.stackCount]]; }; PopToActiveMark: PUBLIC PROC [self: Ref] RETURNS [Marker] ~ { DO marker: Marker ~ TopMarker[self]; WHILE self.stackCount>0 DO Pop[self] ENDLOOP; IF marker=nullMarker THEN RETURN[nullMarker]; FOR context: Context _ self.context, context.caller UNTIL context=NIL DO IF context.marker=marker THEN RETURN[marker]; -- context still exists ENDLOOP; PopMark[self]; ENDLOOP; }; <<>> END.