eric
/
mysticbbs
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

More record work. Pretty functional now

This commit is contained in:
mysticbbs 2012-03-28 15:37:48 -04:00
parent ad59923a0d
commit 6b6145fadb
3 changed files with 282 additions and 214 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

186
mystic/mpl_compile.pas
View File

@ -82,6 +82,7 @@ Type
CurFile : Byte; CurFile : Byte;
Ch : Char; Ch : Char;
IdentStr : String; IdentStr : String;
AllowOutput : Boolean;
UpdateProc : TParserUpdateProc; UpdateProc : TParserUpdateProc;
UpdateInfo : TParserUpdateInfo; UpdateInfo : TParserUpdateInfo;
VarData : VarDataRec; VarData : VarDataRec;
@ -128,7 +129,7 @@ Type
Procedure ParseIdent; Procedure ParseIdent;
Procedure ParseBlock (VarStart: Word; OneLine, CheckBlock, IsRepeat: Boolean); Procedure ParseBlock (VarStart: Word; OneLine, CheckBlock, IsRepeat: Boolean);
Procedure ParseVarNumber; Procedure ParseVarNumber (DoOps: Boolean);
Procedure ParseVarString; Procedure ParseVarString;
Procedure ParseVarFile; Procedure ParseVarFile;
Procedure ParseVarBoolean; Procedure ParseVarBoolean;
@ -136,6 +137,7 @@ Type
Procedure ParseVariable (VT: TIdentTypes); Procedure ParseVariable (VT: TIdentTypes);
Procedure ParseArray (VN: Word); Procedure ParseArray (VN: Word);
Function ParseElement (VN: Word; TypeCheck: Boolean; VT: TIdentTypes) : TIdentTypes; Function ParseElement (VN: Word; TypeCheck: Boolean; VT: TIdentTypes) : TIdentTypes;
Function ParseElementType (VN: Word; SkipIdent: Boolean) : TIdentTypes;
Procedure DefineRecordType; Procedure DefineRecordType;
Procedure DefineVariable; Procedure DefineVariable;
@ -161,7 +163,6 @@ Type
Function GetErrorMessage (Str: String) : String; Function GetErrorMessage (Str: String) : String;
Procedure Error (ErrNum: Byte; Str: String); Procedure Error (ErrNum: Byte; Str: String);
Procedure NewNumberCrap;
Procedure NewBooleanCrap; Procedure NewBooleanCrap;
Public Public
tkw : TTokenWordType; tkw : TTokenWordType;
@ -192,6 +193,7 @@ Begin
CurRecNum := 0; CurRecNum := 0;
CurConstNum := 0; CurConstNum := 0;
UpdateProc := Update; UpdateProc := Update;
AllowOutput := True;
UpdateInfo.ErrorType := 0; UpdateInfo.ErrorType := 0;
UpdateInfo.ErrorText := ''; UpdateInfo.ErrorText := '';
@ -361,9 +363,6 @@ Begin
If CurRecNum = 0 Then Exit; If CurRecNum = 0 Then Exit;
Repeat Repeat
writeln('rec ident: ', recdata[count]^.ident);
writeln('str: ', str);
If strUpper(RecData[Count]^.Ident) = Str Then Begin If strUpper(RecData[Count]^.Ident) = Str Then Begin
Result := Count; Result := Count;
Exit; Exit;
@ -375,14 +374,14 @@ End;
Procedure TParserEngine.OutString (Str: String); Procedure TParserEngine.OutString (Str: String);
Begin Begin
If UpdateInfo.ErrorType <> 0 Then Exit; If (Not AllowOutput) or (UpdateInfo.ErrorType <> 0) Then Exit;
BlockWrite (OutFile, Str[1], Byte(Str[0])); BlockWrite (OutFile, Str[1], Byte(Str[0]));
End; End;
Procedure TParserEngine.OutWord (W: Word); Procedure TParserEngine.OutWord (W: Word);
Begin Begin
If UpdateInfo.ErrorType <> 0 Then Exit; If (Not AllowOutput) or (UpdateInfo.ErrorType <> 0) Then Exit;
BlockWrite (OutFile, W, 2); BlockWrite (OutFile, W, 2);
End; End;
@ -699,6 +698,8 @@ Procedure TParserEngine.OutPosition (P: LongInt; W: Word);
Var Var
SavedPos : LongInt; SavedPos : LongInt;
Begin Begin
If (Not AllowOutput) or (UpdateInfo.ErrorType <> 0) Then Exit;
SavedPos := CurFilePos; SavedPos := CurFilePos;
Seek (OutFile, P + mplVerLength); Seek (OutFile, P + mplVerLength);
@ -714,7 +715,7 @@ Begin
GetStr(tkw[wOpenArray], True, False); GetStr(tkw[wOpenArray], True, False);
For X := 1 to VarData[VN]^.ArrPos Do Begin For X := 1 to VarData[VN]^.ArrPos Do Begin
ParseVarNumber; ParseVarNumber(True);
If X < VarData[VN]^.ArrPos Then If X < VarData[VN]^.ArrPos Then
GetStr(tkw[wArrSep], True, False) GetStr(tkw[wArrSep], True, False)
@ -724,6 +725,62 @@ Begin
End; End;
End; End;
Function TParserEngine.ParseElementType (VN: Word; SkipIdent: Boolean) : TIdentTypes;
Var
Element : String;
Count : Word;
Found : Boolean = False;
SavedPos : LongInt;
Begin
Result := VarData[VN]^.vType;
If Result <> iRecord Then Exit;
SavedPos := InFile[CurFile].DataFile.FilePos;
If SkipIdent Then GetIdent(False);
AllowOutput := False;
If VarData[VN]^.ArrPos > 0 Then Begin
GetStr(tkw[wOpenArray], True, False);
For Count := 1 to VarData[VN]^.ArrPos Do Begin
ParseVarNumber(True);
If Count < VarData[VN]^.ArrPos Then
GetStr(tkw[wArrSep], True, False)
Else
GetStr(tkw[wCloseArray], True, False);
End;
End;
AllowOutput := True;
NextChar;
If (Ch <> '.') Then Begin
InFile[CurFile].DataFile.Seek(SavedPos);
Exit;
End;
GetIdent(False);
Element := strUpper(IdentStr);
For Count := 1 to RecData[VarData[VN]^.RecID]^.NumFields Do Begin
If strUpper(RecData[VarData[VN]^.RecID]^.Fields[Count].Ident[1]) = Element Then Begin
Found := True;
Result := RecData[VarData[VN]^.RecID]^.Fields[Count].vType;
End;
End;
If Not Found Then
Error (mpsUnknownIdent, '');
InFile[CurFile].DataFile.Seek(SavedPos);
End;
Function TParserEngine.ParseElement (VN: Word; TypeCheck: Boolean; VT: TIdentTypes) : TIdentTypes; Function TParserEngine.ParseElement (VN: Word; TypeCheck: Boolean; VT: TIdentTypes) : TIdentTypes;
Var Var
Element : String; Element : String;
@ -741,6 +798,12 @@ Begin
If Ch <> '.' Then Begin If Ch <> '.' Then Begin
PrevChar; PrevChar;
OutString (VarType2Char(iRecord));
OutWord (RecData[VarData[VN]^.RecID]^.DataSize);
OutWord (0); // offset
OutWord (0); // array element
Exit; Exit;
End; End;
@ -754,15 +817,22 @@ Begin
Found := True; Found := True;
Result := RecData[VarData[VN]^.RecID]^.Fields[Count].vType; Result := RecData[VarData[VN]^.RecID]^.Fields[Count].vType;
//VarType OutString (VarType2Char(RecData[VarData[VN]^.RecID]^.Fields[Count].vType));
//Offset
//Size Case RecData[VarData[VN]^.RecID]^.Fields[Count].vType of
iString : OutWord(RecData[VarData[VN]^.RecID]^.Fields[Count].StrLen);
Else
OutWord(GetVarSize(RecData[VarData[VN]^.RecID]^.Fields[Count].vType));
End;
OutWord (Offset);
OutWord (RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem);
If RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem > 0 Then Begin If RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem > 0 Then Begin
GetStr(tkw[wOpenArray], True, False); GetStr(tkw[wOpenArray], True, False);
For X := 1 to RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem Do Begin For X := 1 to RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem Do Begin
ParseVarNumber; ParseVarNumber(True);
If X < RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem Then If X < RecData[VarData[VN]^.RecID]^.Fields[Count].ArrDem Then
GetStr(tkw[wArrSep], True, False) GetStr(tkw[wArrSep], True, False)
@ -771,8 +841,6 @@ Begin
End; End;
End; End;
// writeln('creating ', recdata[vardata[vn]^.recid]^.fields[count].varsize, ' at ', offset);
Break; Break;
End; End;
@ -783,7 +851,7 @@ Begin
Error (mpsUnknownIdent, ''); Error (mpsUnknownIdent, '');
End; End;
Procedure TParserEngine.NewNumberCrap; Procedure TParserEngine.ParseVarNumber (DoOps: Boolean);
var var
IsDecimal : Boolean; IsDecimal : Boolean;
IsLast : Boolean; IsLast : Boolean;
@ -794,6 +862,9 @@ begin
IsLast := False; IsLast := False;
Found := False; Found := False;
If DoOps Then
OutString (Char(opOpenNum));
Repeat Repeat
If Not IsLast Then Begin If Not IsLast Then Begin
If GetStr(tkw[wExpAnd], False, True) Then Begin If GetStr(tkw[wExpAnd], False, True) Then Begin
@ -838,9 +909,8 @@ begin
Dec(TempStr[0]); Dec(TempStr[0]);
If UpdateInfo.ErrorType = 0 Then Begin If UpdateInfo.ErrorType = 0 Then
OutString (strI2S(strH2I(TempStr))); OutString (strI2S(strH2I(TempStr)));
End;
End Else End Else
If Ch in chDigit Then Begin If Ch in chDigit Then Begin
If IsLast Then Begin If IsLast Then Begin
@ -870,13 +940,15 @@ begin
IsDecimal := True; IsDecimal := True;
End; End;
If Ch in chNumber Then OutString (Ch); If Ch in chNumber Then
OutString (Ch);
Until (UpdateInfo.ErrorType <> 0) or (Not (Ch in chNumber)); Until (UpdateInfo.ErrorType <> 0) or (Not (Ch in chNumber));
If UpdateInfo.ErrorType = 0 Then PrevChar; If UpdateInfo.ErrorType = 0 Then PrevChar;
End Else End Else
If Ch in chIdent1 Then Begin If Ch in chIdent1 Then Begin
PrevChar; PrevChar;
If Not IsLast Then Begin If Not IsLast Then Begin
Found := True; Found := True;
IsLast := True; IsLast := True;
@ -895,7 +967,7 @@ begin
If VarNum = 0 Then If VarNum = 0 Then
Error (mpsUnknownIdent, IdentStr) Error (mpsUnknownIdent, IdentStr)
Else Else
If Not (VarData[VarNum]^.vType in vNums) And (VarData[VarNum]^.vType <> iRecord) Then If Not (ParseElementType(VarNum, False) in vNums) Then
Error (mpsTypeMismatch, ''); Error (mpsTypeMismatch, '');
If UpdateInfo.ErrorType <> 0 Then Exit; If UpdateInfo.ErrorType <> 0 Then Exit;
@ -906,7 +978,7 @@ begin
OutString (Char(opVariable)); OutString (Char(opVariable));
OutWord (VarData[VarNum]^.VarID); OutWord (VarData[VarNum]^.VarID);
ParseArray (VarNum); ParseArray (VarNum);
ParseElement (VarNum, True, iLongInt); ParseElement (VarNum, False, iLongInt);
End; End;
End; End;
End Else End Else
@ -921,7 +993,7 @@ begin
If Ch = tkw[wLeftParan, 1] Then Begin If Ch = tkw[wLeftParan, 1] Then Begin
OutString (Char(opLeftParan)); OutString (Char(opLeftParan));
Self.NewNumberCrap; Self.ParseVarNumber(False);
GetStr (tkw[wRightParan], True, False); GetStr (tkw[wRightParan], True, False);
OutString (Char(opRightParan)); OutString (Char(opRightParan));
@ -937,13 +1009,9 @@ begin
If UpdateInfo.ErrorType <> 0 Then Exit; If UpdateInfo.ErrorType <> 0 Then Exit;
If Not Found Then Error (mpsInStatement, ''); If Not Found Then Error (mpsInStatement, '');
End;
Procedure TParserEngine.ParseVarNumber; If DoOps Then
Begin OutString (Char(opCloseNum));
OutString (Char(opOpenNum));
NewNumberCrap;
OutString (Char(opCloseNum));
End; End;
Procedure TParserEngine.ParseVarChar; Procedure TParserEngine.ParseVarChar;
@ -1063,7 +1131,7 @@ Begin
If Ch = tkw[wOpenArray] Then Begin If Ch = tkw[wOpenArray] Then Begin
OutString (Char(opStrArray)); OutString (Char(opStrArray));
ParseVarNumber; ParseVarNumber(True);
GetStr (tkw[wCloseArray], True, False); GetStr (tkw[wCloseArray], True, False);
NextChar; NextChar;
End; End;
@ -1145,7 +1213,7 @@ Begin
If VarNum = 0 Then If VarNum = 0 Then
Error (mpsUnknownIdent, IdentStr) Error (mpsUnknownIdent, IdentStr)
Else Else
If Not (VarData[VarNum]^.vType in vStrings) And (VarData[VarNum]^.vType <> iRecord) Then If Not (ParseElementType(VarNum, False) in vStrings) Then
Error (mpsTypeMismatch, ''); Error (mpsTypeMismatch, '');
If UpdateInfo.ErrorType <> 0 Then Exit; If UpdateInfo.ErrorType <> 0 Then Exit;
@ -1194,7 +1262,7 @@ Begin
If Ch = tkw[wOpenArray] Then Begin If Ch = tkw[wOpenArray] Then Begin
OutString (Char(opStrArray)); OutString (Char(opStrArray));
ParseVarNumber; ParseVarNumber(True);
GetStr (tkw[wCloseArray], True, False); GetStr (tkw[wCloseArray], True, False);
NextChar; NextChar;
End; End;
@ -1249,7 +1317,7 @@ Begin
If VarNum = 0 Then If VarNum = 0 Then
Error (mpsUnknownIdent, IdentStr) Error (mpsUnknownIdent, IdentStr)
Else Else
If (VarData[VarNum]^.vType <> iBool) And (VarData[VarNum]^.vType <> iRecord) Then If ParseElementType(VarNum, False) <> iBool Then
Error (mpsTypeMismatch, '') Error (mpsTypeMismatch, '')
Else Else
If VarData[VarNum]^.Proc Then If VarData[VarNum]^.Proc Then
@ -1344,7 +1412,9 @@ Procedure TParserEngine.ParseVarBoolean;
If Ch = tkw[wLeftParan] Then Begin If Ch = tkw[wLeftParan] Then Begin
OutString (Char(opLeftParan)); OutString (Char(opLeftParan));
ParseVarBoolean; ParseVarBoolean;
OutString (Char(opRightParan)); OutString (Char(opRightParan));
GetStr (tkw[wRightParan], True, False); GetStr (tkw[wRightParan], True, False);
@ -1360,13 +1430,14 @@ Procedure TParserEngine.ParseVarBoolean;
LoadPosition; LoadPosition;
VarNum := FindConst(IdentStr); VarNum := FindConst(IdentStr);
If VarNum > 0 Then If VarNum > 0 Then
VarType := ConstData[VarNum]^.vType VarType := ConstData[VarNum]^.vType
Else Begin Else Begin
VarNum := FindVariable(IdentStr); VarNum := FindVariable(IdentStr);
If VarNum > 0 Then If VarNum > 0 Then
VarType := VarData[VarNum]^.vType VarType := ParseElementType(VarNum, True) //VarData[VarNum]^.vType
Else Begin Else Begin
IdentStr := strLower(IdentStr); IdentStr := strLower(IdentStr);
@ -1386,7 +1457,7 @@ Procedure TParserEngine.ParseVarBoolean;
iInteger, iInteger,
iLongInt, iLongInt,
iCardinal, iCardinal,
iReal : ParseVarNumber; iReal : ParseVarNumber(True);
iBool : NewBooleanCrap; iBool : NewBooleanCrap;
Else Else
Error (mpsOperation, ''); Error (mpsOperation, '');
@ -1394,12 +1465,12 @@ Procedure TParserEngine.ParseVarBoolean;
End Else End Else
If (Ch in chDigit) or (Ch = '-') Then Begin If (Ch in chDigit) or (Ch = '-') Then Begin
PrevChar; PrevChar;
ParseVarNumber; ParseVarNumber(True);
VarType := iReal; VarType := iReal;
End Else End Else
If Ch = tkw[wHexPrefix] Then Begin If Ch = tkw[wHexPrefix] Then Begin
PrevChar; PrevChar;
ParseVarNumber; ParseVarNumber(True);
VarType := iReal; VarType := iReal;
End Else End Else
If Ch in [tkw[wCharPrefix, 1], tkw[wOpenString, 1]] Then Begin If Ch in [tkw[wCharPrefix, 1], tkw[wOpenString, 1]] Then Begin
@ -1463,7 +1534,7 @@ end;
Procedure TParserEngine.ParseVariable (VT: TIdentTypes); Procedure TParserEngine.ParseVariable (VT: TIdentTypes);
Begin Begin
If VT in vNums Then ParseVarNumber Else If VT in vNums Then ParseVarNumber(True) Else
If VT = iString Then ParseVarString Else If VT = iString Then ParseVarString Else
If VT = iChar Then ParseVarChar Else If VT = iChar Then ParseVarChar Else
If VT = iBool Then ParseVarBoolean Else If VT = iBool Then ParseVarBoolean Else
@ -1615,8 +1686,6 @@ Function TParserEngine.ParseVariableInfo (Param: Boolean; IsRec: Boolean; Var In
If Info.VarSize > mplMaxDataSize Then If Info.VarSize > mplMaxDataSize Then
Error (mpsDataTooBig, ''); Error (mpsDataTooBig, '');
// writeln('parsed variable of size: ' , info.varsize);
End; End;
Begin Begin
@ -1792,15 +1861,15 @@ Begin
OutString (VarType2Char(Info.vType)); OutString (VarType2Char(Info.vType));
If (Info.vType = iString) and (Info.StrLen > 0) Then If (Info.vType = iString) and (Info.StrLen > 0) Then
OutString(Char(opStrSize) + Char(opOpenNum) + strI2S(Info.StrLen) + Char(opCloseNum)); OutString (Char(opStrSize) + Char(opOpenNum) + strI2S(Info.StrLen) + Char(opCloseNum));
If Info.vType = iRecord Then Begin If Info.vType = iRecord Then Begin
OutString (Char(opTypeRec)); OutString (Char(opTypeRec));
OutWord (Info.DataSize); OutWord (RecData[Info.RecID]^.DataSize);
End; End;
If Info.ArrDem = 0 Then If Info.ArrDem = 0 Then
OutString(Char(opVarNormal)) OutString (Char(opVarNormal))
Else Begin Else Begin
OutString (Char(opArrDef)); OutString (Char(opArrDef));
OutWord (Info.ArrDem); OutWord (Info.ArrDem);
@ -1886,25 +1955,6 @@ Begin
If RecData[CurRecNum]^.DataSize > mplMaxDataSize Then If RecData[CurRecNum]^.DataSize > mplMaxDataSize Then
Error (mpsDataTooBig, ''); Error (mpsDataTooBig, '');
(*
OutString (Char(opTypeRec));
OutWord (RecData[CurRecNum]^.RecID);
OutWord (RecData[CurRecNum]^.NumFields);
OutWord (RecData[CUrRecNum]^.DataSize);
*)
// what would we need:
// 1. vartype (byte)
// 2. offset (Word)
// 3. size (word)
// output record define OP
// output record ID
// output record variable types STRING needs size and how do we do array?
// output record size?
// ALSO need to output on createvariable for RECORD type
// need to add both to interpreter engine
// need to change interpreter to address vars by data pointer always?
End; End;
Procedure TParserEngine.DefineProc; Procedure TParserEngine.DefineProc;
@ -2075,8 +2125,8 @@ Begin
// if = '*' and type iString then...do the string index // if = '*' and type iString then...do the string index
End Else Begin End Else Begin
// use setvariable here?? cant cuz ifile isnt processed in setvariable... // use setvariable here?? cant cuz ifile isnt processed in setvariable...
// need irecord // need irecord?
If Char2VarType(VarData[VN]^.Params[Count]) in vNums Then ParseVarNumber Else If Char2VarType(VarData[VN]^.Params[Count]) in vNums Then ParseVarNumber(True) Else
If Char2VarType(VarData[VN]^.Params[Count]) = iString Then ParseVarString Else If Char2VarType(VarData[VN]^.Params[Count]) = iString Then ParseVarString Else
If Char2VarType(VarData[VN]^.Params[Count]) = iChar Then ParseVarChar Else If Char2VarType(VarData[VN]^.Params[Count]) = iChar Then ParseVarChar Else
If Char2VarType(VarData[VN]^.Params[Count]) = iBool Then ParseVarBoolean Else If Char2VarType(VarData[VN]^.Params[Count]) = iBool Then ParseVarBoolean Else
@ -2118,7 +2168,7 @@ Begin
If UpdateInfo.ErrorType <> 0 Then Exit; If UpdateInfo.ErrorType <> 0 Then Exit;
ParseVarNumber; ParseVarNumber(True);
If UpdateInfo.ErrorType <> 0 Then Exit; If UpdateInfo.ErrorType <> 0 Then Exit;
@ -2132,7 +2182,7 @@ Begin
If UpdateInfo.ErrorType <> 0 Then Exit; If UpdateInfo.ErrorType <> 0 Then Exit;
ParseVarNumber; ParseVarNumber(True);
If UpdateInfo.ErrorType <> 0 Then Exit; If UpdateInfo.ErrorType <> 0 Then Exit;
@ -2212,7 +2262,7 @@ Begin
ParseVarBoolean ParseVarBoolean
Else Else
If VarData[VarNum]^.vType in vNums Then If VarData[VarNum]^.vType in vNums Then
ParseVarNumber ParseVarNumber(True)
Else Else
Error (mpsTypeMismatch, ''); Error (mpsTypeMismatch, '');
@ -2246,7 +2296,7 @@ Begin
iLongInt, iLongInt,
iCardinal, iCardinal,
iReal : Repeat iReal : Repeat
ParseVarNumber; ParseVarNumber(True);
If GetStr(tkw[wParamSep], False, False) Then If GetStr(tkw[wParamSep], False, False) Then
OutString(Char(opParamSep)) OutString(Char(opParamSep))
@ -2515,7 +2565,7 @@ Begin
// prob shoud be iString check here. also need to // prob shoud be iString check here. also need to
If (Ch = tkw[wOpenArray]) Then Begin If (Ch = tkw[wOpenArray]) Then Begin
OutString(Char(opStrArray)); OutString(Char(opStrArray));
ParseVarNumber; ParseVarNumber(True);
// check here to make sure is <= string length? // check here to make sure is <= string length?
GetStr(tkw[wCloseArray], True, False); GetStr(tkw[wCloseArray], True, False);
End Else End Else
@ -2692,7 +2742,7 @@ Begin
FillChar (InFile[CurFile], SizeOf(InFile[CurFile]), 0); FillChar (InFile[CurFile], SizeOf(InFile[CurFile]), 0);
InFile[CurFile].Position := 1; InFile[CurFile].Position := 1;
InFile[CurFile].PosSaved := 1; InFile[CurFile].PosSaved := -1;
InFile[CurFile].Size := 1; InFile[CurFile].Size := 1;
If CurFile = 1 Then If CurFile = 1 Then

281
mystic/mpl_execute.pas
View File

@ -22,9 +22,7 @@ Type
DataFile : PCharFile; DataFile : PCharFile;
CurVarNum : Word; CurVarNum : Word;
CurVarID : Word; CurVarID : Word;
CurRecNum : Word;
VarData : VarDataRec; VarData : VarDataRec;
RecData : RecDataRec;
Ch : Char; Ch : Char;
W : Word; W : Word;
IoError : LongInt; IoError : LongInt;
@ -55,24 +53,24 @@ Type
Procedure NextChar; Procedure NextChar;
Procedure NextWord; Procedure NextWord;
Procedure PrevChar; Procedure PrevChar;
Function GetDataPtr (VN: Word; Var A: TArrayInfo) : Pointer; Function GetDataPtr (VN: Word; Var A: TArrayInfo; Var R: TRecInfo) : Pointer;
Function GetDataSize (VarNum: Word) : Word; Function GetDataSize (VarNum: Word) : Word;
Function FindVariable (ID: Word) : Word; Function FindVariable (ID: Word) : Word;
Procedure CheckArray (VN: Word; Var A: TArrayInfo); Procedure CheckArray (VN: Word; Var A: TArrayInfo; Var R: TRecInfo);
Function GetNumber (VN: Word; Var A: TArrayInfo) : Real; Function GetNumber (VN: Word; Var A: TArrayInfo; Var R: TRecInfo) : Real;
Function RecastNumber (Var Num; T: TIdentTypes) : Real; Function RecastNumber (Var Num; T: TIdentTypes) : Real;
Function EvaluateNumber : Real; Function EvaluateNumber : Real;
Function EvaluateString : String; Function EvaluateString : String;
Function EvaluateBoolean : Boolean; Function EvaluateBoolean : Boolean;
Procedure SetString (VarNum: Word; Var A: TArrayInfo; Str: String); Procedure SetString (VarNum: Word; Var A: TArrayInfo; Var R: TRecInfo; Str: String);
Procedure SetNumber (VN: Word; R: Real; Var A: TArrayInfo); Procedure SetNumber (VN: Word; Num: Real; Var A: TArrayInfo; Var R: TRecInfo);
Procedure SetVariable (VarNum: Word); Procedure SetVariable (VarNum: Word);
Function DefineVariable : LongInt; Function DefineVariable : LongInt;
Procedure DefineProcedure; Procedure DefineProcedure;
//Procedure DefineRecordType;
Procedure StatementRepeatUntil; Procedure StatementRepeatUntil;
Function StatementIfThenElse : Byte; Function StatementIfThenElse : Byte;
@ -81,7 +79,7 @@ Type
Procedure StatementWhileDo; Procedure StatementWhileDo;
Function ExecuteProcedure (DP: Pointer) : TIdentTypes; Function ExecuteProcedure (DP: Pointer) : TIdentTypes;
Function ExecuteBlock (StartVar, StartRec: Word) : Byte; Function ExecuteBlock (StartVar: Word) : Byte;
// BBS DATA ACCESS FUNCTIONS // BBS DATA ACCESS FUNCTIONS
Procedure FileReadLine (Var F: File; Var Str: String); Procedure FileReadLine (Var F: File; Var Str: String);
@ -314,11 +312,7 @@ Begin
Dispose(VarData[Count]); Dispose(VarData[Count]);
End; End;
For Count := 1 to CurRecNum Do
Dispose(RecData[Count]);
CurVarNum := 0; CurVarNum := 0;
CurRecNum := 0;
Inherited Destroy; Inherited Destroy;
End; End;
@ -392,39 +386,77 @@ Begin
Until (Count = 0); Until (Count = 0);
End; End;
Function TInterpEngine.GetDataPtr (VN: Word; Var A: TArrayInfo) : Pointer; Function TInterpEngine.GetDataPtr (VN: Word; Var A: TArrayInfo; Var R: TRecInfo) : Pointer;
Begin Begin
With VarData[VN]^ Do With VarData[VN]^ Do
Case ArrPos of Case ArrPos of
0 : Result := Data; 0 : Result := @Data^[R.Offset + 1];
1 : Result := @Data^[VarSize * (A[1] - 1) + 1]; 1 : Result := @Data^[VarSize * (A[1] - 1) + 1 + R.Offset];
2 : Result := @Data^[VarSize * ((A[1] - 1) * ArrDim[2] + A[2])]; 2 : Result := @Data^[VarSize * ((A[1] - 1) * ArrDim[2] + A[2]) + R.Offset];
3 : Result := @Data^[VarSize * ((A[1] - 1) * (ArrDim[2] * ArrDim[3]) + (A[2] - 1) * ArrDim[3] + A[3])]; 3 : Result := @Data^[VarSize * ((A[1] - 1) * (ArrDim[2] * ArrDim[3]) + (A[2] - 1) * ArrDim[3] + A[3]) + R.Offset];
End; End;
End; End;
Procedure TInterpEngine.CheckArray (VN: Word; Var A: TArrayInfo); Procedure TInterpEngine.CheckArray (VN: Word; Var A: TArrayInfo; Var R: TRecInfo);
Var Var
Count : Word; Count : Word;
Temp : TArrayInfo;
Offset : Word;
Begin Begin
For Count := 1 to mplMaxArrayDem Do A[Count] := 1; For Count := 1 to mplMaxArrayDem Do A[Count] := 1;
If VarData[VN]^.ArrPos = 0 Then Exit; R.Offset := 0;
R.vType := VarData[VN]^.vType;
R.OneSize := VarData[VN]^.VarSize;
For Count := 1 to VarData[VN]^.ArrPos Do If VarData[VN]^.ArrPos > 0 Then Begin
A[Count] := Trunc(EvaluateNumber); For Count := 1 to VarData[VN]^.ArrPos Do
A[Count] := Trunc(EvaluateNumber);
End;
If VarData[VN]^.vType = iRecord Then Begin
// blockread this crap instead of this?
NextChar;
R.vType := Char2VarType(Ch);
NextWord;
R.OneSize := W;
NextWord;
R.Offset := W;
NextWord;
R.ArrDem := W;
If R.ArrDem > 0 Then Begin
For Count := 1 to R.ArrDem Do
Temp[Count] := Trunc(EvaluateNumber);
Offset := 0;
For Count := 1 to R.ArrDem Do
Offset := Offset + ((Temp[Count] - 1) * R.OneSize);
R.Offset := R.Offset + Offset;
End;
End;
End; End;
Function TInterpEngine.GetNumber(VN: Word; Var A: TArrayInfo) : Real; Function TInterpEngine.GetNumber (VN: Word; Var A: TArrayInfo; Var R: TRecInfo) : Real;
Begin Begin
Case VarData[VN]^.vType of Case R.vType of
iByte : Result := Byte(GetDataPtr(VN, A)^); iByte : Result := Byte(GetDataPtr(VN, A, R)^);
iShort : Result := ShortInt(GetDataPtr(VN, A)^); iShort : Result := ShortInt(GetDataPtr(VN, A, R)^);
iWord : Result := Word(GetDataPtr(VN, A)^); iWord : Result := Word(GetDataPtr(VN, A, R)^);
iInteger : Result := Integer(GetDataPtr(VN, A)^); iInteger : Result := Integer(GetDataPtr(VN, A, R)^);
iLongInt : Result := LongInt(GetDataPtr(VN, A)^); iLongInt : Result := LongInt(GetDataPtr(VN, A, R)^);
iCardinal : Result := Cardinal(GetDataPtr(VN, A)^); iCardinal : Result := Cardinal(GetDataPtr(VN, A, R)^);
iReal : Result := Real(GetDataPtr(VN, A)^); iReal : Result := Real(GetDataPtr(VN, A, R)^);
End; End;
End; End;
@ -450,6 +482,7 @@ Var
Procedure ParseNext; Procedure ParseNext;
Begin Begin
NextChar; NextChar;
If Ch = Char(opCloseNum) Then CheckChar := ^M Else CheckChar := Ch; If Ch = Char(opCloseNum) Then CheckChar := ^M Else CheckChar := Ch;
End; End;
@ -469,6 +502,7 @@ Var
Var Var
Start : LongInt; Start : LongInt;
ArrayInfo : TArrayInfo; ArrayInfo : TArrayInfo;
RecInfo : TRecInfo;
NumStr : String; NumStr : String;
Begin Begin
Case TTokenOpsRec(Byte(CheckChar)) of Case TTokenOpsRec(Byte(CheckChar)) of
@ -479,9 +513,13 @@ Var
End; End;
opVariable : Begin opVariable : Begin
NextWord; NextWord;
VarNum := FindVariable(w);
CheckArray(VarNum, ArrayInfo); VarNum := FindVariable(W);
Result := GetNumber(VarNum, ArrayInfo);
CheckArray (VarNum, ArrayInfo, RecInfo);
Result := GetNumber(VarNum, ArrayInfo, RecInfo);
ParseNext; ParseNext;
End; End;
opProcExec : Begin opProcExec : Begin
@ -576,6 +614,7 @@ Function TInterpEngine.EvaluateString : String;
Var Var
VarNum : Word; VarNum : Word;
ArrayData : TArrayInfo; ArrayData : TArrayInfo;
RecInfo : TRecInfo;
Res : LongInt; Res : LongInt;
Begin Begin
Result := ''; Result := '';
@ -586,12 +625,14 @@ Begin
opVariable : Begin opVariable : Begin
NextWord; NextWord;
VarNum := FindVariable(W); VarNum := FindVariable(W);
CheckArray (VarNum, ArrayData);
If VarData[VarNum].vType = iChar Then Begin CheckArray (VarNum, ArrayData, RecInfo);
If RecInfo.vType = iChar Then Begin
Result[0] := #1; Result[0] := #1;
Result[1] := Char(GetDataPtr(VarNum, ArrayData)^); Result[1] := Char(GetDataPtr(VarNum, ArrayData, RecInfo)^);
End Else End Else
Result := String(GetDataPtr(VarNum, ArrayData)^); Result := String(GetDataPtr(VarNum, ArrayData, RecInfo)^);
End; End;
opOpenString : Begin opOpenString : Begin
NextChar; NextChar;
@ -646,6 +687,7 @@ Var
StringA : String; StringA : String;
StringB : String; StringB : String;
ArrayData : TArrayInfo; ArrayData : TArrayInfo;
RecInfo : TRecInfo;
Begin Begin
// set default result? // set default result?
VarType1 := iNone; VarType1 := iNone;
@ -668,28 +710,32 @@ Begin
End; End;
opVariable : Begin opVariable : Begin
NextWord; NextWord;
VarNum := FindVariable(W); VarNum := FindVariable(W);
CheckArray(VarNum, ArrayData);
VarType1 := VarData[VarNum]^.vType; CheckArray(VarNum, ArrayData, RecInfo);
VarType1 := RecInfo.vType;
If VarType1 = iBool Then If VarType1 = iBool Then
BooleanA := ByteBool(GetDataPtr(VarNum, ArrayData)^) BooleanA := ByteBool(GetDataPtr(VarNum, ArrayData, RecInfo)^)
Else Else
If (VarType1 in vStrings) Then Begin If (VarType1 in vStrings) Then Begin
NextChar; NextChar;
If Ch = Char(opStrArray) Then If Ch = Char(opStrArray) Then
StringA := String(GetDataPtr(VarNum, ArrayData)^)[Trunc(EvaluateNumber)] StringA := String(GetDataPtr(VarNum, ArrayData, RecInfo)^)[Trunc(EvaluateNumber)]
Else Begin Else Begin
PrevChar; PrevChar;
If VarData[VarNum]^.vType = iChar Then Begin If VarType1 = iChar Then Begin
StringA[0] := #1; StringA[0] := #1;
StringA[1] := Char(GetDataPtr(VarNum, ArrayData)^); StringA[1] := Char(GetDataPtr(VarNum, ArrayData, RecInfo)^);
End Else End Else
StringA := String(GetDataPtr(VarNum, ArrayData)^); StringA := String(GetDataPtr(VarNum, ArrayData, RecInfo)^);
End; End;
End Else End Else
If VarType1 in vNums Then If VarType1 in vNums Then
RealA := GetNumber(VarNum, ArrayData); // evalnumber here RealA := GetNumber(VarNum, ArrayData, RecInfo); // evalnumber here
GotA := True; GotA := True;
End; End;
@ -760,28 +806,32 @@ Begin
End; End;
opVariable : Begin opVariable : Begin
NextWord; NextWord;
VarNum := FindVariable(w);
CheckArray (VarNum, ArrayData); VarNum := FindVariable(W);
VarType2 := VarData[VarNum]^.vType;
CheckArray (VarNum, ArrayData, RecInfo);
VarType2 := RecInfo.vType;
If VarType2 = iBool Then If VarType2 = iBool Then
BooleanB := ByteBool(GetDataPtr(VarNum,ArrayData)^) BooleanB := ByteBool(GetDataPtr(VarNum,ArrayData, RecInfo)^)
Else Else
If (VarType2 in vStrings) Then Begin If (VarType2 in vStrings) Then Begin
NextChar; NextChar;
If Ch = Char(opStrArray) Then If Ch = Char(opStrArray) Then
StringB := String(GetDataPtr(VarNum, ArrayData)^)[Trunc(EvaluateNumber)] StringB := String(GetDataPtr(VarNum, ArrayData, RecInfo)^)[Trunc(EvaluateNumber)]
Else Begin Else Begin
PrevChar; PrevChar;
If VarData[VarNum]^.vType = iChar Then Begin
If VarType2 = iChar Then Begin
StringB[0] := #1; StringB[0] := #1;
StringB[1] := Char(GetDataPtr(VarNum, ArrayData)^); StringB[1] := Char(GetDataPtr(VarNum, ArrayData, RecInfo)^);
End Else End Else
StringB := String(GetDataPtr(VarNum, ArrayData)^); StringB := String(GetDataPtr(VarNum, ArrayData, RecInfo)^);
End; End;
End Else End Else
If VarType2 in vNums Then If VarType2 in vNums Then
RealB := GetNumber(VarNum, ArrayData); RealB := GetNumber(VarNum, ArrayData, RecInfo);
GotB := True; GotB := True;
End; End;
@ -863,62 +913,64 @@ Begin
End; End;
End; End;
Procedure TInterpEngine.SetString (VarNum: Word; Var A: TArrayInfo; Str: String); Procedure TInterpEngine.SetString (VarNum: Word; Var A: TArrayInfo; Var R: TRecInfo; Str: String);
Begin Begin
If VarData[VarNum].vType = iString Then Begin If R.vType = iString Then Begin
If Ord(Str[0]) >= VarData[VarNum]^.VarSize Then If Ord(Str[0]) >= R.OneSize Then
Str[0] := Chr(VarData[VarNum]^.VarSize - 1); Str[0] := Chr(R.OneSize - 1);
Move (Str, GetDataPtr(VarNum, A)^, VarData[VarNum]^.VarSize); Move (Str, GetDataPtr(VarNum, A, R)^, R.OneSize);
End Else End Else
Move (Str[1], GetDataPtr(VarNum, A)^, 1); Move (Str[1], GetDataPtr(VarNum, A, R)^, 1);
End; End;
Procedure TInterpEngine.SetVariable (VarNum: Word); Procedure TInterpEngine.SetVariable (VarNum: Word);
Var Var
ArrayData : TArrayInfo; ArrayData : TArrayInfo;
RecInfo : TRecInfo;
Target : Byte; Target : Byte;
TempStr : String; TempStr : String;
Begin Begin
CheckArray (VarNum, ArrayData); CheckArray (VarNum, ArrayData, RecInfo);
Case VarData[VarNum]^.vType of Case RecInfo.vType of
iChar, iChar,
iString : Begin iString : Begin
NextChar; NextChar;
If Ch = Char(opStrArray) Then Begin If Ch = Char(opStrArray) Then Begin
TempStr := String(GetDataPtr(VarNum, ArrayData)^); TempStr := String(GetDataPtr(VarNum, ArrayData, RecInfo)^);
Target := Byte(Trunc(EvaluateNumber)); Target := Byte(Trunc(EvaluateNumber));
TempStr[Target] := EvaluateString[1]; TempStr[Target] := EvaluateString[1];
SetString (VarNum, ArrayData, TempStr); SetString (VarNum, ArrayData, RecInfo, TempStr);
End Else Begin End Else Begin
PrevChar; PrevChar;
SetString (VarNum, ArrayData, EvaluateString);
SetString (VarNum, ArrayData, RecInfo, EvaluateString);
End; End;
End; End;
iByte : Byte(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); iByte : Byte(GetDataPtr(VarNum, ArrayData, RecInfo)^) := Trunc(EvaluateNumber);
iShort : ShortInt(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); iShort : ShortInt(GetDataPtr(VarNum, ArrayData, RecInfo)^) := Trunc(EvaluateNumber);
iWord : Word(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); iWord : Word(GetDataPtr(VarNum, ArrayData, RecInfo)^) := Trunc(EvaluateNumber);
iInteger : Integer(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); iInteger : Integer(GetDataPtr(VarNum, ArrayData, RecInfo)^) := Trunc(EvaluateNumber);
iLongInt : LongInt(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); iLongInt : LongInt(GetDataPtr(VarNum, ArrayData, RecInfo)^) := Trunc(EvaluateNumber);
iCardinal : Cardinal(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); iCardinal : Cardinal(GetDataPtr(VarNum, ArrayData, RecInfo)^) := Trunc(EvaluateNumber);
iReal : Real(GetDataPtr(VarNum, ArrayData)^) := EvaluateNumber; iReal : Real(GetDataPtr(VarNum, ArrayData, RecInfo)^) := EvaluateNumber;
iBool : ByteBool(GetDataPtr(VarNum, ArrayData)^) := EvaluateBoolean; iBool : ByteBool(GetDataPtr(VarNum, ArrayData, RecInfo)^) := EvaluateBoolean;
End; End;
End; End;
Procedure TInterpEngine.SetNumber (VN: Word; R: Real; Var A: TArrayInfo); Procedure TInterpEngine.SetNumber (VN: Word; Num: Real; Var A: TArrayInfo; Var R: TRecInfo);
Begin Begin
Case VarData[VN]^.vType of Case R.vType of
iByte : Byte(GetDataPtr(VN, A)^) := Trunc(R); iByte : Byte(GetDataPtr(VN, A, R)^) := Trunc(Num);
iShort : ShortInt(GetDataPtr(VN, A)^) := Trunc(R); iShort : ShortInt(GetDataPtr(VN, A, R)^) := Trunc(Num);
iWord : Word(GetDataPtr(VN, A)^) := Trunc(R); iWord : Word(GetDataPtr(VN, A, R)^) := Trunc(Num);
iInteger : Integer(GetDataPtr(VN, A)^) := Trunc(R); iInteger : Integer(GetDataPtr(VN, A, R)^) := Trunc(Num);
iLongInt : LongInt(GetDataPtr(VN, A)^) := Trunc(R); iLongInt : LongInt(GetDataPtr(VN, A, R)^) := Trunc(Num);
iCardinal : Cardinal(GetDataPtr(VN, A)^) := Trunc(R); iCardinal : Cardinal(GetDataPtr(VN, A, R)^) := Trunc(Num);
iReal : Real(GetDataPtr(VN, A)^) := R; iReal : Real(GetDataPtr(VN, A, R)^) := Num;
end; end;
end; end;
@ -1011,7 +1063,7 @@ Begin
End; End;
iRecord : Begin iRecord : Begin
VarSize := RecSize; VarSize := RecSize;
DataSize := RecSize; DataSize := GetDataSize(CurVarNum);
End; End;
Else Else
VarSize := GetVarSize(VarType); VarSize := GetVarSize(VarType);
@ -1129,6 +1181,7 @@ Var
TempInt : SmallInt; TempInt : SmallInt;
Sub : LongInt; Sub : LongInt;
ArrayData : TArrayInfo; ArrayData : TArrayInfo;
RecInfo : TRecInfo;
Procedure Store (Var Dat; Siz: Word); Procedure Store (Var Dat; Siz: Word);
Begin Begin
@ -1153,9 +1206,10 @@ Begin
NextWord; NextWord;
Param[Count].vID := FindVariable(W); Param[Count].vID := FindVariable(W);
CheckArray(Param[Count].vID, ArrayData);
Param[Count].vData := GetDataPtr(Param[Count].vID, ArrayData); CheckArray(Param[Count].vID, ArrayData, RecInfo);
Param[Count].vData := GetDataPtr(Param[Count].vID, ArrayData, RecInfo);
If VarData[Param[Count].vID]^.vType = iString Then If VarData[Param[Count].vID]^.vType = iString Then
Param[Count].vSize := VarData[Param[Count].vID]^.VarSize; Param[Count].vSize := VarData[Param[Count].vID]^.VarSize;
@ -1179,7 +1233,6 @@ Begin
'l' : Param[Count].L := Trunc(EvaluateNumber); 'l' : Param[Count].L := Trunc(EvaluateNumber);
'r' : Param[Count].R := EvaluateNumber; 'r' : Param[Count].R := EvaluateNumber;
'o' : Param[Count].O := EvaluateBoolean; 'o' : Param[Count].O := EvaluateBoolean;
'x' : //getmem, set dataptr to record data, but we need to free at end!;
End; End;
End; End;
@ -1221,7 +1274,6 @@ Begin
DataSize := GetDataSize(CurVarNum); DataSize := GetDataSize(CurVarNum);
If VarData[VarNum]^.Params[Count] = UpCase(VarData[VarNum]^.Params[Count]) Then Begin If VarData[VarNum]^.Params[Count] = UpCase(VarData[VarNum]^.Params[Count]) Then Begin
// Data := VarData[Param[Count].vID]^.Data;
Data := Param[Count].vData; Data := Param[Count].vData;
Kill := False; Kill := False;
End Else Begin End Else Begin
@ -1242,7 +1294,6 @@ Begin
'l' : LongInt(Pointer(Data)^) := Param[Count].L; 'l' : LongInt(Pointer(Data)^) := Param[Count].L;
'r' : Real(Pointer(Data)^) := Param[Count].R; 'r' : Real(Pointer(Data)^) := Param[Count].R;
'o' : Boolean(Pointer(Data)^) := Param[Count].O; 'o' : Boolean(Pointer(Data)^) := Param[Count].O;
'x' : // still need to redo all of this nonsense;
End; End;
Kill := True; Kill := True;
@ -1258,7 +1309,7 @@ Begin
FillChar (VarData[VarNum]^.Data^, VarData[VarNum]^.DataSize, 0); FillChar (VarData[VarNum]^.Data^, VarData[VarNum]^.DataSize, 0);
End; End;
ExecuteBlock (SavedVar, CurRecNum); ExecuteBlock (SavedVar);
If ExitProc Then Begin If ExitProc Then Begin
ExitProc := False; ExitProc := False;
@ -1820,6 +1871,7 @@ Procedure TInterpEngine.StatementForLoop;
Var Var
VarNum : Word; VarNum : Word;
VarArray : TArrayInfo; VarArray : TArrayInfo;
RecInfo : TRecInfo;
LoopStart : Real; LoopStart : Real;
LoopEnd : Real; LoopEnd : Real;
Count : Real; Count : Real;
@ -1830,7 +1882,7 @@ Begin
VarNum := FindVariable(W); VarNum := FindVariable(W);
CheckArray (VarNum, VarArray); CheckArray (VarNum, VarArray, RecInfo);
LoopStart := EvaluateNumber; LoopStart := EvaluateNumber;
@ -1846,17 +1898,17 @@ Begin
Else Else
If CountTo Then If CountTo Then
While (Count <= LoopEnd) And Not Done Do Begin While (Count <= LoopEnd) And Not Done Do Begin
SetNumber(VarNum, Count, VarArray); SetNumber(VarNum, Count, VarArray, RecInfo);
MoveToPos(SavedPos); MoveToPos(SavedPos);
If ExecuteBlock (CurVarNum, CurRecNum) = 1 Then Break; If ExecuteBlock (CurVarNum) = 1 Then Break;
Count := GetNumber(VarNum, VarArray) + 1; Count := GetNumber(VarNum, VarArray, RecInfo) + 1;
End End
Else Else
While (Count >= LoopEnd) And Not Done Do Begin While (Count >= LoopEnd) And Not Done Do Begin
SetNumber(VarNum, Count, VarArray); SetNumber(VarNum, Count, VarArray, RecInfo);
MoveToPos(SavedPos); MoveToPos(SavedPos);
If ExecuteBlock (CurVarNum, CurRecNum) = 1 Then Break; If ExecuteBlock (CurVarNum) = 1 Then Break;
Count := GetNumber(VarNum, VarArray) - 1; Count := GetNumber(VarNum, VarArray, RecInfo) - 1;
End; End;
End; End;
@ -1872,7 +1924,7 @@ begin
IsTrue := EvaluateBoolean; IsTrue := EvaluateBoolean;
If IsTrue Then Begin If IsTrue Then Begin
If ExecuteBlock (CurVarNum, CurRecNum) = 1 Then Begin If ExecuteBlock (CurVarNum) = 1 Then Begin
MoveToPos (StartPos); MoveToPos (StartPos);
EvaluateBoolean; EvaluateBoolean;
SkipBlock; SkipBlock;
@ -1892,7 +1944,7 @@ Begin
Repeat Repeat
MoveToPos (StartPos); MoveToPos (StartPos);
If ExecuteBlock (CurVarNum, CurRecNum) = 1 Then Begin If ExecuteBlock (CurVarNum) = 1 Then Begin
EvaluateBoolean; EvaluateBoolean;
Break; Break;
End; End;
@ -1983,7 +2035,7 @@ Begin
End; End;
If Found Then Begin If Found Then Begin
Result := ExecuteBlock (CurVarNum, CurRecNum); Result := ExecuteBlock (CurVarNum);
MoveToPos (StartPos + EndPos); MoveToPos (StartPos + EndPos);
Exit; Exit;
End Else End Else
@ -1993,7 +2045,7 @@ Begin
If Ch = Char(opElse) Then Begin If Ch = Char(opElse) Then Begin
// we probably want to skip the open block here in compiler // we probably want to skip the open block here in compiler
Result := ExecuteBlock(CurVarNum, CurRecNum); Result := ExecuteBlock(CurVarNum);
Break; Break;
End Else End Else
If Ch = Char(opBlockClose) Then If Ch = Char(opBlockClose) Then
@ -2013,7 +2065,7 @@ Begin
Ok := EvaluateBoolean; Ok := EvaluateBoolean;
If Ok Then If Ok Then
Result := ExecuteBlock(CurVarNum, CurRecNum) Result := ExecuteBlock(CurVarNum)
Else Else
SkipBlock; SkipBlock;
@ -2021,19 +2073,14 @@ Begin
If Ch = Char(opElse) Then Begin If Ch = Char(opElse) Then Begin
If Not Ok Then If Not Ok Then
Result := ExecuteBlock(CurVarNum, CurRecNum) Result := ExecuteBlock(CurVarNum)
Else Else
SkipBlock; SkipBlock;
End Else End Else
PrevChar; PrevChar;
End; End;
//Procedure TInterpEngine.DefineRecordType; Function TInterpEngine.ExecuteBlock (StartVar: Word) : Byte;
//Begin
//asdf
//End;
Function TInterpEngine.ExecuteBlock (StartVar, StartRec: Word) : Byte;
Var Var
Count : Word; Count : Word;
BlockStart : LongInt; BlockStart : LongInt;
@ -2059,7 +2106,7 @@ Begin
Case TTokenOpsRec(Byte(Ch)) of Case TTokenOpsRec(Byte(Ch)) of
{0} opBlockOpen : Begin {0} opBlockOpen : Begin
PrevChar; PrevChar;
Self.ExecuteBlock(CurVarNum, CurRecNum); Self.ExecuteBlock(CurVarNum);
End; End;
{1} opBlockClose : Break; {1} opBlockClose : Break;
{2} opVarDeclare : DefineVariable; {2} opVarDeclare : DefineVariable;
@ -2093,7 +2140,6 @@ Begin
Break; Break;
End; End;
End; End;
//{52} opTypeRec : DefineRecordType;
{53} opBreak : Begin {53} opBreak : Begin
MoveToPos (BlockStart + BlockSize); MoveToPos (BlockStart + BlockSize);
Result := 1; Result := 1;
@ -2124,13 +2170,6 @@ Begin
End; End;
Until (ErrNum <> 0) or Done or DataFile^.EOF; Until (ErrNum <> 0) or Done or DataFile^.EOF;
{$IFDEF LOGGING}
Session.SystemLog('[' + strI2S(Depth) + '] ExecBlock KILL REC: ' + strI2S(CurRecNum) + ' to ' + strI2S(StartRec + 1));
{$ENDIF}
For Count := CurRecNum DownTo StartRec + 1 Do
Dispose(RecData[Count]);
{$IFDEF LOGGING} {$IFDEF LOGGING}
Session.SystemLog('[' + strI2S(Depth) + '] ExecBlock KILL VAR: ' + strI2S(CurVarNum) + ' to ' + strI2S(StartVar + 1)); Session.SystemLog('[' + strI2S(Depth) + '] ExecBlock KILL VAR: ' + strI2S(CurVarNum) + ' to ' + strI2S(StartVar + 1));
{$ENDIF} {$ENDIF}
@ -2156,7 +2195,6 @@ Begin
End; End;
CurVarNum := StartVar; CurVarNum := StartVar;
CurRecNum := StartRec;
{$IFDEF LOGGING} {$IFDEF LOGGING}
Session.SystemLog('[' + strI2S(Depth) + '] ExecBlock END'); Session.SystemLog('[' + strI2S(Depth) + '] ExecBlock END');
@ -2173,7 +2211,6 @@ Begin
Result := 0; Result := 0;
CurVarNum := 0; CurVarNum := 0;
CurVarID := 0; CurVarID := 0;
CurRecNum := 0;
ReloadMenu := False; ReloadMenu := False;
Done := False; Done := False;
ExitProc := False; ExitProc := False;
@ -2227,7 +2264,7 @@ Begin
End; End;
InitProcedures (Owner, Self, VarData, CurVarNum, CurVarID, 0); InitProcedures (Owner, Self, VarData, CurVarNum, CurVarID, 0);
ExecuteBlock (CurVarNum, CurRecNum); ExecuteBlock (CurVarNum);
DataFile^.Close; DataFile^.Close;

29
mystic/mpl_types.pas
View File

@ -233,17 +233,12 @@ Type
PStack = ^TStack; PStack = ^TStack;
TStack = Array[1..mplMaxDataSize] of Byte; TStack = Array[1..mplMaxDataSize] of Byte;
TArrayInfo = Array[1..mplMaxArrayDem] of Word; TArrayInfo = Array[1..mplMaxArrayDem] of Word;
TRecordInfo = Record TRecInfo = Record
vType : Byte; vType : TIdentTypes;
Offset : Word; OneSize : Word;
DataSize : Word; Offset : Word;
ArrDem : Word;
End; End;
//TVarInfo = Record
// AInfo : Array[1..mplMaxArrayDem] of Word;
// RInfo : Word;
// End;
// Basically, an ArrayInfo will have an appended Offset for DataPtr
// if it is a record and probably some sort of record element ID
(* (*
// MEMORY SAVING... could be 28 bytes per var?!?! // MEMORY SAVING... could be 28 bytes per var?!?!
@ -276,21 +271,7 @@ Type
ArrDim : TArrayInfo; ArrDim : TArrayInfo;
End; End;
TRecordElement = Record
ESize : Word;
Offset : Word;
End;
PRecordRec = ^TRecordRec;
TRecordRec = Record
RecID : Word;
Fields : Word;
DataSize : Word;
Element : Array[1..mplMaxRecFields] of TRecordElement;
End;
VarDataRec = Array[1..mplMaxVars] of PVarRec; VarDataRec = Array[1..mplMaxVars] of PVarRec;
RecDataRec = Array[1..mplMaxRecords] of PRecordRec;
{$ELSE} {$ELSE}
PVarRec = ^TVarRec; PVarRec = ^TVarRec;
TVarRec = Record TVarRec = Record