unit uSyntax;

uses uGlobal;

type //note: subtract 10 from line number to get ORD()

nodeType=(ntNOP, //used for syntax tree manipulation

ntOperator,

ntExpression,

ntCommand, //-

ntCreateSchema,

ntAuthorization,

ntCreateTable,

ntCreateView,

ntCreateRoutine, //-

ntRoutine,

ntProcedure,

ntFunction,

ntProcedureOrFunction,

ntParameterDef,

ntVariableRef, //note: converted by evalConExpr.complete from ntColumnRef

ntIn,

ntOut,

ntInOut,

ntResult,

ntCallRoutine,

ntUserFunction,

ntDeclaration,

ntAssignment,

ntReturn,

ntCursorDeclaration,

ntSensitive,

ntInsensitive,

ntAsensitive,

ntScroll,

ntCursorHold,

ntCursorReturn,

ntForReadOnly,

ntForUpdate,

ntOpen,

ntClose,

ntFetch,

ntNext,

ntPrior,

ntFirst,

ntLast,

ntAbsolute,

ntRelative,

ntSQLState,

ntCreateDomain,

ntWithCheckOption,

ntCascaded,

ntLocal,

ntNumber,

ntString,

ntId,

ntLocalTemporary,

ntGlobalTemporary,

ntOnCommitDelete,

ntOnCommitPreserve,

ntColumnDef,

ntNull,

ntParam,

ntDefault,

ntNotNull,

ntPrimaryKey,

ntUnique, //note: used for 2 slightly different nodes (2nd one should really be ntUNIQUE)

ntReferences,

ntReferencesDef,

ntConstraintDef, //-

ntConstraint,

ntAlterTable,

ntAddColumn,

ntAlterColumn,

ntDropColumn,

ntAddConstraint,

ntDropConstraint,

ntDropUser, //-

ntDropSchema,

ntDropTable,

ntDropView,

ntDropRoutine,

ntDropDomain,

ntNumeric, //-

ntDecimal,

ntInteger,

ntSmallInt,

ntBigInt,

ntFloat,

ntCharacter,

ntVarChar,

ntBit,

ntVarBit,

ntDate,

ntTime,

ntTimestamp,

ntWithTimezone,

ntBlob,

ntClob,

ntCount, //-

ntAvg,

ntMax,

ntMin,

ntSum,

ntAggregate,

ntPlus,

ntMinus,

ntMultiply,

ntDivide,

ntPrimaryKeyDef,

ntUniqueDef,

ntForeignKeyDef,

ntMatchFull,

ntMatchPartial,

ntOnDelete,

ntOnUpdate,

ntNoAction,

ntCascade,

ntRestrict,

ntSetDefault,

ntSetNull,

ntCheckConstraint,

ntCondExpText, //todo never used: remove?

ntInitiallyDeferred,

ntInitiallyImmediate,

ntDeferrable,

ntNotDeferrable,

ntSetConstraints,

ntDeferred,

ntImmediate,

ntSchema,

ntCatalog,

ntDomain,

ntConcat, //-

ntSelect,

ntInto,

ntDistinct,

ntAll,

ntWhere,

ntSelectItem,

ntSelectAll,

ntColumnRef,

ntHaving,

ntGroupBy,

ntOrderBy,

ntOrderItem,

ntAsc,

ntDesc,

ntTableRef, //-

ntAND,

ntOR,

ntNOT,

ntIS,

ntTrue,

ntFalse,

ntUnknown,

ntISnull,

ntEqual,

ntEqualOrNull,

ntLT,

ntLTEQ,

ntGT,

ntGTEQ,

ntNotEqual,

ntLike,

ntAny,

ntInScalar,

ntExists,

ntIsUnique, //-

ntInsert,

ntInsertValues,

ntDefaultValues,

ntUpdate,

ntUpdateAssignment,

ntDelete,

ntTableConstructor, //-

ntTable,

ntRowConstructor,

ntCharacterExp, //todo remove?

ntBitExp, //todo remove?

ntNumericExp, //todo rename to genericExp

ntDatetimeExp, //todo remove?

ntTableExp, //-

ntJoin,

ntCrossJoin,

ntJoinOn,

ntJoinUsing,

ntJoinInner,

ntJoinLeft,

ntJoinRight,

ntJoinFull,

ntJoinUnion,

ntOuter,

ntNatural,

ntNonJoinTableExp,

ntCorrespondingBy,

ntCorresponding,

ntNonJoinTableTerm,

ntJoinTableExp,

ntUnionExcept,

ntUnion,

ntExcept,

ntIntersect,

ntTableTerm,

ntTablePrimary,

ntNonJoinTablePrimary, //-

ntCommit,

ntRollback,

ntSetTransaction,

ntOptionDiagnostic,

ntOptionReadOnly,

ntOptionReadWrite,

ntOptionIsolationReadUncommitted,

ntOptionIsolationReadCommitted,

ntOptionIsolationRepeatableRead,

ntOptionIsolationSerializable,

ntConnect,

ntAsConnection,

ntUser,

ntCurrentUser,

ntSessionUser,

ntSystemUser,

ntCurrentDate,

ntCurrentTime,

ntCurrentTimestamp,

ntDisconnect,

ntSetSchema,

ntGrant,

ntAllPrivileges,

ntPrivilegeSelect,

ntPrivilegeInsert,

ntPrivilegeUpdate,

ntPrivilegeDelete,

ntPrivilegeReferences,

ntPrivilegeUsage,

ntPrivilegeExecute,

ntCharacterSet,

ntCollation,

ntTranslation,

ntWithGrantOption,

ntRevoke,

ntCast,

ntCase,

ntCaseOf,

ntWhen,

ntWhenType2,

ntCoalesce,

ntNullIf, //-

ntMatch,

ntPARTIAL,

ntFULL, //-

ntEqualFilter, //internally generated node to allow separate chaining

ntTrim,

ntTrimWhat,

ntTrimLeading,

ntTrimTrailing,

ntTrimBoth,

ntCharLength,

ntOctetLength,

ntLower,

ntUpper,

ntPosition,

ntSubstring,

ntSubstringFrom,

ntCompoundBlock,

ntAtomic,

ntNotAtomic,

ntCompoundElement,

ntCompoundWhile,

ntCompoundIf,

ntCompoundCase,

ntIfThen,

ntCompoundLoop,

ntCompoundRepeat,

ntLeave,

ntIterate,

//Non-SQL/92 (implementation-defined) nodes: subtract 12

ntPassword,

ntCreateCatalog,

ntCreateUser,

ntAlterUser,

ntDEBUGTABLE, //DEBUG ONLY - REMOVE/HIDE!

ntDEBUGINDEX, //DEBUG ONLY - REMOVE/HIDE!

ntDEBUGCATALOG, //DEBUG ONLY - REMOVE/HIDE!

ntDEBUGSERVER, //DEBUG ONLY - REMOVE/HIDE!

ntDEBUGPAGE, //DEBUG ONLY - REMOVE/HIDE!

ntDEBUGPLAN, //DEBUG ONLY - REMOVE/HIDE!

ntDEBUGPRINT, //DEBUG ONLY - REMOVE/HIDE!

ntSUMMARY, //DEBUG ONLY - REMOVE/HIDE!

ntKILLTRAN,

ntCANCELTRAN,

ntREBUILDINDEX, //DEBUG ONLY - REMOVE/HIDE!

ntSHOWTRANS, //DEBUG ONLY - REMOVE!

ntCurrentAuthID,

ntCurrentCatalog,

ntCurrentSchema,

ntIndex,

ntCreateIndex,

ntDropIndex,

ntSequence,

ntCreateSequence,

ntDropSequence,

ntStartingAt,

ntNextSequence,

ntLatestSequence,

ntBackupCatalog,

ntOpenCatalog,

ntCloseCatalog,

ntGarbageCollectCatalog,

ntSHUTDOWN //SYSTEM DEBUG - REMOVE!?

); //todo etc?

{Used during optimisation SARG passing}

pushedType=(ptAvailable, //available for a child to pull

ptPulled, //marked as pulled by a child

ptMustPull //force pull to child, e.g. to override local rules for equi-join inner-filter

);

TSyntaxNodePtr=^TSyntaxNode;

{Note: use the functions below to create and link!}

TSyntaxNode=record

{Node type}

nType:nodeType;

systemNode:boolean; //(initially) used for ntColumnRef/Id for optimiser to FindCol natural join columns

//also used to flag optimiser-handled joins (i.e. common columns set by optimiser from implicit join)

{Reference count}

refCount:shortint; //reference count to allow a sub-tree to be referenced more than once (save space & time)

//Note: this is also inc/dec'ed in the CondToCNF routine(s) & processor routine for cursor declarations

//Note: if/when these syntax trees can be shared among threads we must make

// sure that the inc/dec refCount is made thread-safe! todo

{Link to iterator root}

ptree:TObject; {=TIterator;} //plan root - needed for main & sub-plans

//since we now build (& destroy) the sub-plans once, eval needs links

{Link to algebra root}

atree:pointer; {=TAlgebraNodePtr;} //algebra root - only needed so we can delete the algebra tree/sub-tree(s) once

//we're done with the plans.

//probably better to use ptree.anodeRef once we're sure that

//it is always set properly - then we can get rid of this link space!

{Link to tuple column}

cTuple:TObject; {=TTuple} //used for fast evaluation once FindCol has found the source

cRef:colRef; // "

{Link to variable def}

vVariableSet:TObject; {=TVariableSet} //used for fast evaluation once FindVar has found the source

vRef:varRef; // "

{Definition (based on tuple column or variable def & passed up tree)}

//todo: are these always associated with some iTuple.colDef? if so can't we use that to store this data?

dType:TDataType; //datatype, passed up through tree

dwidth:integer; //storage size (0=variable)

dscale:smallint; //precision

aggregate:boolean; //flag to indicate aggregation within IterGroup group-by loops

{Mutually exclusive values}

nullVal:boolean; //null (introduced for aggregate counting + used for null literal)

idVal:string; //id (also used to store param number (will be name in future))

numVal:double; //number (also used to store param length if param string contains #0s, i.e. blob length)

strVal:string; //string (also used to store param value - initially ?=value not set)

(*todo ?

pushed:pushedType; //pushed flag - set during optimisation to denote moving of a SARG (actually is 'pulled'?)

optimised:pushedType; //pushed flag - set during (trial) algebra optimisation to denote moving of a SARG (actually is 'pulled'?)

//in development: note: will replace pushed

{Child nodes}

leftChild:TSyntaxNodePtr;

rightChild:TSyntaxNodePtr;

{Peer nodes}

nextNode:TSyntaxNodePtr;

prevNode:TSyntaxNodePtr; //Note: used for hiding dynamically created syntax nodes at the root level to allow full cleanup //todo use another hook for this...

{Lexical references}

line,col:word; //pointer back to source SQL

//Note this will break if column gets too big, e.g. create schema on one line

// - make an integer & have lexlib.inc(colNo) wrap around to 0 instead, i.e. make IT a word as well!

allocNext:TSyntaxNodePtr; //allocation chain pointer (to guarantee full clean up after syntax error etc.)

//old deleteSyntaxTree tried used recursive traversal & refCount but

//would miss some nodes (& so sub-trees) (maybe after other routines had fiddled with the tree)

//and yacc wouldn't return partial trees after syntax error

// - seemed quicker to chain all allocations to a stmt root node

// and the deleteSyntaxTree is quick and simple & should never lose any nodes

//May make pre-allocation/pooling of nodes easier in future?

end; {TSyntaxNode} //approx size=1+2+4+4+4+2+1+2+2+1+1+1+4+4+4+1+4+4+4+4+2+2 +idVal+strVal = 58+ ~10 = ~68 bytes (so <16 per K)

// how much of this is unecessary overhead?:

// is prevNode ever used?

// combine idVal & strVal - too confusing!

// line, col any use here?

// ptree/atree rarely used - maybe use for other things (but be careful, e.g. when deleting trees!)

// cTuple/cRef rarely used - maybe use for other things (no! as TTuple often used to test)

//(but remember, record is not packed, so saving <4 bytes may not reduce the size)

//todo: maybe a better solution would be to have a basic syntaxNode class

// and inherited classes could add their own data

// - more elegant (safer), but what's the speed/memory overhead?

// - also, would be much harder to use our own memory allocation

// because the sizes would be different & less control (whereas a record can be plonked anywhere)

//So maybe use a variant record instead? with nType as the flag/switch...

function mkNode(allocRoot:TSyntaxNodePtr;ntype:nodeType;dtype:TdataType;lp,rp:TSyntaxNodePtr):TSyntaxNodePtr;

function cloneNode(allocRoot:TSyntaxNodePtr;np:TSyntaxNodePtr;cloneSiblingLinks,cloneChildLinks:boolean):TSyntaxNodePtr;

procedure chainNext(var tp:TSyntaxNodePtr;np:TSyntaxNodePtr);

procedure chainAppendNext(tp,np:TSyntaxNodePtr);

procedure chainTempLink(var tp:TSyntaxNodePtr;np:TSyntaxNodePtr);

procedure chainAppendTempLink(var tp:TSyntaxNodePtr;np:TSyntaxNodePtr);

procedure chainPrev(var tp:TSyntaxNodePtr;np:TSyntaxNodePtr);

procedure linkLeftChild(tp,cp:TSyntaxNodePtr);

procedure linkRightChild(tp,cp:TSyntaxNodePtr);

procedure unlinkRightChild(tp:TSyntaxNodePtr);

procedure unlinkLeftChild(tp:TSyntaxNodePtr);

function mkLeaf(allocRoot:TSyntaxNodePtr;ntype:nodeType;dtype:Tdatatype;dwidth:integer;dscale:smallint):TSyntaxNodePtr;

function infixSyntax(node:TSyntaxNodePtr):string;

function DisplaySyntaxTree(stree:TSyntaxNodePtr):integer;

function DeleteSyntaxTree(stree:TSyntaxNodePtr):integer;

function hasAggregate(stree:TSyntaxNodePtr):boolean;

debugSyntaxCreate:integer=0; //todo remove -or at least make thread-safe & private

debugSyntaxDestroy:integer=0; //"

uLog,

{$ENDIF}

sysUtils, uAlgebra, uIterator {for deleting trees}, uIterMaterialise;

where='uSyntax';

who='';

function mkNode(allocRoot:TSyntaxNodePtr;ntype:nodeType;dtype:Tdatatype;lp,rp:TSyntaxNodePtr):TSyntaxNodePtr;

const routine=':mkNode';

n:TSyntaxNodePtr;

combinedDtype:TDatatype;

lDWidth,rDWidth:integer;

lDScale,rDScale:smallint;

//todo replace new() with a node handler

new(n);

inc(debugSyntaxCreate); //todo remove

{$IFDEF DEBUG_LOG}

if debugSyntaxCreate=1 then

log.add(who,where,format(' Syntax node memory size=%d',[sizeof(TSyntaxNode)]),vDebugLow);

{$ENDIF}

n.allocNext:=allocRoot.allocNext;

allocRoot.allocNext:=n;

{$IFDEF DEBUGDETAIL2}

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format(' chaining syntax node %p to %p',[n,allocRoot]),vdebugLow);

{$ENDIF}

{$ENDIF}

n.ntype:=ntype;

n.systemNode:=False;

n.refCount:=0; //we increment via link/chain..Child() and decrement during DeleteSyntaxTree

n.ptree:=nil;

n.atree:=nil;

n.cTuple:=nil;

n.cRef:=0; //todo better make maxint? because 0 is actually valid!

n.vVariableSet:=nil;

n.vRef:=0; //todo better make maxint? because 0 is actually valid!

n.dwidth:=0; //default //remove=speed

n.dscale:=0; //default //remove=speed

n.aggregate:=false;

n.nullVal:=true;

n.idVal:='';

n.numVal:=0;

n.strVal:='';

n.pushed:=ptAvailable;

n.optimised:=ptAvailable;

n.nextNode:=nil; n.prevNode:=nil;

//todo use link routines...!

n.leftChild:=lp; if lp<>nil then inc(lp.refCount);

n.rightChild:=rp; if rp<>nil then inc(rp.refCount);

{Pass up the datatype etc. from the children}

//speed- could directly change n values...

combinedDtype:=dtype; //default/override

if combinedDtype=ctUnknown then

begin

if n.rightChild<>nil then

combinedDtype:=n.rightChild.dtype

else

if n.leftChild<>nil then //note: new addition to handle ntunknown with typed left-child

combinedDtype:=n.leftChild.dtype;

if n.leftChild<>nil then

begin

if (n.leftChild.dType=combinedDtype) or (n.leftChild.dType=ctUnknown) then

//ok, all children are same - use this dtype

else

if combinedDtype<>ctUnknown then

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('Invalid types: node default [%d], left [%d]',[ord(dtype),ord(n.leftChild.dtype)]),vDebugError);

{$ELSE}

;

{$ENDIF}

end;

end;

n.dtype:=combinedDtype;

{etc}

lDWidth:=0; rDWidth:=0;

lDScale:=0; rDScale:=0;

if n.leftChild<>nil then

begin

lDWidth:=n.leftChild.dWidth;

lDScale:=n.leftChild.dScale;

end;

if n.rightChild<>nil then

begin

rDWidth:=n.rightChild.dWidth;

rDScale:=n.rightChild.dScale;

end;

{Note the following rules are not always correct (80/20?)

n.dWidth:=maxINTEGER(lDWidth,rDWidth);

n.dScale:=maxSMALLINT(lDScale,rDScale);

n.line:=0;

n.col:=0;

{$IFDEF DEBUGDETAIL}

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('(%p)%d [%d %d %d] %p %p',[n,ord(n.ntype),ord(n.dtype),n.dwidth,n.dscale,n.leftChild,n.rightChild]),vDebug);

{$ENDIF}

{$ENDIF}

result:=n;

end; {mkNode}

function cloneNode(allocRoot:TSyntaxNodePtr;np:TSyntaxNodePtr;cloneSiblingLinks,cloneChildLinks:boolean):TSyntaxNodePtr;

const routine=':cloneNode';

n:TSyntaxNodePtr;

//todo replace new() with a node handler

new(n);

inc(debugSyntaxCreate); //todo remove

n.allocNext:=allocRoot.allocNext;

allocRoot.allocNext:=n;

{$IFDEF DEBUGDETAIL2}

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format(' chaining syntax node %p to %p',[n,allocRoot]),vdebugLow);

{$ENDIF}

{$ENDIF}

n.ntype:=np.ntype;

n.systemNode:=False;

n.refCount:=0; //we increment via link/chain..Child() and decrement during DeleteSyntaxTree

n.ptree:=np.ptree;

n.atree:=np.atree;

n.cTuple:=np.cTuple;

n.cRef:=np.cRef;

n.vVariableSet:=np.vVariableSet;

n.vRef:=np.vRef;

n.dwidth:=np.dwidth;

n.dscale:=np.dscale;

n.aggregate:=np.aggregate;

n.nullVal:=np.nullVal;

n.idVal:=np.idVal;

n.numVal:=np.numVal;

n.strVal:=np.strVal;

n.pushed:=np.pushed;

n.optimised:=np.optimised;

n.nextNode:=np.nextNode;

n.prevNode:=np.prevNode;

//todo use link routines...!

if cloneSiblingLinks then

begin

if n.nextNode<>nil then inc(n.nextNode.refCount);

if n.prevNode<>nil then inc(n.prevNode.refCount);

end;

n.leftChild:=np.leftChild;

n.rightChild:=np.rightChild;

//todo use link routines...!

if cloneChildLinks then

begin

if n.leftChild<>nil then inc(n.leftChild.refCount);

if n.rightChild<>nil then inc(n.rightChild.refCount);

end;

n.dtype:=np.dtype;

{etc}

n.dWidth:=np.dWidth;

n.dScale:=np.dScale;

n.line:=np.line;

n.col:=np.col;

{$IFDEF DEBUGDETAIL}

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('(%p <- %p)%d [%d %d %d] %p %p',[n,np,ord(n.ntype),ord(n.dtype),n.dwidth,n.dscale,n.leftChild,n.rightChild]),vDebug);

{$ENDIF}

{$ENDIF}

result:=n;

end; {cloneNode}

procedure chainNext(var tp:TSyntaxNodePtr;np:TSyntaxNodePtr);

const routine=':chainNext';

tempn, lastInInsertedChain:TSyntaxNodePtr;

looping:integer; //todo remove loop detector in final code!

if tp<>np then

begin

if tp<>nil then

begin

if np<>nil then

begin

tempn:=tp.nextNode;

tp.nextNode:=np; //insert in chain

inc(np.refCount);

//todo link np.prevNode?

lastInInsertedChain:=np; //find end of this sub-chain being inserted

looping:=0; //todo remove loop detector ****or at least increase in case we have many items!!!

while (lastInInsertedChain.nextNode<>nil) and (looping<200) do

begin

lastInInsertedChain:=lastInInsertedChain.nextNode;

inc(looping);

end;

if looping=200 then

begin

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('%p %p: Chain probably has a loop! It will be corrupt now...',[tp,np]),vDebugError);

{$ELSE}

;

{$ENDIF}

end;

lastInInsertedChain.NextNode:=tempn; //re-link end to rest of existing chain

//todo link tempn.prevNode?

{$IFDEF DEBUGDETAIL}

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('%p %p',[tp,np]),vDebug);

{$ENDIF}

{$ENDIF}

end

else

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,'np=nil',vDebug);

{$ELSE}

;

{$ENDIF}

end

else

begin //tp=nil -> new list

if np<>nil then

begin

tp:=np;

//todo remove! inc(np.refCount);

// we assume that if we're starting a list this way that

// the np node will become the tp node & so is not actually being referenced

// from another node (but is pointing tp to itself, so caller must ignore np = fine if temp/loop)

{$IFDEF DEBUGDETAIL}

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('%s %p',['nil',np]),vDebug);

{$ENDIF}

{$ENDIF}

end

else

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,'np=nil (and tp=nil!)',vDebug);

{$ELSE}

;

{$ENDIF}

end;

end

else

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,'tp=np',vAssertion);

{$ELSE}

;

{$ENDIF}

end; {chainNext}

procedure chainAppendNext(tp,np:TSyntaxNodePtr);

const routine=':chainAppendNext';

lastInChain:TSyntaxNodePtr;

looping:integer; //todo remove loop detector in final code!

if tp<>np then

begin

if tp<>nil then

begin

if np<>nil then

begin

lastInChain:=tp; //find end of the current chain //todo speed up repeated calls - maybe tp.prevNode should point to its end=loop?

looping:=0; //todo remove loop detector ****or at least increase in case we have many items!!!

while (lastInChain.nextNode<>nil) and (looping<200) do

begin

lastInChain:=lastInChain.nextNode;

inc(looping);

end;

if looping=200 then

begin

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('%p %p: Chain probably has a loop! It will be corrupt now...',[tp,np]),vDebugError);

{$ENDIF}

end;

lastInChain.NextNode:=np; //link end to new node/chain

inc(np.refCount);

//todo link np.prevNode?

{$IFDEF DEBUGDETAIL}

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('%p %p',[tp,np]),vDebug);

{$ELSE}

;

{$ENDIF}

{$ENDIF}

end

else

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,'np=nil',vDebug);

{$ELSE}

;

{$ENDIF}

end

else

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,'tp=nil',vDebug);

{$ELSE}

;

{$ENDIF}

end

else

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,'tp=np',vAssertion);

{$ELSE}

;

{$ENDIF}

end; {chainAppendNext}

procedure chainTempLink(var tp:TSyntaxNodePtr;np:TSyntaxNodePtr);

const routine=':chainTempLink';

tempn, lastInInsertedChain:TSyntaxNodePtr;

looping:integer; //todo remove loop detector in final code!

if tp=nil then

begin

tp:=np;

end

else

begin

if tp<>np then

begin

if np<>nil then

begin

tempn:=tp.nextNode;

tp.nextNode:=np; //insert in chain

//todo link np.prevNode?

lastInInsertedChain:=np; //find end of this sub-chain being inserted

looping:=0; //todo remove loop detector ****or at least increase in case we have many items!!!

while (lastInInsertedChain.nextNode<>nil) and (looping<2000) do

begin

lastInInsertedChain:=lastInInsertedChain.nextNode;

inc(looping);

end;

if looping=2000 then

begin

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('%p %p: Chain probably has a loop! It will be corrupt now...',[tp,np]),vDebugError);

{$ELSE}

;

{$ENDIF}

end;

lastInInsertedChain.NextNode:=tempn; //re-link end to rest of existing chain

//todo link tempn.prevNode?

{$IFDEF DEBUGDETAIL}

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('%p %p',[tp,np]),vDebug);

{$ENDIF}

{$ENDIF}

end;

//else np=nil - ok, nothing to chain

end

else

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,'tp=np',vAssertion);

{$ELSE}

;

{$ENDIF}

end;

end; {chainTempLink}

procedure chainAppendTempLink(var tp:TSyntaxNodePtr;np:TSyntaxNodePtr);

const routine=':chainAppendTempLink';

lastInChain:TSyntaxNodePtr;

looping:integer; //todo remove loop detector in final code!

if tp=nil then

begin

tp:=np;

end

else

begin

if tp<>np then

begin

if np<>nil then

begin

lastInChain:=tp; //find end of the current chain //todo speed up repeated calls - maybe tp.prevNode should point to its end=loop?

looping:=0; //todo remove loop detector ****or at least increase in case we have many items!!!

while (lastInChain.nextNode<>nil) and (looping<2000) do

begin

lastInChain:=lastInChain.nextNode;

inc(looping);

end;

if looping=2000 then

begin

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('%p %p: Chain probably has a loop! It will be corrupt now...',[tp,np]),vDebugError);

{$ENDIF}

end;

lastInChain.NextNode:=np; //link end to new node/chain

//todo link prevNode?

{$IFDEF DEBUGDETAIL}

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('%p %p',[tp,np]),vDebug);

{$ENDIF}

{$ENDIF}

end;

//else np=nil - ok, nothing to chain

end

else

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,'tp=np',vAssertion);

{$ELSE}

;

{$ENDIF}

end;

end; {chainAppendTempLink}

procedure chainPrev(var tp:TSyntaxNodePtr;np:TSyntaxNodePtr);

const routine=':chainPrev';

tempn, lastInInsertedChain:TSyntaxNodePtr;

looping:integer; //todo remove loop detector in final code!

if tp<>np then

begin

if tp<>nil then

begin

if np<>nil then

begin

tempn:=tp.prevNode;

tp.prevNode:=np; //insert in chain

inc(np.refCount);

//todo link np.nextNode?!

lastInInsertedChain:=np; //find end of this sub-chain being inserted

looping:=0; //todo remove loop detector ****or at least increase in case we have many items!!!

while (lastInInsertedChain.prevNode<>nil) and (looping<200) do

begin

lastInInsertedChain:=lastInInsertedChain.prevNode;

inc(looping);

end;

if looping=200 then

begin

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('%p %p: Chain probably has a loop! It will be corrupt now...',[tp,np]),vDebugError);

{$ENDIF}

end;

lastInInsertedChain.prevNode:=tempn; //re-link end to rest of existing chain

//todo link tempn.prevNode?

{$IFDEF DEBUGDETAIL}

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('%p %p',[tp,np]),vDebug);

{$ENDIF}

{$ENDIF}

end

else

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,'np=nil',vDebug);

{$ELSE}

;

{$ENDIF}

end

else

begin //tp=nil -> new list

if np<>nil then

begin

tp:=np;

//todo remove! inc(np.refCount);

// we assume that if we're starting a list this way that

// the np node will become the tp node & so is not actually being referenced

// from another node (but is pointing tp to itself, so caller must ignore np = fine if temp/loop)

{$IFDEF DEBUGDETAIL}

{$IFDEF DEBUG_LOG}

log.add(who,where+routine,format('%s %p',['nil',np]),vDebug);

{$ENDIF}