TJaMStackImpl.mesa
Copyright Ó 1985, 1986, 1987, 1991, 1992 by Xerox Corporation. All rights reserved.
Michael Plass, November 19, 1987 3:58:32 pm PST
Doug Wyatt, November 27, 1992 1:44 pm PST
DIRECTORY
Rope USING [NewText],
TJaM,
TJaMPrivate;
TJaMStackImpl: CEDAR PROGRAM
IMPORTS Rope, TJaM
EXPORTS TJaM, TJaMPrivate
~ BEGIN OPEN TJaM, TJaMPrivate;
FrameImplRep: PUBLIC TYPE ~ TJaMPrivate.FrameImplRep;
NewStack:
PUBLIC
PROC [size:
NAT]
RETURNS [Stack] ~ {
stack: Stack ~ NEW[StackRep[size]];
stack.count ¬ stack.max ¬ 0;
RETURN[stack];
};
Push:
PUBLIC
PROC [frame: Frame, val: Any] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
IF NOT stack.count<stack.size THEN {array: Array ~ NewArray[stack.count]; AStore[frame, array]; Push[frame, array]; ProduceError[stackOverflow]};
IF val=NIL THEN ProduceError[invalidArgs];
stack[stack.count].ref ¬ val;
stack.count ¬ stack.count+1;
IF stack.count>stack.max THEN stack.max ¬ stack.count;
};
PushNum:
PUBLIC
PROC [frame: Frame, val: NumberRep] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
IF NOT stack.count<stack.size THEN {array: Array ~ NewArray[stack.count]; AStore[frame, array]; Push[frame, array]; ProduceError[stackOverflow]};
IF stack[stack.count].ref#NIL THEN ERROR;
TRUSTED{stack[stack.count].num ¬ val};
stack.count ¬ stack.count+1;
IF stack.count>stack.max THEN stack.max ¬ stack.count;
};
PushInt:
PUBLIC
PROC [frame: Frame, val:
INT] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
num: NumberRep ~ [int[val]];
IF stack.count<stack.size
AND stack[stack.count].ref=
NIL
THEN {
TRUSTED{stack[stack.count].num ¬ num};
stack.count ¬ stack.count+1;
IF stack.count>stack.max THEN stack.max ¬ stack.count;
}
ELSE PushNum[frame, num];
};
PushBool:
PUBLIC
PROC [frame: Frame, val:
BOOL] ~ {
PushInt[frame, IF val THEN 1 ELSE 0];
};
PushReal:
PUBLIC
PROC [frame: Frame, val:
REAL] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
num: NumberRep ~ [real[val]];
IF stack.count<stack.size
AND stack[stack.count].ref=
NIL
THEN {
TRUSTED{stack[stack.count].num ¬ num};
stack.count ¬ stack.count+1;
IF stack.count>stack.max THEN stack.max ¬ stack.count;
}
ELSE PushNum[frame, num];
};
PushAtom:
PUBLIC
PROC [frame: Frame, val:
ATOM] ~ {
IF val=NIL THEN ProduceError[invalidArgs];
Push[frame, val];
};
emptyRope:
ROPE ~ Rope.NewText[0];
PushRope:
PUBLIC
PROC [frame: Frame, val:
ROPE] ~ {
rope: ROPE ~ IF val=NIL THEN emptyRope ELSE val; -- be sure to retain its type
Push[frame, rope];
};
PushStream:
PUBLIC
PROC [frame: Frame, val:
STREAM] ~ {
IF val=NIL THEN ProduceError[invalidArgs];
Push[frame, val];
};
PushCmd:
PUBLIC
PROC [frame: Frame, val: Cmd] ~ {
IF val=NIL THEN ProduceError[invalidArgs];
Push[frame, val];
};
PushArray:
PUBLIC
PROC [frame: Frame, val: Array] ~ {
IF val=NIL THEN ProduceError[invalidArgs];
Push[frame, val];
};
PushDict:
PUBLIC
PROC [frame: Frame, val: Dict] ~ {
IF val=NIL THEN ProduceError[invalidArgs];
Push[frame, val];
};
PushMark:
PUBLIC
PROC [frame: Frame, val: Mark] ~ {
IF val=NIL THEN ProduceError[invalidArgs];
Push[frame, val];
};
Pop:
PUBLIC
PROC [frame: Frame]
RETURNS [Any] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
ref: REF;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
stack.count ¬ stack.count-1;
ref ¬ stack[stack.count].ref;
IF ref=NIL THEN RETURN[NEW[NumberRep ¬ stack[stack.count].num]]
ELSE { stack[stack.count].ref ¬ NIL; RETURN[ref] };
};
Remove:
PROC [frame: Frame] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
stack.count ¬ stack.count-1;
IF stack[stack.count].ref#NIL THEN stack[stack.count].ref ¬ NIL;
};
PopNum:
PUBLIC
PROC [frame: Frame]
RETURNS [NumberRep] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
ref: REF;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
stack.count ¬ stack.count-1;
ref ¬ stack[stack.count].ref;
IF ref=NIL THEN RETURN[stack[stack.count].num]
ELSE { stack[stack.count].ref ¬ NIL; RETURN[NumberFromAny[ref]] };
};
PopInt:
PUBLIC
PROC [frame: Frame]
RETURNS [
INT] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
ref: REF;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
stack.count ¬ stack.count-1;
ref ¬ stack[stack.count].ref;
IF ref=
NIL
THEN {
n: NumberRep ~ stack[stack.count].num;
WITH n: n
SELECT
FROM
int => RETURN[n.int];
ENDCASE => RETURN[IntFromNum[n]];
}
ELSE { stack[stack.count].ref ¬ NIL; RETURN[IntFromAny[ref]] };
};
PopBool:
PUBLIC
PROC [frame: Frame]
RETURNS [
BOOL] ~ {
RETURN[PopInt[frame]#0];
};
PopReal:
PUBLIC
PROC [frame: Frame]
RETURNS [
REAL] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
ref: REF;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
stack.count ¬ stack.count-1;
ref ¬ stack[stack.count].ref;
IF ref=
NIL
THEN {
n: NumberRep ~ stack[stack.count].num;
WITH n: n
SELECT
FROM
int => RETURN[REAL[n.int]];
real => RETURN[n.real];
ENDCASE => RETURN[RealFromNum[n]];
}
ELSE { stack[stack.count].ref ¬ NIL; RETURN[RealFromAny[ref]] };
};
PopAtom:
PUBLIC
PROC [frame: Frame]
RETURNS [
ATOM] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x:
ATOM =>
RETURN[x];
ENDCASE => RETURN[AtomFromAny[x]];
};
PopRope:
PUBLIC
PROC [frame: Frame]
RETURNS [
ROPE] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x:
ROPE =>
RETURN[x];
ENDCASE => RETURN[RopeFromAny[x]];
};
PopStream:
PUBLIC
PROC [frame: Frame]
RETURNS [
STREAM] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x:
STREAM =>
RETURN[x];
ENDCASE => RETURN[StreamFromAny[x]];
};
PopCmd:
PUBLIC
PROC [frame: Frame]
RETURNS [Cmd] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x: Cmd =>
RETURN[x];
ENDCASE => RETURN[CmdFromAny[x]];
};
PopArray:
PUBLIC
PROC [frame: Frame]
RETURNS [Array] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x: Array =>
RETURN[x];
ENDCASE => RETURN[ArrayFromAny[x]];
};
PopDict:
PUBLIC
PROC [frame: Frame]
RETURNS [Dict] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x: Dict =>
RETURN[x];
ENDCASE => RETURN[DictFromAny[x]];
};
PopMark:
PUBLIC
PROC [frame: Frame]
RETURNS [Mark] ~ {
x: Any ~ Pop[frame];
WITH x
SELECT
FROM x: Mark =>
RETURN[x];
ENDCASE => RETURN[MarkFromAny[x]];
};
Copy:
PUBLIC
PROC [frame: Frame, n:
INT] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
IF n<0 THEN ProduceError[invalidArgs];
IF stack.count<n THEN ProduceError[stackUnderflow];
IF (stack.size-stack.count)<n THEN {array: Array ~ NewArray[stack.count]; AStore[frame, array]; Push[frame, array]; ProduceError[stackOverflow]};
IF n#0
THEN {
k: NAT ~ n;
b: NAT ~ stack.count-k;
FOR i:
NAT
IN[b..b+k)
DO
TRUSTED { stack[i+k] ¬ stack[i] }
ENDLOOP;
stack.count ¬ stack.count+k;
};
};
Dup:
PUBLIC
PROC [frame: Frame] ~ { Copy[frame, 1] };
Roll:
PUBLIC
PROC [frame: Frame, n, k:
INT] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
IF k<0 THEN k ¬ n+k;
IF n<0 OR k<0 OR k>n THEN ProduceError[invalidArgs];
IF stack.count<n THEN ProduceError[stackUnderflow];
IF n=0 OR k=0 OR k=n THEN NULL
ELSE {
b: INT ~ stack.count-n;
m: INT ~ n-k;
Reverse:
PROC [bot, top:
INT] ~ {
-- reverse stack[bot..top)
FOR x:
NAT
IN[0..
NAT[top-bot]/2)
DO
i: NAT ~ bot+x; j: NAT ~ top-1-x;
temp: StackElement ~ stack[i];
TRUSTED { stack[i] ¬ stack[j] };
TRUSTED { stack[j] ¬ temp };
ENDLOOP;
};
Reverse[b, b+m]; Reverse[b+m, b+n]; Reverse[b, b+n];
}
};
Exch:
PUBLIC
PROC [frame: Frame] ~ { Roll[frame, 2, 1] };
Top:
PUBLIC
PROC [frame: Frame]
RETURNS [Any] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
ref: REF;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
ref ¬ stack[stack.count-1].ref;
IF ref=NIL THEN RETURN[NEW[NumberRep ¬ stack[stack.count-1].num]]
ELSE RETURN[ref];
};
TopType:
PUBLIC
PROC [frame: Frame]
RETURNS [TypeCode] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
ref: REF;
IF NOT stack.count>0 THEN ProduceError[stackUnderflow];
ref ¬ stack[stack.count-1].ref;
IF ref=NIL THEN RETURN[number]
ELSE RETURN[Type[ref]];
};
StackIsEmpty:
PUBLIC
PROC [frame: Frame]
RETURNS [
BOOL] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
RETURN[stack.count=0];
};
CountStack:
PUBLIC
PROC [frame: Frame]
RETURNS [
INT] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
RETURN[stack.count];
};
Index:
PUBLIC
PROC [frame: Frame, i:
INT]
RETURNS [Any] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
k: NAT; ref: REF;
IF i<0 THEN ProduceError[invalidArgs];
IF i>=stack.count THEN ProduceError[stackUnderflow];
k ¬ stack.count-1-i;
ref ¬ stack[k].ref;
IF ref=NIL THEN RETURN[NEW[NumberRep ¬ stack[k].num]]
ELSE RETURN[ref];
};
CountToMark:
PUBLIC
PROC [frame: Frame]
RETURNS [
INT] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
FOR i:
NAT
DECREASING
IN[0..stack.count)
DO
WITH stack[i].ref
SELECT
FROM
x: Mark => RETURN[stack.count-(i+1)];
ENDCASE;
ENDLOOP;
RETURN[stack.count];
};
ClearToMark:
PUBLIC
PROC [frame: Frame] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
WHILE stack.count>0
DO
ref: REF ~ stack[stack.count ¬ stack.count-1].ref;
IF ref#NIL THEN stack[stack.count].ref ¬ NIL;
WITH ref SELECT FROM x: Mark => EXIT; ENDCASE;
ENDLOOP;
};
ClearStack:
PUBLIC
PROC [frame: Frame] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
WHILE stack.count>0
DO
ref: REF ~ stack[stack.count ¬ stack.count-1].ref;
IF ref#NIL THEN stack[stack.count].ref ¬ NIL;
ENDLOOP;
};
ApplyPop: CommandProc ~ {
Remove[frame];
};
ApplyCopy: CommandProc ~ {
n: INT ~ PopInt[frame];
Copy[frame, n];
};
ApplyDup: CommandProc ~ {
Copy[frame, 1];
};
ApplyRoll: CommandProc ~ {
k: INT ~ PopInt[frame];
n: INT ~ PopInt[frame];
Roll[frame, n, k];
};
ApplyExch: CommandProc ~ {
Roll[frame, 2, 1];
};
ApplyCount: CommandProc ~ {
n: INT ~ CountStack[frame];
PushInt[frame, n];
};
ApplyClearStack: CommandProc ~ {
ClearStack[frame];
};
ApplyIndex: CommandProc ~ {
i: INT ~ PopInt[frame];
Push[frame, Index[frame, i]];
};
defaultMark: Mark ~ NEW[MarkRep ¬ [0]];
ApplyMark: CommandProc ~ {
PushMark[frame, defaultMark];
};
ApplyCountToMark: CommandProc ~ {
n: INT ~ CountToMark[frame];
PushInt[frame, n];
};
ApplyClearToMark: CommandProc ~ {
ClearToMark[frame];
};
RegisterPrimitive[".pop", ApplyPop];
RegisterPrimitive[".exch", ApplyExch];
RegisterPrimitive[".dup", ApplyDup];
RegisterPrimitive[".clrstk", ApplyClearStack];
RegisterPrimitive[".copy", ApplyCopy];
RegisterPrimitive[".roll", ApplyRoll];
RegisterPrimitive[".cntstk", ApplyCount];
RegisterPrimitive[".cnttomrk", ApplyCountToMark];
RegisterPrimitive[".clrtomrk", ApplyClearToMark];
RegisterPrimitive[".mark", ApplyMark];
RegisterPrimitive[".index", ApplyIndex];
END.