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]];
};


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 {
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.

žIPStackImpl.mesa
Copyright c 1984, 1985, 1986 by Xerox Corporation.  All rights reserved.
Doug Wyatt, October 14, 1986 5:11:42 pm PDT
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];
};

-- Avoid useless NEW[NumberRep].

Κ˜
codeš
œ™Kšœ
Οm
œ=™HKš
œ+™+—K˜š
Οk	˜	Kšžœ
žœ˜Kš
œ˜—K˜KšΠblœžœ
ž˜Kšžœ
žœ˜Kšžœ˜Kšœžœ
žœ˜K˜šΟnœžœ˜$šžœžœ
žœž˜)Kšœžœ!˜2Kšœžœ˜+Kšžœ
˜—Kš
œ˜K˜K˜—š 
œžœ˜#Kšœ/žœ/žœ˜}K˜K˜—š œžœ˜$Kš
œC˜CK˜K˜—š œžœ˜"Kš
œ`˜`K˜K˜—š œžœ
žœ˜-Kšžœ
žœ$žœ˜CKšžœ
žœžœ˜9Kšœžœ˜+Kš
œ$˜$K˜K˜—š œžœ
žœ˜3Kšžœ
žœ$žœ˜CKšžœ
žœ%žœ˜FKšžœ0˜7Kš
œ.˜.Kš
œ$˜$K˜K˜—š œžœ
žœžœ˜/Kšœžœžœžœ˜)Kš
œ˜K˜—š œžœ
žœ˜7Kš
œ/˜/šžœ$žœ%žœ˜TKšžœ.˜5Kš
œ.˜.Kš
œ$˜$K˜
—Kšžœ˜Kš
œ˜K˜—š œžœ
žœžœ˜/K˜šžœ$žœ%žœ˜TKšžœ.˜5Kš
œ.˜.Kš
œ$˜$K˜
—Kšžœ˜Kš
œ˜K˜—š œžœ
žœ ˜;Kšžœžœ
žœ3˜BKš
œ˜Kš
œ˜K˜—š 
œžœ
žœ˜3Kšžœžœ
žœ/˜>Kš
œ˜Kš
œ˜K˜—š œžœ
žœ˜7Kšžœžœ
žœ1˜@Kš
œ˜Kš
œ˜K˜—K˜š œžœ
žœžœ	˜/Kšžœ
žœžœ˜3Kš
œ$˜$šžœžœ˜ Kš
œN˜NKšžœ
žœ˜K˜
—Kšžœ?žœ˜WK˜K˜—š œžœ
žœžœ˜5šžœžœžœ˜6Kš
œN˜NKš
œ$˜$Kšžœ˜
K˜
—Kšžœ
žœ˜*K˜K˜—š
 œžœ
žœžœ
žœ˜1Kšžœ˜Kš
œ˜K˜—š œžœ
žœžœ˜9šžœžœžœ˜6Kš
œN˜NKš
œ$˜$šžœžœ
ž˜Kš	œžœžœžœ
žœ˜6Kšžœ
˜—Kšžœ˜K˜
—Kšžœ
žœ ˜+K˜K˜—š
 œžœ
žœžœ
žœ˜1šžœžœžœ˜6Kš
œN˜NKš
œ$˜$šžœžœ
ž˜Kšœžœ
žœ	˜Kšœžœ	˜Kšžœ
˜—Kšžœ˜K˜
—Kšžœ
žœ˜'K˜K˜—š 
œžœ
žœžœ˜=K˜Kš
žœžœ
žœžœžœ
˜7Kšžœ˜K˜K˜—š 	œžœ
žœžœ˜5K˜Kš
žœžœ
žœžœžœ
˜3Kšžœ˜K˜K˜—š œžœ
žœžœ˜9K˜Kš
žœžœ
žœžœžœ
˜5Kšžœ˜K˜K˜—K˜š œžœ
žœžœ	™,Kšžœ
žœžœ™:šžœž™Kšžœ
žœ6™@—Kšžœ
žœ™"K™K™—š œžœ
žœžœ˜5Kšžœ
žœžœ˜3Kšžœžœ
žœ˜-Kšžœ
žœ˜(K˜K˜—š œžœ
žœ˜šžœžœžœ˜6Kš
Οc ™ Kš
œ$˜$Kš
œ.˜.K˜
—Kšžœ˜K˜K˜—š œžœ
žœ ˜1Kšžœ
žœ-žœ˜MKšžœ
žœ-žœ˜LKšžœ	žœ
žœ
˜šžœžœ.žœ˜VKšœžœ	˜Kšœžœ˜ Kš
œ$˜$šžœžœ
žœ	ž˜Kšžœ˜!Kšžœ
˜—Kš
œ.˜.K˜
—šžœ˜Kšœžœ
˜"Kšžœ
žœžœ˜9K˜šžœž˜Kšœžœ
žœ˜(Kšžœžœ
žœ
žœ˜3K˜Kšžœ
˜—K˜2K˜—Kš
œ(˜(K˜K˜—š œžœ
žœ+˜<Kšžœ
žœ<žœ<˜‚
Kšžœ
žœžœ˜8Kš
žœ	žœ
žœžœ
žœ
˜9šžœžœ˜%Kšœžœ	˜Kšœžœ
˜Kšœžœ˜ Kš
œ ˜ š œžœžœ‘˜7š	žœžœ
žœžœ
ž˜#Kšœžœ
žœ˜!Kš
œ˜Kšžœ˜Kšžœ˜Kšžœ
˜—K˜—Kš
œ4˜4K˜
—šžœ˜Kš
œ˜Kšœ!žœ
˜%Kšžœ
žœžœ˜9Kš
œ˜Kšžœžœžœ
˜7Kšœ‘˜*Kšžœžœžœ
˜;K˜ K˜—K˜K˜—K˜Kšœžœ˜K˜š œžœ
žœ˜>šžœžœ˜#Kš
œ˜Kš
œ˜Kš
œ4˜4Kš
œ
˜
—Kšžœžœ˜K˜K˜—š 
œžœ!˜4šžœ/žœ˜7Kš
œ˜Kš
œ˜Kš
œ4˜4Kš
œ˜—K˜K˜—š œžœ
žœ˜-Kš	œžœžœ
žœžœ˜UKš
œ'˜'Kšžœ
žœ)žœ˜IKšœ ‘(˜HKšœ‘˜:Kšœ.‘˜4Kš
œ3˜3Kš
œ˜Kš
œ˜K˜K˜—š œžœ
žœ˜/Kš	œžœžœ
žœžœ˜UKš
œ!˜!Kšžœ
žœžœ˜9Kšžœ
žœ)žœ˜IKšžœ
žœžœL˜iKš
œ-˜-Kš
œ3˜3Kš
œ˜K˜K˜K˜—š œžœ
žœžœ˜3Kš	œžœžœ
žœžœ˜UKš
œ!˜!Kšžœ
žœžœ˜9Kšžœ'˜-Kš
œ˜K˜—š œžœ
žœ
žœ
˜=šžœ"˜$Kšžœžœžœ
˜-Kšžœžœ
žœ˜3šžœ1žœ	žœ
ž˜HKšžœžœ
žœ‘˜OKšžœ
˜—Kš
œ-˜-Kš
œ3˜3Kš
œ˜K˜Kšžœ
˜—Kš
œ˜K˜—K™Kšžœ
˜—…—$¨2W