From 6b6145fadb50be61e15e5686430c284991c4e39c Mon Sep 17 00:00:00 2001 From: mysticbbs Date: Wed, 28 Mar 2012 15:37:48 -0400 Subject: [PATCH] More record work. Pretty functional now --- mystic/mpl_compile.pas | 186 +++++++++++++++++---------- mystic/mpl_execute.pas | 281 +++++++++++++++++++++++------------------ mystic/mpl_types.pas | 29 +---- 3 files changed, 282 insertions(+), 214 deletions(-) diff --git a/mystic/mpl_compile.pas b/mystic/mpl_compile.pas index 96147ab..2dfefa3 100644 --- a/mystic/mpl_compile.pas +++ b/mystic/mpl_compile.pas @@ -82,6 +82,7 @@ Type CurFile : Byte; Ch : Char; IdentStr : String; + AllowOutput : Boolean; UpdateProc : TParserUpdateProc; UpdateInfo : TParserUpdateInfo; VarData : VarDataRec; @@ -128,7 +129,7 @@ Type Procedure ParseIdent; Procedure ParseBlock (VarStart: Word; OneLine, CheckBlock, IsRepeat: Boolean); - Procedure ParseVarNumber; + Procedure ParseVarNumber (DoOps: Boolean); Procedure ParseVarString; Procedure ParseVarFile; Procedure ParseVarBoolean; @@ -136,6 +137,7 @@ Type Procedure ParseVariable (VT: TIdentTypes); Procedure ParseArray (VN: Word); Function ParseElement (VN: Word; TypeCheck: Boolean; VT: TIdentTypes) : TIdentTypes; + Function ParseElementType (VN: Word; SkipIdent: Boolean) : TIdentTypes; Procedure DefineRecordType; Procedure DefineVariable; @@ -161,7 +163,6 @@ Type Function GetErrorMessage (Str: String) : String; Procedure Error (ErrNum: Byte; Str: String); - Procedure NewNumberCrap; Procedure NewBooleanCrap; Public tkw : TTokenWordType; @@ -192,6 +193,7 @@ Begin CurRecNum := 0; CurConstNum := 0; UpdateProc := Update; + AllowOutput := True; UpdateInfo.ErrorType := 0; UpdateInfo.ErrorText := ''; @@ -361,9 +363,6 @@ Begin If CurRecNum = 0 Then Exit; Repeat - writeln('rec ident: ', recdata[count]^.ident); - writeln('str: ', str); - If strUpper(RecData[Count]^.Ident) = Str Then Begin Result := Count; Exit; @@ -375,14 +374,14 @@ End; Procedure TParserEngine.OutString (Str: String); Begin - If UpdateInfo.ErrorType <> 0 Then Exit; + If (Not AllowOutput) or (UpdateInfo.ErrorType <> 0) Then Exit; BlockWrite (OutFile, Str[1], Byte(Str[0])); End; Procedure TParserEngine.OutWord (W: Word); Begin - If UpdateInfo.ErrorType <> 0 Then Exit; + If (Not AllowOutput) or (UpdateInfo.ErrorType <> 0) Then Exit; BlockWrite (OutFile, W, 2); End; @@ -699,6 +698,8 @@ Procedure TParserEngine.OutPosition (P: LongInt; W: Word); Var SavedPos : LongInt; Begin + If (Not AllowOutput) or (UpdateInfo.ErrorType <> 0) Then Exit; + SavedPos := CurFilePos; Seek (OutFile, P + mplVerLength); @@ -714,7 +715,7 @@ Begin GetStr(tkw[wOpenArray], True, False); For X := 1 to VarData[VN]^.ArrPos Do Begin - ParseVarNumber; + ParseVarNumber(True); If X < VarData[VN]^.ArrPos Then GetStr(tkw[wArrSep], True, False) @@ -724,6 +725,62 @@ Begin 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; Var Element : String; @@ -741,6 +798,12 @@ Begin If Ch <> '.' Then Begin PrevChar; + + OutString (VarType2Char(iRecord)); + OutWord (RecData[VarData[VN]^.RecID]^.DataSize); + OutWord (0); // offset + OutWord (0); // array element + Exit; End; @@ -754,15 +817,22 @@ Begin Found := True; Result := RecData[VarData[VN]^.RecID]^.Fields[Count].vType; - //VarType - //Offset - //Size + OutString (VarType2Char(RecData[VarData[VN]^.RecID]^.Fields[Count].vType)); + + 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 GetStr(tkw[wOpenArray], True, False); 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 GetStr(tkw[wArrSep], True, False) @@ -771,8 +841,6 @@ Begin End; End; -// writeln('creating ', recdata[vardata[vn]^.recid]^.fields[count].varsize, ' at ', offset); - Break; End; @@ -783,7 +851,7 @@ Begin Error (mpsUnknownIdent, ''); End; -Procedure TParserEngine.NewNumberCrap; +Procedure TParserEngine.ParseVarNumber (DoOps: Boolean); var IsDecimal : Boolean; IsLast : Boolean; @@ -794,6 +862,9 @@ begin IsLast := False; Found := False; + If DoOps Then + OutString (Char(opOpenNum)); + Repeat If Not IsLast Then Begin If GetStr(tkw[wExpAnd], False, True) Then Begin @@ -838,9 +909,8 @@ begin Dec(TempStr[0]); - If UpdateInfo.ErrorType = 0 Then Begin + If UpdateInfo.ErrorType = 0 Then OutString (strI2S(strH2I(TempStr))); - End; End Else If Ch in chDigit Then Begin If IsLast Then Begin @@ -870,13 +940,15 @@ begin IsDecimal := True; End; - If Ch in chNumber Then OutString (Ch); + If Ch in chNumber Then + OutString (Ch); Until (UpdateInfo.ErrorType <> 0) or (Not (Ch in chNumber)); If UpdateInfo.ErrorType = 0 Then PrevChar; End Else If Ch in chIdent1 Then Begin PrevChar; + If Not IsLast Then Begin Found := True; IsLast := True; @@ -895,7 +967,7 @@ begin If VarNum = 0 Then Error (mpsUnknownIdent, IdentStr) Else - If Not (VarData[VarNum]^.vType in vNums) And (VarData[VarNum]^.vType <> iRecord) Then + If Not (ParseElementType(VarNum, False) in vNums) Then Error (mpsTypeMismatch, ''); If UpdateInfo.ErrorType <> 0 Then Exit; @@ -906,7 +978,7 @@ begin OutString (Char(opVariable)); OutWord (VarData[VarNum]^.VarID); ParseArray (VarNum); - ParseElement (VarNum, True, iLongInt); + ParseElement (VarNum, False, iLongInt); End; End; End Else @@ -921,7 +993,7 @@ begin If Ch = tkw[wLeftParan, 1] Then Begin OutString (Char(opLeftParan)); - Self.NewNumberCrap; + Self.ParseVarNumber(False); GetStr (tkw[wRightParan], True, False); OutString (Char(opRightParan)); @@ -937,13 +1009,9 @@ begin If UpdateInfo.ErrorType <> 0 Then Exit; If Not Found Then Error (mpsInStatement, ''); -End; -Procedure TParserEngine.ParseVarNumber; -Begin - OutString (Char(opOpenNum)); - NewNumberCrap; - OutString (Char(opCloseNum)); + If DoOps Then + OutString (Char(opCloseNum)); End; Procedure TParserEngine.ParseVarChar; @@ -1063,7 +1131,7 @@ Begin If Ch = tkw[wOpenArray] Then Begin OutString (Char(opStrArray)); - ParseVarNumber; + ParseVarNumber(True); GetStr (tkw[wCloseArray], True, False); NextChar; End; @@ -1145,7 +1213,7 @@ Begin If VarNum = 0 Then Error (mpsUnknownIdent, IdentStr) Else - If Not (VarData[VarNum]^.vType in vStrings) And (VarData[VarNum]^.vType <> iRecord) Then + If Not (ParseElementType(VarNum, False) in vStrings) Then Error (mpsTypeMismatch, ''); If UpdateInfo.ErrorType <> 0 Then Exit; @@ -1194,7 +1262,7 @@ Begin If Ch = tkw[wOpenArray] Then Begin OutString (Char(opStrArray)); - ParseVarNumber; + ParseVarNumber(True); GetStr (tkw[wCloseArray], True, False); NextChar; End; @@ -1249,7 +1317,7 @@ Begin If VarNum = 0 Then Error (mpsUnknownIdent, IdentStr) Else - If (VarData[VarNum]^.vType <> iBool) And (VarData[VarNum]^.vType <> iRecord) Then + If ParseElementType(VarNum, False) <> iBool Then Error (mpsTypeMismatch, '') Else If VarData[VarNum]^.Proc Then @@ -1344,7 +1412,9 @@ Procedure TParserEngine.ParseVarBoolean; If Ch = tkw[wLeftParan] Then Begin OutString (Char(opLeftParan)); + ParseVarBoolean; + OutString (Char(opRightParan)); GetStr (tkw[wRightParan], True, False); @@ -1360,13 +1430,14 @@ Procedure TParserEngine.ParseVarBoolean; LoadPosition; VarNum := FindConst(IdentStr); + If VarNum > 0 Then VarType := ConstData[VarNum]^.vType Else Begin VarNum := FindVariable(IdentStr); If VarNum > 0 Then - VarType := VarData[VarNum]^.vType + VarType := ParseElementType(VarNum, True) //VarData[VarNum]^.vType Else Begin IdentStr := strLower(IdentStr); @@ -1386,7 +1457,7 @@ Procedure TParserEngine.ParseVarBoolean; iInteger, iLongInt, iCardinal, - iReal : ParseVarNumber; + iReal : ParseVarNumber(True); iBool : NewBooleanCrap; Else Error (mpsOperation, ''); @@ -1394,12 +1465,12 @@ Procedure TParserEngine.ParseVarBoolean; End Else If (Ch in chDigit) or (Ch = '-') Then Begin PrevChar; - ParseVarNumber; + ParseVarNumber(True); VarType := iReal; End Else If Ch = tkw[wHexPrefix] Then Begin PrevChar; - ParseVarNumber; + ParseVarNumber(True); VarType := iReal; End Else If Ch in [tkw[wCharPrefix, 1], tkw[wOpenString, 1]] Then Begin @@ -1463,7 +1534,7 @@ end; Procedure TParserEngine.ParseVariable (VT: TIdentTypes); Begin - If VT in vNums Then ParseVarNumber Else + If VT in vNums Then ParseVarNumber(True) Else If VT = iString Then ParseVarString Else If VT = iChar Then ParseVarChar 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 Error (mpsDataTooBig, ''); - -// writeln('parsed variable of size: ' , info.varsize); End; Begin @@ -1792,15 +1861,15 @@ Begin OutString (VarType2Char(Info.vType)); 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 OutString (Char(opTypeRec)); - OutWord (Info.DataSize); + OutWord (RecData[Info.RecID]^.DataSize); End; If Info.ArrDem = 0 Then - OutString(Char(opVarNormal)) + OutString (Char(opVarNormal)) Else Begin OutString (Char(opArrDef)); OutWord (Info.ArrDem); @@ -1886,25 +1955,6 @@ Begin If RecData[CurRecNum]^.DataSize > mplMaxDataSize Then 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; Procedure TParserEngine.DefineProc; @@ -2075,8 +2125,8 @@ Begin // if = '*' and type iString then...do the string index End Else Begin // use setvariable here?? cant cuz ifile isnt processed in setvariable... -// need irecord - If Char2VarType(VarData[VN]^.Params[Count]) in vNums Then ParseVarNumber Else +// need irecord? + 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]) = iChar Then ParseVarChar Else If Char2VarType(VarData[VN]^.Params[Count]) = iBool Then ParseVarBoolean Else @@ -2118,7 +2168,7 @@ Begin If UpdateInfo.ErrorType <> 0 Then Exit; - ParseVarNumber; + ParseVarNumber(True); If UpdateInfo.ErrorType <> 0 Then Exit; @@ -2132,7 +2182,7 @@ Begin If UpdateInfo.ErrorType <> 0 Then Exit; - ParseVarNumber; + ParseVarNumber(True); If UpdateInfo.ErrorType <> 0 Then Exit; @@ -2212,7 +2262,7 @@ Begin ParseVarBoolean Else If VarData[VarNum]^.vType in vNums Then - ParseVarNumber + ParseVarNumber(True) Else Error (mpsTypeMismatch, ''); @@ -2246,7 +2296,7 @@ Begin iLongInt, iCardinal, iReal : Repeat - ParseVarNumber; + ParseVarNumber(True); If GetStr(tkw[wParamSep], False, False) Then OutString(Char(opParamSep)) @@ -2515,7 +2565,7 @@ Begin // prob shoud be iString check here. also need to If (Ch = tkw[wOpenArray]) Then Begin OutString(Char(opStrArray)); - ParseVarNumber; + ParseVarNumber(True); // check here to make sure is <= string length? GetStr(tkw[wCloseArray], True, False); End Else @@ -2692,7 +2742,7 @@ Begin FillChar (InFile[CurFile], SizeOf(InFile[CurFile]), 0); InFile[CurFile].Position := 1; - InFile[CurFile].PosSaved := 1; + InFile[CurFile].PosSaved := -1; InFile[CurFile].Size := 1; If CurFile = 1 Then diff --git a/mystic/mpl_execute.pas b/mystic/mpl_execute.pas index c3647a2..324035e 100644 --- a/mystic/mpl_execute.pas +++ b/mystic/mpl_execute.pas @@ -22,9 +22,7 @@ Type DataFile : PCharFile; CurVarNum : Word; CurVarID : Word; - CurRecNum : Word; VarData : VarDataRec; - RecData : RecDataRec; Ch : Char; W : Word; IoError : LongInt; @@ -55,24 +53,24 @@ Type Procedure NextChar; Procedure NextWord; 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 FindVariable (ID: Word) : Word; - Procedure CheckArray (VN: Word; Var A: TArrayInfo); - Function GetNumber (VN: Word; Var A: TArrayInfo) : Real; + Procedure CheckArray (VN: Word; Var A: TArrayInfo; Var R: TRecInfo); + Function GetNumber (VN: Word; Var A: TArrayInfo; Var R: TRecInfo) : Real; Function RecastNumber (Var Num; T: TIdentTypes) : Real; Function EvaluateNumber : Real; Function EvaluateString : String; Function EvaluateBoolean : Boolean; - Procedure SetString (VarNum: Word; Var A: TArrayInfo; Str: String); - Procedure SetNumber (VN: Word; R: Real; Var A: TArrayInfo); + Procedure SetString (VarNum: Word; Var A: TArrayInfo; Var R: TRecInfo; Str: String); + Procedure SetNumber (VN: Word; Num: Real; Var A: TArrayInfo; Var R: TRecInfo); + Procedure SetVariable (VarNum: Word); Function DefineVariable : LongInt; Procedure DefineProcedure; - //Procedure DefineRecordType; Procedure StatementRepeatUntil; Function StatementIfThenElse : Byte; @@ -81,7 +79,7 @@ Type Procedure StatementWhileDo; Function ExecuteProcedure (DP: Pointer) : TIdentTypes; - Function ExecuteBlock (StartVar, StartRec: Word) : Byte; + Function ExecuteBlock (StartVar: Word) : Byte; // BBS DATA ACCESS FUNCTIONS Procedure FileReadLine (Var F: File; Var Str: String); @@ -314,11 +312,7 @@ Begin Dispose(VarData[Count]); End; - For Count := 1 to CurRecNum Do - Dispose(RecData[Count]); - CurVarNum := 0; - CurRecNum := 0; Inherited Destroy; End; @@ -392,39 +386,77 @@ Begin Until (Count = 0); End; -Function TInterpEngine.GetDataPtr (VN: Word; Var A: TArrayInfo) : Pointer; +Function TInterpEngine.GetDataPtr (VN: Word; Var A: TArrayInfo; Var R: TRecInfo) : Pointer; Begin With VarData[VN]^ Do Case ArrPos of - 0 : Result := Data; - 1 : Result := @Data^[VarSize * (A[1] - 1) + 1]; - 2 : Result := @Data^[VarSize * ((A[1] - 1) * ArrDim[2] + A[2])]; - 3 : Result := @Data^[VarSize * ((A[1] - 1) * (ArrDim[2] * ArrDim[3]) + (A[2] - 1) * ArrDim[3] + A[3])]; + 0 : Result := @Data^[R.Offset + 1]; + 1 : Result := @Data^[VarSize * (A[1] - 1) + 1 + R.Offset]; + 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]) + R.Offset]; End; End; -Procedure TInterpEngine.CheckArray (VN: Word; Var A: TArrayInfo); +Procedure TInterpEngine.CheckArray (VN: Word; Var A: TArrayInfo; Var R: TRecInfo); Var - Count : Word; + Count : Word; + Temp : TArrayInfo; + Offset : Word; Begin 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 - A[Count] := Trunc(EvaluateNumber); + If VarData[VN]^.ArrPos > 0 Then Begin + 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; -Function TInterpEngine.GetNumber(VN: Word; Var A: TArrayInfo) : Real; +Function TInterpEngine.GetNumber (VN: Word; Var A: TArrayInfo; Var R: TRecInfo) : Real; Begin - Case VarData[VN]^.vType of - iByte : Result := Byte(GetDataPtr(VN, A)^); - iShort : Result := ShortInt(GetDataPtr(VN, A)^); - iWord : Result := Word(GetDataPtr(VN, A)^); - iInteger : Result := Integer(GetDataPtr(VN, A)^); - iLongInt : Result := LongInt(GetDataPtr(VN, A)^); - iCardinal : Result := Cardinal(GetDataPtr(VN, A)^); - iReal : Result := Real(GetDataPtr(VN, A)^); + Case R.vType of + iByte : Result := Byte(GetDataPtr(VN, A, R)^); + iShort : Result := ShortInt(GetDataPtr(VN, A, R)^); + iWord : Result := Word(GetDataPtr(VN, A, R)^); + iInteger : Result := Integer(GetDataPtr(VN, A, R)^); + iLongInt : Result := LongInt(GetDataPtr(VN, A, R)^); + iCardinal : Result := Cardinal(GetDataPtr(VN, A, R)^); + iReal : Result := Real(GetDataPtr(VN, A, R)^); End; End; @@ -450,6 +482,7 @@ Var Procedure ParseNext; Begin NextChar; + If Ch = Char(opCloseNum) Then CheckChar := ^M Else CheckChar := Ch; End; @@ -469,6 +502,7 @@ Var Var Start : LongInt; ArrayInfo : TArrayInfo; + RecInfo : TRecInfo; NumStr : String; Begin Case TTokenOpsRec(Byte(CheckChar)) of @@ -479,9 +513,13 @@ Var End; opVariable : Begin NextWord; - VarNum := FindVariable(w); - CheckArray(VarNum, ArrayInfo); - Result := GetNumber(VarNum, ArrayInfo); + + VarNum := FindVariable(W); + + CheckArray (VarNum, ArrayInfo, RecInfo); + + Result := GetNumber(VarNum, ArrayInfo, RecInfo); + ParseNext; End; opProcExec : Begin @@ -576,6 +614,7 @@ Function TInterpEngine.EvaluateString : String; Var VarNum : Word; ArrayData : TArrayInfo; + RecInfo : TRecInfo; Res : LongInt; Begin Result := ''; @@ -586,12 +625,14 @@ Begin opVariable : Begin NextWord; 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[1] := Char(GetDataPtr(VarNum, ArrayData)^); + Result[1] := Char(GetDataPtr(VarNum, ArrayData, RecInfo)^); End Else - Result := String(GetDataPtr(VarNum, ArrayData)^); + Result := String(GetDataPtr(VarNum, ArrayData, RecInfo)^); End; opOpenString : Begin NextChar; @@ -646,6 +687,7 @@ Var StringA : String; StringB : String; ArrayData : TArrayInfo; + RecInfo : TRecInfo; Begin // set default result? VarType1 := iNone; @@ -668,28 +710,32 @@ Begin End; opVariable : Begin NextWord; + VarNum := FindVariable(W); - CheckArray(VarNum, ArrayData); - VarType1 := VarData[VarNum]^.vType; + + CheckArray(VarNum, ArrayData, RecInfo); + + VarType1 := RecInfo.vType; If VarType1 = iBool Then - BooleanA := ByteBool(GetDataPtr(VarNum, ArrayData)^) + BooleanA := ByteBool(GetDataPtr(VarNum, ArrayData, RecInfo)^) Else If (VarType1 in vStrings) Then Begin NextChar; + If Ch = Char(opStrArray) Then - StringA := String(GetDataPtr(VarNum, ArrayData)^)[Trunc(EvaluateNumber)] + StringA := String(GetDataPtr(VarNum, ArrayData, RecInfo)^)[Trunc(EvaluateNumber)] Else Begin PrevChar; - If VarData[VarNum]^.vType = iChar Then Begin + If VarType1 = iChar Then Begin StringA[0] := #1; - StringA[1] := Char(GetDataPtr(VarNum, ArrayData)^); + StringA[1] := Char(GetDataPtr(VarNum, ArrayData, RecInfo)^); End Else - StringA := String(GetDataPtr(VarNum, ArrayData)^); + StringA := String(GetDataPtr(VarNum, ArrayData, RecInfo)^); End; End Else If VarType1 in vNums Then - RealA := GetNumber(VarNum, ArrayData); // evalnumber here + RealA := GetNumber(VarNum, ArrayData, RecInfo); // evalnumber here GotA := True; End; @@ -760,28 +806,32 @@ Begin End; opVariable : Begin NextWord; - VarNum := FindVariable(w); - CheckArray (VarNum, ArrayData); - VarType2 := VarData[VarNum]^.vType; + + VarNum := FindVariable(W); + + CheckArray (VarNum, ArrayData, RecInfo); + + VarType2 := RecInfo.vType; If VarType2 = iBool Then - BooleanB := ByteBool(GetDataPtr(VarNum,ArrayData)^) + BooleanB := ByteBool(GetDataPtr(VarNum,ArrayData, RecInfo)^) Else If (VarType2 in vStrings) Then Begin NextChar; If Ch = Char(opStrArray) Then - StringB := String(GetDataPtr(VarNum, ArrayData)^)[Trunc(EvaluateNumber)] + StringB := String(GetDataPtr(VarNum, ArrayData, RecInfo)^)[Trunc(EvaluateNumber)] Else Begin PrevChar; - If VarData[VarNum]^.vType = iChar Then Begin + + If VarType2 = iChar Then Begin StringB[0] := #1; - StringB[1] := Char(GetDataPtr(VarNum, ArrayData)^); + StringB[1] := Char(GetDataPtr(VarNum, ArrayData, RecInfo)^); End Else - StringB := String(GetDataPtr(VarNum, ArrayData)^); + StringB := String(GetDataPtr(VarNum, ArrayData, RecInfo)^); End; End Else If VarType2 in vNums Then - RealB := GetNumber(VarNum, ArrayData); + RealB := GetNumber(VarNum, ArrayData, RecInfo); GotB := True; End; @@ -863,62 +913,64 @@ Begin 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 - If VarData[VarNum].vType = iString Then Begin - If Ord(Str[0]) >= VarData[VarNum]^.VarSize Then - Str[0] := Chr(VarData[VarNum]^.VarSize - 1); + If R.vType = iString Then Begin + If Ord(Str[0]) >= R.OneSize Then + Str[0] := Chr(R.OneSize - 1); - Move (Str, GetDataPtr(VarNum, A)^, VarData[VarNum]^.VarSize); + Move (Str, GetDataPtr(VarNum, A, R)^, R.OneSize); End Else - Move (Str[1], GetDataPtr(VarNum, A)^, 1); + Move (Str[1], GetDataPtr(VarNum, A, R)^, 1); End; Procedure TInterpEngine.SetVariable (VarNum: Word); Var ArrayData : TArrayInfo; + RecInfo : TRecInfo; Target : Byte; TempStr : String; Begin - CheckArray (VarNum, ArrayData); + CheckArray (VarNum, ArrayData, RecInfo); - Case VarData[VarNum]^.vType of + Case RecInfo.vType of iChar, iString : Begin NextChar; If Ch = Char(opStrArray) Then Begin - TempStr := String(GetDataPtr(VarNum, ArrayData)^); + TempStr := String(GetDataPtr(VarNum, ArrayData, RecInfo)^); Target := Byte(Trunc(EvaluateNumber)); TempStr[Target] := EvaluateString[1]; - SetString (VarNum, ArrayData, TempStr); + SetString (VarNum, ArrayData, RecInfo, TempStr); End Else Begin PrevChar; - SetString (VarNum, ArrayData, EvaluateString); + + SetString (VarNum, ArrayData, RecInfo, EvaluateString); End; End; - iByte : Byte(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); - iShort : ShortInt(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); - iWord : Word(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); - iInteger : Integer(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); - iLongInt : LongInt(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); - iCardinal : Cardinal(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); - iReal : Real(GetDataPtr(VarNum, ArrayData)^) := EvaluateNumber; - iBool : ByteBool(GetDataPtr(VarNum, ArrayData)^) := EvaluateBoolean; + iByte : Byte(GetDataPtr(VarNum, ArrayData, RecInfo)^) := Trunc(EvaluateNumber); + iShort : ShortInt(GetDataPtr(VarNum, ArrayData, RecInfo)^) := Trunc(EvaluateNumber); + iWord : Word(GetDataPtr(VarNum, ArrayData, RecInfo)^) := Trunc(EvaluateNumber); + iInteger : Integer(GetDataPtr(VarNum, ArrayData, RecInfo)^) := Trunc(EvaluateNumber); + iLongInt : LongInt(GetDataPtr(VarNum, ArrayData, RecInfo)^) := Trunc(EvaluateNumber); + iCardinal : Cardinal(GetDataPtr(VarNum, ArrayData, RecInfo)^) := Trunc(EvaluateNumber); + iReal : Real(GetDataPtr(VarNum, ArrayData, RecInfo)^) := EvaluateNumber; + iBool : ByteBool(GetDataPtr(VarNum, ArrayData, RecInfo)^) := EvaluateBoolean; 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 - Case VarData[VN]^.vType of - iByte : Byte(GetDataPtr(VN, A)^) := Trunc(R); - iShort : ShortInt(GetDataPtr(VN, A)^) := Trunc(R); - iWord : Word(GetDataPtr(VN, A)^) := Trunc(R); - iInteger : Integer(GetDataPtr(VN, A)^) := Trunc(R); - iLongInt : LongInt(GetDataPtr(VN, A)^) := Trunc(R); - iCardinal : Cardinal(GetDataPtr(VN, A)^) := Trunc(R); - iReal : Real(GetDataPtr(VN, A)^) := R; + Case R.vType of + iByte : Byte(GetDataPtr(VN, A, R)^) := Trunc(Num); + iShort : ShortInt(GetDataPtr(VN, A, R)^) := Trunc(Num); + iWord : Word(GetDataPtr(VN, A, R)^) := Trunc(Num); + iInteger : Integer(GetDataPtr(VN, A, R)^) := Trunc(Num); + iLongInt : LongInt(GetDataPtr(VN, A, R)^) := Trunc(Num); + iCardinal : Cardinal(GetDataPtr(VN, A, R)^) := Trunc(Num); + iReal : Real(GetDataPtr(VN, A, R)^) := Num; end; end; @@ -1011,7 +1063,7 @@ Begin End; iRecord : Begin VarSize := RecSize; - DataSize := RecSize; + DataSize := GetDataSize(CurVarNum); End; Else VarSize := GetVarSize(VarType); @@ -1129,6 +1181,7 @@ Var TempInt : SmallInt; Sub : LongInt; ArrayData : TArrayInfo; + RecInfo : TRecInfo; Procedure Store (Var Dat; Siz: Word); Begin @@ -1153,9 +1206,10 @@ Begin NextWord; 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 Param[Count].vSize := VarData[Param[Count].vID]^.VarSize; @@ -1179,7 +1233,6 @@ Begin 'l' : Param[Count].L := Trunc(EvaluateNumber); 'r' : Param[Count].R := EvaluateNumber; 'o' : Param[Count].O := EvaluateBoolean; - 'x' : //getmem, set dataptr to record data, but we need to free at end!; End; End; @@ -1221,7 +1274,6 @@ Begin DataSize := GetDataSize(CurVarNum); If VarData[VarNum]^.Params[Count] = UpCase(VarData[VarNum]^.Params[Count]) Then Begin -// Data := VarData[Param[Count].vID]^.Data; Data := Param[Count].vData; Kill := False; End Else Begin @@ -1242,7 +1294,6 @@ Begin 'l' : LongInt(Pointer(Data)^) := Param[Count].L; 'r' : Real(Pointer(Data)^) := Param[Count].R; 'o' : Boolean(Pointer(Data)^) := Param[Count].O; - 'x' : // still need to redo all of this nonsense; End; Kill := True; @@ -1258,7 +1309,7 @@ Begin FillChar (VarData[VarNum]^.Data^, VarData[VarNum]^.DataSize, 0); End; - ExecuteBlock (SavedVar, CurRecNum); + ExecuteBlock (SavedVar); If ExitProc Then Begin ExitProc := False; @@ -1820,6 +1871,7 @@ Procedure TInterpEngine.StatementForLoop; Var VarNum : Word; VarArray : TArrayInfo; + RecInfo : TRecInfo; LoopStart : Real; LoopEnd : Real; Count : Real; @@ -1830,7 +1882,7 @@ Begin VarNum := FindVariable(W); - CheckArray (VarNum, VarArray); + CheckArray (VarNum, VarArray, RecInfo); LoopStart := EvaluateNumber; @@ -1846,17 +1898,17 @@ Begin Else If CountTo Then While (Count <= LoopEnd) And Not Done Do Begin - SetNumber(VarNum, Count, VarArray); + SetNumber(VarNum, Count, VarArray, RecInfo); MoveToPos(SavedPos); - If ExecuteBlock (CurVarNum, CurRecNum) = 1 Then Break; - Count := GetNumber(VarNum, VarArray) + 1; + If ExecuteBlock (CurVarNum) = 1 Then Break; + Count := GetNumber(VarNum, VarArray, RecInfo) + 1; End Else While (Count >= LoopEnd) And Not Done Do Begin - SetNumber(VarNum, Count, VarArray); + SetNumber(VarNum, Count, VarArray, RecInfo); MoveToPos(SavedPos); - If ExecuteBlock (CurVarNum, CurRecNum) = 1 Then Break; - Count := GetNumber(VarNum, VarArray) - 1; + If ExecuteBlock (CurVarNum) = 1 Then Break; + Count := GetNumber(VarNum, VarArray, RecInfo) - 1; End; End; @@ -1872,7 +1924,7 @@ begin IsTrue := EvaluateBoolean; If IsTrue Then Begin - If ExecuteBlock (CurVarNum, CurRecNum) = 1 Then Begin + If ExecuteBlock (CurVarNum) = 1 Then Begin MoveToPos (StartPos); EvaluateBoolean; SkipBlock; @@ -1892,7 +1944,7 @@ Begin Repeat MoveToPos (StartPos); - If ExecuteBlock (CurVarNum, CurRecNum) = 1 Then Begin + If ExecuteBlock (CurVarNum) = 1 Then Begin EvaluateBoolean; Break; End; @@ -1983,7 +2035,7 @@ Begin End; If Found Then Begin - Result := ExecuteBlock (CurVarNum, CurRecNum); + Result := ExecuteBlock (CurVarNum); MoveToPos (StartPos + EndPos); Exit; End Else @@ -1993,7 +2045,7 @@ Begin If Ch = Char(opElse) Then Begin // we probably want to skip the open block here in compiler - Result := ExecuteBlock(CurVarNum, CurRecNum); + Result := ExecuteBlock(CurVarNum); Break; End Else If Ch = Char(opBlockClose) Then @@ -2013,7 +2065,7 @@ Begin Ok := EvaluateBoolean; If Ok Then - Result := ExecuteBlock(CurVarNum, CurRecNum) + Result := ExecuteBlock(CurVarNum) Else SkipBlock; @@ -2021,19 +2073,14 @@ Begin If Ch = Char(opElse) Then Begin If Not Ok Then - Result := ExecuteBlock(CurVarNum, CurRecNum) + Result := ExecuteBlock(CurVarNum) Else SkipBlock; End Else PrevChar; End; -//Procedure TInterpEngine.DefineRecordType; -//Begin -//asdf -//End; - -Function TInterpEngine.ExecuteBlock (StartVar, StartRec: Word) : Byte; +Function TInterpEngine.ExecuteBlock (StartVar: Word) : Byte; Var Count : Word; BlockStart : LongInt; @@ -2059,7 +2106,7 @@ Begin Case TTokenOpsRec(Byte(Ch)) of {0} opBlockOpen : Begin PrevChar; - Self.ExecuteBlock(CurVarNum, CurRecNum); + Self.ExecuteBlock(CurVarNum); End; {1} opBlockClose : Break; {2} opVarDeclare : DefineVariable; @@ -2093,7 +2140,6 @@ Begin Break; End; End; -//{52} opTypeRec : DefineRecordType; {53} opBreak : Begin MoveToPos (BlockStart + BlockSize); Result := 1; @@ -2124,13 +2170,6 @@ Begin End; 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} Session.SystemLog('[' + strI2S(Depth) + '] ExecBlock KILL VAR: ' + strI2S(CurVarNum) + ' to ' + strI2S(StartVar + 1)); {$ENDIF} @@ -2156,7 +2195,6 @@ Begin End; CurVarNum := StartVar; - CurRecNum := StartRec; {$IFDEF LOGGING} Session.SystemLog('[' + strI2S(Depth) + '] ExecBlock END'); @@ -2173,7 +2211,6 @@ Begin Result := 0; CurVarNum := 0; CurVarID := 0; - CurRecNum := 0; ReloadMenu := False; Done := False; ExitProc := False; @@ -2227,7 +2264,7 @@ Begin End; InitProcedures (Owner, Self, VarData, CurVarNum, CurVarID, 0); - ExecuteBlock (CurVarNum, CurRecNum); + ExecuteBlock (CurVarNum); DataFile^.Close; diff --git a/mystic/mpl_types.pas b/mystic/mpl_types.pas index 1848fde..5056a85 100644 --- a/mystic/mpl_types.pas +++ b/mystic/mpl_types.pas @@ -233,17 +233,12 @@ Type PStack = ^TStack; TStack = Array[1..mplMaxDataSize] of Byte; TArrayInfo = Array[1..mplMaxArrayDem] of Word; - TRecordInfo = Record - vType : Byte; - Offset : Word; - DataSize : Word; + TRecInfo = Record + vType : TIdentTypes; + OneSize : Word; + Offset : Word; + ArrDem : Word; 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?!?! @@ -276,21 +271,7 @@ Type ArrDim : TArrayInfo; 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; - RecDataRec = Array[1..mplMaxRecords] of PRecordRec; {$ELSE} PVarRec = ^TVarRec; TVarRec = Record