DIRECTORY
JaM,
JaMPrimitives,
Real;

JaMStackImpl: CEDAR PROGRAM
IMPORTS JaM, Real
EXPORTS JaM, JaMPrimitives
~ BEGIN OPEN JaM;

NumberRep: TYPE ~ RECORD[
SELECT tag: * FROM
int => [int: INT],
real => [real: REAL],
ENDCASE
];

AnyFromNum: PROC[n: NumberRep] RETURNS[Any] ~ {
WITH n: n SELECT FROM
int => RETURN[NEW[INT _ n.int]];
real => RETURN[NEW[REAL _ n.real]];
ENDCASE => ERROR;
};

NumFromAny: PROC[x: Any] RETURNS[NumberRep] ~ {
WITH x SELECT FROM
x: REF INT => RETURN[[int[x^]]];
x: REF REAL => RETURN[[real[x^]]];
ENDCASE => ERROR Error[WrongType];
};

firstInt: REAL _ INT.FIRST;
lastInt: REAL _ INT.LAST;

IntFromReal: PROC[r: REAL] RETURNS[INT] ~ {
i: INT _ 0;
IF r IN[firstInt..lastInt] THEN i _ Real.Fix[r];
IF i=r THEN RETURN[i];
ERROR Error[WrongType];
};

IntFromNum: PROC[n: NumberRep] RETURNS[INT] ~ {
WITH n: n SELECT FROM
int => RETURN[n.int];
real => RETURN[IntFromReal[n.real]];
ENDCASE => ERROR;
};

IntFromAny: PROC[x: Any] RETURNS[INT] ~ {
WITH x SELECT FROM
x: REF INT => RETURN[x^];
x: REF REAL => RETURN[IntFromReal[x^]];
ENDCASE => ERROR Error[WrongType];
};

RealFromNum: PROC[n: NumberRep] RETURNS[REAL] ~ {
WITH n: n SELECT FROM
int => RETURN[REAL[n.int]];
real => RETURN[n.real];
ENDCASE => ERROR;
};

RealFromAny: PROC[x: Any] RETURNS[REAL] ~ {
WITH x SELECT FROM
x: REF INT => RETURN[REAL[x^]];
x: REF REAL => RETURN[x^];
ENDCASE => ERROR Error[WrongType];
};


arraySize: NAT ~ 8;
StackArray: TYPE ~ REF StackArrayRep;
StackArrayRep: TYPE ~ ARRAY[0..arraySize) OF NumberRep;
StackList: TYPE ~ LIST OF Any;

Stack: TYPE ~ REF StackRep;
StackRep: PUBLIC TYPE ~ RECORD[
array: StackArray _ NIL, -- a few numbers on top of the stack
arrayCount: [0..arraySize] _ 0, -- number of elements in array
list: StackList _ NIL, -- the rest of the stack
count: INT _ 0, -- number of stack elements above the top mark
countMax: INT _ 0 -- maximum count permitted above the top mark
];


NewStack: PUBLIC PROC RETURNS[Stack] ~ {
stack: Stack ~ NEW[StackRep _ []];
stack.array _ NEW[StackArrayRep];
stack.countMax _ 1000;
RETURN[stack];
};

FlushStackArray: PROC[stack: Stack] ~ {
FOR i: NAT IN[0..stack.arrayCount) DO
n: NumberRep ~ stack.array[i];
stack.list _ CONS[AnyFromNum[n], stack.list];
ENDLOOP;
stack.arrayCount _ 0;
};


Push: PUBLIC PROC[self: State, x: Any] ~ {
stack: Stack ~ self.stack;
IF NOT stack.count<stack.countMax THEN ERROR Error[StackOverflow];
IF NOT stack.arrayCount=0 THEN FlushStackArray[stack];
stack.list _ CONS[x, stack.list];
stack.count _ stack.count+1;
};

PushNum: PROC[self: State, x: NumberRep] ~ {
stack: Stack ~ self.stack;
IF NOT stack.count<stack.countMax THEN ERROR Error[StackOverflow];
IF NOT stack.arrayCount<arraySize THEN FlushStackArray[stack];
TRUSTED{ stack.array[stack.arrayCount] _ x };
stack.arrayCount _ stack.arrayCount+1;
stack.count _ stack.count+1;
};

PushBool: PUBLIC PROC[self: State, x: BOOL] ~ {
PushInt[self, IF x THEN 1 ELSE 0];
};

PushInt: PUBLIC PROC[self: State, x: INT] ~ {
stack: Stack ~ self.stack;
n: NumberRep ~ [int[x]];
IF stack.count<stack.countMax AND stack.arrayCount<arraySize THEN {
TRUSTED{ stack.array[stack.arrayCount] _ n };
stack.arrayCount _ stack.arrayCount+1;
stack.count _ stack.count+1;
}
ELSE PushNum[self, n];
};

PushReal: PUBLIC PROC[self: State, x: REAL] ~ {
stack: Stack ~ self.stack;
n: NumberRep ~ [real[x]];
IF stack.count<stack.countMax AND stack.arrayCount<arraySize THEN {
TRUSTED{ stack.array[stack.arrayCount] _ n };
stack.arrayCount _ stack.arrayCount+1;
stack.count _ stack.count+1;
}
ELSE PushNum[self, n];
};


Pop: PUBLIC PROC[self: State] RETURNS[Any] ~ {
stack: Stack ~ self.stack;
IF NOT stack.count>0 THEN ERROR Error[StackUnderflow];
stack.count _ stack.count-1;
IF stack.arrayCount>0 THEN {
n: NumberRep ~ stack.array[stack.arrayCount _ stack.arrayCount-1];
RETURN[AnyFromNum[n]];
}
ELSE { top: StackList ~ stack.list; stack.list _ top.rest; RETURN[top.first] };
};

PopNum: PROC[self: State] RETURNS[NumberRep] ~ {
stack: Stack ~ self.stack;
IF stack.count>0 AND stack.arrayCount>0 THEN {
n: NumberRep ~ stack.array[stack.arrayCount _ stack.arrayCount-1];
stack.count _ stack.count-1;
RETURN[n];
}
ELSE RETURN[NumFromAny[Pop[self]]];
};

PopBool: PUBLIC PROC[self: State] RETURNS[BOOL] ~ {
RETURN[PopInt[self]#0];
};

PopInt: PUBLIC PROC[self: State] RETURNS[INT] ~ {
stack: Stack ~ self.stack;
IF stack.count>0 AND stack.arrayCount>0 THEN {
n: NumberRep ~ stack.array[stack.arrayCount _ stack.arrayCount-1];
stack.count _ stack.count-1;
WITH n: n SELECT FROM
int => RETURN[n.int];
ENDCASE;
RETURN[IntFromNum[n]];
}
ELSE RETURN[IntFromAny[Pop[self]]];
};

PopReal: PUBLIC PROC[self: State] RETURNS[REAL] ~ {
stack: Stack ~ self.stack;
IF stack.count>0 AND stack.arrayCount>0 THEN {
n: NumberRep ~ stack.array[stack.arrayCount _ stack.arrayCount-1];
stack.count _ stack.count-1;
WITH n: n SELECT FROM
int => RETURN[REAL[n.int]];
real => RETURN[n.real];
ENDCASE;
RETURN[RealFromNum[n]];
}
ELSE RETURN[RealFromAny[Pop[self]]];
};


PopRope: PUBLIC PROC[self: State] RETURNS[ROPE] ~ {
x: Any ~ Pop[self];
WITH x SELECT FROM
x: ROPE => RETURN[x];
x: ATOM => RETURN[AtomToRope[x]];
ENDCASE => ERROR Error[WrongType];
};

PopStream: PUBLIC PROC[self: State] RETURNS[STREAM] ~ {
x: Any ~ Pop[self];
WITH x SELECT FROM
x: STREAM => RETURN[x];
ENDCASE => ERROR Error[WrongType];
};

PopArray: PUBLIC PROC[self: State] RETURNS[Array] ~ {
x: Any ~ Pop[self];
WITH x SELECT FROM
x: Array => RETURN[x];
ENDCASE => ERROR Error[WrongType];
};

PopDict: PUBLIC PROC[self: State] RETURNS[Dict] ~ {
x: Any ~ Pop[self];
WITH x SELECT FROM
x: Dict => RETURN[x];
ENDCASE => ERROR Error[WrongType];
};


Copy: PUBLIC PROC[self: State, n: INT] ~ {
stack: Stack ~ self.stack;
IF n<0 THEN ERROR Error[InvalidArgs];
IF NOT stack.count>=n THEN ERROR Error[StackUnderflow];
IF NOT (stack.countMax-stack.count)>=n THEN ERROR Error[StackOverflow];
IF n=0 THEN RETURN;
IF stack.arrayCount>=n AND (arraySize-stack.arrayCount)>=n THEN {
k: NAT ~ n;
b: NAT ~ stack.arrayCount-k;
array: StackArray ~ stack.array;
FOR i: NAT IN[b..b+k) DO TRUSTED{ array[i+k] _ array[i] } ENDLOOP;
stack.arrayCount _ stack.arrayCount+k;
}
ELSE {
head, tail, each: StackList _ NIL;
IF NOT stack.arrayCount=0 THEN FlushStackArray[stack];
each _ stack.list;
THROUGH [0..n) 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 _ stack.list; stack.list _ head;
};
stack.count _ stack.count+n;
};

Roll: PUBLIC PROC[self: State, n, k: INT] ~ {
stack: Stack ~ self.stack;
IF k<0 THEN k _ n+k;
IF n<0 OR k<0 OR k>n THEN ERROR Error[InvalidArgs];
IF n>stack.count THEN ERROR Error[StackUnderflow];
IF n=0 OR k=0 OR k=n THEN RETURN;
IF stack.arrayCount>=n THEN {
m: INT ~ n-k;
b: INT ~ stack.arrayCount-n;
a: StackArray ~ stack.array;
Reverse: PROC[bot, top: INT] ~ { -- 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 {
top, kth, nth, each: StackList _ NIL;
IF NOT stack.arrayCount=0 THEN FlushStackArray[stack];
each _ top _ stack.list;
THROUGH [0..k) DO kth _ each; each _ each.rest ENDLOOP;
stack.list _ each; -- new top of stack
THROUGH [k..n) DO nth _ each; each _ each.rest ENDLOOP;
kth.rest _ each; nth.rest _ top;
};
};


Count: PUBLIC PROC[self: State] RETURNS[INT] ~ {
stack: Stack ~ self.stack;
RETURN[stack.count];
};

Index: PUBLIC PROC[self: State, i: INT] RETURNS[Any] ~ {
stack: Stack ~ self.stack;
ERROR Error[Unimplemented];
};

PushMark: PUBLIC PROC[self: State, m: INT _ 0] ~ {
Push[self, NEW[MarkRep _ [m]]];
};

PopMark: PUBLIC PROC[self: State, m: INT _ 0] ~ {
WITH Pop[self] SELECT FROM
x: Mark => IF x.m#m THEN ERROR Error[WrongMark];
ENDCASE => ERROR Error[WrongType];
};

CountToMark: PUBLIC PROC[self: State, m: INT _ 0] RETURNS[INT] ~ {
stack: Stack ~ self.stack;
list: StackList _ stack.list;
FOR i: INT IN[stack.arrayCount..stack.count) DO
WITH list.first SELECT FROM
x: Mark => IF x.m=m THEN RETURN[i] ELSE ERROR Error[WrongMark];
ENDCASE;
list _ list.rest;
ENDLOOP;
RETURN[stack.count];
};


ApplyPop: PUBLIC PROC[self: State] ~ {
stack: Stack ~ self.stack;
IF stack.count>0 AND stack.arrayCount>0 THEN { -- Avoid useless NEW
stack.count _ stack.count-1;
stack.arrayCount _ stack.arrayCount-1;
}
ELSE [] _ Pop[self];
};

ApplyCopy: PUBLIC PROC[self: State] ~ {
n: INT ~ PopInt[self];
Copy[self, n];
};

ApplyDup: PUBLIC PROC[self: State] ~ {
Copy[self, 1];
};

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

ApplyExch: PUBLIC PROC[self: State] ~ {
Roll[self, 2, 1];
};

ApplyCount: PUBLIC PROC[self: State] ~ {
n: INT ~ Count[self];
PushInt[self, n];
};

ApplyIndex: PUBLIC PROC[self: State] ~ {
i: INT ~ Count[self];
Push[self, Index[self, i]];
};

ApplyMark: PUBLIC PROC[self: State] ~ {
PushMark[self];
};

ApplyCountToMark: PUBLIC PROC[self: State] ~ {
n: INT ~ CountToMark[self];
PushInt[self, n];
};

END.
ŠJaMStackImpl.mesa
Copyright (C) 1984, 1985 by Xerox Corporation.  All rights reserved.
Doug Wyatt, January 10, 1985 4:11:55 pm PST

Κς˜Icodeš
œ™š
œD™DKš
œ+™+—K˜š
Οk	˜	Kš
œ˜Kš
œ˜Kš
œ˜K˜—Kšœœ
˜Kšœ
˜Kšœ˜Kšœœ
œ˜K˜šœœœ
˜šœ˜Kšœ
œ˜Kšœœ˜Kš
˜—K˜—K˜šΟn
œœœ	˜/šœœ
˜Kšœœ
œ
œ˜ Kšœœ
œ
œ˜#Kšœœ
˜—K˜K˜—šž
œœ	œ˜/šœœ
˜Kšœœ
œœ˜ Kšœœ
œœ
˜"Kšœœ˜"—K˜K˜—Kšœ
œœ
œ
˜Kšœ	œœ
œ
˜K˜š
žœœœœ
œ˜+Kšœœ˜Kšœœœ˜0Kšœœ
œ˜Kšœ˜K˜K˜—šž
œœœ
œ˜/šœœ
˜Kšœœ˜Kšœœ˜$Kšœœ
˜—K˜K˜—šž
œœ	œ
œ˜)šœœ
˜Kšœœ
œœ˜Kšœœ
œœ˜'Kšœœ˜"—K˜K˜—šžœœœ
œ˜1šœœ
˜Kšœœ
œ	˜Kšœœ	˜Kšœœ
˜—K˜K˜—šžœœ	œ
œ˜+šœœ
˜Kš	œœ
œœ
œ˜Kšœœ
œœ˜Kšœœ˜"—K˜K˜—K˜Kšœœ˜Kšœœœ˜%Kšœœœœ˜7Kšœœœ
œ˜K˜Jšœœœ
˜šœ
œ
œœ
˜KšœœΟc$˜=Kšœ Ÿ˜>KšœœŸ˜/KšœœŸ.˜>Kšœ
œŸ-˜?J˜J˜—J˜šžœœ
œ
œ˜(Jšœœ˜"Jšœœ˜!Jš
œ˜Jšœ˜J˜J˜—šžœœ˜'šœœ
œ˜%Kš
œ˜Kšœ
œ˜-Kšœ
˜—Kš
œ˜K˜K˜—K˜šžœœ
œ˜*Kš
œ˜Kšœ
œœ
œ˜BKšœ
œœ˜6Kšœ
œ˜!Kš
œ˜K˜K˜—šžœœ˜,Kš
œ˜Kšœ
œœ
œ˜BKšœ
œœ˜>Kšœ&˜-Kš
œ&˜&Kš
œ˜K˜K˜—šžœœ
œœ˜/Kšœœœœ˜"Kš
œ˜K˜—šžœœ
œœ˜-Kš
œ˜K˜šœœœ˜CKšœ&˜-Kš
œ&˜&Kš
œ˜K˜
—Kšœ˜Kš
œ˜K˜—šžœœ
œœ˜/Kš
œ˜K˜šœœœ˜CKšœ&˜-Kš
œ&˜&Kš
œ˜K˜
—Kšœ˜Kš
œ˜K˜—K˜šžœœ
œœ	˜.Kš
œ˜Kšœ
œœ
œ˜6Kš
œ˜šœœ˜Kš
œB˜BKšœ˜K˜
—Kšœ7œ˜OK˜K˜—šžœœœ˜0Kš
œ˜šœœœ˜.Kš
œB˜BKš
œ˜Kšœ˜
K˜
—Kšœ
œ˜#K˜K˜—š
žœœ
œœ
œ˜3Kšœ˜Kš
œ˜K˜—š
žœœ
œœ
œ˜1Kš
œ˜šœœœ˜.Kš
œB˜BKš
œ˜šœœ
˜Kšœœ˜Kšœ
˜—Kšœ˜K˜
—Kšœ
œ˜#K˜K˜—š
žœœ
œœ
œ˜3Kš
œ˜šœœœ˜.Kš
œB˜BKš
œ˜šœœ
˜Kšœœ
œ	˜Kšœœ	˜Kšœ
˜—Kšœ˜K˜
—Kšœ
œ˜$K˜K˜—K˜š
žœœ
œœ
œ˜3K˜šœœ
˜Jšœœœ˜Jšœœœ˜!Jšœœ˜"—K˜K˜—š
ž	œœ
œœ
œ˜7K˜šœœ
˜Jšœœœ˜Jšœœ˜"—K˜K˜—šžœœ
œœ˜5K˜šœœ
˜Jšœœ˜Jšœœ˜"—K˜K˜—šžœœ
œœ
˜3K˜šœœ
˜Jšœœ˜Jšœœ˜"—K˜K˜—K˜šžœœ
œœ˜*J˜Jšœœ
œ˜%Kšœ
œœ
œ˜7Kšœ
œ!œ
œ˜GKšœœ
œ
˜šœœ!œ˜AKšœœ˜Kšœœ˜Kš
œ ˜ Kšœœ
œ	œ
œœ
˜BKš
œ&˜&K˜
—šœ˜Kšœœ
˜"Kšœ
œœ˜6K˜šœ˜Kšœœ
œ˜(Kšœœ
œ
œ˜3K˜Kšœ
˜—K˜*K˜—Kš
œ˜K˜K˜—šžœœ
œœ˜-J˜Jšœœ	˜Jš
œœœœ
œ˜3Jšœœ
œ˜2Kš
œœœœ
œ
˜!šœœ˜Kšœœ˜
Kšœœ˜Kš
œ˜šžœœœŸ˜7š	œœ
œœ
˜#Kšœœ
œ˜!Kš
œ˜Kšœ˜Kšœ˜Kšœ
˜—K˜—Kš
œ4˜4K˜
—šœ˜Kšœ!œ
˜%Kšœ
œœ˜6Kš
œ˜Kšœœœ
˜7KšœŸ˜&Kšœœœ
˜7K˜ K˜—K˜K˜—K˜š
žœœ
œœ
œ˜0J˜Jšœ˜Kš
œ˜K˜—š
žœœ
œœœ	˜8J˜Jšœ˜Jš
œ˜—J˜šžœœ
œœ	˜2Jšœœ˜J˜J˜—šžœœ
œœ	˜1šœœ
˜Jšœœœ
œ˜0Jšœœ˜"—J˜J˜—šžœœ
œœœ
œ˜BJ˜J˜šœœ
œ ˜/šœœ
˜Jšœœœ
œœ
œ˜?Jšœ
˜—J˜Jšœ
˜—Jšœ˜J˜J˜—J˜šžœœ
œ˜&J˜šœœœŸ˜CKš
œ˜Kš
œ&˜&K˜
—Kšœ˜J˜J˜—šž	œœ
œ˜'Jšœœ˜J˜J˜J˜—šžœœ
œ˜&J˜J˜J˜—šž	œœ
œ˜'Jšœœ˜Jšœœ˜J˜J˜J˜—šž	œœ
œ˜'J˜J˜J˜—šž
œœ
œ˜(Jšœœ˜J˜J˜J˜—šž
œœ
œ˜(Jšœœ˜J˜J˜J˜—šž	œœ
œ˜'J˜J˜J˜—šžœœ
œ˜.Jšœœ˜J˜J˜J˜—K™Kšœ
˜—…—#f2β