IPStackImpl.mesa
Copyright © 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
Doug Wyatt, October 14, 1986 5:11:42 pm PDT
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.stackCount<self.stackCountMax THEN StackOverflow[self];
IF NOT self.stackArrayCount=0 THEN FlushStackArray[self];
self.stackList ← CONS[val, self.stackList];
self.stackCount ← self.stackCount+1;
};
PushNum:
PUBLIC
PROC[self: Ref, val: NumberRep] ~ {
IF NOT self.stackCount<self.stackCountMax THEN StackOverflow[self];
IF NOT self.stackArrayCount<stackArraySize THEN FlushStackArray[self];
TRUSTED{ self.stackArray[self.stackArrayCount] ← val };
self.stackArrayCount ← self.stackArrayCount+1;
self.stackCount ← self.stackCount+1;
};
PushBool:
PUBLIC
PROC[self: Ref, val:
BOOL] ~ {
PushCardinal[self, IF val THEN 1 ELSE 0];
};
PushCardinal:
PUBLIC
PROC[self: Ref, val: Cardinal] ~ {
n: NumberRep ~ [int[BoundsCheckCardinal[val]]];
IF self.stackCount<self.stackCountMax
AND self.stackArrayCount<stackArraySize
THEN {
TRUSTED{ self.stackArray[self.stackArrayCount] ← n };
self.stackArrayCount ← self.stackArrayCount+1;
self.stackCount ← self.stackCount+1;
}
ELSE PushNum[self, n];
};
PushReal:
PUBLIC
PROC[self: Ref, val:
REAL] ~ {
n: NumberRep ~ [real[val]];
IF self.stackCount<self.stackCountMax
AND self.stackArrayCount<stackArraySize
THEN {
TRUSTED{ self.stackArray[self.stackArrayCount] ← n };
self.stackArrayCount ← self.stackArrayCount+1;
self.stackCount ← self.stackCount+1;
}
ELSE PushNum[self, n];
};
PushIdentifier:
PUBLIC
PROC[self: Ref, val: Identifier] ~ {
IF val=NIL THEN MasterError[$nilFault, "Identifier value is NIL"];
PushAny[self, val];
};
PushVector:
PUBLIC
PROC[self: Ref, val: Vector] ~ {
IF val=NIL THEN MasterError[$nilFault, "Vector value is NIL"];
PushAny[self, val];
};
PushOperator:
PUBLIC
PROC[self: Ref, val: Operator] ~ {
IF val=NIL THEN MasterError[$nilFault, "Operator value is NIL"];
PushAny[self, val];
};
PopAny:
PUBLIC
PROC[self: Ref]
RETURNS[Any] ~ {
IF NOT self.stackCount>0 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]];
};
Top: PUBLIC PROC[self: Ref] RETURNS[Any] ~ {
IF NOT self.stackCount>0 THEN MasterError[stackUnderflow];
IF self.stackArrayCount>0 THEN
RETURN[NEW[NumberRep ← self.stackArray[self.stackArrayCount-1]]]
ELSE RETURN[self.stackList.first];
};
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<stackMarkFreeCountMax
THEN {
mark.rest ← self.stackMarkFree;
self.stackMarkFree ← mark;
self.stackMarkFreeCount ← self.stackMarkFreeCount+1;
};
};
Mark:
PUBLIC
PROC[self: Ref, n: Cardinal] ~ {
contextMarker: Marker ~ IF self.context=NIL THEN nullMarker ELSE self.context.marker;
mark: StackMark ~ AllocStackMark[self];
IF NOT self.stackCount>=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.