X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fshared%2Fxdynrec.pas;h=fe9c5616f346c30fe79c9ba24b19193763a9e9c2;hb=4915b85cae0bdda83e7ae7ee0b049a07e550395f;hp=c71250ce9ee8bc4697133ee8960465739b57f537;hpb=a0b4df67e96c6b5e55e95269a87975df67692e6b;p=d2df-sdl.git diff --git a/src/shared/xdynrec.pas b/src/shared/xdynrec.pas index c71250c..fe9c561 100644 --- a/src/shared/xdynrec.pas +++ b/src/shared/xdynrec.pas @@ -123,7 +123,7 @@ type function definition (): AnsiString; function pasdef (): AnsiString; - function clone (newOwner: TDynRecord=nil): TDynField; + function clone (newOwner: TDynRecord=nil; registerIn: TDynRecord=nil): TDynField; procedure parseValue (pr: TTextParser); procedure parseBinValue (st: TStream); @@ -191,6 +191,8 @@ type mTagInt: Integer; mTagPtr: Pointer; + mRec2Free: TDynRecList; + private procedure parseDef (pr: TTextParser); // parse definition @@ -206,6 +208,8 @@ type function getForTrigCount (): Integer; inline; function getForTrigAt (idx: Integer): AnsiString; inline; + procedure regrec (rec: TDynRecord); + protected function findRecordByTypeId (const atypename, aid: AnsiString): TDynRecord; function findRecordNumByType (const atypename: AnsiString; rc: TDynRecord): Integer; @@ -222,7 +226,7 @@ type function definition (): AnsiString; function pasdef (): AnsiString; - function clone (): TDynRecord; + function clone (registerIn: TDynRecord): TDynRecord; function isSimpleEqu (rec: TDynRecord): Boolean; @@ -501,7 +505,7 @@ begin end; -function TDynField.clone (newOwner: TDynRecord=nil): TDynField; +function TDynField.clone (newOwner: TDynRecord=nil; registerIn: TDynRecord=nil): TDynField; var rec: TDynRecord; begin @@ -518,7 +522,7 @@ begin begin if (result.mRVal = nil) then result.mRVal := TDynRecList.Create(mRVal.count); if (result.mRHash = nil) then result.mRHash := hashNewStrInt(); - for rec in mRVal do result.addListItem(rec.clone()); + for rec in mRVal do result.addListItem(rec.clone(registerIn)); end; result.mRecRef := mRecRef; result.mMaxDim := mMaxDim; @@ -1414,15 +1418,11 @@ begin if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without TriggerType field', [mName, rec.mName])); rc := mOwner.mOwner.findTrigFor(tfld.mSVal); // find in mapdef if (rc = nil) then raise Exception.Create(Format('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal])); - rc := rc.clone(); + rc := rc.clone(mOwner.mHeaderRec); rc.mHeaderRec := mOwner.mHeaderRec; - try - rc.parseBinValue(st, true); - mRecRef := rc; - rc := nil; - finally - rc.Free(); - end; + // on error, it will be freed be memowner + rc.parseBinValue(st, true); + mRecRef := rc; mDefined := true; exit; end @@ -1593,6 +1593,8 @@ var tk: AnsiString; edim: AnsiChar; begin + if (pr.tokType = pr.TTEOF) then raise Exception.Create('field value expected'); + if (pr.tokType = pr.TTSemi) then raise Exception.Create('extra semicolon'); // if this field should contain struct, convert type and parse struct case mEBS of TEBS.TNone: begin end; @@ -1616,16 +1618,12 @@ begin if (tfld = nil) then raise Exception.Create(Format('triggerdata value for field ''%s'' in record ''%s'' without ''type'' field', [mName, rec.mName])); rc := mOwner.mOwner.findTrigFor(tfld.mSVal); // find in mapdef if (rc = nil) then raise Exception.Create(Format('triggerdata definition for field ''%s'' in record ''%s'' with type ''%s'' not found', [mName, rec.mName, tfld.mSVal])); - rc := rc.clone(); + rc := rc.clone(mOwner.mHeaderRec); rc.mHeaderRec := mOwner.mHeaderRec; //writeln(rc.definition); - try - rc.parseValue(pr, true); - mRecRef := rc; - rc := nil; - finally - rc.Free(); - end; + // on error, it will be freed be memowner + rc.parseValue(pr, true); + mRecRef := rc; end; mDefined := true; pr.eatTT(pr.TTSemi); // hack: allow (but don't require) semicolon after inline records @@ -1641,9 +1639,17 @@ begin else begin rec := mOwner.findRecordByTypeId(mEBSTypeName, pr.tokStr); - if (rec = nil) then raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSTypeName, mName])); + if (rec = nil) then + begin + //raise Exception.Create(Format('record ''%s'' (%s) value for field ''%s'' not found', [pr.tokStr, mEBSTypeName, mName])); + mRecRefId := pr.tokStr; + end + else + begin + mRecRef := rec; + mRecRefId := ''; + end; pr.expectId(); - mRecRef := rec; end; mDefined := true; pr.expectTT(pr.TTSemi); @@ -1655,7 +1661,7 @@ begin rec := nil; if (mEBSType <> nil) and (mEBSType is TDynRecord) then rec := (mEBSType as TDynRecord); if (rec = nil) then raise Exception.Create(Format('record type ''%s'' for field ''%s'' not found', [mEBSTypeName, mName])); - rc := rec.clone(); + rc := rec.clone(mOwner.mHeaderRec); rc.mHeaderRec := mOwner.mHeaderRec; rc.parseValue(pr); mRecRef := rc; @@ -1852,12 +1858,30 @@ begin mHeaderRec := nil; mTagInt := 0; mTagPtr := nil; + mRec2Free := nil; end; destructor TDynRecord.Destroy (); +var + fld: TDynField; + rec: TDynRecord; begin + if (mRec2Free <> nil) then + begin + for rec in mRec2Free do + begin + if (rec <> self) then + begin + //writeln(formatstrf('freeing: 0x%08x; name=%s; id=%s', [Pointer(rec), rec.mName, rec.mId])); + rec.Free(); + end; + end; + mRec2Free.Free(); + mRec2Free := nil; + end; mName := ''; + for fld in mFields do fld.Free(); mFields.Free(); mFields := nil; {$IF DEFINED(XDYNREC_USE_FIELDHASH)} @@ -1872,6 +1896,16 @@ begin end; +procedure TDynRecord.regrec (rec: TDynRecord); +begin + if (rec <> nil) and (rec <> self) then + begin + if (mRec2Free = nil) then mRec2Free := TDynRecList.Create(); + mRec2Free.append(rec); + end; +end; + + procedure TDynRecord.addField (fld: TDynField); inline; begin if (fld = nil) then raise Exception.Create('cannot append nil field to record'); @@ -1967,7 +2001,7 @@ begin end; -function TDynRecord.clone (): TDynRecord; +function TDynRecord.clone (registerIn: TDynRecord): TDynRecord; var fld: TDynField; f: Integer; @@ -1978,18 +2012,19 @@ begin result.mPasName := mPasName; result.mName := mName; result.mSize := mSize; + result.mHeader := mHeader; + result.mBinBlock := mBinBlock; + result.mHeaderRec := mHeaderRec; + result.mTagInt := mTagInt; + result.mTagPtr := mTagPtr; if (mFields.count > 0) then begin result.mFields.capacity := mFields.count; - for fld in mFields do result.addField(fld.clone(result)); + for fld in mFields do result.addField(fld.clone(result, registerIn)); end; SetLength(result.mTrigTypes, Length(mTrigTypes)); for f := 0 to High(mTrigTypes) do result.mTrigTypes[f] := mTrigTypes[f]; - result.mHeader := mHeader; - result.mBinBlock := mBinBlock; - result.mHeaderRec := mHeaderRec; - result.mTagInt := mTagInt; - result.mTagPtr := mTagPtr; + if (registerIn <> nil) then registerIn.regrec(result); end; @@ -2132,83 +2167,6 @@ begin end; -{ -procedure TDynRecord.setUserField (const fldname: AnsiString; v: LongInt); -var - fld: TDynField; -begin - if (Length(fldname) = 0) then exit; - fld := field[fldname]; - if (fld <> nil) then - begin - if (fld.mType <> fld.TType.TInt) or (fld.mEBS <> fld.TEBS.TNone) then - begin - raise Exception.Create(Format('invalid user field ''%s'' type', [fld.name])); - end; - end - else - begin - fld := TDynField.Create(fldname, fld.TType.TInt); - fld.mOwner := self; - fld.mIVal := v; - fld.mInternal := true; - fld.mDefined := true; - addField(fld); - end; -end; - - -procedure TDynRecord.setUserField (const fldname: AnsiString; v: AnsiString); -var - fld: TDynField; -begin - if (Length(fldname) = 0) then exit; - fld := field[fldname]; - if (fld <> nil) then - begin - if (fld.mType <> fld.TType.TString) or (fld.mEBS <> fld.TEBS.TNone) then - begin - raise Exception.Create(Format('invalid user field ''%s'' type', [fld.name])); - end; - end - else - begin - fld := TDynField.Create(fldname, fld.TType.TString); - fld.mOwner := self; - fld.mSVal := v; - fld.mInternal := true; - fld.mDefined := true; - addField(fld); - end; -end; - - -procedure TDynRecord.setUserField (const fldname: AnsiString; v: Boolean); -var - fld: TDynField; -begin - if (Length(fldname) = 0) then exit; - fld := field[fldname]; - if (fld <> nil) then - begin - if (fld.mType <> fld.TType.TBool) or (fld.mEBS <> fld.TEBS.TNone) then - begin - raise Exception.Create(Format('invalid user field ''%s'' type', [fld.name])); - end; - end - else - begin - fld := TDynField.Create(fldname, fld.TType.TBool); - fld.mOwner := self; - fld.mIVal := Integer(v); - fld.mInternal := true; - fld.mDefined := true; - addField(fld); - end; -end; -} - - procedure TDynRecord.parseDef (pr: TTextParser); var fld: TDynField; @@ -2441,7 +2399,7 @@ begin for f := 0 to (bsize div rec.mSize)-1 do begin mst.setup(buf+f*rec.mSize, rec.mSize); - rec := rect.clone(); + rec := rect.clone(self); rec.mHeaderRec := self; rec.parseBinValue(mst); rec.mId := Format('%s%d', [rec.mName, f]); @@ -2676,6 +2634,40 @@ var {$IF DEFINED(D2D_DYNREC_PROFILER)} stt, stall: UInt64; {$ENDIF} + + procedure linkNames (rec: TDynRecord); + var + fld: TDynField; + rt: TDynRecord; + begin + //writeln('*** rec: ', rec.mName, '.', rec.mId, ' (', rec.mFields.count, ')'); + for fld in rec.mFields do + begin + if (fld.mType = TDynField.TType.TTrigData) then + begin + if (fld.mRecRef <> nil) then linkNames(fld.mRecRef); + continue; + end; + if (Length(fld.mRecRefId) = 0) then continue; + assert(fld.mEBSType <> nil); + 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.mName, rec.mId, fld.mEBSTypeName, fld.mRecRefId], MSG_WARNING); + //raise Exception.Create(Format('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, ')'); + fld.mRecRefId := ''; + fld.mRecRef := rt; + fld.mDefined := true; + end; + for fld in rec.mFields do + begin + //writeln(' ', fld.mName); + fld.fixDefaultValue(); // just in case + end; + end; + begin if (mOwner = nil) then raise Exception.Create(Format('can''t parse record ''%s'' value without owner', [mName])); @@ -2709,49 +2701,49 @@ begin if (trc <> nil) then begin {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} - rec := trc.clone(); + rec := trc.clone(mHeaderRec); {$IF DEFINED(D2D_DYNREC_PROFILER)}profCloneRec := curTimeMicro()-stt;{$ENDIF} rec.mHeaderRec := mHeaderRec; - try - pr.skipToken(); - rec.parseValue(pr); + // on error, it will be freed be memowner + pr.skipToken(); + rec.parseValue(pr); + (* + if (Length(rec.mId) > 0) then + begin + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + fld := field[pr.tokStr]; + {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF} (* - if (Length(rec.mId) > 0) then + if (fld <> nil) and (fld.mRVal <> nil) then begin {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} - fld := field[pr.tokStr]; - {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF} - (* - if (fld <> nil) and (fld.mRVal <> nil) then - begin - {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} - //idtmp := trc.mName+':'+rec.mId; - //if ids.put(idtmp, 1) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName])); - if fld.mRHash.has(rec.mId) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName])); - {$IF DEFINED(D2D_DYNREC_PROFILER)}profListDupChecking := curTimeMicro()-stt;{$ENDIF} - end; + //idtmp := trc.mName+':'+rec.mId; + //if ids.put(idtmp, 1) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName])); + if fld.mRHash.has(rec.mId) then raise Exception.Create(Format('duplicate thing ''%s'' in record ''%s''', [fld.mName, mName])); + {$IF DEFINED(D2D_DYNREC_PROFILER)}profListDupChecking := curTimeMicro()-stt;{$ENDIF} end; - *) - {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} - addRecordByType(rec.mName, rec); - {$IF DEFINED(D2D_DYNREC_PROFILER)}profAddRecByType := curTimeMicro()-stt;{$ENDIF} - rec := nil; - finally - rec.Free(); end; + *) + {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + addRecordByType(rec.mName, rec); + {$IF DEFINED(D2D_DYNREC_PROFILER)}profAddRecByType := curTimeMicro()-stt;{$ENDIF} continue; end; end; // fields {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} + //writeln('0: <', mName, '.', pr.tokStr, '>'); fld := field[pr.tokStr]; + //writeln('1: <', mName, '.', pr.tokStr, '>'); {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldSearching := curTimeMicro()-stt;{$ENDIF} if (fld <> nil) then begin + //writeln('2: <', mName, '.', pr.tokStr, '>'); if fld.defined then raise Exception.Create(Format('duplicate field ''%s'' in record ''%s''', [fld.mName, mName])); if fld.internal then raise Exception.Create(Format('internal field ''%s'' in record ''%s''', [fld.mName, mName])); - pr.skipToken(); + pr.skipToken(); // skip field name + //writeln('3: <', mName, '.', pr.tokStr, '>:', pr.tokType); {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} fld.parseValue(pr); {$IF DEFINED(D2D_DYNREC_PROFILER)}profFieldValParsing := curTimeMicro()-stt;{$ENDIF} @@ -2762,6 +2754,17 @@ begin raise Exception.Create(Format('unknown field ''%s'' in record ''%s''', [pr.tokStr, mName])); end; pr.expectTT(pr.TTEnd); + + 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; + end; + // fix field defaults {$IF DEFINED(D2D_DYNREC_PROFILER)}stt := curTimeMicro();{$ENDIF} for fld in mFields do fld.fixDefaultValue(); @@ -2972,6 +2975,7 @@ var rec: TDynRecord; ebs: TDynEBS; begin + //!!!FIXME!!! check who owns trigs and recs! for rec in recTypes do rec.Free(); for rec in trigTypes do rec.Free(); for ebs in ebsTypes do ebs.Free(); @@ -3143,17 +3147,29 @@ end; function TDynMapDef.parseMap (pr: TTextParser): TDynRecord; var res: TDynRecord = nil; + //fo: TextFile; begin result := nil; try pr.expectId(headerType.name); - res := headerType.clone(); + res := headerType.clone(nil); res.mHeaderRec := res; res.parseValue(pr); result := res; res := nil; finally res.Free(); + { + except on e: Exception do + begin + //TMP:segfaults! + AssignFile(fo, 'z.log'); + Rewrite(fo); + DumpExceptionBackTrace(fo); + CloseFile(fo); + res.Free(); + end; + } end; end; @@ -3164,7 +3180,7 @@ var begin result := nil; try - res := headerType.clone(); + res := headerType.clone(nil); res.mHeaderRec := res; res.parseBinValue(st); result := res;