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] _ [count: 0, max: 0, seq: ]];
RETURN[stack];
};


Push: PUBLIC PROC [frame: Frame, val: Any] ~ {
impl: FrameImpl ~ frame.impl;
stack: Stack ~ impl.stack;
IF NOT stack.count<stack.size THEN 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 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 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: PUBLIC PROC [frame: Frame] ~ {
Remove[frame];
};

ApplyCopy: PUBLIC PROC [frame: Frame] ~ {
n: INT ~ PopInt[frame];
Copy[frame, n];
};

ApplyDup: PUBLIC PROC [frame: Frame] ~ {
Copy[frame, 1];
};

ApplyRoll: PUBLIC PROC [frame: Frame] ~ {
k: INT ~ PopInt[frame];
n: INT ~ PopInt[frame];
Roll[frame, n, k];
};

ApplyExch: PUBLIC PROC [frame: Frame] ~ {
Roll[frame, 2, 1];
};

ApplyCount: PUBLIC PROC [frame: Frame] ~ {
n: INT ~ CountStack[frame];
PushInt[frame, n];
};

ApplyClearStack: PUBLIC PROC [frame: Frame] ~ {
ClearStack[frame];
};

ApplyIndex: PUBLIC PROC [frame: Frame] ~ {
i: INT ~ PopInt[frame];
Push[frame, Index[frame, i]];
};

defaultMark: Mark ~ NEW[MarkRep _ [0]];

ApplyMark: PUBLIC PROC [frame: Frame] ~ {
PushMark[frame, defaultMark];
};

ApplyCountToMark: PUBLIC PROC [frame: Frame] ~ {
n: INT ~ CountToMark[frame];
PushInt[frame, n];
};

ApplyClearToMark: PUBLIC PROC [frame: Frame] ~ {
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.
‚TJaMStackImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Doug Wyatt, March 26, 1985 10:10:19 am PST

Κ‚˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ*™*—K˜š
Οk	˜	Kšœžœ˜Kš
œ˜Kš
œ˜—K˜KšΠbl
œžœ
ž˜Kšžœ˜Kšžœ˜Kšœžœ
žœ˜K˜Jšœžœ
žœ˜5K˜š
Οnœžœ
žœžœžœ˜5Kšœžœ-˜?Kšžœ˜K˜K˜—K˜š œžœ
žœ˜.K˜Kš
œ˜Kšžœ
žœžœ˜?Kšžœžœ
žœ˜*K˜Kš
œ˜Kšžœžœ˜6K˜K˜—š œžœ
žœ#˜7K˜Kš
œ˜Kšžœ
žœžœ˜?Kšžœžœ
žœ
žœ
˜)Kšžœ˜&Kš
œ˜Kšžœžœ˜6K˜K˜—š œžœ
žœžœ˜1K˜Kš
œ˜K˜šžœžœžœ
žœ˜?Kšžœ˜&Kš
œ˜Kšžœžœ˜6K˜
—Kšžœ˜Kš
œ˜K˜—š œžœ
žœžœ˜3Kšœžœžœžœ˜%Kš
œ˜K˜—š œžœ
žœžœ˜3K˜Kš
œ˜K˜šžœžœžœ
žœ˜?Kšžœ˜&Kš
œ˜Kšžœžœ˜6K˜
—Kšžœ˜Kš
œ˜K˜—š œžœ
žœžœ˜3Kšžœžœ
žœ˜*Kš
œ˜K˜K˜—šœžœ˜"K˜—š œžœ
žœžœ˜3Kšœžœžœžœ
žœžœΟc˜NKš
œ˜K˜K˜—š 
œžœ
žœžœ˜7Kšžœžœ
žœ˜*Kš
œ˜K˜K˜—š œžœ
žœ˜1Kšžœžœ
žœ˜*Kš
œ˜K˜K˜—š 	œžœ
žœ˜5Kšžœžœ
žœ˜*Kš
œ˜K˜K˜—š œžœ
žœ˜3Kšžœžœ
žœ˜*Kš
œ˜K˜K˜—š œžœ
žœ˜3Kšžœžœ
žœ˜*Kš
œ˜K˜K˜—K˜š œžœ
žœžœ
˜1K˜Kš
œ˜Kšœžœ
˜	Kšžœ
žœžœ˜7Kš
œ˜Kš
œ˜Kš
žœžœ
žœ
žœ
žœ%˜?Kšžœžœžœ˜3K˜K˜—š œžœ˜K˜Kš
œ˜Kšžœ
žœžœ˜7Kš
œ˜Kšžœžœ
žœžœ
˜@K˜K˜—š œžœ
žœžœ˜:K˜Kš
œ˜Kšœžœ
˜	Kšžœ
žœžœ˜7Kš
œ˜Kš
œ˜Kšžœžœ
žœ
žœ˜.Kšžœžœžœ˜CK˜K˜—š
 œžœ
žœžœžœ˜4K˜Kš
œ˜Kšœžœ
˜	Kšžœ
žœžœ˜7Kš
œ˜Kš
œ˜šžœžœ
žœ˜Kš
œ&˜&šžœžœ
ž˜Kšœžœ˜Kšžœžœ˜!—K˜
—Kšžœžœžœ˜?K˜K˜—š
 œžœ
žœžœžœ˜6Kšžœ˜Kš
œ˜K˜—š
 œžœ
žœžœžœ˜6K˜Kš
œ˜Kšœžœ
˜	Kšžœ
žœžœ˜7Kš
œ˜Kš
œ˜šžœžœ
žœ˜Kš
œ&˜&šžœžœ
ž˜Kšœžœ
žœ	˜Kšœžœ	˜Kšžœžœ˜"—K˜
—Kšžœžœžœ˜@K˜K˜—K˜š
 œžœ
žœžœžœ˜6Kš
œ˜š
žœžœ
žœžœžœ˜(Kšžœžœ˜"—K˜K˜—š
 œžœ
žœžœžœ˜6Kš
œ˜š
žœžœ
žœžœžœ˜(Kšžœžœ˜"—K˜K˜—š
 	œžœ
žœžœžœ˜:Kš
œ˜š
žœžœ
žœžœžœ˜*Kšžœžœ˜$—K˜K˜—š œžœ
žœžœ
˜4Kš
œ˜šžœžœ
žœžœ˜'Kšžœžœ˜!—K˜K˜—š œžœ
žœžœ˜8Kš
œ˜šžœžœ
žœ
žœ˜)Kšžœžœ˜#—K˜K˜—š œžœ
žœžœ˜6Kš
œ˜šžœžœ
žœžœ˜(Kšžœžœ˜"—K˜K˜—š œžœ
žœžœ˜6Kš
œ˜šžœžœ
žœžœ˜(Kšžœžœ˜"—K˜K˜—K˜š œžœ
žœžœ˜,K˜Kš
œ˜Kšžœžœ˜&Kšžœžœ˜3Kšžœžœ˜?šžœžœ˜
Kšœžœ˜Kšœžœ˜šžœžœ
žœ	ž˜Kšžœ˜!Kšžœ
˜—Kš
œ˜K˜—K˜K˜—š œžœ
žœ%˜5K˜—š œžœ
žœžœ˜/K˜Kš
œ˜Kšžœžœ	˜Kšžœžœžœžœ˜4Kšžœžœ˜3Kš	žœžœžœžœ
ž˜šžœ˜Kšœžœ˜Kšœžœ˜
š œžœžœ‘˜<š	žœžœ
žœžœ
ž˜#Kšœžœ
žœ˜!Kš
œ˜Kšžœ˜ Kšžœ˜Kšžœ
˜—K˜—Kš
œ4˜4K˜
—K˜K˜—š œžœ
žœ(˜9K˜—K˜š œžœ
žœžœ
˜1K˜Kš
œ˜Kšœžœ
˜	Kšžœ
žœžœ˜7Kš
œ˜Kš
žœžœ
žœ
žœ
žœ'˜AKšžœ
žœ˜K˜K˜—š œžœ
žœžœ˜:K˜Kš
œ˜Kšœžœ
˜	Kšžœ
žœžœ˜7Kš
œ˜Kšžœžœ
žœ
žœ˜Kšžœ
žœ˜K˜K˜—š
 œžœ
žœžœžœ˜;K˜Kš
œ˜Kšžœ˜Kš
œ˜K˜—š
 
œžœ
žœžœžœ˜8K˜Kš
œ˜Kšžœ˜Kš
œ˜K˜—š
 œžœ
žœžœžœ
˜;K˜Kš
œ˜Kšœžœžœ
˜Kšžœžœ˜&Kšžœžœ˜4K˜Kš
œ˜Kš
žœžœ
žœ
žœ
žœ˜5Kšžœ
žœ˜Kš
œ˜—K˜š
 œžœ
žœžœžœ˜9K˜Kš
œ˜š	žœžœ
ž
œ
žœž˜+šžœžœ
ž˜Kšœžœ˜%Kšžœ
˜—Kšžœ
˜—Kšžœ˜K˜K˜—š œžœ
žœ˜+K˜Kš
œ˜šžœž˜Kšœžœ*˜2Kšžœžœ
žœžœ
˜-Kš
žœžœ
žœžœžœ
˜.Kšžœ
˜—K˜K˜—š 
œžœ
žœ˜*K˜Kš
œ˜šžœž˜Kšœžœ*˜2Kšžœžœ
žœžœ
˜-Kšžœ
˜—K˜K˜—K˜š œžœ
žœ˜(Kš
œ˜K˜K˜—š 	œžœ
žœ˜)Kšœžœ˜K˜K˜K˜—š œžœ
žœ˜(K˜K˜K˜—š 	œžœ
žœ˜)Kšœžœ˜Kšœžœ˜K˜K˜K˜—š 	œžœ
žœ˜)K˜K˜K˜—š 
œžœ
žœ˜*Kšœžœ˜K˜K˜K˜—š œžœ
žœ˜/Kš
œ˜K˜K˜—š 
œžœ
žœ˜*Kšœžœ˜K˜K˜K˜—Kšœžœ˜'K˜š 	œžœ
žœ˜)Kš
œ˜K˜K˜—š œžœ
žœ˜0Kšœžœ˜K˜K˜K˜—š œžœ
žœ˜0Kš
œ˜K˜K˜—J˜$J˜&J˜$J˜.J˜&J˜&J˜)J˜1J˜1J˜&J˜(K™Kšžœ
˜—…—(>8B