-- JaMArrayImpl.mesa
-- Last edit by Doug Wyatt,  7-Oct-81 16:57:40

DIRECTORY
  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],
  Inline USING [LongMult];

JaMArrayImpl: PROGRAM
IMPORTS JaMOps, JaMVM, Inline
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 + Inline.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