Cardinal + record stuff

This commit is contained in:
mysticbbs 2012-03-20 11:21:06 -04:00
parent cc33cd02d5
commit a4ab7a1990
4 changed files with 143 additions and 115 deletions

View File

@ -4087,3 +4087,5 @@
+ The ALT-U local Sysop command has been removed (moved to user editor). + The ALT-U local Sysop command has been removed (moved to user editor).
Alt-E now opens a local user editor for the user which also contains the Alt-E now opens a local user editor for the user which also contains the
Upgrade option. Upgrade option.
+ Added CARDINAL (Unsigned 32-bit Integer) type to MPL

View File

@ -45,17 +45,18 @@ Function GetVarSize (T: TIdentTypes) : Word;
Begin Begin
Case T of Case T of
iRecord, iRecord,
iNone : Result := 0; iNone : Result := 0;
iString : Result := 256; iString : Result := 256;
iChar : Result := 1; iChar : Result := 1;
iByte : Result := 1; iByte : Result := 1;
iShort : Result := 1; iShort : Result := 1;
iWord : Result := 2; iWord : Result := 2;
iInteger : Result := 2; iInteger : Result := 2;
iLongInt : Result := 4; iLongInt : Result := 4;
iReal : Result := SizeOf(Real); // {$IFDEF FPC}8{$ELSE}6{$ENDIF}; iCardinal : Result := 4;
iBool : Result := 1; iReal : Result := SizeOf(Real); // {$IFDEF FPC}8{$ELSE}6{$ENDIF};
iFile : Result := SizeOf(File); // was 128; iBool : Result := 1;
iFile : Result := SizeOf(File); // was 128;
End; End;
End; End;

View File

@ -70,6 +70,7 @@ Type
NumVars : Word; NumVars : Word;
StrLen : Byte; StrLen : Byte;
VarSize : LongInt; VarSize : LongInt;
DataSize : LongInt;
End; End;
PRecordRec = ^TRecordRec; PRecordRec = ^TRecordRec;
@ -133,6 +134,7 @@ Type
Function FindConst (Str: String) : Integer; Function FindConst (Str: String) : Integer;
Function FindIdent (Str: String) : Boolean; Function FindIdent (Str: String) : Boolean;
// CODE PROCESSING // CODE PROCESSING
Function GetDataSize (Info: TParserVarInfoRec) : LongInt;
Procedure CreateVariable (Var Info: TParserVarInfoRec); Procedure CreateVariable (Var Info: TParserVarInfoRec);
Procedure ParseVariableInfo (Param: Boolean; IsRec: Boolean; Var Info: TParserVarInfoRec); Procedure ParseVariableInfo (Param: Boolean; IsRec: Boolean; Var Info: TParserVarInfoRec);
Procedure ParseIdent; Procedure ParseIdent;
@ -1348,6 +1350,7 @@ Procedure TParserEngine.ParseVarBoolean;
iWord, iWord,
iInteger, iInteger,
iLongInt, iLongInt,
iCardinal,
iReal : ParseVarNumber; iReal : ParseVarNumber;
iBool : NewBooleanCrap; iBool : NewBooleanCrap;
Else Else
@ -1432,6 +1435,26 @@ Begin
If VT = iFile Then Error(mpsInStatement,''); If VT = iFile Then Error(mpsInStatement,'');
End; End;
Function TParserEngine.GetDataSize (Info: TParserVarInfoRec) : LongInt;
Var
DimSize : LongInt;
OneSize : LongInt;
Count : Byte;
Begin
OneSize := Info.VarSize;
If Info.ArrDem = 0 Then
DimSize := OneSize
Else Begin
DimSize := (Info.ArrEnd[Info.ArrDem] - Info.ArrStart[Info.ArrDem] + 1) * OneSize;
For Count := Pred(Info.ArrDem) DownTo 1 Do
DimSize := DimSize * (Info.ArrEnd[Count] - Info.ArrStart[Count] + 1);
End;
Result := DimSize;
End;
Procedure TParserEngine.ParseVariableInfo (Param: Boolean; IsRec: Boolean; Var Info: TParserVarInfoRec); Procedure TParserEngine.ParseVariableInfo (Param: Boolean; IsRec: Boolean; Var Info: TParserVarInfoRec);
Function ParseNum : LongInt; Function ParseNum : LongInt;
@ -1499,26 +1522,6 @@ Procedure TParserEngine.ParseVariableInfo (Param: Boolean; IsRec: Boolean; Var I
Until (UpdateInfo.ErrorType <> 0) Or (Not GetStr(tkw[wVarSep], False, False)); Until (UpdateInfo.ErrorType <> 0) Or (Not GetStr(tkw[wVarSep], False, False));
End; End;
Function GetDataSize : LongInt;
Var
DimSize : LongInt;
OneSize : LongInt;
Count : Byte;
Begin
OneSize := Info.VarSize;
If Info.ArrDem = 0 Then
DimSize := OneSize
Else Begin
DimSize := (Info.ArrEnd[Info.ArrDem] - Info.ArrStart[Info.ArrDem] + 1) * OneSize;
For Count := Pred(Info.ArrDem) DownTo 1 Do
DimSize := DimSize * (Info.ArrEnd[Count] - Info.ArrStart[Count] + 1);
End;
Result := DimSize;
End;
Procedure ParseVarType; Procedure ParseVarType;
Var Var
Count : LongInt; Count : LongInt;
@ -1530,20 +1533,22 @@ Procedure TParserEngine.ParseVariableInfo (Param: Boolean; IsRec: Boolean; Var I
IdentStr := strLower(IdentStr); IdentStr := strLower(IdentStr);
// separate function? // separate function?
If IdentStr = tkv[iString ] Then Info.vType := iString Else If IdentStr = tkv[iString ] Then Info.vType := iString Else
If IdentStr = tkv[iChar ] Then Info.vType := iChar Else If IdentStr = tkv[iChar ] Then Info.vType := iChar Else
If IdentStr = tkv[iByte ] Then Info.vType := iByte Else If IdentStr = tkv[iByte ] Then Info.vType := iByte Else
If IdentStr = tkv[iShort ] Then Info.vType := iShort Else If IdentStr = tkv[iShort ] Then Info.vType := iShort Else
If IdentStr = tkv[iWord ] Then Info.vType := iWord Else If IdentStr = tkv[iWord ] Then Info.vType := iWord Else
If IdentStr = tkv[iInteger] Then Info.vType := iInteger Else If IdentStr = tkv[iInteger ] Then Info.vType := iInteger Else
If IdentStr = tkv[iLongInt] Then Info.vType := iLongInt Else If IdentStr = tkv[iLongInt ] Then Info.vType := iLongInt Else
If IdentStr = tkv[iReal ] Then Info.vType := iReal Else If IdentStr = tkv[iCardinal] Then Info.vType := iCardinal Else
If IdentStr = tkv[iBool ] Then Info.vType := iBool Else If IdentStr = tkv[iReal ] Then Info.vType := iReal Else
If IdentStr = tkv[iFile ] Then Begin If IdentStr = tkv[iBool ] Then Info.vType := iBool Else
If IdentStr = tkv[iFile ] Then Begin
If IsRec Then Error(mpsSyntaxError, 'Cannot define file in record'); If IsRec Then Error(mpsSyntaxError, 'Cannot define file in record');
Info.vType := iFile; Info.vType := iFile;
End Else Begin End Else Begin
Count := FindRecord(IdentStr); Count := FindRecord(IdentStr);
If Count = 0 Then If Count = 0 Then
Error(mpsUnknownIdent, IdentStr) Error(mpsUnknownIdent, IdentStr)
Else If IsRec Then Else If IsRec Then
@ -1552,6 +1557,8 @@ Procedure TParserEngine.ParseVariableInfo (Param: Boolean; IsRec: Boolean; Var I
Info.vType := iRecord; Info.vType := iRecord;
Info.Prefix := Info.Ident[1] + '.'; Info.Prefix := Info.Ident[1] + '.';
Info.StrLen := Count; Info.StrLen := Count;
// this crap needs to go?
End; End;
End; End;
@ -1570,7 +1577,7 @@ Procedure TParserEngine.ParseVariableInfo (Param: Boolean; IsRec: Boolean; Var I
Info.VarSize := GetVarSize(Info.vType); Info.VarSize := GetVarSize(Info.vType);
If Info.ArrDem > 0 Then If Info.ArrDem > 0 Then
Info.VarSize := GetDataSize; Info.VarSize := GetDataSize(Info);
If Info.VarSize > mplMaxDataSize Then If Info.VarSize > mplMaxDataSize Then
Error (mpsDataTooBig, ''); Error (mpsDataTooBig, '');
@ -1739,7 +1746,6 @@ Var
Info : TParserVarInfoRec; Info : TParserVarInfoRec;
BaseRec : TParserVarInfoRec; BaseRec : TParserVarInfoRec;
Count : LongInt; Count : LongInt;
RecSize : LongInt;
Begin Begin
ParseVariableInfo(False, False, Info); ParseVariableInfo(False, False, Info);
@ -1747,33 +1753,30 @@ Begin
OutString (Char(opTypeRec)); OutString (Char(opTypeRec));
OutWord (RecData[Info.StrLen]^.NumFields); OutWord (RecData[Info.StrLen]^.NumFields);
RecSize := 0; BaseRec := Info;
BaseRec.VarSize := 0;
BaseRec.ArrDem := Info.ArrDem;
BaseRec.ArrStart := Info.ArrStart;
BaseRec.ArrEnd := Info.ArrEnd;
BaseRec.Prefix := '';
BaseRec.NumVars := 1;
BaseRec.StrLen := 0;
For Count := 1 to RecData[Info.StrLen]^.NumFields Do For Count := 1 to RecData[Info.StrLen]^.NumFields Do
Inc (RecSize, RecData[Info.StrLen]^.Fields[Count].VarSize); Inc (BaseRec.VarSize, RecData[Info.StrLen]^.Fields[Count].VarSize);
If RecSize > mplMaxDataSize Then Begin If BaseRec.VarSize > mplMaxDataSize Then Begin
Error (mpsDataTooBig, ''); Error (mpsDataTooBig, '');
Exit; Exit;
End; End;
OutWord (RecSize); BaseRec.DataSize := GetDataSize(BaseRec);
BaseRec := Info; OutWord (BaseRec.DataSize);
BaseRec.Prefix := '';
BaseRec.NumVars := 1;
BaseRec.StrLen := 0;
BaseRec.ArrDem := 0;
CreateVariable(BaseRec); CreateVariable(BaseRec);
// how do we support an array here with this terrible idea of
// a record system? redone data system is complete but i dont have
// the drive to implement it into MPL just yet
// IRECORD should be whatever it is... same as anything.
For Count := 1 to RecData[Info.StrLen]^.NumFields Do Begin For Count := 1 to RecData[Info.StrLen]^.NumFields Do Begin
RecData[Info.StrLen]^.Fields[Count].Prefix := Info.Prefix; RecData[Info.StrLen]^.Fields[Count].Prefix := Info.Prefix;
CreateVariable(RecData[Info.StrLen]^.Fields[Count]); CreateVariable(RecData[Info.StrLen]^.Fields[Count]);
@ -1797,6 +1800,7 @@ Begin
Else Begin Else Begin
OutString (Char(opArrDef)); OutString (Char(opArrDef));
OutWord (Info.ArrDem); OutWord (Info.ArrDem);
For Count := 1 to Info.ArrDem Do For Count := 1 to Info.ArrDem Do
OutString (Char(opOpenNum) + strI2S(Info.ArrEnd[Count]) + Char(opCloseNum)); OutString (Char(opOpenNum) + strI2S(Info.ArrEnd[Count]) + Char(opCloseNum));
End; End;
@ -1975,16 +1979,17 @@ Begin
IdentStr := strLower(IdentStr); IdentStr := strLower(IdentStr);
// make this into a separate function??? // make this into a separate function???
If IdentStr = tkv[iString ] Then VarType := iString Else If IdentStr = tkv[iString ] Then VarType := iString Else
If IdentStr = tkv[iChar ] Then VarType := iChar Else If IdentStr = tkv[iChar ] Then VarType := iChar Else
If IdentStr = tkv[iByte ] Then VarType := iByte Else If IdentStr = tkv[iByte ] Then VarType := iByte Else
If IdentStr = tkv[iShort ] Then VarType := iShort Else If IdentStr = tkv[iShort ] Then VarType := iShort Else
If IdentStr = tkv[iWord ] Then VarType := iWord Else If IdentStr = tkv[iWord ] Then VarType := iWord Else
If IdentStr = tkv[iInteger] Then VarType := iInteger Else If IdentStr = tkv[iInteger ] Then VarType := iInteger Else
If IdentStr = tkv[iLongInt] Then VarType := iLongInt Else If IdentStr = tkv[iLongInt ] Then VarType := iLongInt Else
If IdentStr = tkv[iReal ] Then VarType := iReal Else If IdentStr = tkv[iCardinal] Then VarType := iCardinal Else
If IdentStr = tkv[iBool ] Then VarType := iBool Else If IdentStr = tkv[iReal ] Then VarType := iReal Else
If IdentStr = tkv[iFile ] Then If IdentStr = tkv[iBool ] Then VarType := iBool Else
If IdentStr = tkv[iFile ] Then
Error (mpsBadFunction, '') Error (mpsBadFunction, '')
Else Else
Error (mpsUnknownIdent, IdentStr); Error (mpsUnknownIdent, IdentStr);
@ -2038,6 +2043,7 @@ 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
If Char2VarType(VarData[VN]^.Params[Count]) in vNums Then ParseVarNumber Else If Char2VarType(VarData[VN]^.Params[Count]) in vNums Then ParseVarNumber 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
@ -2204,6 +2210,7 @@ Begin
iWord, iWord,
iInteger, iInteger,
iLongInt, iLongInt,
iCardinal,
iReal : Repeat iReal : Repeat
ParseVarNumber; ParseVarNumber;

View File

@ -418,24 +418,26 @@ End;
Function TInterpEngine.GetNumber(VN: Word; Var A: TArrayInfo) : Real; Function TInterpEngine.GetNumber(VN: Word; Var A: TArrayInfo) : Real;
Begin Begin
Case VarData[VN]^.vType of Case VarData[VN]^.vType of
iByte : Result := Byte(GetDataPtr(VN, A)^); iByte : Result := Byte(GetDataPtr(VN, A)^);
iShort : Result := ShortInt(GetDataPtr(VN, A)^); iShort : Result := ShortInt(GetDataPtr(VN, A)^);
iWord : Result := Word(GetDataPtr(VN, A)^); iWord : Result := Word(GetDataPtr(VN, A)^);
iInteger : Result := Integer(GetDataPtr(VN, A)^); iInteger : Result := Integer(GetDataPtr(VN, A)^);
iLongInt : Result := LongInt(GetDataPtr(VN, A)^); iLongInt : Result := LongInt(GetDataPtr(VN, A)^);
iReal : Result := Real(GetDataPtr(VN, A)^); iCardinal : Result := Cardinal(GetDataPtr(VN, A)^);
iReal : Result := Real(GetDataPtr(VN, A)^);
End; End;
End; End;
Function TInterpEngine.RecastNumber (Var Num; T: TIdentTypes) : Real; Function TInterpEngine.RecastNumber (Var Num; T: TIdentTypes) : Real;
Begin Begin
Case T of Case T of
iByte : Result := Byte(Num); iByte : Result := Byte(Num);
iShort : Result := ShortInt(Num); iShort : Result := ShortInt(Num);
iWord : Result := Word(Num); iWord : Result := Word(Num);
iInteger : Result := Integer(Num); iInteger : Result := Integer(Num);
iLongInt : Result := LongInt(Num); iLongInt : Result := LongInt(Num);
iReal : Result := Real(Num); iCardinal : Result := Cardinal(Num);
iReal : Result := Real(Num);
End; End;
End; End;
@ -511,6 +513,7 @@ Var
While CheckChar = '^' Do Begin While CheckChar = '^' Do Begin
ParseNext; ParseNext;
If Result <> 0 Then If Result <> 0 Then
Result := Exp(Ln(Abs(Result)) * SignedOp) Result := Exp(Ln(Abs(Result)) * SignedOp)
Else Else
@ -520,14 +523,18 @@ Var
Begin Begin
Result := Power; Result := Power;
While CheckChar in ['%','*','/'] Do Begin While CheckChar in ['%','*','/'] Do Begin
OpChar := CheckChar; OpChar := CheckChar;
ParseNext; ParseNext;
Case OpChar of Case OpChar of
'%' : Result := Trunc(Result) MOD Trunc(Power); '%' : Result := Trunc(Result) MOD Trunc(Power);
'*' : Result := Result * Power; '*' : Result := Result * Power;
'/' : Begin '/' : Begin
PowerRes := Power; PowerRes := Power;
If PowerRes = 0 Then If PowerRes = 0 Then
Error (mpxDivisionByZero, '') Error (mpxDivisionByZero, '')
Else Else
@ -542,7 +549,9 @@ Var
While CheckChar in ['+','-','&','|','@','<','>'] Do Begin While CheckChar in ['+','-','&','|','@','<','>'] Do Begin
OpChar := CheckChar; OpChar := CheckChar;
ParseNext; ParseNext;
Case OpChar of Case OpChar of
'+' : Result := Result + MultiplyDivide; '+' : Result := Result + MultiplyDivide;
'-' : Result := Result - MultiplyDivide; '-' : Result := Result - MultiplyDivide;
@ -554,9 +563,12 @@ Var
End; End;
End; End;
End; End;
Begin Begin
NextChar; NextChar;
ParseNext; ParseNext;
Result := AddSubtract; Result := AddSubtract;
End; End;
@ -872,39 +884,41 @@ Begin
Case VarData[VarNum]^.vType of Case VarData[VarNum]^.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)^);
Target := Byte(Trunc(EvaluateNumber)); Target := Byte(Trunc(EvaluateNumber));
TempStr[Target] := EvaluateString[1]; TempStr[Target] := EvaluateString[1];
SetString (VarNum, ArrayData, TempStr); SetString (VarNum, ArrayData, TempStr);
End Else Begin End Else Begin
PrevChar; PrevChar;
SetString (VarNum, ArrayData, EvaluateString); SetString (VarNum, ArrayData, EvaluateString);
End; End;
End; End;
iByte : Byte(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); iByte : Byte(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber);
iShort : ShortInt(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); iShort : ShortInt(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber);
iWord : Word(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); iWord : Word(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber);
iInteger : Integer(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); iInteger : Integer(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber);
iLongInt : LongInt(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber); iLongInt : LongInt(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber);
iReal : Real(GetDataPtr(VarNum, ArrayData)^) := EvaluateNumber; iCardinal : Cardinal(GetDataPtr(VarNum, ArrayData)^) := Trunc(EvaluateNumber);
iBool : ByteBool(GetDataPtr(VarNum, ArrayData)^) := EvaluateBoolean; iReal : Real(GetDataPtr(VarNum, ArrayData)^) := EvaluateNumber;
iBool : ByteBool(GetDataPtr(VarNum, ArrayData)^) := EvaluateBoolean;
End; End;
End; End;
Procedure TInterpEngine.SetNumber (VN: Word; R: Real; Var A: TArrayInfo); Procedure TInterpEngine.SetNumber (VN: Word; R: Real; Var A: TArrayInfo);
Begin Begin
Case VarData[VN]^.vType of Case VarData[VN]^.vType of
iByte : Byte(GetDataPtr(VN, A)^) := Trunc(R); iByte : Byte(GetDataPtr(VN, A)^) := Trunc(R);
iShort : ShortInt(GetDataPtr(VN, A)^) := Trunc(R); iShort : ShortInt(GetDataPtr(VN, A)^) := Trunc(R);
iWord : Word(GetDataPtr(VN, A)^) := Trunc(R); iWord : Word(GetDataPtr(VN, A)^) := Trunc(R);
iInteger : Integer(GetDataPtr(VN, A)^) := Trunc(R); iInteger : Integer(GetDataPtr(VN, A)^) := Trunc(R);
iLongInt : LongInt(GetDataPtr(VN, A)^) := Trunc(R); iLongInt : LongInt(GetDataPtr(VN, A)^) := Trunc(R);
iReal : Real(GetDataPtr(VN, A)^) := R; iCardinal : Cardinal(GetDataPtr(VN, A)^) := Trunc(R);
iReal : Real(GetDataPtr(VN, A)^) := R;
end; end;
end; end;
@ -914,6 +928,7 @@ Var
Begin Begin
With VarData[VarNum]^ Do Begin With VarData[VarNum]^ Do Begin
Result := VarSize; Result := VarSize;
For Count := 1 To ArrPos Do For Count := 1 To ArrPos Do
Result := Result * ArrDim[Count]; Result := Result * ArrDim[Count];
End; End;
@ -949,7 +964,9 @@ Begin
If Ch = Char(opArrDef) Then Begin If Ch = Char(opArrDef) Then Begin
NextWord; NextWord;
ArrayPos := W; ArrayPos := W;
For Count := 1 to ArrayPos Do ArrayData[Count] := Trunc(EvaluateNumber); For Count := 1 to ArrayPos Do ArrayData[Count] := Trunc(EvaluateNumber);
End; End;
@ -1082,15 +1099,16 @@ Type
vID : Word; vID : Word;
vData : PStack; vData : PStack;
Case TIdentTypes of // this all needs to go... push to vData Case TIdentTypes of // this all needs to go... push to vData
iChar : (C : Char); iChar : (C : Char);
iString : (S : String); iString : (S : String);
iByte : (B : Byte); iByte : (B : Byte);
iShort : (H : ShortInt); iShort : (H : ShortInt);
iWord : (W : Word); iWord : (W : Word);
iInteger : (I : Integer); iInteger : (I : Integer);
iLongInt : (L : LongInt); iLongInt : (L : LongInt);
iReal : (R : Real); iCardinal : (A : Cardinal);
iBool : (O : Boolean); iReal : (R : Real);
iBool : (O : Boolean);
End; End;
Var Var