X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxdynrec.pas;h=511c82dd0fd2ba8aeafa406cc5ef26e714318148;hb=c737ec14212534a2b7069615641afdf329ea8cb4;hp=4afab5f2a2f5b31812bc36b9fbaaf5a53590bbc6;hpb=31d174a428ef1235e1708b0738804b47e006cf5c;p=d2df-sdl.git diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index 4afab5f..511c82d 100644 --- a/src/shared/xdynrec.pas +++ b/src/shared/xdynrec.pas @@ -1,9 +1,8 @@ -(* Copyright (C) DooM 2D:Forever Developers +(* Copyright (C) Doom 2D: Forever Developers * * This program is free software: you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. + * the Free Software Foundation, version 3 of the License ONLY. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of @@ -21,7 +20,8 @@ interface uses SysUtils, Variants, Classes, - xparser, xstreams, utils, hashtable, mempool; + {$IFDEF USE_MEMPOOL}mempool,{$ENDIF} + xparser, xstreams, utils, hashtable; // ////////////////////////////////////////////////////////////////////////// // @@ -54,7 +54,7 @@ type TDynEBSList = specialize TSimpleList; // this is base type for all scalars (and arrays) - TDynField = class(TPoolObject) + TDynField = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} public type TType = (TBool, TChar, TByte, TUByte, TShort, TUShort, TInt, TUInt, TString, TPoint, TSize, TColor, TList, TTrigData); @@ -238,7 +238,7 @@ type // record, either with actual values, or with type definitions - TDynRecord = class(TPoolObject) + TDynRecord = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} private mOwner: TDynMapDef; mId: AnsiString; @@ -375,7 +375,7 @@ type // bitset/enum definition - TDynEBS = class(TPoolObject) + TDynEBS = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} private mOwner: TDynMapDef; mIsEnum: Boolean; @@ -420,7 +420,7 @@ type // parsed "mapdef.txt" - TDynMapDef = class(TPoolObject) + TDynMapDef = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} public recTypes: TDynRecList; // [0] is always header trigTypes: TDynRecList; // trigdata @@ -489,12 +489,15 @@ type procedure xdynDumpProfiles (); {$ENDIF} +var + DynWarningCB: procedure (const msg: AnsiString; line, col: Integer) = nil; implementation +{$IF DEFINED(D2D_DYNREC_PROFILER)} uses - e_log - {$IF DEFINED(D2D_DYNREC_PROFILER)},xprofiler{$ENDIF}; + xprofiler; +{$ENDIF} // ////////////////////////////////////////////////////////////////////////// // @@ -547,7 +550,7 @@ begin if (mType = TType.TList) then begin mRVal := TDynRecList.Create(); - mRHash := hashNewStrInt(); + mRHash := THashStrInt.Create(); end; end; @@ -695,7 +698,7 @@ begin if (mRVal <> nil) then begin if (result.mRVal = nil) then result.mRVal := TDynRecList.Create(mRVal.count); - if (result.mRHash = nil) then result.mRHash := hashNewStrInt(); + if (result.mRHash = nil) then result.mRHash := THashStrInt.Create(); for rec in mRVal do result.addListItem(rec.clone(registerIn)); end; result.mRecRef := mRecRef; @@ -1176,9 +1179,9 @@ begin ahelp := ''; // field name - fldname := pr.expectStrOrId(); + fldname := pr.expectIdOrStr(); - while (pr.tokType <> pr.TTSemi) do + while (not pr.isDelim(';')) do begin if pr.eatId('type') then begin @@ -1311,7 +1314,7 @@ begin lebs := TDynField.TEBS.TRec; end; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); // create field mName := fldname; @@ -1918,7 +1921,7 @@ var edim: AnsiChar; begin if (pr.tokType = pr.TTEOF) then raise TDynParseException.Create(pr, 'field value expected'); - if (pr.tokType = pr.TTSemi) then raise TDynParseException.Create(pr, 'extra semicolon'); + if (pr.isDelim(';')) then raise TDynParseException.Create(pr, 'extra semicolon'); // if this field should contain struct, convert type and parse struct case mEBS of TEBS.TNone: begin end; @@ -1927,12 +1930,11 @@ begin // ugly hack. sorry. if (mType = TType.TTrigData) then begin - pr.expectTT(pr.TTBegin); - if (pr.tokType = pr.TTEnd) then + pr.expectDelim('{'); + if (pr.eatDelim('}')) then begin // '{}' mRecRef := nil; - pr.expectTT(pr.TTEnd); end else begin @@ -1950,7 +1952,7 @@ begin mRecRef := rc; end; mDefined := true; - pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records + pr.eatDelim(';'); // hack: allow (but don't require) semicolon after inline records exit; end; // other record types @@ -1975,10 +1977,10 @@ begin pr.expectId(); end; mDefined := true; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end - else if (pr.tokType = pr.TTBegin) then + else if (pr.isDelim('{')) then begin //rec := mOwner.mOwner.recType[mEBSTypeName]; // find in mapdef rec := nil; @@ -1993,10 +1995,10 @@ begin begin raise TDynParseException.CreateFmt(pr, 'duplicate record with id ''%s'' for field ''%s'' in record ''%s''', [rc.mId, mName, mOwner.mTypeName]); end; - pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records + pr.eatDelim(';'); // hack: allow (but don't require) semicolon after inline records exit; end; - pr.expectTT(pr.TTBegin); + pr.expectDelim('{'); end; TEBS.TEnum: begin @@ -2010,7 +2012,7 @@ begin mSVal := tk; //writeln('ENUM ', mEBSName, '; element <', mSVal, '> with value ', mIVal); mDefined := true; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TEBS.TBitSet: @@ -2031,7 +2033,7 @@ begin pr.skipToken(); // plus or pipe end; mDefined := true; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; else raise TDynParseException.Create(pr, 'ketmar forgot to handle some EBS type'); @@ -2044,7 +2046,7 @@ begin else if pr.eatId('false') or pr.eatId('ona') or pr.eatId('no') then mIVal := 0 else raise TDynParseException.CreateFmt(pr, 'invalid bool value for field ''%s''', [mName]); mDefined := true; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TChar: @@ -2064,50 +2066,50 @@ begin if (Length(mSVal) > mMaxDim) then raise TDynParseException.CreateFmt(pr, 'invalid string size for field ''%s''', [mName]); end; mDefined := true; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TByte: begin parseInt(-128, 127); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TUByte: begin parseInt(0, 255); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TShort: begin parseInt(-32768, 32768); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TUShort: begin parseInt(0, 65535); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TInt: begin parseInt(Integer($80000000), $7fffffff); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TUInt: begin parseInt(0, $7fffffff); //FIXME - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TString: begin mSVal := pr.expectStr(true); mDefined := true; - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TPoint, @@ -2126,7 +2128,7 @@ begin end; mDefined := true; pr.expectDelim(edim); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TColor: @@ -2149,7 +2151,7 @@ begin end; mDefined := true; pr.expectDelim(edim); - pr.expectTT(pr.TTSemi); + pr.expectDelim(';'); exit; end; TType.TList: @@ -2433,7 +2435,7 @@ begin if (fld.mRVal = nil) then begin fld.mRVal := TDynRecList.Create(); - fld.mRHash := hashNewStrInt(); + fld.mRHash := THashStrInt.Create(); end; result := fld.addListItem(rc); end; @@ -2591,7 +2593,7 @@ begin begin while true do begin - while pr.eatTT(pr.TTComma) do begin end; + while (pr.eatDelim(',')) do begin end; if pr.eatDelim(')') then break; tdn := pr.expectId(); if isForTrig[tdn] then raise TDynParseException.CreateFmt(pr, 'duplicate trigdata ''%s'' trigtype ''%s''', [mTypeName, tdn]); @@ -2609,8 +2611,8 @@ begin end else begin - mTypeName := pr.expectStrOrId(); - while (pr.tokType <> pr.TTBegin) do + mTypeName := pr.expectIdOrStr(); + while (not pr.isDelim('{')) do begin if pr.eatId('header') then begin mHeader := true; continue; end; if pr.eatId('size') then @@ -2643,9 +2645,9 @@ begin end; end; - pr.expectTT(pr.TTBegin); + pr.expectDelim('{'); // load fields - while (pr.tokType <> pr.TTEnd) do + while (not pr.isDelim('}')) do begin fld := TDynField.Create(pr); // append @@ -2657,7 +2659,7 @@ begin end; // done with field end; - pr.expectTT(pr.TTEnd); + pr.expectDelim('}'); end; @@ -2732,7 +2734,10 @@ var rt := findRecordByTypeId(fld.mEBSTypeName, fld.mRecRefId); if (rt = nil) then begin - e_LogWritefln('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mTypeName, rec.mId, fld.mEBSTypeName, fld.mRecRefId], MSG_WARNING); + if assigned(DynWarningCB) then + begin + DynWarningCB(formatstrf('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mTypeName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]), -1, -1); + end; //raise TDynRecException.CreateFmt('record of type ''%s'' with id ''%s'' links to inexistant record of type ''%s'' with id ''%s''', [rec.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId]); end; //writeln(' ', rec.mName, '.', rec.mId, ':', fld.mName, ' -> ', rt.mName, '.', rt.mId, ' (', fld.mEBSTypeName, '.', fld.mRecRefId, ')'); @@ -3066,14 +3071,19 @@ var procedure linkNames (rec: TDynRecord); var fld: TDynField; - rt: TDynRecord; + rt, rvc: TDynRecord; begin + if (rec = nil) then exit; //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')'); for fld in rec.mFields do begin + if (fld.mType = TDynField.TType.TList) then + begin + for rvc in fld.mRVal do linkNames(rvc); + end; if (fld.mType = TDynField.TType.TTrigData) then begin - if (fld.mRecRef <> nil) then linkNames(fld.mRecRef); + //if (fld.mRecRef <> nil) then linkNames(fld.mRecRef); continue; end; if (Length(fld.mRecRefId) = 0) then continue; @@ -3092,7 +3102,7 @@ var for fld in rec.mFields do begin //writeln(' ', fld.mName); - fld.fixDefaultValue(); // just in case + fld.fixDefaultValue(); end; end; @@ -3113,8 +3123,8 @@ begin end; //writeln('parsing record <', mName, '>'); - if not beginEaten then pr.expectTT(pr.TTBegin); - while (pr.tokType <> pr.TTEnd) do + if not beginEaten then pr.expectDelim('{'); + while (not pr.isDelim('}')) do begin if (pr.tokType <> pr.TTId) then raise TDynParseException.Create(pr, 'identifier expected'); //writeln('<', mName, '.', pr.tokStr, '>'); @@ -3164,22 +3174,14 @@ begin // something is wrong raise TDynParseException.CreateFmt(pr, 'unknown field ''%s'' in record ''%s''', [pr.tokStr, mTypeName]); end; - pr.expectTT(pr.TTEnd); + pr.expectDelim('}'); if mHeader then begin // link fields - for fld in mFields do - begin - if (fld.mType <> TDynField.TType.TList) then continue; - for rec in fld.mRVal do linkNames(rec); - end; + linkNames(self); + for rec in mRec2Free do if (rec <> nil) then linkNames(rec); end; - - // fix field defaults - {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := getTimeMicro();{$ENDIF} - for fld in mFields do fld.fixDefaultValue(); - {$IF DEFINED(D2D_DYNREC_PROFILER)}profFixDefaults := getTimeMicro()-stt;{$ENDIF} //writeln('done parsing record <', mName, '>'); //{$IF DEFINED(D2D_DYNREC_PROFILER)}writeln('stall: ', getTimeMicro()-stall);{$ENDIF} {$IF DEFINED(D2D_DYNREC_PROFILER)}profRecValParse := getTimeMicro()-stall;{$ENDIF} @@ -3311,7 +3313,7 @@ begin mTypeName := pr.expectId(); mMaxVal := Integer($80000000); if mIsEnum then cv := 0 else cv := 1; - while (pr.tokType <> pr.TTBegin) do + while (not pr.isDelim('{')) do begin if pr.eatId('tip') then begin @@ -3327,8 +3329,8 @@ begin end; break; end; - pr.expectTT(pr.TTBegin); - while (pr.tokType <> pr.TTEnd) do + pr.expectDelim('{'); + while (not pr.isDelim('}')) do begin idname := pr.expectId(); for f := 0 to High(mIds) do @@ -3373,11 +3375,11 @@ begin if mIsEnum then Inc(cv) else cv := cv shl 1; end; end; - if (pr.tokType = pr.TTEnd) then break; - pr.expectTT(pr.TTComma); - while pr.eatTT(pr.TTComma) do begin end; + if (pr.isDelim('}')) then break; + pr.expectDelim(','); + while (pr.eatDelim(',')) do begin end; end; - pr.expectTT(pr.TTEnd); + pr.expectDelim('}'); // add max field if (Length(mMaxName) > 0) then begin