-- BasicVariable.mesa
-- edited by Brotz and Hilton, July 20, 1982  3:29 PM

DIRECTORY
  Ascii,
  BasicDefs,
  BasicImpDefs,
  Storage,
  String;

BasicVariable: PROGRAM
  IMPORTS BasicImpDefs, Storage, String 
  EXPORTS BasicDefs, BasicImpDefs =

BEGIN
OPEN BasicDefs, BasicImpDefs;


variableHead: PUBLIC VariablePtr _ NIL;
constantHead: PUBLIC VariablePtr _ NIL;
nConstants: CARDINAL _ 0;


AllocateArray: PUBLIC PROCEDURE [rowIndex, columnIndex: CARDINAL _ optionBase,
  varPtr: VariablePtr] = 
BEGIN
aPtr: ArrayRecordPtr;
optionBaseCalled _ TRUE;
aPtr _ Storage.Node[SIZE[ArrayRecord] + SIZE[BasicValue] *
  (rowIndex - optionBase + 1) * (columnIndex - optionBase + 1)];
aPtr^ _ [lb1: optionBase, ub1: rowIndex, lb2: optionBase, ub2: columnIndex,
  base: ];
FOR i: CARDINAL _ 0, i + 1 
  UNTIL i = (rowIndex - optionBase + 1) * (columnIndex - optionBase + 1) DO
    aPtr.base[i] _ BasicValueZero;
    ENDLOOP;
WITH v: varPtr SELECT FROM
  numeric => v.arrayPtr _ aPtr;
  ENDCASE => ERROR;
END;  -- of AllocateArray --


AllocateConstant:
  PUBLIC PROCEDURE [bv: BasicValue] RETURNS [varPtr: VariablePtr] =
BEGIN
FOR varPtr _ constantHead, varPtr.next UNTIL varPtr = NIL DO
  IF bv.type = varPtr.value.type
    AND (SELECT bv.type FROM
      integer => bv.integerValue = varPtr.value.integerValue,
      real => bv.realValue = varPtr.value.realValue,
      string => String.EqualString[bv.stringValue, varPtr.value.stringValue],
      ENDCASE => ERROR)
    THEN RETURN;
  ENDLOOP;
varPtr _ Storage.Node[SIZE[VariableRecord]];
varPtr^ _ VariableRecord
  [next: constantHead, pushDown: NIL, name: NIL, value: bv,
  varPart: numeric[arrayPtr: NIL]];
IF bv.type = string THEN
  varPtr.value.stringValue _ Storage.CopyString[bv.stringValue];
constantHead _ varPtr;
END;  -- of AllocateConstant --


AllocateVariableRecord: PUBLIC PROCEDURE [name: STRING, next: VariablePtr]
  RETURNS [new: VariablePtr] =
BEGIN
nameString: STRING _ Storage.String[name.length];
String.AppendString[nameString, name];
new _ Storage.Node[SIZE[VariableRecord]];
SELECT TRUE FROM
  ~IsVariableName[name] =>
      new^ _ [next: next, pushDown: NIL, name: nameString, value: BasicValueZero,
        varPart: builtInFunction[proc: NIL]];
  (String.LowerCase[nameString[0]] = 'f 
    AND String.LowerCase[nameString[1]] = 'n) =>
      BEGIN
      new^ _ [next: next, pushDown: NIL, name: nameString, value: BasicValueZero,
        varPart: userFunction[defLineNumber: 0]];
      IF LastChar[name] = '$ THEN
        new.value _ BasicValue[string, string[stringValue: Storage.String[18]]];
      END;
  LastChar[name] = '$ =>
    new^ _ VariableRecord[next: next, pushDown: NIL, name: nameString,
        value: BasicValue[string, string[stringValue: Storage.String[18]]], varPart: string[]];
  ENDCASE => new^ _ VariableRecord[next: next, pushDown: NIL, name: nameString,
      value: BasicValueZero, varPart: numeric[arrayPtr: NIL]];
END;  -- of AllocateVariableRecord --


IsVariableName: PROCEDURE [name: STRING] RETURNS [BOOLEAN] =
BEGIN
RETURN[name.length > 0 AND charTablePtr[name[0]] = letter
  AND (name.length = 1
    OR (name.length = 2 AND (name[1] IN ['0 .. '9] OR name[1] = '$))
    OR (name.length = 3 AND name[1] IN ['0 .. '9] AND name[2] = '$)
    OR (String.LowerCase[name[0]] = 'f AND String.LowerCase[name[1]] = 'n
      AND charTablePtr[name[2]] = letter
      AND (name.length = 3 OR (name.length = 4 AND name[3] = '$))))];
END;  -- of IsVariableName --


LastChar: PUBLIC PROCEDURE [string: STRING] RETURNS [char: CHARACTER] =
BEGIN
RETURN[IF string.length = 0 THEN Ascii.NUL ELSE string[string.length - 1]];
END;  -- of LastChar --


LookUpVariable: PUBLIC PROCEDURE [varString: STRING] RETURNS [varPtr: VariablePtr] =
-- Looks up the variable varString from the single linked variable chain and returns the
--   pointer to that variable.  If no such variable exists then LookUpVariable allocates storage
--   for the new variable and initializes its record fields.
BEGIN
SELECT TRUE FROM
  charTablePtr[varString[0]] # letter => ParseError["Variables must begin with a letter!"L];
  IsReservedWord[varString] => ParseError["A variable cannot be a reserved word!"L];
  ENDCASE =>
    BEGIN
    varPtr _ variableHead;
    FOR varPtr _ variableHead, varPtr _ varPtr.next
      UNTIL varPtr = NIL OR String.EquivalentString[varPtr.name, varString] DO
      ENDLOOP;
    IF varPtr = NIL THEN
      variableHead _ varPtr _ AllocateVariableRecord[varString, variableHead];
    END;
END;  -- of LookUpVariable --


PopVariable: PUBLIC PROCEDURE [varPtr: VariablePtr] =
-- Restores the variable pushed below varPtr for function return.  Destroys variable
--   currently at varPtr.
BEGIN
old: VariablePtr _ varPtr.pushDown;
IF old = NIL THEN RunTimeError["BASIC internal error: PopVariable"L];
WITH v: varPtr SELECT FROM
  string => Storage.FreeString[v.value.stringValue];
  ENDCASE;
varPtr^ _ old^;
Storage.Free[old];
END;  -- of PopVariable --


PushDownVariable: PUBLIC PROCEDURE [varPtr: VariablePtr] =
-- Creates a new variable at varPtr for a function's parameter, saving the old variable.
BEGIN
old: VariablePtr _ Storage.Node[SIZE[VariableRecord]];
old^ _ varPtr^;
WITH v: varPtr SELECT FROM
  numeric => {v.value _ BasicValueZero; v.arrayPtr _ NIL};
  string => NULL;
  ENDCASE => RunTimeError["BASIC internal error: PushDownVariable"L];
IF varPtr.value.type = string THEN varPtr.value.stringValue _ Storage.String[18];
varPtr.pushDown _ old;
END;  -- of PushDownVariable --


RegisterBuiltInFunction: PUBLIC PROCEDURE [name: STRING, proc: BuiltInFunction] =
BEGIN
varPtr: VariablePtr;
IF IsVariableName[name] OR IsReservedWord[name] THEN
  BEGIN
  string: STRING _ [80];
  String.AppendString[string, name];
  String.AppendString[string, " is not a valid name for a built in function."L];
  RunTimeError[string];
  END;
varPtr _ LookUpVariable[name];
WITH v: varPtr SELECT FROM
  builtInFunction => v.proc _ proc;
  ENDCASE => ERROR;
END;  -- of RegisterBuiltInFunction --


VariableCleanUp:  PUBLIC PROCEDURE =
BEGIN
varPtr, nextVarPtr: VariablePtr;
FOR varPtr _ variableHead, nextVarPtr UNTIL varPtr = NIL DO
  nextVarPtr  _ varPtr.next;
  IF varPtr.value.type = string THEN Storage.FreeString[varPtr.value.stringValue];
  WITH v: varPtr SELECT FROM
    numeric => IF v.arrayPtr # NIL THEN Storage.Free[v.arrayPtr];
    ENDCASE;
  Storage.FreeString[varPtr.name];
  Storage.Free[varPtr];
  ENDLOOP;
END;  -- of VariableCleanUp --


END.  -- of BasicVariable --(635)\f1