-- BasicInterpA.mesa
-- edited by Brotz and Hilton, September 23, 1982 2:28 PM

DIRECTORY
BasicDefs,
BasicImpDefs,
BasicOps,
Inline,
IODefs,
RealFns,
RealOps,
Storage,
StreamDefs,
String,
vmD: FROM "VirtualMgrDefs";

BasicInterpA: PROGRAM
IMPORTS BasicImpDefs, BasicOps, Inline, IODefs, RealFns, RealOps, Storage, StreamDefs,
String, vmD
EXPORTS BasicImpDefs, BasicOps =

BEGIN
OPEN BasicDefs, BasicImpDefs;

stack: PUBLIC ARRAY (0 .. stackLimit) OF BasicValue;
stackPointer: PUBLIC CARDINAL ← 0;

currentProgLine: PUBLIC ProgramLineDescPtr ← NIL;
contPc: PUBLIC ProgramLineDescPtr ← NIL;

autoIncrement: PUBLIC CARDINAL ← 10;
autoOn: PUBLIC BOOLEAN ← FALSE; -- used for automatic numbering --
autoStart: PUBLIC CARDINAL ← 10;

dataLinePc: PUBLIC ProgramLineDescPtr ← NIL;
dataItem: PUBLIC CARDINAL ← 0;
noMoreData: PUBLIC BOOLEAN ← FALSE;

fnEvalStack: PUBLIC FnEvalRecordPtr ← NIL;

goSubHead: PUBLIC GoSubStackPtr ← NIL;

loadedConfigs: PUBLIC LoadedConfigRecPtr ← NIL;

nextStackHead: PUBLIC NextStackPtr ← NIL;

trigMode: PUBLIC TrigonometricMode ← radians;


opCode: PUBLIC ARRAY [1 .. BasicOps.nOps] OF BasicOps.OpCodeRec ←
[[BasicOps.PushOp, var, "Push"],
[BasicOps.PopOp, var, "Pop"],
[BasicOps.PushIOp, byte, "PushI"],
[AddOp, loner, "Add"],
[BasicOps.SubOp, loner, "Sub"],
[BasicOps.MulOp, loner, "Mul"],
[DivOp, loner, "Div"],
[CallBuiltInFnOp, var, "CallBuiltInFn"],
[Arr1PushOp, var, "Arr1Push"],
[Arr2PushOp, var, "Arr2Push"],
[Arr1PopOp, var, "Arr1Pop"],
[Arr2PopOp, var, "Arr2Pop"],
[CallUserFnOp, var, "CallUserFn"],
[AndOp, loner, "And"],
[BasicOps.OrOp, loner, "Or"],
[BasicOps.NotOp, loner, "Not"],
[ExpOp, loner, "Exp"],
[EqualOp, loner, "Equal"],
[BasicOps.NEOp, loner, "NE"],
[GEOp, loner, "GE"],
[BasicOps.LEOp, loner, "LE"],
[GreaterOp, loner, "Greater"],
[BasicOps.LesserOp, loner, "Lesser"],
[BasicOps.ReadOp, loner, "Read"],
[BasicOps.PrintOp, loner, "Print"],
[EndOp, loner, "End"],
[FnEndOp, loner, "FnEnd"],
[GoToOp, label, "GoTo"],
[GoSubOp, label, "GoSub"],
[DoneOp, loner, "Done"],
[BasicOps.OnGoToOp, labelList, "OnGoTo"],
[BasicOps.OnGoSubOp, labelList, "OnGoSub"],
[IfZeroDoneOp, loner, "IfZeroDone"],
[ForOp, var, "For"],
[BasicOps.NextOp, var, "Next"],
[BasicOps.ReturnOp, loner, "Return"],
[BasicOps.QuitOp, loner, "Quit"],
[BasicOps.UnaryMinusOp, loner, "UnaryMinus"],
[BasicOps.TabOp, loner, "Tab"],
[BasicOps.LoadOp, loner, "Load"],
[BasicOps.RunOp, loner, "Run"],
[ContOp, loner, "Cont"],
[AutoOp, loner, "Auto"],
[BasicOps.ListOp, loner, "List"],
[BasicOps.RenumberOp, loner, "Renumber"],
[BasicOps.StopOp, loner, "Stop"],
[DeleteOp, loner, "Delete"],
[DimOp, var, "Dim"],
[DimStrOp, var, "DimStr"],
[DefFnOp, defFn, "DefFn"],
[BasicOps.NormalOp, loner, "Normal"],
[CodeListOp, loner, "CodeList"],
[ImageOp, loner, "Image"],
[BasicOps.UsingOp, label, "Using"],
[InputNumOp, byte, "InputNum"],
[InputStrOp, byte, "InputStr"],
[BasicOps.RestoreOp, loner, "Restore"],
[DataOp, varList, "Data"],
[BasicOps.Str1PushOp, var, "Str1Push"],
[BasicOps.Str2PushOp, var, "Str2Push"],
[BasicOps.Str1PopOp, var, "Str1Pop"],
[BasicOps.Str2PopOp, var, "Str2Pop"],
[HelpOp, loner, "Help"]];


AddOp: BasicOps.OpCodeProc =
BEGIN
RETURN[ArithmeticOp[add], pc];
END; -- of AddOp --


AndOp: BasicOps.OpCodeProc =
BEGIN
bv1, bv2: BasicValue;
bv2 ← Pop[];
bv1 ← Pop[];
IF (bv1.type = string) # (bv2.type = string) THEN
RunTimeError["And between numeric and string!"L];
IF bv1.type = string THEN
BEGIN
string: STRING ← Storage.String[bv1.stringValue.length + bv2.stringValue.length];
String.AppendString[string, bv1.stringValue];
String.AppendString[string, bv2.stringValue];
Storage.FreeString[bv1.stringValue];
Storage.FreeString[bv2.stringValue];
bv1.stringValue ← string;
Push[bv1];
Storage.FreeString[bv1.stringValue];
END
ELSE BEGIN
i1: CARDINAL ← ConvertToCardinal[@bv1];
i2: CARDINAL ← ConvertToCardinal[@bv1];
PushInteger[IF i1 = 0 OR i2 = 0 THEN 0 ELSE 1];
END;
RETURN[FALSE, pc];
END; -- of AndOp --


AppendByte: PUBLIC PROCEDURE [cm: vmD.ComposedMessagePtr, byte: BasicOps.Byte] =
BEGIN
vmD.AppendMessageChar[cm, LOOPHOLE[byte]];
END; -- of AppendByte --


AppendPointer: PUBLIC PROCEDURE [cm: vmD.ComposedMessagePtr, pointer: POINTER] =
BEGIN
TwoHalf: TYPE = MACHINE DEPENDENT RECORD [high, low: BasicOps.Byte];
vmD.AppendMessageChar[cm, LOOPHOLE[LOOPHOLE[pointer, TwoHalf].high]];
vmD.AppendMessageChar[cm, LOOPHOLE[LOOPHOLE[pointer, TwoHalf].low]];
END; -- of AppendPointer --


ArithmeticOp: PUBLIC PROCEDURE [op: BasicOps.ArithmeticOpType]
RETURNS [done: BOOLEAN] =
BEGIN
bv1, bv2, result: BasicValue;
real1, real2: REAL;
int1, int2: Numeric;
operation: {integer, real} ← integer;
bv2 ← Pop[];
bv1 ← Pop[];
IF bv1.type = string OR bv2.type = string THEN
BEGIN
IF bv1.type = string THEN Storage.FreeString[bv1.stringValue];
IF bv2.type = string THEN Storage.FreeString[bv2.stringValue];
RunTimeError["Non-Numeric value in numeric expression"L];
END;
IF bv1.type = real OR bv2.type = real OR op = exp OR op = div THEN
BEGIN -- make sure both numbers are real --
[real1, real2] ← FloatIntegers[@bv1, @bv2];
operation ← real;
END
ELSE -- make sure both numbers are integers --
{int1 ← bv1.integerValue; int2 ← bv2.integerValue};
IF operation = real THEN
result ← BasicValue[real, real[realValue:
SELECT op FROM
add => RealOps.FAdd[real1, real2],
sub => RealOps.FSub[real1, real2],
mul => RealOps.FMul[real1, real2],
div => RealOps.FDiv[real1, real2],
exp => RealFns.Power[real1, real2],
ENDCASE => ERROR]]
ELSE result ← BasicValue[integer, integer[integerValue:
SELECT op FROM
add => int1 + int2,
sub => int1 - int2,
mul => int1 * int2,
div => int1 / int2,
ENDCASE => ERROR]];
Push[result];
RETURN[FALSE];
END; -- of ArithmeticOp --


Arr1PopOp: BasicOps.OpCodeProc =
BEGIN
bvIndex, bv: BasicValue;
index: CARDINAL;
vp: VariablePtr;
done ← FALSE;
bv ← Pop[];
bvIndex ← Pop[];
[vp, newPc] ← FetchPointer[cm, pc];
index ← ConvertToCardinal[@bvIndex];
WITH varptr: vp SELECT FROM
numeric =>
BEGIN
IF varptr.arrayPtr = NIL THEN
BEGIN
IF index <= optionBase + 9 THEN AllocateArray[optionBase + 9, optionBase, vp]
ELSE RunTimeError["Array index out of bounds."L];
END;
IF index ~IN [varptr.arrayPtr.lb1 .. varptr.arrayPtr.ub1] THEN
RunTimeError["Array index out of bounds."L]
ELSE varptr.arrayPtr.base[index - varptr.arrayPtr.lb1] ← bv;
END;
ENDCASE => RunTimeError["Assignment to non-numeric array"L];
END; -- of Arr1PopOp --


Arr1PushOp: BasicOps.OpCodeProc =
BEGIN
bvIndex: BasicValue;
index: CARDINAL;
vp: VariablePtr;
done ← FALSE;
bvIndex ← Pop[];
[vp, newPc] ← FetchPointer[cm, pc];
index ← ConvertToCardinal[@bvIndex];
WITH varptr: vp SELECT FROM
numeric =>
BEGIN
IF varptr.arrayPtr = NIL THEN
BEGIN
IF index <= optionBase + 9 THEN AllocateArray[optionBase + 9, optionBase, vp]
ELSE RunTimeError["Array index out of bounds."L];
END;
IF index ~IN [varptr.arrayPtr.lb1 .. varptr.arrayPtr.ub1] THEN
RunTimeError["Array index out of bounds."L]
ELSE Push[varptr.arrayPtr.base[index - varptr.arrayPtr.lb1]];
END;
ENDCASE => RunTimeError["Assignment to non-numeric array"L];
END; -- of Arr1PushOp --


Arr2PopOp: BasicOps.OpCodeProc =
BEGIN
bvIndex1, bvIndex2, bv: BasicValue;
index1, index2: CARDINAL;
vp: VariablePtr;
done ← FALSE;
bv ← Pop[];
bvIndex2 ← Pop[];
bvIndex1 ← Pop[];
[vp, newPc] ← FetchPointer[cm, pc];
index1 ← ConvertToCardinal[@bvIndex1];
index2 ← ConvertToCardinal[@bvIndex2];
WITH varptr: vp SELECT FROM
numeric =>
BEGIN
IF varptr.arrayPtr = NIL THEN
BEGIN
IF (index1 <= optionBase + 9) AND (index2 <= optionBase + 9) THEN
AllocateArray[optionBase + 9, optionBase + 9, vp]
ELSE RunTimeError["Array index out of bounds."L];
END;
IF index1 ~IN [varptr.arrayPtr.lb1 .. varptr.arrayPtr.ub1]
OR index2 ~IN [varptr.arrayPtr.lb2 .. varptr.arrayPtr.ub2]
THEN RunTimeError["Array index out of bounds."L]
ELSE varptr.arrayPtr.base
[(index1 - varptr.arrayPtr.lb1) * (varptr.arrayPtr.ub2 - varptr.arrayPtr.lb2 + 1)
+ (index2 - varptr.arrayPtr.lb2)] ← bv;
END;
ENDCASE => RunTimeError["Assignment to non-numeric array"L];
END; -- of Arr2PopOp --


Arr2PushOp: BasicOps.OpCodeProc =
BEGIN
bvIndex1, bvIndex2: BasicValue;
index1, index2: CARDINAL;
vp: VariablePtr;
done ← FALSE;
bvIndex2 ← Pop[];
bvIndex1 ← Pop[];
[vp, newPc] ← FetchPointer[cm, pc];
index1 ← ConvertToCardinal[@bvIndex1];
index2 ← ConvertToCardinal[@bvIndex2];
WITH varptr: vp SELECT FROM
numeric =>
BEGIN
IF varptr.arrayPtr = NIL THEN
BEGIN
IF (index1 <= optionBase + 9) AND (index2 <= optionBase + 9) THEN
AllocateArray[optionBase + 9, optionBase + 9, vp]
ELSE RunTimeError["Array index out of bounds."L];
END;
IF index1 ~IN [varptr.arrayPtr.lb1 .. varptr.arrayPtr.ub1]
OR index2 ~IN [varptr.arrayPtr.lb2 .. varptr.arrayPtr.ub2]
THEN RunTimeError["Array index out of bounds."L]
ELSE Push[varptr.arrayPtr.base
[(index1 - varptr.arrayPtr.lb1) * (varptr.arrayPtr.ub2 - varptr.arrayPtr.lb2 + 1)
+ (index2 - varptr.arrayPtr.lb2)]];
END;
ENDCASE => RunTimeError["Assignment to non-numeric array"L];
END; -- of Arr2PushOp --


AutoOp: BasicOps.OpCodeProc =
BEGIN
bv: BasicValue;
bv ← Pop[];
autoIncrement ← ConvertToCardinal[@bv];
bv ← Pop[];
autoOn ← TRUE;
autoStart ← ConvertToCardinal[@bv] - autoIncrement;
-- OutputAutoLineNumber[] will add autoIncrement back to autoStart.
END; -- of AutoOp --


CallBuiltInFnOp: BasicOps.OpCodeProc =
BEGIN
bv1, bv2: BasicValue;
varPtr: VariablePtr;
bv2 ← Pop[];
bv1 ← Pop[];
[varPtr, newPc] ← FetchPointer[cm, pc];
WITH v: varPtr SELECT FROM
builtInFunction =>
IF v.proc = NIL THEN RunTimeError["Undefined built-in function!"L]
ELSE Push[v.proc[bv1, bv2]];
ENDCASE => ERROR;
RETURN[FALSE, newPc];
END; -- of CallBuiltInFnOp --


CallUserFnOp: BasicOps.OpCodeProc =
BEGIN
bv: BasicValue;
varPtr: VariablePtr;
bv ← Pop[];
[varPtr, pc] ← FetchPointer[cm, pc];
WITH v: varPtr SELECT FROM
userFunction =>
BEGIN
node: FnEvalRecordPtr ← Storage.Node[SIZE[FnEvalRecord]];
parVarPtr: VariablePtr;
newProgLine: ProgramLineDescPtr;
[newPc, newProgLine] ← FindUserFunctionDef[varPtr, cm];
[parVarPtr, newPc] ← FetchPointer[cm, newPc];
node↑ ← FnEvalRecord
[next: fnEvalStack, fn: @v, parameter: parVarPtr, returnPc: pc,
returnProgLine: currentProgLine];
fnEvalStack ← node;
currentProgLine ← newProgLine;
IF parVarPtr # LOOPHOLE[0] THEN
BEGIN
PushDownVariable[parVarPtr];
WITH p: parVarPtr SELECT FROM
numeric => p.value ← bv;
string =>
BEGIN
target: STRING ← p.value.stringValue;
target.length ← MIN[bv.stringValue.length, target.maxlength];
FOR i: CARDINAL IN [0 .. target.length) DO
target[i] ← bv.stringValue[i];
ENDLOOP;
Storage.FreeString[bv.stringValue];
END;
ENDCASE => ERROR;
END;
v.value ← BasicValueZero;
END
ENDCASE => ERROR;
RETURN[FALSE, newPc];
END; -- of CallUserFnOp --


ChooseLineNumber: PUBLIC PROCEDURE [cm: vmD.ComposedMessagePtr, pc: vmD.CharIndex]
RETURNS [CARDINAL] =
BEGIN
bv: BasicValue ← Pop[];
i: CARDINAL ← ConvertToCardinal[@bv];
lineNumber: POINTER;
IF i < 1 THEN RunTimeError["ON expression out of range!"L];
THROUGH [1 .. i] DO
[lineNumber, pc] ← FetchPointer[cm, pc];
IF lineNumber = LOOPHOLE[0] THEN RunTimeError["ON expression out of range!"L];
ENDLOOP;
RETURN[LOOPHOLE[lineNumber]];
END; -- of ChooseLineNumber --


ClearStack: PUBLIC PROCEDURE =
-- Clears execution stack.
BEGIN
bv: BasicValue;
UNTIL stackPointer = 0 DO
bv ← Pop[];
IF bv.type = string THEN Storage.FreeString[bv.stringValue];
ENDLOOP;
END; -- of ClearStack --


CodeListOp: BasicOps.OpCodeProc =
BEGIN
ListOperation[ListSourceAndCodeLine];
RETURN[FALSE, pc];
END; -- of CodeListOp --


Compare: PUBLIC PROCEDURE [bvp1, bvp2: BasicValuePtr] RETURNS [result: INTEGER] =
-- Returns -1 if bvp1 < bvp2, 0 if bvp1 = bvp2, 1 if bvp1 > bvp2.
BEGIN
SELECT bvp1.type FROM
integer =>
SELECT bvp2.type FROM
integer => RETURN
[SELECT bvp1.integerValue FROM
= bvp2.integerValue => 0,
< bvp2.integerValue => -1,
ENDCASE => 1];
real => RETURN[RealOps.FComp[RealOps.Float[bvp1.integerValue], bvp2.realValue]];
string =>
BEGIN
Storage.FreeString[bvp2.stringValue];
RunTimeError["Comparing numeric to string!"L];
END;
ENDCASE;
real =>
SELECT bvp2.type FROM
integer => RETURN[RealOps.FComp[bvp1.realValue, RealOps.Float[bvp2.integerValue]]];
real => RETURN[RealOps.FComp[bvp1.realValue, bvp2.realValue]];
string =>
BEGIN
Storage.FreeString[bvp2.stringValue];
RunTimeError["Comparing numeric to string!"L];
END;
ENDCASE;
string =>
SELECT bvp2.type FROM
integer, real =>
BEGIN
Storage.FreeString[bvp1.stringValue];
RunTimeError["Comparing string to numeric!"L];
END;
string => BEGIN
result ← String.CompareStrings[bvp1.stringValue, bvp2.stringValue];
Storage.FreeString[bvp1.stringValue];
Storage.FreeString[bvp2.stringValue];
END;
ENDCASE;
ENDCASE;
END; -- of Compare --


ContOp: BasicOps.OpCodeProc =
BEGIN
bv: BasicValue;
IF contPc = NIL THEN RunTimeError["Can’t continue."L];
bv ← BasicValue[type: integer, varPart: integer[integerValue: contPc.lineNumber]];
Push[bv];
[ , ] ← BasicOps.RunOp[cm, pc];
RETURN[TRUE, pc];
END; -- of ContOp --


ConvertToCardinal: PUBLIC PROCEDURE [bv: BasicValuePtr] RETURNS [n: CARDINAL] =
BEGIN
SELECT bv.type FROM
integer => n ← Inline.LowHalf[bv.integerValue];
real => n ← RealOps.RoundC[bv.realValue];
ENDCASE =>
BEGIN
Storage.FreeString[bv.stringValue];
RunTimeError["Numeric value required."L];
END;
END; -- of ConvertToCardinal --


DataOp: BasicOps.OpCodeProc =
BEGIN
currentProgLine ← currentProgLine.next;
RETURN[TRUE, pc];
END; -- of DataOp --


DefFnOp: BasicOps.OpCodeProc =
BEGIN
fnVarPtr: VariablePtr;
byte: BasicOps.Byte;
[byte, newPc] ← FetchByte[cm, pc];
[fnVarPtr, newPc] ← FetchPointer[cm, newPc];
WITH v: fnVarPtr SELECT FROM
userFunction => v.defLineNumber ← currentProgLine.lineNumber;
ENDCASE => ERROR;
IF byte = 2 THEN
currentProgLine ← SearchForOpCodeByLines[cm, currentProgLine.next, BasicOps.FnEnd];
IF currentProgLine = NIL THEN RunTimeError["Missing FN END statement!"L];
currentProgLine ← currentProgLine.next;
RETURN[TRUE, newPc];
END; -- of DefFnOp --


DeleteOp: BasicOps.OpCodeProc =
BEGIN
bv: BasicValue;
cur, prev, next: ProgramLineDescPtr;
start, end: CARDINAL;
startText, endText, startCode, endCode: vmD.CharIndex;
bv ← Pop[];
end ← ConvertToCardinal[@bv];
bv ← Pop[];
start ← ConvertToCardinal[@bv];
prev ← NIL;
FOR cur ← programLineDescHead, cur.next UNTIL cur = NIL OR cur.lineNumber >= start DO
prev ← cur;
ENDLOOP;
IF cur = NIL OR cur.lineNumber > start THEN
RunTimeError["Initial DELETE line number does not exist."L];
startText ← endText ← cur.start;
startCode ← endCode ← cur.codeStart;
UNTIL cur = NIL OR (end # 0 AND cur.lineNumber > end) DO
endText ← cur.end;
endCode ← cur.codeEnd;
next ← cur.next;
Storage.Free[cur];
IF prev = NIL THEN programLineDescHead ← next ELSE prev.next ← next;
cur ← next;
IF end = 0 THEN EXIT;
ENDLOOP;
vmD.DeleteRangeInMessage[[startText, endText, cM]];
vmD.DeleteRangeInMessage[[startCode, endCode, codeCm]];
UNTIL cur = NIL DO
cur.start ← cur.start - (endText - startText);
cur.end ← cur.end - (endText - startText);
cur.codeStart ← cur.codeStart - (endCode - startCode);
cur.codeEnd ← cur.codeEnd - (endCode - startCode);
cur ← cur.next;
ENDLOOP;
RETURN[TRUE, pc];
END; -- of DeleteOp --


DimOp: BasicOps.OpCodeProc =
BEGIN
bv1, bv2: BasicValue;
ub1, ub2: CARDINAL;
varPtr: VariablePtr;
bv2 ← Pop[];
bv1 ← Pop[];
ub1 ← ConvertToCardinal[@bv1];
ub2 ← ConvertToCardinal[@bv2];
[varPtr, newPc] ← FetchPointer[cm, pc];
WITH v: varPtr SELECT FROM
numeric =>
IF v.arrayPtr = NIL OR v.arrayPtr.ub1 # ub1
OR ((ub2 = 0 AND v.arrayPtr.ub2 # optionBase)
OR (ub2 # 0 AND v.arrayPtr.ub2 # ub2)) THEN
BEGIN
optionBaseCalled ← TRUE;
IF v.arrayPtr # NIL THEN Storage.Free[v.arrayPtr];
AllocateArray[ub1, IF ub2 = 0 THEN optionBase ELSE ub2, varPtr];
RETURN[FALSE, newPc];
END;
ENDCASE => RunTimeError["DIM’ed array variable already in use!"L];
END; -- of DimOp --


DimStrOp: BasicOps.OpCodeProc =
BEGIN
bv: BasicValue ← Pop[];
varPtr: VariablePtr;
length: CARDINAL ← ConvertToCardinal[@bv];
[varPtr, newPc] ← FetchPointer[cm, pc];
WITH v: varPtr SELECT FROM
string =>
IF varPtr.value.stringValue.maxlength # length THEN
BEGIN
Storage.FreeString[varPtr.value.stringValue];
varPtr.value.stringValue ← Storage.String[length];
RETURN[FALSE, newPc];
END;
ENDCASE => RunTimeError["String DIMension of non-string variable!"L];
END; -- of DimStrOp --


DivOp: BasicOps.OpCodeProc =
BEGIN
RETURN[ArithmeticOp[div], pc];
END; -- of DivOp --


DoneOp: BasicOps.OpCodeProc =
BEGIN
currentProgLine ← currentProgLine.next;
RETURN[TRUE, pc];
END; -- of DoneOp --


EndOp: BasicOps.OpCodeProc =
BEGIN
currentProgLine ← NIL;
RETURN[TRUE, pc];
END; -- of EndOp --


EqualOp: BasicOps.OpCodeProc =
BEGIN
PushInteger[IF BasicOps.PopAndCompare[] = 0 THEN 1 ELSE 0];
RETURN[FALSE, pc];
END; -- of EqualOp --


ExpOp: BasicOps.OpCodeProc =
BEGIN
RETURN[ArithmeticOp[exp], pc];
END; -- of ExpOp --


FetchByte: PUBLIC PROCEDURE [cm: vmD.ComposedMessagePtr, pc: vmD.CharIndex]
RETURNS [byte: BasicOps.Byte, newPc: vmD.CharIndex] =
BEGIN
byte ← LOOPHOLE[vmD.GetMessageChar[cm, pc]];
newPc ← pc + 1;
END; -- of FetchByte --


FetchPointer: PUBLIC PROCEDURE [cm: vmD.ComposedMessagePtr, pc: vmD.CharIndex]
RETURNS [pointer: POINTER, newPc: vmD.CharIndex] =
BEGIN
TwoHalf: TYPE = MACHINE DEPENDENT RECORD [high, low: BasicOps.Byte];
LOOPHOLE[pointer, TwoHalf].high ← LOOPHOLE[vmD.GetMessageChar[cm, pc]];
LOOPHOLE[pointer, TwoHalf].low ← LOOPHOLE[vmD.GetMessageChar[cm, pc + 1]];
newPc ← pc + 2;
END; -- of FetchPointer --


FindUserFunctionDef: PROCEDURE [fn: VariablePtr, cm: vmD.ComposedMessagePtr]
RETURNS [pc: vmD.CharIndex, line: ProgramLineDescPtr] =
-- "fn" is a userFunction variable. "line" returned is the program line on which "fn"s
-- definition is found, "pc" is the code pc for the parameter variable in the DefFn op code.
BEGIN

ThisIsIt: PROCEDURE RETURNS [BOOLEAN] =
BEGIN
byte: BasicOps.Byte;
var: VariablePtr;
[byte, pc] ← FetchByte[cm, line.codeStart];
IF byte # BasicOps.DefFn THEN RETURN[FALSE];
[byte, pc] ← FetchByte[cm, pc];
[var, pc] ← FetchPointer[cm, pc];
RETURN[var = fn];
END; -- of ThisIsIt --

WITH v: fn SELECT FROM
userFunction =>
BEGIN
IF v.defLineNumber # 0 THEN
BEGIN
line ← FindLineNumber[v.defLineNumber];
IF ThisIsIt[] THEN RETURN;
END;
line ← programLineDescHead;
DO
line ← SearchForOpCodeByLines[cm, line, BasicOps.DefFn];
IF line = NIL THEN RunTimeError["Function definition not found!"L];
IF ThisIsIt[] THEN RETURN;
line ← line.next;
ENDLOOP;
END;
ENDCASE => ERROR;
END; -- of FindUserFunctionDef --


FloatIntegers: PROCEDURE [value1, value2: BasicValuePtr]
RETURNS [real1, real2: REAL] =
BEGIN
real1 ← IF value1.type = real THEN value1.realValue
ELSE RealOps.Float[value1.integerValue];
real2 ← IF value2.type = real THEN value2.realValue
ELSE RealOps.Float[value2.integerValue];
END; -- of FloatIntegers --


FnEndOp: BasicOps.OpCodeProc =
BEGIN
node: FnEvalRecordPtr ← fnEvalStack;
IF node = NIL THEN RunTimeError["Unmatched FN END!"L];
Push[node.fn.value];
PopVariable[node.parameter];
fnEvalStack ← node.next;
newPc ← node.returnPc;
currentProgLine ← node.returnProgLine;
Storage.Free[node];
RETURN[FALSE, newPc];
END; -- of FnEndOp --


ForOp: BasicOps.OpCodeProc =
BEGIN
bvInitial, bvFinal, bvStep: BasicValue;
bvZero: BasicValue ← BasicValueZero;
stepResult, boundsResult: INTEGER;
varPtr: VariablePtr;
node: NextStackPtr;
bvStep ← Pop[];
bvFinal ← Pop[];
bvInitial ← Pop[];
[varPtr, newPc] ← FetchPointer[cm, pc];
IF bvStep.type = string OR bvFinal.type = string OR bvInitial.type = string THEN
RunTimeError["String value illegal in FOR statement!"L];
varPtr.value ← bvInitial;
stepResult ← Compare[@bvStep, @bvZero];
IF stepResult = 0 THEN RunTimeError["Zero step value in FOR statement!"L];
boundsResult ← Compare[@bvInitial, @bvFinal];
IF stepResult = boundsResult THEN
BEGIN
plpc: ProgramLineDescPtr ← currentProgLine;
nextVarPtr: VariablePtr;
DO
plpc ← SearchForOpCodeByLines[cm, plpc.next, BasicOps.Next];
IF plpc = NIL THEN RunTimeError["Corresponding NEXT statement not found!"L];
[nextVarPtr, ] ← FetchPointer[cm, plpc.codeStart + 1];
IF nextVarPtr = varPtr THEN {currentProgLine ← plpc.next; RETURN[TRUE, newPc]};
ENDLOOP;
END;
node ← Storage.Node[SIZE[NextStackRec]];
node↑ ← NextStackRec
[next: nextStackHead,
varPtr: varPtr,
stepDirection: stepResult,
stepValue: bvStep,
finalValue: bvFinal,
progLine: currentProgLine];
nextStackHead ← node;
currentProgLine ← currentProgLine.next;
RETURN[TRUE, newPc];
END; -- of ForOp --


GEOp: BasicOps.OpCodeProc =
BEGIN
PushInteger[IF BasicOps.PopAndCompare[] >= 0 THEN 1 ELSE 0];
RETURN[FALSE, pc];
END; -- of GEOp --


GoSubGuts: PUBLIC PROCEDURE [lineNumber: CARDINAL] =
BEGIN
node: GoSubStackPtr;
node ← Storage.Node[SIZE[GoSubRec]];
node↑ ← GoSubRec[goSubHead, currentProgLine];
goSubHead ← node;
currentProgLine ← FindLineNumber[LOOPHOLE[lineNumber]];
IF currentProgLine = NIL THEN RunTimeError["GOSUB target not found!"L];
END; -- of GoSubGuts --


GoSubOp: BasicOps.OpCodeProc =
BEGIN
lineNumber: POINTER;
[lineNumber, newPc] ← FetchPointer[cm, pc];
GoSubGuts[LOOPHOLE[lineNumber]];
RETURN[TRUE, newPc];
END; -- of GoSubOp --


GoToGuts: PUBLIC PROCEDURE [lineNumber: CARDINAL] =
BEGIN
currentProgLine ← FindLineNumber[lineNumber];
IF currentProgLine = NIL THEN RunTimeError["GO TO target not found!"L];
END; -- of GoToGuts --


GoToOp: BasicOps.OpCodeProc =
BEGIN
lineNumber: POINTER;
[lineNumber, newPc] ← FetchPointer[cm, pc];
GoToGuts[LOOPHOLE[lineNumber]];
RETURN[TRUE, pc];
END; -- of GoToOp --


GreaterOp: BasicOps.OpCodeProc =
BEGIN
PushInteger[IF BasicOps.PopAndCompare[] = 1 THEN 1 ELSE 0];
RETURN[FALSE, pc];
END; -- of GreaterOp --


HelpOp: BasicOps.OpCodeProc =
BEGIN
IODefs.WriteLine["Begin each line with either a line number or with a command."L];
IODefs.WriteLine["A line number indicates a program line to be executed later;"L];
IODefs.WriteLine["no line number indicates a direct command to be executed immediately."L];
IODefs.WriteLine["Commands supported by Laurel Basic are acceptable either in program"L];
IODefs.WriteLine["lines, as direct commands, or in both contexts according to the following lists."L];
IODefs.WriteLine[""L];
IODefs.WriteLine["Direct commands"L];
IODefs.WriteLine["AUTO, CONTINUE, CODELIST, DELETE, HELP, LIST, NORMAL, QUIT, RUN"L];
IODefs.WriteLine[""L];
IODefs.WriteLine["Program commands"L];
IODefs.WriteLine["!, CLEAR, DATA, DEF FN, DIM, END, FN END, FOR, GOSUB, GOTO,"L];
IODefs.WriteLine["IF, INPUT, NEXT, ON GOSUB, ON GOTO, PAUSE, REM, RETURN, STOP"L];
IODefs.WriteLine[""L];
IODefs.WriteLine["Direct or program commands"L];
IODefs.WriteLine["DEG, DISPLAY, LET, LOAD, OPTION BASE, PRINT, RAD, READ, RESTORE, "L];
IODefs.WriteLine[""L];
IODefs.WriteLine["Pre-loaded functions include:"L];
IODefs.WriteLine["ABS, ACS, ASN, ATN, ATN2, CEIL, CHR$, COS, COT, CSC, DTR, ESP,"L];
IODefs.WriteLine["EXP, FLOOR, FP, IP, INT, LEN, LGT, LOG, MAX, MIN, NUM, PI, POS,"L];
IODefs.WriteLine["RTD, RMD, SEC, SGN, SIN, SQR, TAN, UPC$, VAL, VAL$"L];
IODefs.WriteLine[""L];
RETURN[TRUE, pc];
END; -- of HelpOp --


IfZeroDoneOp: BasicOps.OpCodeProc =
BEGIN
bv: BasicValue ← Pop[];
i: CARDINAL ← ConvertToCardinal[@bv];
IF i = 0 THEN currentProgLine ← currentProgLine.next;
RETURN[i = 0, pc];
END; -- of IfZeroDoneOp --


ImageOp: BasicOps.OpCodeProc =
BEGIN
currentProgLine ← currentProgLine.next;
RETURN[TRUE, pc];
END; -- of ImageOp --


InputNumOp: BasicOps.OpCodeProc =
BEGIN
byte: BasicOps.Byte;
value: BasicValue;
[byte, newPc] ← FetchByte[cm, pc];
IF byte = 0 THEN
BEGIN
IODefs.WriteLine["?"L];
IODefs.ReadLine[inputLine];
inputLineIndex ← 0;
END;
value ← GetInputValue[FALSE];
Push[value];
IF value.type = string THEN Storage.FreeString[value.stringValue];
RETURN[FALSE, newPc];
END; -- of InputNumOp --


InputStrOp: BasicOps.OpCodeProc =
BEGIN
byte: BasicOps.Byte;
value: BasicValue;
[byte, newPc] ← FetchByte[cm, pc];
IF byte = 0 THEN
BEGIN
IODefs.WriteLine["?"L];
IODefs.ReadLine[inputLine];
inputLineIndex ← 0;
END;
value ← GetInputValue[TRUE];
Push[value];
IF value.type = string THEN Storage.FreeString[value.stringValue];
RETURN[FALSE, newPc];
END; -- of InputStrOp --


InterpretCode: PUBLIC PROCEDURE [cm: vmD.ComposedMessagePtr, pc: vmD.CharIndex] =
BEGIN
done: BOOLEAN ← FALSE;
op: BasicOps.Byte;
StreamDefs.ResetControlDEL[];
UNTIL done DO
IF StreamDefs.ControlDELtyped[] THEN RunTimeError["Program interrupted!"L];
[op, pc] ← FetchByte[cm, pc];
[done, pc] ← opCode[op].proc[cm, pc];
ENDLOOP;
END; -- of InterpretCode --


END. -- of BasicInterpA --