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.