unit srFlow;

{$mode objfpc}{$H+}

interface

uses
 sysutils,
 ps4_pssl,
 spirv,
 srNode,
 srCFGParser,
 srCFGCursor,
 srPrivate,
 srType,
 srConst,
 srReg,
 srOp,
 srOpUtils,
 srConfig,
 emit_op;

type
 TConvertResult=record
  pNode:TsrNode;
  pLine:TspirvOp;
 end;

 TEmitFlow=class(TEmitOp)
  //
  Procedure InitFlow;
  procedure mark_end_of(mark:TsrVolMark);
  Procedure PushBlockOp(pLine:TspirvOp;pChild:TsrOpBlock;iCursor:TsrCursor);
  function  PopBlockOp:Boolean;
  function  ConvertCond(cond:TsrCondition;pLine:TspirvOp):TConvertResult;
  function  ConvertStatment(node:TsrStatement;pLine:TspirvOp):TConvertResult;
  function  LoadStatment(C:TConvertResult):TConvertResult;
  procedure emit_break(pCurr:TsrOpBlock);
  procedure EmitStatment(node:TsrStatement);
  function  NewMerge(iCursor:TsrCursor):TsrOpBlock;
  function  NewIf   (pOpMerge:TsrOpBlock;iCursor:TsrCursor;src:TsrRegNode):TsrOpBlock;
  function  NewElse (pOpMerge:TsrOpBlock;iCursor:TsrCursor):TsrOpBlock;
  function  NewLoop (iCursor:TsrCursor):TsrOpBlock;
  function  BlockBeg:Boolean;
  function  BlockEnd:Boolean;
  //
  function  get_code_ptr:Pointer;
  procedure set_code_ptr(base:Pointer;bType:TsrBlockType);
  function  fetch_cursor_ptr(base:Pointer;bType:TsrBlockType):TsrCursor;
  //function  IsFinalize:Boolean;
  //
  procedure Finalize;
  //
  function  ParseStage(base:Pointer):Integer;
 end;  

implementation

Procedure TEmitFlow.InitFlow;
begin
 CodeHeap.Init(Self);
 //
 InitBlock:=AllocBlockOp;
 InitBlock.SetInfo(btOther);
 PushBlockOp(line,InitBlock,Default(TsrCursor));
 Main.PopBlock;
end;

procedure TEmitFlow.mark_end_of(mark:TsrVolMark);
var
 node:TsrOpBlock;
begin
 node:=Main.pBlock;
 While (node<>nil) do
 begin

  if (node.FVolMark<>vmNone) then
  begin
   //already marked, exit
   Exit;
  end;

  node.FVolMark:=mark;

  //exit if real block
  if IsReal(node.bType) then Exit;

  node:=node.Parent;
 end;
end;

Procedure TEmitFlow.PushBlockOp(pLine:TspirvOp;pChild:TsrOpBlock;iCursor:TsrCursor);
begin
 pChild.FCursor:=iCursor; //prev
 //pChild.FLBlock:=pLBlock;

 InsSpirvOp(pLine,pChild);

 Main.PushBlock(pChild);

 {
 if (pLBlock<>nil) then
 begin
  Cursor.pBlock:=pLBlock; //push
 end;
 }
end;

function TEmitFlow.PopBlockOp:Boolean;
var
 pOpBlock:TsrOpBlock;
 pOpChild:TsrOpBlock;
 pBegOp,pEndOp,pMrgOp:TspirvOp;

 procedure pop_merge(pOpBlock:TsrOpBlock);
 begin
  Assert(pMrgOp<>nil);

  if not is_term_op(line) then
  begin
   OpBranch(line,pMrgOp);
  end;

  AddSpirvOp(line,pMrgOp); //end
 end;

 procedure pop_merge_after(pOpBlock:TsrOpBlock);
 begin
  //
 end;

 procedure pop_cond(pOpBlock:TsrOpBlock);
 begin
  //
 end;

 procedure pop_cond_after(pOpBlock:TsrOpBlock);
 begin
  if (pOpBlock.pElse<>nil) then //have else
  begin
   //save current to prev
   pOpBlock.Regs.prev^:=RegsStory.get_snapshot;
   //restore original by start "else"
   PrivateList.build_volatile_reset(pOpBlock.Regs.orig);
  end else
  begin
   //save current to prev
   pOpBlock.Regs.prev^:=RegsStory.get_snapshot;
   //
   if (pOpBlock.FVolMark<>vmNone) then
   begin
    //restore original if inside endpgm/break/continue
    PrivateList.build_volatile_reset(pOpBlock.Regs.orig);
   end else
   begin
    //calc next volatile state
    PrivateList.build_volatile_endif(pOpBlock.vctx,pOpBlock.Regs.orig,pOpBlock.Regs.prev,pOpBlock.Regs.next);
    //set next volatile state
    PrivateList.build_volatile_reset(pOpBlock.Regs.next);
   end;
  end;
 end;

 procedure pop_else(pOpBlock:TsrOpBlock);
 begin
  //
 end;

 procedure pop_else_after(pOpBlock:TsrOpBlock);
 var
  pIf:TsrOpBlock;
 begin
  pIf:=pOpBlock.pIf;
  if (pOpBlock.FVolMark<>vmNone) and  //pElse
     (pIf.FVolMark<>vmNone) then      //pIf
  begin
   //restore original if both blocks inside endpgm/break/continue
   PrivateList.build_volatile_reset(pOpBlock.Regs.orig);
   //mark up
   if (pOpBlock.FVolMark=pIf.FVolMark) then
   begin
    mark_end_of(pOpBlock.FVolMark);
   end else
   begin
    mark_end_of(vmMixed);
   end;
  end else
  begin
   //calc next volatile state
   PrivateList.build_volatile_endif(pOpBlock.vctx,pOpBlock.Regs.orig,pOpBlock.Regs.prev,pOpBlock.Regs.next);
   //set next volatile state
   PrivateList.build_volatile_reset(pOpBlock.Regs.next);
  end;
 end;

 procedure pop_loop(pOpBlock:TsrOpBlock);
 var
  pLine:TspirvOp;
  parent:TsrSourceBlock;
  src:TsrRegNode;
 begin
  //add OpLoopMerge continue

  Assert(pBegOp<>nil);
  Assert(pEndOp<>nil);
  Assert(pMrgOp<>nil);

  parent:=pOpBlock.FCursor.AsBlock;
  Assert(parent<>nil);

  pLine:=line; //before close

  //if pOpBlock.Cond.FUseCont then //use continue

  if (parent.pCond<>nil) then
  begin
   //have post conditions
   if not is_term_op(line) then
   begin
    OpBranch(line,pMrgOp); //LoopMerge
   end;
  end else
  begin
   //not post conditions
   if not is_term_op(line) then
   begin
    OpBranch(line,pEndOp); //break
   end;
  end;

  AddSpirvOp(line,pMrgOp); //OpLoopMerge end

    pOpChild:=AllocBlockOp;
    pOpChild.SetInfo(btOther);
    PushBlockOp(line,pOpChild,Default(TsrCursor));

    if (parent.pCond<>nil) then
    begin
     //have post conditions
     src:=LoadStatment(ConvertStatment(parent.pCond,pLine)).pNode;
     Assert(src<>nil);
     //
     OpBranchCond(line,pBegOp,pEndOp,src); //True|False
    end else
    begin
     //not post conditions
     OpBranch(line,pBegOp); //continue
    end;

  Main.PopBlock;

  AddSpirvOp(line,pEndOp); //end

 end;

 Function IsUnconditional(cond:TsrStatement):Boolean; inline;
 begin
  Result:=(cond.sType=sCond) and (cond.u.cond=cTrue)
 end;

 Function IsUnreachable(cond:TsrStatement):Boolean; inline;
 begin
  Result:=(cond.sType=sCond) and (cond.u.cond=cFalse)
 end;

 procedure pop_loop_after(pOpBlock:TsrOpBlock);
 var
  parent:TsrSourceBlock;
 begin
  if (pOpBlock.FVolMark<>vmNone) then
  begin
   //set next volatile state
   PrivateList.build_volatile_reset(pOpBlock.Regs.next);
  end else
  begin
   parent:=pOpBlock.FCursor.AsBlock;

   if (parent.pCond=nil) then
   begin
    //continue
    PrivateList.build_volatile_conti(pOpBlock.vctx,pOpBlock.Regs.orig,pOpBlock.Regs.prev,pOpBlock.Regs.next);
   end else
   if IsUnconditional(parent.pCond) then
   begin
    //continue
    PrivateList.build_volatile_conti(pOpBlock.vctx,pOpBlock.Regs.orig,pOpBlock.Regs.prev,pOpBlock.Regs.next);
   end else
   if IsUnreachable(parent.pCond) then
   begin
    //break
    PrivateList.build_volatile_break(pOpBlock.vctx,pOpBlock.Regs.orig,pOpBlock.Regs.prev,pOpBlock.Regs.next);
   end else
   begin
    //break
    PrivateList.build_volatile_break(pOpBlock.vctx,pOpBlock.Regs.orig,pOpBlock.Regs.prev,pOpBlock.Regs.next);
    //continue
    PrivateList.build_volatile_conti(pOpBlock.vctx,pOpBlock.Regs.orig,pOpBlock.Regs.prev,pOpBlock.Regs.next);
   end;

   //set next volatile state
   PrivateList.build_volatile_reset(pOpBlock.Regs.next);
  end;
 end;

 procedure pop_other(pOpBlock:TsrOpBlock);
 begin
  //pMrgOp???
  if (pEndOp<>nil) then
  begin
   if not is_term_op(line) then
   begin
    OpBranch(line,pEndOp);
   end;
   AddSpirvOp(line,pEndOp);
  end;
 end;

begin
 Result:=False;
 if (Main=nil) then Exit;

 pOpBlock:=Main.pBlock;
 if (pOpBlock=nil) then Exit;

 pBegOp:=pOpBlock.Labels.pBegOp;
 pEndOp:=pOpBlock.Labels.pEndOp;
 pMrgOp:=pOpBlock.Labels.pMrgOp;

 Case pOpBlock.bType of
  btMerg:
   begin
    pop_merge(pOpBlock);
   end;
  btCond:
   begin
    pop_cond(pOpBlock);
   end;
  btElse:
   begin
    pop_else(pOpBlock);
   end;
  btLoop:
   begin
    pop_loop(pOpBlock);
   end;
  else
    pop_other(pOpBlock);
 end;

 //restore

 Case pOpBlock.bType of
  btInline:
   begin
    Assert(pOpBlock.FCursor.pCode<>nil);
    Assert(pOpBlock.FCursor.pNode<>nil);
    Cursor:=pOpBlock.FCursor;
   end;
  btOther:
   begin
    if (pOpBlock.FCursor.pCode<>nil) then
    if (pOpBlock.FCursor.pNode<>nil) then
    begin
     Cursor:=pOpBlock.FCursor;
    end;
   end;
  else
   begin
    Assert(pOpBlock.FCursor.pCode<>nil);
    Assert(pOpBlock.FCursor.pNode<>nil);
    Cursor.PopBlock;
   end;
 end;

 Result:=Main.PopBlock;

 Case pOpBlock.bType of
  btMerg:
   begin
    pop_merge_after(pOpBlock);
   end;
  btCond:
   begin
    pop_cond_after(pOpBlock);
   end;
  btElse:
   begin
    pop_else_after(pOpBlock);
   end;
  btLoop:
   begin
    pop_loop_after(pOpBlock);
   end;
  else
   begin
   end;
 end;

end;

function Base64(b:Byte):Char;
begin
 case (b and 63) of
   0..25:Result:=Char(b+Byte('A')-0);
  26..51:Result:=Char(b+Byte('a')-26);
  52..61:Result:=Char(b+Byte('0')-52);
      62:Result:='+';
      63:Result:='-';
 end;
end;


function TEmitFlow.ConvertCond(cond:TsrCondition;pLine:TspirvOp):TConvertResult;
begin
 case cond of
  cFalse :Result.pNode:=NewImm_b(False,pLine);
  cTrue  :Result.pNode:=NewImm_b(True ,pLine);
  cScc0  :Result.pNode:=fetch_scc;                 //It means that (scc == 0)
  cScc1  :Result.pNode:=fetch_scc;                 //It means that (scc == 1)
  cVccz  :Result.pNode:=fetch_vccnz     (@pLine);  //It means that (vcc0  == 0) && (vcc1  == 0)
  cVccnz :Result.pNode:=fetch_vccnz     (@pLine);  //It means that (vcc0  != 0) || (vcc1  != 0)
  cExecz :Result.pNode:=fetch_execnz    (@pLine);  //It means that (exec0 == 0) && (exec1 == 0)
  cExecnz:Result.pNode:=fetch_execnz    (@pLine);  //It means that (exec0 != 0) || (exec1 != 0)
  cTidz  :Result.pNode:=fetch_execnz_tid(@pLine);  //It means that (exec[thread_id:] == 0)
  cTidnz :Result.pNode:=fetch_execnz_tid(@pLine);  //It means that (exec[thread_id:] != 0)
  else
   Assert(false,'ConvertCond');
 end;
 //Since the main condition is this condition equal to zero, then we need to invert it again!
 case cond of
  cScc0,
  cVccz,
  cExecz,
  cTidz:
   begin
    //invert
    if TsrRegNode(Result.pNode).is_const then
    begin
     //early optimization
     Result.pNode:=NewImm_b(not TsrRegNode(Result.pNode).AsConst.AsBool,pLine);
    end else
    begin
     Result.pNode:=OpLogicalNotTo(Result.pNode,@pLine);
    end;
    //
   end;
  else;
 end;
 //
 Result.pLine:=pLine;
end;

function TEmitFlow.ConvertStatment(node:TsrStatement;pLine:TspirvOp):TConvertResult;
var
 V:TsrVolatile;
begin
 Result.pNode:=nil;
 Result.pLine:=pLine;
 //
 case node.sType of
  sCond :begin
          Result:=ConvertCond(node.u.cond,pLine);
         end;
  sCopy :begin
          Result.pNode:=TsrNode(node.pCache);
          Assert(Result.pNode<>nil);
         end;
  sVar  :begin
          if (node.pCache<>nil) then
          begin
           Result.pNode:=TsrNode(node.pCache);
          end else
          begin
           V:=PrivateList.NewVolatile(@RegsStory.FUnattach);
           V.ForceBool:=True;
           //
           Result.pNode:=V;
           node.pCache:=Result.pNode;
          end;
          //load

         end;
  sNot  :begin
          Result.pNode:=TsrNode(node.pCache);
          Assert(Result.pNode<>nil);
         end;
  sOr   :begin
          Result.pNode:=TsrNode(node.pCache);
          Assert(Result.pNode<>nil);
         end;
  sAnd  :begin
          Result.pNode:=TsrNode(node.pCache);
          Assert(Result.pNode<>nil);
         end;
  else
   Assert(false,'ConvertStatment');
 end;
end;

function TEmitFlow.LoadStatment(C:TConvertResult):TConvertResult;
var
 V:TsrVolatile;
 R:TsrRegNode;
begin
 Result:=C;

 if C.pNode.IsType(ntVolatile) then
 begin
  V:=C.pNode.specialize AsType<TsrVolatile>;
  Assert(V<>nil);

  R:=NewReg(dtBool);
  R.pWriter:=V;
  R.CustomLine:=C.pLine;

  Result.pNode:=R;
 end;

end;

procedure TEmitFlow.emit_break(pCurr:TsrOpBlock);
var
 pOpLabel:TspirvOp;

 parent:TsrSourceBlock;

 pLoop:TsrOpBlock;

 bnew:Boolean;
begin
 pLoop:=Main.pBlock.FindUpLoop;
 Assert(pLoop<>nil,'Break to Unknow');

 pOpLabel:=nil;

 {
 parent:=pLoop.FCursor.AsBlock;
 Assert(parent<>nil);

 if (parent.Last=Cursor.pNode) then //is break?
 begin
  pOpLabel:=pLoop.Labels.pEndOp;
 end else
 begin
  Assert(false,'break');
 end;
 }

 pOpLabel:=pLoop.Labels.pEndOp;
 Assert(pOpLabel<>nil);

 Assert(pLoop.FCursor.pNode<>nil);
 parent:=pLoop.FCursor.AsBlock;
 Assert(parent<>nil);

 bnew:=true;
 //if pCurr.IsEndOf(Cursor.Adr) then //is last
 begin
  if IsReal(pCurr.bType) then
  begin
   bnew:=false;
  end;
 end;

 //calc volatile
 PrivateList.build_volatile_break(pLoop.vctx,pLoop.Regs.orig,pLoop.Regs.prev,pLoop.Regs.next);

 //mark hints
 mark_end_of(vmBreak);

 OpBranch(pCurr.line,pOpLabel);
 if bnew then
 begin
  AddSpirvOp(pCurr.line,NewLabelOp(True));
 end;
end;

procedure TEmitFlow.EmitStatment(node:TsrStatement);
Var
 V:TsrVolatile;
 R:TsrRegNode;
 D:TsrRegNode;
 C:TConvertResult;
begin
 case node.sType of
  sCond:; //skip
  sCopy:
   begin
    C:=ConvertStatment(node.pSrc,line);
    C:=LoadStatment(C);
    R:=C.pNode.specialize AsType<TsrRegNode>;
    Assert(R<>nil);

    node.pCache:=R;
   end;
  sStore:
   begin
    C:=ConvertStatment(node.pDst,line);
    V:=C.pNode.specialize AsType<TsrVolatile>;
    Assert(V<>nil);

    C:=ConvertStatment(node.pSrc,C.pLine);
    C:=LoadStatment(C);
    D:=C.pNode.specialize AsType<TsrRegNode>;
    Assert(D<>nil);

    //Writeln('sStore to:',node.pDst.u.id,' from ',node.pSrc.u.id);

    V.AddStore(D);
   end;
  sBreak:
   begin
    emit_break(Main.pBlock);
   end;
  sNot:
   begin
    C:=ConvertStatment(node.pSrc,line);
    C:=LoadStatment(C);
    R:=C.pNode.specialize AsType<TsrRegNode>;
    Assert(R<>nil);

    R:=OpLogicalNotTo(R);

    node.pCache:=R;
   end;
  sOr:
   begin
    C:=ConvertStatment(node.pSrc,line);
    C:=LoadStatment(C);
    R:=C.pNode.specialize AsType<TsrRegNode>;
    Assert(R<>nil);

    C:=ConvertStatment(node.pDst,line);
    C:=LoadStatment(C);
    D:=C.pNode.specialize AsType<TsrRegNode>;
    Assert(D<>nil);

    R:=OpOrTo(R,D);

    node.pCache:=R;
   end;
  sAnd:
   begin
    C:=ConvertStatment(node.pSrc,line);
    C:=LoadStatment(C);
    R:=C.pNode.specialize AsType<TsrRegNode>;
    Assert(R<>nil);

    C:=ConvertStatment(node.pDst,line);
    C:=LoadStatment(C);
    D:=C.pNode.specialize AsType<TsrRegNode>;
    Assert(D<>nil);

    R:=OpAndTo(R,D);

    node.pCache:=R;
   end;
  else
   Assert(false,'EmitStatment');
 end;
end;

function TEmitFlow.NewMerge(iCursor:TsrCursor):TsrOpBlock;
var
 pMrgOp:TspirvOp;
 pLine:TspirvOp;
 pNop :TspirvOp;
begin
 pMrgOp:=NewLabelOp(False); //merge

 //save push point
 pLine:=line;

 pNop:=nil;
 if pLine.IsType(ntOp) then
 if (pLine.OpId=Op.OpNop) then
 begin
  pNop:=pLine;
  pNop.mark([soNotUsed,soPost]);
 end;

 if (pNop=nil) then
 begin
  pNop:=AddSpirvOp(pLine,Op.OpNop);
  pNop.mark([soNotUsed,soPost]);
  //
  pLine:=pNop;
 end;

 Result:=AllocBlockOp;
 Result.SetInfo(btMerg);
 Result.SetLabels(nil,nil,pMrgOp);
 //Result.Cond.FExcMerg:=pLBlock.ExcMerg;

 //save nop before
 Result.vctx.Befor:=pNop;

 //add nop aka PostLink
 pNop:=AddSpirvOp(pLine,Op.OpNop);
 pNop.mark([soNotUsed,soPost]);

 Result.vctx.After:=pNop;

 //add by push point
 PushBlockOp(pLine,Result,iCursor);

 //Deferred instruction
 //OpCondMerge(line,pMrgOp);
end;

function _IsConstTrue(pReg:TsrRegNode):Boolean;
var
 pConst:TsrConst;
begin
 Result:=False;
 if (pReg=nil) then Exit;
 pConst:=pReg.AsConst;
 if (pConst=nil) then Exit;
 Result:=pConst.AsBool;
end;

function TEmitFlow.NewIf(pOpMerge:TsrOpBlock;iCursor:TsrCursor;src:TsrRegNode):TsrOpBlock;
var
 orig:TsrRegsSnapshot;
 pLBlock:TsrSourceBlock;
 pLElse:TsrSourceBlock;
 pBegOp,pEndOp,pMrgOp,pAfter,pBefor:TspirvOp;
 pOpElse:TsrOpBlock;
 pOpBody:TsrOpBlock;

 function _IsNestedTrue(src:TsrRegNode):Boolean;
 var
  pCond :TsrOpBlock;
  Invert:Boolean;
 begin
  Invert:=false;
  pCond:=Main.pBlock.FindUpCondByReg(src,False,Invert);
  Result:=(pCond<>nil) and (Invert=False);
 end;

begin
 pMrgOp:=pOpMerge.Labels.pMrgOp;
 pAfter:=pOpMerge.vctx.After;
 pBefor:=pOpMerge.vctx.Befor;

 pLBlock:=iCursor.AsBlock;

 if (pLBlock<>nil) then
 if (pLBlock.pElse=nil) then  //no else
 if (pLBlock.pCond<>nil) then //have cond
 begin
  src:=LoadStatment(ConvertStatment(pLBlock.pCond,pBefor)).pNode;
  //
  if _IsConstTrue(src) or
     _IsNestedTrue(src) then
  begin
   //early optimization

   pOpMerge.bType:=btOther;

   //down body group
   pOpBody:=AllocBlockOp;
   pOpBody.SetInfo(btOther);
   PushBlockOp(line,pOpBody,Default(TsrCursor));

   Exit(pOpBody);
  end;
 end;

 //Add deferred instruction
 OpCondMerge(line,pMrgOp);

 if (pLBlock<>nil) then
 begin
  pLElse:=pLBlock.pElse;
 end else
 begin
  pLElse:=nil;
 end;

 orig:=RegsStory.get_snapshot;

 pBegOp:=NewLabelOp(False); //begin

 if (pLElse<>nil) then //have else
 begin
  pEndOp:=NewLabelOp(False); //endif/begelse
 end else
 begin
  pEndOp:=pMrgOp; //endif
 end;

 Result:=NewBlockOp(orig);
 Result.SetLabels(pBegOp,pEndOp,pMrgOp);
 Result.SetInfo(btCond);

 Result.vctx.Befor:=pBefor;
 Result.vctx.After:=pAfter; //move nop link

 PushBlockOp(line,Result,iCursor);

 pOpMerge.pBody:=Result; //Merge->if

 if (pLBlock<>nil) then
 begin
  if (pLBlock.pCond<>nil) then
  begin
   if (src=nil) then
   begin
    src:=LoadStatment(ConvertStatment(pLBlock.pCond,pBefor)).pNode;
   end;
   Assert(src<>nil);
   //
   PrepTypeNode(src,dtBool,False);
   //
   Result.Labels.pBcnOp:=OpBranchCond(line,pBegOp,pEndOp,src); //True|False
   //
   Result.SetCond(src,true);
  end else
  begin
   //deffered
   Result.Labels.pBcnOp:=AddSpirvOp(line,Op.OpBranchConditional);
  end;
 end else
 begin
  if (src<>nil) then
  begin
   PrepTypeNode(src,dtBool,False);
   //
   Result.Labels.pBcnOp:=OpBranchCond(line,pBegOp,pEndOp,src); //True|False
   //
   Result.SetCond(src,true);
  end else
  begin
   //deffered
   Result.Labels.pBcnOp:=AddSpirvOp(line,Op.OpBranchConditional);
  end;
 end;

 AddSpirvOp(line,pBegOp);

 if (pLElse<>nil) then //have else
 begin

  //create else block
  pOpElse:=AllocBlockOp;
  pOpElse.SetLabels(pEndOp,pMrgOp,pMrgOp);
  pOpElse.SetInfo(btElse);
  pOpElse.vctx.After:=pAfter; //move nop link

  //save snap links
  pOpElse.Regs.orig:=Result.Regs.orig;
  pOpElse.Regs.prev:=Result.Regs.prev;
  pOpElse.Regs.next:=Result.Regs.next;

  Result .pElse:=pOpElse; //if->else
  pOpElse.pIf  :=Result;  //else->if

  pOpMerge.pElse:=pOpElse;
 end;

 pOpMerge.pIf:=Result;

 //down body group
 pOpBody:=AllocBlockOp;
 pOpBody.SetInfo(btOther);
 Result.pBody:=pOpBody; //save body link
 PushBlockOp(line,pOpBody,Default(TsrCursor));
end;

function TEmitFlow.NewElse(pOpMerge:TsrOpBlock;iCursor:TsrCursor):TsrOpBlock;
var
 pBegOp,pMrgOp:TspirvOp;
 pOpBody:TsrOpBlock;
begin
 Result:=pOpMerge.pElse;
 Assert(Result<>nil);

 //down else block
 PushBlockOp(line,Result,iCursor);

 pBegOp:=Result.Labels.pBegOp;
 pMrgOp:=Result.Labels.pMrgOp;

 if not is_term_op(line) then
 begin
  OpBranch (line,pMrgOp); //goto end
 end;
 AddSpirvOp(line,pBegOp); //start else

 //down body group
 pOpBody:=AllocBlockOp;
 pOpBody.SetInfo(btOther);
 Result.pBody:=pOpBody; //save body link
 PushBlockOp(line,pOpBody,Default(TsrCursor));
end;

function TEmitFlow.NewLoop(iCursor:TsrCursor):TsrOpBlock;
var
 orig:TsrRegsSnapshot;
 pLine:TspirvOp;
 pBegOp,pEndOp,pMrgOp,pRepOp:TspirvOp;
 pNop:TspirvOp;
 pOpBody:TsrOpBlock;
begin
 orig:=RegsStory.get_snapshot;
 PrivateList.make_copy_all;

 //get before
 pLine:=line;

 pNop:=nil;
 if pLine.IsType(ntOp) then
 if (pLine.OpId=Op.OpNop) then
 begin
  pNop:=pLine;
  pNop.mark([soNotUsed,soPost]);
 end;

 if (pNop=nil) then
 begin
  pNop:=AddSpirvOp(pLine,Op.OpNop);
  pNop.mark([soNotUsed,soPost]);
  //
  pLine:=pNop;
 end;

 Assert(pLine.IsType(ntOp) ,'WTF');
 Assert(pLine.OpId=Op.OpNop,'WTF');

 pBegOp:=NewLabelOp(False); //continue
 pEndOp:=NewLabelOp(False); //end
 pMrgOp:=NewLabelOp(False); //cond
 pRepOp:=NewLabelOp(False); //start

 Result:=NewBlockOp(RegsStory.get_snapshot,orig);
 Result.SetLabels(pBegOp,pEndOp,pMrgOp);
 Result.SetInfo(btLoop);

 //save nop before
 Result.vctx.Befor:=pNop;

 //save push point
 pLine:=line;

 //add nop aka PostLink
 pNop:=AddSpirvOp(pLine,Op.OpNop);
 pNop.mark([soNotUsed,soPost]);
 //
 Result.vctx.After:=pNop;

 PushBlockOp(pLine,Result,iCursor);

 OpBranch  (line,pBegOp);
 AddSpirvOp(line,pBegOp);    //continue loop

 OpLoopMerge(line,pEndOp,pMrgOp);
 OpBranch   (line,pRepOp);
 AddSpirvOp (line,pRepOp);

 //down group
 pOpBody:=AllocBlockOp;
 pOpBody.SetInfo(btOther);
 Result.pBody:=pOpBody; //save body link

 PushBlockOp(line,pOpBody,Default(TsrCursor));
end;

function TEmitFlow.BlockBeg:Boolean;
var
 parent:TsrSourceBlock;
 pOpMerge:TsrOpBlock;
begin
 Result:=False;

 //is marked of end
 //if IsFinalize then Exit;

 parent:=Cursor.AsBlock;

 Case parent.bType of
  btMerg:
   begin
    pOpMerge:=NewMerge(Cursor);

    Result:=True;
   end;
  btCond:
   begin
    pOpMerge:=line.Parent;
    Assert(pOpMerge<>nil);
    Assert(pOpMerge.bType=btMerg);

    NewIf(pOpMerge,Cursor,nil);

    Result:=True;
   end;
  btElse:
   begin
    pOpMerge:=line.Parent;
    Assert(pOpMerge<>nil);
    Assert(pOpMerge.bType=btMerg);

    NewElse(pOpMerge,Cursor);

    Result:=True;
   end;
  btLoop:
   begin
    NewLoop(Cursor);

    Result:=True;
   end;
  btInline: //skip
   begin
    //
   end;
  else
   begin
    Assert(false);
   end;
 end;

end;

function TEmitFlow.BlockEnd:Boolean;
begin
 Result:=False;
 if (Main=nil) then Exit;
 if (Main.pBlock=nil) then Exit;

 if (Main.pBlock.Parent<>nil) then
 begin
  Result:=PopBlockOp;
 end;
end;

//

function TEmitFlow.get_code_ptr:Pointer;
begin
 Result:=Cursor.e_adr.get_code_ptr;
end;

procedure TEmitFlow.set_code_ptr(base:Pointer;bType:TsrBlockType);
begin
 if (Cursor.b_adr.get_code_ptr=base) then Exit;
 Cursor:=CodeHeap.FetchByPtr(base,bType);
end;

function TEmitFlow.fetch_cursor_ptr(base:Pointer;bType:TsrBlockType):TsrCursor;
begin
 Result:=CodeHeap.FetchByPtr(base,bType);
end;

{
function TEmitFlow.IsFinalize:Boolean;
begin
 Result:=False;
 if (Main.pBlock.Parent=nil) then
 if Cursor.pBlock.IsEndOf(Cursor.Adr) or
    (Main.pBlock.FVolMark=vmEndpg) then //marked of end
 begin
  Result:=True;
 end;
end;
}

procedure TEmitFlow.Finalize;
begin
 if (Main=nil) then Exit;

 if (Main.pBlock<>nil) then
  While (Main.pBlock.Parent<>nil) do
  begin
   PopBlockOp;
  end;

 AddSpirvOp(Op.OpFunctionEnd);
end;

//

function TEmitFlow.ParseStage(base:Pointer):Integer;
label
 _skip;
var
 next:TsrSourceNode;
 FLevel:DWORD;
begin
 Result:=0;
 set_code_ptr(base,btMain);

 while (Cursor.pNode<>nil) do
 begin

  if Cursor.fnext then
  begin
   //skip intruction
   Cursor.fnext:=False;
   goto _skip;
  end;

  //down
  while (Cursor.pNode.ntype=TsrSourceBlock) do
  begin
   next:=Cursor.pNode.First;
   if (next=nil) then
   begin
    //up
    goto _skip;
   end;
   //
   BlockBeg;
   //
   Cursor.pNode:=next;
   Cursor.UpdateAdr;
  end;

  if (Cursor.pNode.ntype=TsrSourceNode) then
  begin
   //skip
  end else
  if (Cursor.pNode.ntype=TsrSourceLabel) then
  begin
   //skip
  end else
  if (Cursor.pNode.ntype=TsrSourceInstruction) then
  begin
   //
   FSPI:=TsrSourceInstruction(Cursor.pNode).FSPI;
   //
   if Config.PrintAsm then
   begin

    FLevel:=0;
    if (Main<>nil) then
    if (Main.pBlock<>nil) then
    begin
     FLevel:=Main.pBlock.Level;
    end;

    Writeln(HexStr(Cursor.b_adr.Offset,4),Space(FLevel+1),get_str_spi(FSPI));
   end;
   //
   next:=Cursor.pNode;

   emit_spi;

   if (Cursor.pNode<>next) then
   begin
    //node is change
    Continue;
   end;
   //
  end else
  if (Cursor.pNode.ntype=TsrStatement) then
  begin
   //
   EmitStatment(TsrStatement(Cursor.pNode));
   //
  end else
  begin
   Assert(false,'Unhandled node:'+Cursor.pNode.ntype.ClassName);
  end;

  _skip:

  next:=Cursor.pNode.pNext;
  while (next=nil) and
        (Cursor.pNode.pParent<>nil) and
        (Cursor.pNode.pParent<>Cursor.pCode.FTop) do
  begin
   //up
   BlockEnd; //"Cursor.pNode:=Cursor.pNode.pParent" in "PopBlockOp"
   //
   next:=Cursor.pNode.pNext;
  end;
  //
  Cursor.pNode:=next;
  Cursor.UpdateAdr;

 end; //while

 Finalize;
end;

end.