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

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

70
mystic/mpl_common.pas
View File

@ -1,5 +1,5 @@
Function cGetVarChar (T: TIdentTypes) : Char; Function VarType2Char (T: TIdentTypes) : Char;
Begin Begin
Case T of Case T of
iString : Result := 's'; iString : Result := 's';
@ -9,49 +9,53 @@ Begin
iWord : Result := 'w'; iWord : Result := 'w';
iInteger : Result := 'i'; iInteger : Result := 'i';
iLongInt : Result := 'l'; iLongInt : Result := 'l';
iCardinal : Result := 'a';
iReal : Result := 'r'; iReal : Result := 'r';
iBool : Result := 'o'; iBool : Result := 'o';
iFile : Result := 'f'; iFile : Result := 'f';
iRecord : Result := 'x'; iRecord : Result := 'x';
iPointer : Result := 'p';
Else Else
Result := ' '; Result := ' ';
End; End;
End; End;
Function cVarType (C: Char) : TIdentTypes; Function Char2VarType (C: Char) : TIdentTypes;
begin Begin
case UpCase(c) of Case UpCase(c) of
'S' : cVarType := iString; 'S' : Result := iString;
'C' : cVarType := iChar; 'C' : Result := iChar;
'B' : cVarType := iByte; 'B' : Result := iByte;
'H' : cVarType := iShort; 'H' : Result := iShort;
'W' : cVarType := iWord; 'W' : Result := iWord;
'I' : cVarType := iInteger; 'I' : Result := iInteger;
'L' : cVarType := iLongInt; 'L' : Result := iLongInt;
'R' : cVarType := iReal; 'A' : Result := iCardinal;
'O' : cVarType := iBool; 'R' : Result := iReal;
'F' : cVarType := iFile; 'O' : Result := iBool;
'X' : cVarType := iRecord; 'F' : Result := iFile;
else 'X' : Result := iRecord;
cVarType := iNone; 'P' : Result := iPointer;
end; Else
end; Result := iNone;
End;
End;
Function xVarSize (T: TIdentTypes) : Word; Function GetVarSize (T: TIdentTypes) : Word;
Begin Begin
Case T of Case T of
iRecord, iRecord,
iNone : xVarSize := 0; iNone : Result := 0;
iString : xVarSize := 256; iString : Result := 256;
iChar : xVarSize := 1; iChar : Result := 1;
iByte : xVarSize := 1; iByte : Result := 1;
iShort : xVarSize := 1; iShort : Result := 1;
iWord : xVarSize := 2; iWord : Result := 2;
iInteger : xVarSize := 2; iInteger : Result := 2;
iLongInt : xVarSize := 4; iLongInt : Result := 4;
iReal : xVarSize := SizeOf(Real); // {$IFDEF FPC}8{$ELSE}6{$ENDIF}; iReal : Result := SizeOf(Real); // {$IFDEF FPC}8{$ELSE}6{$ENDIF};
iBool : xVarSize := 1; iBool : Result := 1;
iFile : xVarSize := SizeOf(File); // was 128; iFile : Result := SizeOf(File); // was 128;
End; End;
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); Procedure AddVar ({$IFDEF MPLPARSER} I: String; {$ENDIF} T: TIdentTypes);
Begin Begin
AddStr ({$IFDEF MPLPARSER} I, {$ENDIF} T, xVarSize(T) - 1); AddStr ({$IFDEF MPLPARSER} I, {$ENDIF} T, GetVarSize(T) - 1);
End; End;
Procedure AddPointer ({$IFDEF MPLPARSER} I: String; {$ENDIF} T: TIdentTypes; SI: Word; PD: Pointer); 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} '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} '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} '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; End;
1 : Begin 1 : Begin
{$IFNDEF MPLPARSER} TInterpEngine(S).IdxVarUser := X + 1; {$ENDIF} {$IFNDEF MPLPARSER} TInterpEngine(S).IdxVarUser := X + 1; {$ENDIF}

109
mystic/mpl_compile.pas
View File

@ -1,10 +1,19 @@
Unit MPL_Compile;
{$I M_OPS.PAS} {$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 Interface
Uses Uses
DOS,
m_Strings, m_Strings,
m_FileIO, m_FileIO,
MPL_FileIO; MPL_FileIO;
@ -60,6 +69,7 @@ Type
ArrEnd : Array[1..mplMaxArrayDem] of LongInt; ArrEnd : Array[1..mplMaxArrayDem] of LongInt;
NumVars : Word; NumVars : Word;
StrLen : Byte; StrLen : Byte;
VarSize : LongInt;
End; End;
PRecordRec = ^TRecordRec; PRecordRec = ^TRecordRec;
@ -67,6 +77,7 @@ Type
Ident : String[mplMaxIdentLen]; Ident : String[mplMaxIdentLen];
Fields : Array[1..mplMaxRecFields] of TParserVarInfoRec; Fields : Array[1..mplMaxRecFields] of TParserVarInfoRec;
NumFields : Word; NumFields : Word;
// RecSize : Word;
End; End;
PConstRec = ^TConstRec; PConstRec = ^TConstRec;
@ -135,7 +146,7 @@ Type
Procedure ParseVariable (VT: TIdentTypes); Procedure ParseVariable (VT: TIdentTypes);
Procedure ParseArray (VN: Word); Procedure ParseArray (VN: Word);
Procedure DefineRecord; Procedure DefineRecordType;
Procedure DefineVariable; Procedure DefineVariable;
Procedure DefineConst; Procedure DefineConst;
Procedure DefineGoto; Procedure DefineGoto;
@ -537,7 +548,6 @@ Begin
If GetIdent(False) Then Begin If GetIdent(False) Then Begin
If IdentStr = 'include' Then Begin If IdentStr = 'include' Then Begin
Str := GetDirective; Str := GetDirective;
// getchar;
SavePosition; SavePosition;
InFile[CurFile].SavedInfo := UpdateInfo; InFile[CurFile].SavedInfo := UpdateInfo;
OpenSourceFile(Str); 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)); 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;
RecSize : LongInt;
Begin Begin
GetIdent(False); GetIdent(False);
@ -1536,14 +1565,14 @@ Procedure TParserEngine.ParseVariableInfo (Param: Boolean; IsRec: Boolean; Var I
If Info.vType <> iRecord Then Begin If Info.vType <> iRecord Then Begin
If Info.vType = iString Then If Info.vType = iString Then
RecSize := Info.StrLen + 1 Info.VarSize := Info.StrLen + 1
Else Else
RecSize := xVarSize(Info.vType); Info.VarSize := GetVarSize(Info.vType);
If Info.ArrDem > 0 Then 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, ''); Error (mpsDataTooBig, '');
End; End;
End; End;
@ -1708,8 +1737,9 @@ End;
Procedure TParserEngine.DefineVariable; Procedure TParserEngine.DefineVariable;
Var 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);
@ -1717,30 +1747,33 @@ Begin
OutString (Char(opTypeRec)); OutString (Char(opTypeRec));
OutWord (RecData[Info.StrLen]^.NumFields); OutWord (RecData[Info.StrLen]^.NumFields);
// BaseRec := Info; RecSize := 0;
// BaseRec.Prefix := ''; For Count := 1 to RecData[Info.StrLen]^.NumFields Do
// BaseRec.NumVars := 1; Inc (RecSize, RecData[Info.StrLen]^.Fields[Count].VarSize);
// BaseRec.StrLen := 0;
// BaseRec.ArrDem := 0;
(* If RecSize > mplMaxDataSize Then Begin
writeln('baserecord'); Error (mpsDataTooBig, '');
writeln(' ident: ', baserec.ident[1]); Exit;
writeln(' prefix: ', baserec.prefix); End;
writeln(' vtype: ', baserec.vtype);
writeln(' arrdem: ', baserec.arrdem); OutWord (RecSize);
writeln(' numvars: ', baserec.numvars);
writeln(' strlen: ', baserec.strlen); BaseRec := Info;
writeln('arrstart: ', baserec.arrstart[1]);
writeln(' arrend: ', baserec.arrend[1]); BaseRec.Prefix := '';
*) BaseRec.NumVars := 1;
// CreateVariable(BaseRec); BaseRec.StrLen := 0;
BaseRec.ArrDem := 0;
CreateVariable(BaseRec);
// how do we support an array here with this terrible idea of // how do we support an array here with this terrible idea of
// a record system? redone data system is complete but i dont have // a record system? redone data system is complete but i dont have
// the drive to implement it into MPL just yet // 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]);
@ -1754,7 +1787,7 @@ Var
Count : LongInt; Count : LongInt;
Begin Begin
OutString (Char(opVarDeclare)); OutString (Char(opVarDeclare));
OutString (cGetVarChar(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));
@ -1774,8 +1807,6 @@ Begin
Inc (CurVarNum); Inc (CurVarNum);
New (VarData[CurVarNum]); New (VarData[CurVarNum]);
// WriteLn ('Creating new var. ID: ', CurVarID, ' Num: ', CurVarNum);
With VarData[CurVarNum]^ Do Begin With VarData[CurVarNum]^ Do Begin
VarID := CurVarID; VarID := CurVarID;
@ -1802,7 +1833,7 @@ Begin
End; End;
End; End;
Procedure TParserEngine.DefineRecord; Procedure TParserEngine.DefineRecordType;
// get rid of this crap kludge and do records the right way... // get rid of this crap kludge and do records the right way...
Var Var
Ident : String; Ident : String;
@ -1897,7 +1928,7 @@ Begin
If Params + Info.NumVars >= mplMaxProcParams Then If Params + Info.NumVars >= mplMaxProcParams Then
Error (mpsTooManyParams,''); Error (mpsTooManyParams,'');
VarChar := cGetVarChar(Info.vType); VarChar := VarType2Char(Info.vType);
If Info.vType = iFile Then If Info.vType = iFile Then
Error (mpsFileParamVar, ''); Error (mpsFileParamVar, '');
@ -1958,7 +1989,7 @@ Begin
Else Else
Error (mpsUnknownIdent, IdentStr); Error (mpsUnknownIdent, IdentStr);
VarChar := cGetVarChar(VarType); VarChar := VarType2Char(VarType);
VarData[ProcVar]^.vType := VarType; VarData[ProcVar]^.vType := VarType;
@ -1997,7 +2028,7 @@ Begin
RV := FindVariable(IdentStr); 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, ''); Error (mpsTypeMismatch, '');
// OutString (Char(opVariable)); // i dont think we need this // OutString (Char(opVariable)); // i dont think we need this
@ -2007,11 +2038,11 @@ 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...
If cVarType(VarData[VN]^.Params[Count]) in vNums Then ParseVarNumber Else If Char2VarType(VarData[VN]^.Params[Count]) in vNums Then ParseVarNumber Else
If cVarType(VarData[VN]^.Params[Count]) = iString Then ParseVarString Else If Char2VarType(VarData[VN]^.Params[Count]) = iString Then ParseVarString Else
If cVarType(VarData[VN]^.Params[Count]) = iChar Then ParseVarChar Else If Char2VarType(VarData[VN]^.Params[Count]) = iChar Then ParseVarChar Else
If cVarType(VarData[VN]^.Params[Count]) = iBool Then ParseVarBoolean Else If Char2VarType(VarData[VN]^.Params[Count]) = iBool Then ParseVarBoolean Else
If cVarType(VarData[VN]^.Params[Count]) = iFile Then ParseVarFile; If Char2VarType(VarData[VN]^.Params[Count]) = iFile Then ParseVarFile;
End; End;
OutString(Char(opParamSep)); OutString(Char(opParamSep));
@ -2516,7 +2547,7 @@ Begin
DefineVariable; DefineVariable;
End Else End Else
If GetStr(tkw[wType], False, True) Then Begin If GetStr(tkw[wType], False, True) Then Begin
DefineRecord; DefineRecordType;
GotVar := False; GotVar := False;
GotConst := False; GotConst := False;
End Else End Else

41
mystic/mpl_execute.pas
View File

@ -933,7 +933,7 @@ Begin
NextChar; NextChar;
VarType := cVarType(Ch); VarType := Char2VarType(Ch);
NextChar; NextChar;
@ -979,7 +979,7 @@ Begin
If VarType = iString Then If VarType = iString Then
VarSize := StrSize VarSize := StrSize
Else Else
VarSize := xVarSize(VarType); VarSize := GetVarSize(VarType);
Kill := True; Kill := True;
ArrPos := ArrayPos; ArrPos := ArrayPos;
@ -1143,6 +1143,7 @@ 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;
@ -1171,7 +1172,7 @@ Begin
With VarData[CurVarNum]^ Do Begin With VarData[CurVarNum]^ Do Begin
VarID := VarData[VarNum]^.pID[Count]; VarID := VarData[VarNum]^.pID[Count];
vType := cVarType(VarData[VarNum]^.Params[Count]); vType := Char2VarType(VarData[VarNum]^.Params[Count]);
NumParams := 0; NumParams := 0;
ProcPos := 0; ProcPos := 0;
ArrPos := 0; ArrPos := 0;
@ -1179,7 +1180,7 @@ Begin
If vType = iString Then If vType = iString Then
VarSize := Param[Count].vSize VarSize := Param[Count].vSize
Else Else
VarSize := xVarSize(vType); VarSize := GetVarSize(vType);
DataSize := GetDataSize(CurVarNum); DataSize := GetDataSize(CurVarNum);
@ -1205,6 +1206,7 @@ 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' : ;
end; end;
Kill := True; Kill := True;
@ -1763,8 +1765,8 @@ Begin
If Ch = Char(opProcType) Then Begin If Ch = Char(opProcType) Then Begin
NextChar; NextChar;
VarData[CurVarNum]^.vType := cVarType(Ch); VarData[CurVarNum]^.vType := Char2VarType(Ch);
VarData[CurVarNum]^.VarSize := xVarSize(VarData[CurVarNum]^.vType); VarData[CurVarNum]^.VarSize := GetVarSize(VarData[CurVarNum]^.vType);
End Else End Else
PrevChar; PrevChar;
@ -1999,24 +2001,33 @@ Begin
Inc (CurRecNum); Inc (CurRecNum);
New (RecData[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; 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 For Count := 1 to RecData[CurRecNum]^.NumFields Do Begin
NextChar; 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; End;
// now we need to build something to create a record block of data // session.io.outfull('Record vars: ' + strI2S(RecData[CurRecNum]^.NumFields) + ' size: ' + strI2S(RecSize));
// 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.
End; End;
Function TInterpEngine.ExecuteBlock (StartVar, StartRec: Word) : Byte; Function TInterpEngine.ExecuteBlock (StartVar, StartRec: Word) : Byte;

9
mystic/mpl_types.pas
View File

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