-- 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 --