JaMArrayImpl.mesa
Doug Wyatt, 7-Oct-81 16:57:40
Russ Atkinson, July 22, 1983 6:04 pm
DIRECTORY
Basics USING [LongMult],
JaMBasic USING [Object],
JaMInternal USING [Frame, Stack],
JaMOps USING
[CountStack, Equal, Error, Install, InstallReason, MarkLoop, nullOb, Pop, PopArray, PopCardinal, PopDict, Push, PushBoolean, PushInteger, rangechk, RegisterExplicit, RegisterInternal, Top, TryToGet, Underflow, UnmarkLoop],
JaMVM USING [AllocArray, CopyArray, GetElem, PutElem];
JaMArrayImpl: PROGRAM
IMPORTS JaMOps, JaMVM, Basics
EXPORTS JaMOps = {
OPEN VM: JaMVM, JaMOps, JaMInternal, JaMBasic;
Constants
lengthLimit: CARDINAL = LAST[CARDINAL]; -- maximum length for an array
GLOBALS
arraycmd: command Object;
Primitives
Head: PROC[a: array Object, n: CARDINAL] RETURNS[array Object] = INLINE {
IF n<a.length THEN a.length ← n; RETURN[a] };
Tail: PROC[a: array Object, n: CARDINAL] RETURNS[array Object] = INLINE {
IF n>a.length THEN n ← a.length; a.length ← a.length - n;
a.base ← a.base + Basics.LongMult[n,SIZE[Object]]; RETURN[a] };
Array Operations
Array: PUBLIC PROC[length: CARDINAL] RETURNS[array Object] = {
array: array Object ← VM.AllocArray[length];
RETURN[array];
};
ACopy: PUBLIC PROC[array: array Object, expand: CARDINAL ← 0]
RETURNS[array Object] = {
oldlen: CARDINAL = array.length;
newlen: CARDINAL = oldlen + MIN[expand,lengthLimit-oldlen];
new: array Object ← VM.AllocArray[newlen];
VM.CopyArray[src: array, dst: new]; RETURN[new];
};
SubArray: PUBLIC PROC[array: array Object, beg,len: CARDINAL]
RETURNS[array Object] = {
IF beg>array.length OR len>(array.length-beg) THEN ERROR Error[rangechk];
RETURN[Head[Tail[array,beg],len]];
};
PutArray: PUBLIC PROC[from: array Object, beg: CARDINAL, into: array Object] = {
IF beg>into.length OR from.length>(into.length-beg) THEN ERROR Error[rangechk];
VM.CopyArray[from,Tail[into,beg]];
};
APut: PUBLIC PROC[array: array Object, i: CARDINAL, ob: Object] = {
IF i<array.length THEN VM.PutElem[array,i,ob]
ELSE ERROR Error[rangechk];
};
AGet: PUBLIC PROC[array: array Object, i: CARDINAL] RETURNS[Object] = {
IF i<array.length THEN RETURN[VM.GetElem[array,i]]
ELSE ERROR Error[rangechk];
};
AFind: PUBLIC PROC[array: array Object, ob: Object]
RETURNS[found: BOOLEAN, i: CARDINAL] = {
FOR i: CARDINAL IN[0..array.length) DO
elem: Object ← VM.GetElem[array,i];
IF Equal[elem,ob] THEN RETURN[TRUE,i];
ENDLOOP;
RETURN[FALSE,0];
}; -- find object in array
AAtom: PUBLIC PROC[array: array Object]
RETURNS[found: BOOLEAN, atom: Object, rem: array Object] = {
IF array.length>0 THEN RETURN[TRUE,VM.GetElem[array,0],Tail[array,1]]
ELSE RETURN[FALSE,nullOb,array];
}; -- return first element and remainder of array
AStore: PUBLIC PROC[stack: Stack, array: array Object] = {
IF CountStack[stack, array.length]<array.length THEN Underflow[stack];
FOR i: CARDINAL DECREASING IN[0..array.length) DO
ob: Object ← Pop[stack]; VM.PutElem[array,i,ob];
ENDLOOP;
}; -- store all elements into array from stack
ALoad: PUBLIC PROC[stack: Stack, array: array Object] = {
FOR i: CARDINAL IN[0..array.length) DO
ob: Object ← VM.GetElem[array,i]; Push[stack,ob];
ENDLOOP;
}; -- push all elements from array onto stack
ABind: PUBLIC PROC[array: array Object, dict: dict Object] = {
FOR i: CARDINAL IN[0..array.length) DO
ob: Object ← VM.GetElem[array,i];
WITH ob:ob SELECT FROM
array => ABind[ob,dict];
name => IF ob.tag=X THEN {
value: Object; known: BOOLEAN;
[known,value] ← TryToGet[dict,ob];
IF known THEN VM.PutElem[array,i,value] };
ENDCASE;
ENDLOOP;
}; -- bind names in array to values in dict
Array Intrinsics
JArray: PUBLIC PROC[frame: Frame] = {
n: CARDINAL ← PopCardinal[frame.opstk,lengthLimit];
array: array Object ← Array[n];
Push[frame.opstk,array];
};
JACopy: PUBLIC PROC[frame: Frame] = {
array: array Object ← PopArray[frame.opstk];
acopy: array Object ← ACopy[array];
Push[frame.opstk,acopy];
};
JAPut: PUBLIC PROC[frame: Frame] = {
ob: Object ← Pop[frame.opstk];
i: CARDINAL ← PopCardinal[frame.opstk];
array: array Object ← PopArray[frame.opstk];
APut[array,i,ob];
};
JAGet: PUBLIC PROC[frame: Frame] = {
i: CARDINAL ← PopCardinal[frame.opstk];
array: array Object ← PopArray[frame.opstk];
ob: Object ← AGet[array,i];
Push[frame.opstk,ob];
};
JSubArray: PUBLIC PROC[frame: Frame] = {
len: CARDINAL ← PopCardinal[frame.opstk];
beg: CARDINAL ← PopCardinal[frame.opstk];
array: array Object ← PopArray[frame.opstk];
t: array Object ← SubArray[array,beg,len];
Push[frame.opstk,t];
};
JPutArray: PUBLIC PROC[frame: Frame] = {
from: array Object ← PopArray[frame.opstk];
beg: CARDINAL ← PopCardinal[frame.opstk];
into: array Object ← PopArray[frame.opstk];
PutArray[from,beg,into];
Push[frame.opstk,into];
};
JAFind: PUBLIC PROC[frame: Frame] = {
ob: Object ← Pop[frame.opstk];
array: array Object ← PopArray[frame.opstk];
known: BOOLEAN; i: CARDINAL;
[known,i] ← AFind[array,ob];
IF known THEN PushInteger[frame.opstk,i];
PushBoolean[frame.opstk,known];
};
JAAtom: PUBLIC PROC[frame: Frame] = {
array: array Object ← PopArray[frame.opstk];
found: BOOLEAN; atom,rest: Object;
[found,atom,rest] ← AAtom[array];
IF found THEN { Push[frame.opstk,rest]; Push[frame.opstk,atom] };
PushBoolean[frame.opstk,found];
};
JAStore: PUBLIC PROC[frame: Frame] = {
array: array Object ← PopArray[frame.opstk];
AStore[frame.opstk,array];
Push[frame.opstk,array];
};
JALoad: PUBLIC PROC[frame: Frame] = {
array: array Object ← PopArray[frame.opstk];
ALoad[frame.opstk,array];
Push[frame.opstk,array];
};
JABind: PUBLIC PROC[frame: Frame] = {
dict: dict Object ← PopDict[frame.opstk];
array: array Object ← PopArray[frame.opstk];
ABind[array,dict];
};
CArrayForall: PROC[frame: Frame] = {
array: array Object ← PopArray[frame.execstk];
ob: Object ← Top[frame.execstk];
IF array.length>0 THEN {
elem: Object ← VM.GetElem[array,0];
rest: array Object ← Tail[array,1];
Push[frame.execstk,rest]; -- rest of array
Push[frame.execstk,arraycmd]; -- this procedure
Push[frame.opstk,elem]; -- current array element
Push[frame.execstk,ob]; -- object to be executed
}
ELSE {
[] ← Pop[frame.execstk]; -- remove object
UnmarkLoop[frame]; -- remove mark
};
};
JArrayForAll: PUBLIC PROC[frame: Frame] = {
ob: Object ← Pop[frame.opstk];
array: array Object ← PopArray[frame.opstk];
MarkLoop[frame]; -- mark scope of loop
Push[frame.execstk,ob]; -- object to be executed for each element
Push[frame.execstk,array]; -- array to be enumerated
Push[frame.execstk,arraycmd]; -- internal command that does the work
};
Initialization
InstallArray: PROC[why: InstallReason, frame: Frame] = { SELECT why FROM
register => {
arraycmd ← RegisterInternal["@arrayforall"L, CArrayForall];
RegisterExplicit[frame, ".array"L, JArray];
RegisterExplicit[frame, ".aget"L, JAGet];
RegisterExplicit[frame, ".aput"L, JAPut];
RegisterExplicit[frame, ".subarray"L, JSubArray];
RegisterExplicit[frame, ".putarray"L, JPutArray];
RegisterExplicit[frame, ".arrayforall"L, JArrayForAll];
RegisterExplicit[frame, ".astore"L, JAStore];
RegisterExplicit[frame, ".aload"L, JALoad];
RegisterExplicit[frame, ".acopy"L, JACopy];
RegisterExplicit[frame, ".abind"L, JABind];
RegisterExplicit[frame, ".afind"L, JAFind];
};
ENDCASE;
};
Install[InstallArray];
}.
Paxton January 7, 1981 5:03 PM
added ArraySpread, ArryCopy, Arry, ArryGet, ArryPut
Paxton January 23, 1981 2:47 PM
added ArrayBind, ArryBind, ArrayFind, ArryFind
Wyatt 16-Apr-81 12:46:09
Pilot conversion
Wyatt 28-Aug-81 14:45:50
rewrite
Wyatt 22-Sep-81 14:46:44
add .putarray