JaMStackImpl.mesa
Original version by John Warnock, December 1978.
Last changed by Bill Paxton, January 21, 1:09 PM
Last changed by Doug Wyatt, 7-Oct-81 11:07:22
Russ Atkinson, July 22, 1983 7:16 pm
DIRECTORY
Basics USING [LowHalf],
JaMBasic USING [Object],
JaMInternal USING [Frame, Node, NodeSequence, Stack, StackRecord],
JaMOps
USING [APut, Array, Error, Install, InstallReason, MakeName, nullOb,
Overflow, Pop, PopCardinal, PopInteger, Push, PushCardinal, rangechk,
RegisterExplicit, StackOverflow, Top, Underflow],
JaMStorage USING [Zone];
JaMStackImpl: MONITOR
IMPORTS JaMOps, JaMStorage, Basics
EXPORTS JaMOps = {
OPEN JaMOps, JaMInternal, JaMBasic;
Globals
zone: UNCOUNTED ZONE = JaMStorage.Zone[];
stkundflw,stkovrflw: name Object;
Error handling
Underflow: PUBLIC PROC[stack: Stack] = { ERROR Error[stkundflw] };
Overflow: PUBLIC PROC[stack: Stack] = { ERROR StackOverflow[stack] };
Restore:
PUBLIC
PROC[stack: Stack, mark: Node] = {
try to restore the stack so that mark is the head of the free list
first, be sure the marked node is in the free list
FOR node: Node ← stack.free, node.next
UNTIL node=
NIL
DO
IF node=mark THEN EXIT;
REPEAT FINISHED => RETURN; -- not found
ENDLOOP;
move nodes from the free list back onto the stack
UNTIL stack.free=mark
DO
node: Node ← stack.free; stack.free ← node.next;
node.next ← stack.head; stack.head ← node;
ENDLOOP;
};
Stack allocation
NewStack:
PUBLIC
PROC[n:
CARDINAL]
RETURNS[Stack] = {
nodes: LONG POINTER TO NodeSequence ← zone.NEW[NodeSequence[n]];
stack: Stack ← zone.NEW[StackRecord ← [head: NIL, free: NIL, nodes: nodes]];
FOR i:
CARDINAL
IN[0..n)
DO
node: Node ← @nodes[i];
node^ ← [next: stack.free, ob: nullOb];
stack.free ← node;
ENDLOOP;
RETURN[stack];
};
FreeStack:
PUBLIC
PROC[stack: Stack] = {
zone.FREE[@stack.nodes];
zone.FREE[@stack];
};
Stack operations
Dup:
PUBLIC
PROC[stack: Stack] = {
ob: Object ← Top[stack]; Push[stack,ob] };
Exch:
PUBLIC
PROC[stack: Stack] = {
ob1: Object ← Pop[stack]; ob2: Object ← Pop[stack];
Push[stack,ob1]; Push[stack,ob2] };
Returns MIN[<nodes in list>,max]
Count:
PROC[head: Node, max:
CARDINAL ←
LAST[
CARDINAL]]
RETURNS[CARDINAL] = INLINE {
FOR i:
CARDINAL
IN[0..max)
DO
IF head=NIL THEN RETURN[i] ELSE head ← head.next;
ENDLOOP;
RETURN[max] };
Copy the top n entries
Copy:
PUBLIC
PROC[stack: Stack, n:
CARDINAL] = {
head: Node ← NIL; -- will be new head of stack
last: LONG POINTER TO Node ← @head; -- last link field
temp: Node ← stack.head;
IF n=0 THEN RETURN;
IF Count[stack.head,n]<n THEN Underflow[stack]; -- need n nodes to copy
IF Count[stack.free,n]<n THEN Overflow[stack]; -- intend to create n nodes
Now do it
THROUGH [0..n)
DO
node: Node ← stack.free; stack.free ← node.next;
last^ ← node; last ← @node.next;
node.ob ← temp.ob; temp ← temp.next;
ENDLOOP;
last^ ← stack.head; stack.head ← head;
};
Roll the top n entries by k places (in the "Pop" direction)
Roll:
PUBLIC
PROC[stack: Stack, n,k:
CARDINAL] = {
top,kth,nth: Node;
IF n=0 OR (k ← k MOD n)=0 THEN RETURN;
top ← stack.head; IF top=NIL THEN Underflow[stack];
kth ← top;
THROUGH[1..k)
DO kth ← kth.next;
IF kth=NIL THEN Underflow[stack] ENDLOOP;
nth ← kth;
THROUGH[k..n)
DO nth ← nth.next;
IF nth=NIL THEN Underflow[stack] ENDLOOP;
stack.head ← kth.next; kth.next ← nth.next; nth.next ← top;
};
CountStack:
PUBLIC
PROC[stack: Stack, max:
CARDINAL ←
LAST[
CARDINAL]]
RETURNS[CARDINAL] = { RETURN[Count[stack.head,max]] };
ClearStack:
PUBLIC
PROC[stack: Stack] = {
UNTIL stack.head=
NIL
DO
node: Node ← stack.head; stack.head ← node.next;
node.next ← stack.free; stack.free ← node;
ENDLOOP;
};
CountToMark:
PUBLIC
PROC[stack: Stack]
RETURNS[
CARDINAL] = {
n: CARDINAL ← 0;
FOR node: Node ← stack.head, node.next
UNTIL node=
NIL
DO
IF node.ob.type = mark THEN EXIT ELSE n ← n + 1;
ENDLOOP;
RETURN[n];
};
ClearToMark:
PUBLIC
PROC[stack: Stack] = {
UNTIL stack.head=
NIL
DO
IF Pop[stack].type=mark THEN EXIT;
ENDLOOP;
};
Return the ith stack element, counting from 0.
Index:
PUBLIC
PROC[stack: Stack, i:
CARDINAL]
RETURNS[Object] = {
ith: Node ← stack.head;
THROUGH [0..i) UNTIL ith=NIL DO ith ← ith.next ENDLOOP;
IF ith=NIL THEN Underflow[stack];
RETURN[ith.ob];
};
Execute the given procedure for each element on the given stack
Stop the enumeration and return TRUE if the procedure returns TRUE.
StackForAll:
PUBLIC
PROC[stack: Stack, proc:
PROC[Object]
RETURNS[
BOOLEAN],
unwind: BOOLEAN] RETURNS[BOOLEAN] = {
node: Node ← stack.head;
UNTIL node=
NIL
DO
IF proc[node.ob] THEN RETURN[TRUE];
IF unwind THEN { [] ← Pop[stack]; node ← stack.head }
ELSE node ← node.next;
ENDLOOP;
RETURN[FALSE];
};
ArrayFromStack:
PUBLIC
PROC[stack: Stack]
RETURNS[array Object] = {
size: CARDINAL ← Count[stack.head];
array: array Object ← Array[size];
node: Node ← stack.head;
FOR i:
CARDINAL
IN[0..size)
DO
APut[array,i,node.ob]; node ← node.next;
ENDLOOP;
RETURN[array];
};
Stack intrinsics
JPop:
PUBLIC
PROC[frame: Frame] = {
[] ← Pop[frame.opstk];
};
JDup:
PUBLIC
PROC[frame: Frame] = {
Dup[frame.opstk];
};
JExch:
PUBLIC
PROC[frame: Frame] = {
Exch[frame.opstk];
};
JCopy:
PUBLIC
PROC[frame: Frame] = {
i: CARDINAL ← PopCardinal[frame.opstk];
Copy[frame.opstk,i];
};
JRoll:
PUBLIC
PROC[frame: Frame] = {
kk: LONG INTEGER ← PopInteger[frame.opstk];
nn: LONG INTEGER ← PopInteger[frame.opstk];
k,n: INTEGER;
nmax: INTEGER = LAST[INTEGER];
IF nn<0 THEN ERROR Error[rangechk];
n ← Basics.LowHalf[MIN[nn,nmax]]; -- expect .stkundflw IF n=nmax
k ← IF n=0 THEN 0 ELSE Basics.LowHalf[kk MOD n];
IF k<0 THEN k ← k + n; Roll[frame.opstk,n,k];
};
JClrStk:
PUBLIC
PROC[frame: Frame] = {
ClearStack[frame.opstk];
};
JCntStk:
PUBLIC
PROC[frame: Frame] = {
n: CARDINAL ← CountStack[frame.opstk];
PushCardinal[frame.opstk,n];
};
JCntToMrk:
PUBLIC
PROC[frame: Frame] = {
n: CARDINAL ← CountToMark[frame.opstk];
PushCardinal[frame.opstk,n];
};
JClrToMrk:
PUBLIC
PROC[frame: Frame] = {
ClearToMark[frame.opstk];
};
JMark:
PUBLIC
PROC[frame: Frame] = {
Push[frame.opstk,[L,mark[]]];
};
JIndex:
PUBLIC
PROC[frame: Frame] = {
i: CARDINAL ← PopCardinal[frame.opstk];
ob: Object ← Index[frame.opstk, i];
Push[frame.opstk,ob];
};
JExecStk:
PUBLIC
PROC[frame: Frame] = {
array: array Object ← ArrayFromStack[frame.execstk];
Push[frame.opstk, array];
};
JDictStk:
PUBLIC
PROC[frame: Frame] = {
array: array Object ← ArrayFromStack[frame.dictstk];
Push[frame.opstk, array];
};
Initialization
InstallStack:
PROC[why: InstallReason, frame: Frame] = {
SELECT why
FROM
register => {
stkundflw ← MakeName[".stkundflw"L];
stkovrflw ← MakeName[".stkovrflw"L];
RegisterExplicit[frame, ".pop"L, JPop];
RegisterExplicit[frame, ".exch"L, JExch];
RegisterExplicit[frame, ".dup"L, JDup];
RegisterExplicit[frame, ".clrstk"L, JClrStk];
RegisterExplicit[frame, ".copy"L, JCopy];
RegisterExplicit[frame, ".roll"L, JRoll];
RegisterExplicit[frame, ".cntstk"L, JCntStk];
RegisterExplicit[frame, ".cnttomrk"L, JCntToMrk];
RegisterExplicit[frame, ".clrtomrk"L, JClrToMrk];
RegisterExplicit[frame, ".mark"L, JMark];
RegisterExplicit[frame, ".index"L, JIndex];
RegisterExplicit[frame, ".execstk"L, JExecStk];
RegisterExplicit[frame, ".dictstk"L, JDictStk];
};
ENDCASE;
};
Install[InstallStack];
}.