-- JaMArray.mesa
-- Written by: John Warnock, March 2, 1979
-- Last changed by Doug Wyatt, December 8, 1980 4:38 PM

DIRECTORY
JaMArrayDefs,
JaMMasterDefs
USING [Frame, Object, Stack],
JaMControlDefs
USING [GetCurrentFrame, NotifyCommand, NotifyStringObject,
RegisterIntCommand],
JaMExecDefs
USING [JaMError],
JaMFnsDefs
USING [PopInteger, PopObject, PushObject],
JaMStackDefs
USING [CountStk, MoveStkOps, Pop, Push, Top],
JaMTypeChkDefs
USING [DescArrayType],
JaMVMDefs
USING [AllocateWordsVM, GetWordsVM, PutWordsVM];

JaMArray: PROGRAM
IMPORTS JaMControlDefs,JaMExecDefs,JaMFnsDefs,
JaMStackDefs,JaMTypeChkDefs,JaMVMDefs
EXPORTS JaMArrayDefs =
BEGIN OPEN JaMArrayDefs,JaMMasterDefs,JaMFnsDefs,JaMVMDefs;

Array: PUBLIC PROCEDURE =
BEGIN
null:Object ← [lit,NullType[]];
i:INTEGER ← PopInteger[];
j:INTEGER ← 0;
array:ArrayType Object ←
[lit,ArrayType[i,AllocateWordsVM[i*SIZE[Object]]]];
IF i < 0 THEN RangeErr[];
FOR j IN [0..i-1] DO
PutWordsVM[array.ArrayPtr + SIZE[Object]*j,@null,SIZE[Object]];
ENDLOOP;
PushObject[array];
END;

ArrayCopy: PUBLIC PROCEDURE =
BEGIN
obj: Object;
arrayd: ArrayType Object;
arrays: ArrayType Object;
j,l: INTEGER;
arrays ← JaMTypeChkDefs.DescArrayType[PopObject[]];
l←arrays.Length;
arrayd← [arrays.litflag,ArrayType[l,AllocateWordsVM[l*SIZE[Object]]]];
FOR j IN [0..l) DO
GetWordsVM[arrays.ArrayPtr+SIZE[Object]*j,@obj,SIZE[Object]];
PutWordsVM[arrayd.ArrayPtr+SIZE[Object]*j,@obj,SIZE[Object]];
ENDLOOP;
PushObject[arrayd];
END;

ArrayPut: PUBLIC PROCEDURE =
BEGIN
val:Object ← PopObject[];
i:INTEGER ← PopInteger[];
array:ArrayType Object ← JaMTypeChkDefs.DescArrayType[PopObject[]];
IF i < 0 OR ABS[i] > array.Length - 1 THEN RangeErr[];
PutWordsVM[array.ArrayPtr + SIZE[Object]*i,@val,SIZE[Object]];
END;

ArrayGet: PUBLIC PROCEDURE =
BEGIN
val:Object;
i:INTEGER ← PopInteger[];
array:ArrayType Object ← JaMTypeChkDefs.DescArrayType[PopObject[]];
IF i < 0 OR ABS[i] > array.Length - 1 THEN RangeErr[];
GetWordsVM[array.ArrayPtr + SIZE[Object]*i,@val,SIZE[Object]];
PushObject[val];
END;


ArrayPart: PUBLIC PROCEDURE =
BEGIN
i:INTEGER ← PopInteger[];
j:INTEGER ← PopInteger[];
array:ArrayType Object ← JaMTypeChkDefs.DescArrayType[PopObject[]];
IF i < 0 OR j < 0 THEN RangeErr[];
IF ABS[i+j] >= array.Length THEN RangeErr[];
array.ArrayPtr ← array.ArrayPtr + j*SIZE[Object];
array.Length← i;
PushObject[array];
END;

ArrayAtom: PUBLIC PROCEDURE [aob:ArrayType Object,stk:JaMMasterDefs.Stack]
RETURNS [BOOLEAN] =
BEGIN
ob:Object;
IF aob.Length <= 0 THEN RETURN [FALSE];
GetWordsVM[aob.ArrayPtr,@ob,SIZE[Object]];
aob.ArrayPtr ← aob.ArrayPtr + SIZE[Object];
aob.Length← aob.Length - 1;
JaMStackDefs.Push[aob,stk];
JaMStackDefs.Push[ob,stk];
RETURN [TRUE];
END;

ArrayStore: PUBLIC PROCEDURE =
-- expects opstk: (ob0, ob1, ... , obn-1, array) array of length n
-- returns opstk: (array)
BEGIN
array: ArrayType Object ← JaMTypeChkDefs.DescArrayType[PopObject[]];
frame: Frame ← JaMControlDefs.GetCurrentFrame[];
val: Object;
i: CARDINAL ← array.Length*SIZE[Object];
IF array.Length > JaMStackDefs.CountStk[frame.opstk]
THEN JaMExecDefs.JaMError[StkUndFlw,TRUE];
THROUGH [0..array.Length)
DOi ← i - SIZE[Object];
val ← PopObject[];
PutWordsVM[array.ArrayPtr + i, @val,SIZE[Object]];
ENDLOOP;
JaMStackDefs.Push[array, frame.opstk];
END;

ArrayLoad: PUBLIC PROCEDURE =
-- expects opstk: (array) array of length n
-- returns opstk: (array[0], array[1], ... , array[n-1], array)
BEGIN
array: ArrayType Object ← JaMTypeChkDefs.DescArrayType[PopObject[]];
frame: Frame ← JaMControlDefs.GetCurrentFrame[];
val: Object;
i: CARDINAL;
FOR i ← 0, i+SIZE[Object] UNTIL i = array.Length*SIZE[Object]
DOGetWordsVM[array.ArrayPtr + i, @val,SIZE[Object]];
PushObject[val];
ENDLOOP;
JaMStackDefs.Push[array, frame.opstk];
END;


--"ArrayForall" is the "do for each array element" instruction. Two operands are required:
-- an Object. The Object is executed for each member of the
-- given array.

ArrayForall: PUBLIC PROCEDURE =
BEGIN OPEN JaMStackDefs;
frame:Frame ← JaMControlDefs.GetCurrentFrame[];
ob:Object ← Pop[frame.opstk];
array:ArrayType Object ←
JaMTypeChkDefs.DescArrayType[Pop[frame.opstk]];
m:MarkType Object←[nolit,MarkType[]];
Push[m,frame.execstk];
Push[ob,frame.execstk];
Push[array,frame.execstk];
Push[arrayc,frame.execstk];
END;

CArrayForall: PUBLIC PROCEDURE =
BEGIN OPEN JaMStackDefs;
frame:Frame ← JaMControlDefs.GetCurrentFrame[];
array:ArrayType Object ←
JaMTypeChkDefs.DescArrayType[Pop[frame.execstk]];
ob:Object ← Top[frame.execstk];
IF ArrayAtom[array,frame.execstk] THEN
BEGIN
MoveStkOps[frame.execstk,frame.opstk,1];
Push[arrayc,frame.execstk];
Push[ob,frame.execstk];
END
ELSE
BEGIN
[]←Pop[frame.execstk];
[]←Pop[frame.execstk];
END;
END;


RangeErr: PROCEDURE =
BEGIN
JaMExecDefs.JaMError[rangechk,TRUE];
END;

arrayc: CommandType Object;
StkUndFlw: StringType Object;
rangechk:StringType Object;

StartArray: PROCEDURE =
BEGIN OPEN JaMControlDefs;
arrayc ← RegisterIntCommand[CArrayForall];
NotifyStringObject[@StkUndFlw, ".stkundflw"L];
NotifyStringObject[@rangechk, ".rangechk"L];
NotifyCommand[".array"L,Array];
NotifyCommand[".aget"L,ArrayGet];
NotifyCommand[".aput"L,ArrayPut];
NotifyCommand[".subarray"L,ArrayPart];
NotifyCommand[".arrayforall"L,ArrayForall];
NotifyCommand[".astore"L,ArrayStore];
NotifyCommand[".aload"L,ArrayLoad];
NotifyCommand[".acopy"L,ArrayCopy];
END;

-- Initialization
StartArray;

END.

DKW March 28, 1980 4:56 PM
added StartArray

DKW April 1, 1980 2:56 PM
now uses NotifyCommand, NotifyStringObject

DKW December 8, 1980 12:41 PM
cleaned up CArrayForall to reduce stack shuffling