More work on Records, Cardinal, and Pointers

This commit is contained in:
mysticbbs 2012-03-18 18:31:47 -04:00
parent 082d63aa2b
commit 2a88c22671
4 changed files with 152 additions and 103 deletions

View File

@ -1,57 +1,61 @@
Function cGetVarChar (T: TIdentTypes) : Char;
Function VarType2Char (T: TIdentTypes) : Char;
Begin
Case T of
iString : Result := 's';
iChar : Result := 'c';
iByte : Result := 'b';
iShort : Result := 'h';
iWord : Result := 'w';
iInteger : Result := 'i';
iLongInt : Result := 'l';
iReal : Result := 'r';
iBool : Result := 'o';
iFile : Result := 'f';
iRecord : Result := 'x';
iString : Result := 's';
iChar : Result := 'c';
iByte : Result := 'b';
iShort : Result := 'h';
iWord : Result := 'w';
iInteger : Result := 'i';
iLongInt : Result := 'l';
iCardinal : Result := 'a';
iReal : Result := 'r';
iBool : Result := 'o';
iFile : Result := 'f';
iRecord : Result := 'x';
iPointer : Result := 'p';
Else
Result := ' ';
End;
End;
Function cVarType (C: Char) : TIdentTypes;
begin
case UpCase(c) of
'S' : cVarType := iString;
'C' : cVarType := iChar;
'B' : cVarType := iByte;
'H' : cVarType := iShort;
'W' : cVarType := iWord;
'I' : cVarType := iInteger;
'L' : cVarType := iLongInt;
'R' : cVarType := iReal;
'O' : cVarType := iBool;
'F' : cVarType := iFile;
'X' : cVarType := iRecord;
else
cVarType := iNone;
end;
end;
Function Char2VarType (C: Char) : TIdentTypes;
Begin
Case UpCase(c) of
'S' : Result := iString;
'C' : Result := iChar;
'B' : Result := iByte;
'H' : Result := iShort;
'W' : Result := iWord;
'I' : Result := iInteger;
'L' : Result := iLongInt;
'A' : Result := iCardinal;
'R' : Result := iReal;
'O' : Result := iBool;
'F' : Result := iFile;
'X' : Result := iRecord;
'P' : Result := iPointer;
Else
Result := iNone;
End;
End;
Function xVarSize (T: TIdentTypes) : Word;
Function GetVarSize (T: TIdentTypes) : Word;
Begin
Case T of
iRecord,
iNone : xVarSize := 0;
iString : xVarSize := 256;
iChar : xVarSize := 1;
iByte : xVarSize := 1;
iShort : xVarSize := 1;
iWord : xVarSize := 2;
iInteger : xVarSize := 2;
iLongInt : xVarSize := 4;
iReal : xVarSize := SizeOf(Real); // {$IFDEF FPC}8{$ELSE}6{$ENDIF};
iBool : xVarSize := 1;
iFile : xVarSize := SizeOf(File); // was 128;
iNone : Result := 0;
iString : Result := 256;
iChar : Result := 1;
iByte : Result := 1;
iShort : Result := 1;
iWord : Result := 2;
iInteger : Result := 2;
iLongInt : Result := 4;
iReal : Result := SizeOf(Real); // {$IFDEF FPC}8{$ELSE}6{$ENDIF};
iBool : Result := 1;
iFile : Result := SizeOf(File); // was 128;
End;
End;
@ -113,7 +117,7 @@ Procedure InitProcedures (O: Pointer; S: Pointer; Var CV: VarDataRec; Var X: Wor
Procedure AddVar ({$IFDEF MPLPARSER} I: String; {$ENDIF} T: TIdentTypes);
Begin
AddStr ({$IFDEF MPLPARSER} I, {$ENDIF} T, xVarSize(T) - 1);
AddStr ({$IFDEF MPLPARSER} I, {$ENDIF} T, GetVarSize(T) - 1);
End;
Procedure AddPointer ({$IFDEF MPLPARSER} I: String; {$ENDIF} T: TIdentTypes; SI: Word; PD: Pointer);
@ -298,7 +302,7 @@ Begin
AddPointer ({$IFDEF MPLPARSER} 'dirname', {$ENDIF} iString, 256, {$IFNDEF MPLPARSER} @TInterpEngine(S).DirInfo.Name {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'dirsize', {$ENDIF} iLongInt, 4, {$IFNDEF MPLPARSER} @TInterpEngine(S).DirInfo.Size {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'dirtime', {$ENDIF} iLongInt, 4, {$IFNDEF MPLPARSER} @TInterpEngine(S).DirInfo.Time {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'dirattr', {$ENDIF} iByte, 1, {$IFNDEF MPLPARSER} @TInterpEngine(S).DirInfo.Attr {$ELSE} NIL {$ENDIF});
AddPointer ({$IFDEF MPLPARSER} 'dirattr', {$ENDIF} iLongInt, SizeOf(SearchRec.Attr), {$IFNDEF MPLPARSER} @TInterpEngine(S).DirInfo.Attr {$ELSE} NIL {$ENDIF});
End;
1 : Begin
{$IFNDEF MPLPARSER} TInterpEngine(S).IdxVarUser := X + 1; {$ENDIF}

View File

@ -1,10 +1,19 @@
Unit MPL_Compile;
{$I M_OPS.PAS}
Unit MPL_Compile;
// OKAY SO iRECORD HAS DATAPTR ALLOCATED TO ITS FULL SIZE.
// WHEN A RECORD VARIABLE (iRECORD) is DEFINED, EACH VAR
// IS CREATED WITH A POINTER TO iRECORD.DATAPTR[OFFSET]
// IRECORD THEN CAN BE REFERENCED AS EXPECTED.
// ALSO NEED TO FIGURE OUT SIZEOF TOO
// REMOVE VARTYPE2CHAR ETC AND USE ORDINAL
Interface
Uses
DOS,
m_Strings,
m_FileIO,
MPL_FileIO;
@ -60,6 +69,7 @@ Type
ArrEnd : Array[1..mplMaxArrayDem] of LongInt;
NumVars : Word;
StrLen : Byte;
VarSize : LongInt;
End;
PRecordRec = ^TRecordRec;
@ -67,6 +77,7 @@ Type
Ident : String[mplMaxIdentLen];
Fields : Array[1..mplMaxRecFields] of TParserVarInfoRec;
NumFields : Word;
// RecSize : Word;
End;
PConstRec = ^TConstRec;
@ -135,7 +146,7 @@ Type
Procedure ParseVariable (VT: TIdentTypes);
Procedure ParseArray (VN: Word);
Procedure DefineRecord;
Procedure DefineRecordType;
Procedure DefineVariable;
Procedure DefineConst;
Procedure DefineGoto;
@ -537,7 +548,6 @@ Begin
If GetIdent(False) Then Begin
If IdentStr = 'include' Then Begin
Str := GetDirective;
// getchar;
SavePosition;
InFile[CurFile].SavedInfo := UpdateInfo;
OpenSourceFile(Str);
@ -1489,10 +1499,29 @@ Procedure TParserEngine.ParseVariableInfo (Param: Boolean; IsRec: Boolean; Var I
Until (UpdateInfo.ErrorType <> 0) Or (Not GetStr(tkw[wVarSep], False, False));
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;
Var
Count : LongInt;
RecSize : LongInt;
Begin
GetIdent(False);
@ -1536,14 +1565,14 @@ Procedure TParserEngine.ParseVariableInfo (Param: Boolean; IsRec: Boolean; Var I
If Info.vType <> iRecord Then Begin
If Info.vType = iString Then
RecSize := Info.StrLen + 1
Info.VarSize := Info.StrLen + 1
Else
RecSize := xVarSize(Info.vType);
Info.VarSize := GetVarSize(Info.vType);
If Info.ArrDem > 0 Then
RecSize := RecSize * Info.ArrEnd[1] * Info.ArrDem;
Info.VarSize := GetDataSize;
If RecSize > mplMaxDataSize Then
If Info.VarSize > mplMaxDataSize Then
Error (mpsDataTooBig, '');
End;
End;
@ -1708,8 +1737,9 @@ End;
Procedure TParserEngine.DefineVariable;
Var
Info : TParserVarInfoRec;
// BaseRec : TParserVarInfoRec;
BaseRec : TParserVarInfoRec;
Count : LongInt;
RecSize : LongInt;
Begin
ParseVariableInfo(False, False, Info);
@ -1717,30 +1747,33 @@ Begin
OutString (Char(opTypeRec));
OutWord (RecData[Info.StrLen]^.NumFields);
// BaseRec := Info;
RecSize := 0;
// BaseRec.Prefix := '';
// BaseRec.NumVars := 1;
// BaseRec.StrLen := 0;
// BaseRec.ArrDem := 0;
For Count := 1 to RecData[Info.StrLen]^.NumFields Do
Inc (RecSize, RecData[Info.StrLen]^.Fields[Count].VarSize);
(*
writeln('baserecord');
writeln(' ident: ', baserec.ident[1]);
writeln(' prefix: ', baserec.prefix);
writeln(' vtype: ', baserec.vtype);
writeln(' arrdem: ', baserec.arrdem);
writeln(' numvars: ', baserec.numvars);
writeln(' strlen: ', baserec.strlen);
writeln('arrstart: ', baserec.arrstart[1]);
writeln(' arrend: ', baserec.arrend[1]);
*)
// CreateVariable(BaseRec);
If RecSize > mplMaxDataSize Then Begin
Error (mpsDataTooBig, '');
Exit;
End;
OutWord (RecSize);
BaseRec := Info;
BaseRec.Prefix := '';
BaseRec.NumVars := 1;
BaseRec.StrLen := 0;
BaseRec.ArrDem := 0;
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
RecData[Info.StrLen]^.Fields[Count].Prefix := Info.Prefix;
CreateVariable(RecData[Info.StrLen]^.Fields[Count]);
@ -1754,7 +1787,7 @@ Var
Count : LongInt;
Begin
OutString (Char(opVarDeclare));
OutString (cGetVarChar(Info.vType));
OutString (VarType2Char(Info.vType));
If (Info.vType = iString) and (Info.StrLen > 0) Then
OutString(Char(opStrSize) + Char(opOpenNum) + strI2S(Info.StrLen) + Char(opCloseNum));
@ -1774,8 +1807,6 @@ Begin
Inc (CurVarNum);
New (VarData[CurVarNum]);
// WriteLn ('Creating new var. ID: ', CurVarID, ' Num: ', CurVarNum);
With VarData[CurVarNum]^ Do Begin
VarID := CurVarID;
@ -1802,7 +1833,7 @@ Begin
End;
End;
Procedure TParserEngine.DefineRecord;
Procedure TParserEngine.DefineRecordType;
// get rid of this crap kludge and do records the right way...
Var
Ident : String;
@ -1897,7 +1928,7 @@ Begin
If Params + Info.NumVars >= mplMaxProcParams Then
Error (mpsTooManyParams,'');
VarChar := cGetVarChar(Info.vType);
VarChar := VarType2Char(Info.vType);
If Info.vType = iFile Then
Error (mpsFileParamVar, '');
@ -1958,7 +1989,7 @@ Begin
Else
Error (mpsUnknownIdent, IdentStr);
VarChar := cGetVarChar(VarType);
VarChar := VarType2Char(VarType);
VarData[ProcVar]^.vType := VarType;
@ -1997,7 +2028,7 @@ Begin
RV := FindVariable(IdentStr);
If (VarData[RV]^.vType <> cVarType(VarData[VN]^.Params[Count])) And (VarData[VN]^.Params[Count] <> '*') Then
If (VarData[RV]^.vType <> Char2VarType(VarData[VN]^.Params[Count])) And (VarData[VN]^.Params[Count] <> '*') Then
Error (mpsTypeMismatch, '');
// OutString (Char(opVariable)); // i dont think we need this
@ -2007,11 +2038,11 @@ Begin
// if = '*' and type iString then...do the string index
End Else Begin
// use setvariable here?? cant cuz ifile isnt processed in setvariable...
If cVarType(VarData[VN]^.Params[Count]) in vNums Then ParseVarNumber Else
If cVarType(VarData[VN]^.Params[Count]) = iString Then ParseVarString Else
If cVarType(VarData[VN]^.Params[Count]) = iChar Then ParseVarChar Else
If cVarType(VarData[VN]^.Params[Count]) = iBool Then ParseVarBoolean Else
If cVarType(VarData[VN]^.Params[Count]) = iFile Then ParseVarFile;
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]) = iChar Then ParseVarChar Else
If Char2VarType(VarData[VN]^.Params[Count]) = iBool Then ParseVarBoolean Else
If Char2VarType(VarData[VN]^.Params[Count]) = iFile Then ParseVarFile;
End;
OutString(Char(opParamSep));
@ -2516,7 +2547,7 @@ Begin
DefineVariable;
End Else
If GetStr(tkw[wType], False, True) Then Begin
DefineRecord;
DefineRecordType;
GotVar := False;
GotConst := False;
End Else

View File

@ -933,7 +933,7 @@ Begin
NextChar;
VarType := cVarType(Ch);
VarType := Char2VarType(Ch);
NextChar;
@ -979,7 +979,7 @@ Begin
If VarType = iString Then
VarSize := StrSize
Else
VarSize := xVarSize(VarType);
VarSize := GetVarSize(VarType);
Kill := True;
ArrPos := ArrayPos;
@ -1143,6 +1143,7 @@ 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;
@ -1171,7 +1172,7 @@ Begin
With VarData[CurVarNum]^ Do Begin
VarID := VarData[VarNum]^.pID[Count];
vType := cVarType(VarData[VarNum]^.Params[Count]);
vType := Char2VarType(VarData[VarNum]^.Params[Count]);
NumParams := 0;
ProcPos := 0;
ArrPos := 0;
@ -1179,7 +1180,7 @@ Begin
If vType = iString Then
VarSize := Param[Count].vSize
Else
VarSize := xVarSize(vType);
VarSize := GetVarSize(vType);
DataSize := GetDataSize(CurVarNum);
@ -1205,6 +1206,7 @@ Begin
'l' : LongInt(Pointer(Data)^) := Param[Count].L;
'r' : Real(Pointer(Data)^) := Param[Count].R;
'o' : Boolean(Pointer(Data)^) := Param[Count].O;
'x' : ;
end;
Kill := True;
@ -1763,8 +1765,8 @@ Begin
If Ch = Char(opProcType) Then Begin
NextChar;
VarData[CurVarNum]^.vType := cVarType(Ch);
VarData[CurVarNum]^.VarSize := xVarSize(VarData[CurVarNum]^.vType);
VarData[CurVarNum]^.vType := Char2VarType(Ch);
VarData[CurVarNum]^.VarSize := GetVarSize(VarData[CurVarNum]^.vType);
End Else
PrevChar;
@ -1999,24 +2001,33 @@ Begin
Inc (CurRecNum);
New (RecData[CurRecNum]);
RecData[CurRecNum]^.RecStart := CurVarNum + 1;
// Holds ID info for all variables in this record
RecData[CurRecNum]^.RecStart := CurVarNum + 2; {+1 is base}
RecData[CurRecNum]^.NumFields := W;
// DefineVariable; // base record variable
NextWord;
RecSize := 0;
RecSize := W;
NextChar; // opVarDeclare
DefineVariable; // Base var
// get mem the dataptr for recsize
// THIS IS WHERE YOU LEFT OFF LAST TIME PICK IT UP HERE
// TURN DEBUGGING ON SO WE CATCH MEMORY LEAKS NOW
For Count := 1 to RecData[CurRecNum]^.NumFields Do Begin
NextChar;
Inc (RecSize, DefineVariable);
Inc (RecSize, DefineVariable); // create myrecvar.element ID
// DefineVariable should have a RecAllocate that is NIL UNLESS
// it is a Record element. In that case a Pointer to DATAPTR[OFFSET]
// is passed and no getmem is done
End;
// now we need to build something to create a record block of data
// and to dispose it based on the variables
// this method will not work for records in records or arrays of records
// and really should be re-done. the problem is, the evaluators will
// take a lot of changes to suport iRecord correctly.
// session.io.outfull('Record vars: ' + strI2S(RecData[CurRecNum]^.NumFields) + ' size: ' + strI2S(RecSize));
End;
Function TInterpEngine.ExecuteBlock (StartVar, StartRec: Word) : Byte;

View File

@ -8,10 +8,12 @@ Type
iWord,
iInteger,
iLongInt,
iCardinal,
iReal,
iBool,
iFile,
iRecord
iRecord,
iPointer
);
TTokenOpsRec = (
@ -75,7 +77,7 @@ Type
);
Const
mplVer = '110';
mplVer = '11?';
mplVersion = '[MPX ' + mplVer +']' + #26;
mplVerLength = 10;
mplExtSource = '.mps';
@ -174,7 +176,8 @@ Const
tkv : Array[TIdentTypes] of String[mplMaxIdentLen] = (
'none', 'string', 'char', 'byte',
'shortint', 'word', 'integer', 'longint',
'real', 'boolean', 'file', 'record');
'cardinal', 'real', 'boolean', 'file',
'record', 'pointer');
Type
TTokenWordType = Array[TTokenWordRec] of String[mplMaxIdentLen];