void
CfrTil_ForCombinator ( )
{
block doBlock = ( block ) TOS, doPostBlock = ( block ) Dsp [ - 1 ], testBlock =
( block ) Dsp [ - 2 ], doPreBlock = ( block ) Dsp [ - 3 ] ;
_DataStack_DropN ( 4 ) ;
if ( CompileMode )
{
CfrTil_BeginCombinator ( 4 ) ;
_Compile_Block ( ( byte* ) doPreBlock, 3, 0 ) ;
byte * start = Here ;
_Compile_Block ( ( byte* ) testBlock, 2, 1 ) ;
_Context_->Compiler0->ContinuePoint = Here ;
_Compile_Block ( ( byte* ) doBlock, 0, 0 ) ;
_Compile_Block ( ( byte* ) doPostBlock, 1, 0 ) ;
_Compile_JumpToAddress ( start ) ; // runtime
_Context_->Compiler0->BreakPoint = Here ;
CfrTil_CalculateAndSetPreviousJmpOffset_ToHere ( ) ;
CfrTil_EndCombinator ( 4, 1 ) ;
}
else
{
_Block_Eval ( doPreBlock ) ;
do
{
_Block_Eval ( testBlock ) ;
if ( ! _DataStack_Pop ( ) )
break ;
_Context_->Compiler0->ContinuePoint = Here ;
_Block_Eval ( doBlock ) ;
_Block_Eval ( doPostBlock ) ;
_Context_->Compiler0->BreakPoint = Here ;
}
while ( 1 ) ;
}
}
void
CfrTil_If2Combinator ( )
{
block testBlock = ( block ) Dsp [ - 1 ], doBlock = ( block ) TOS ;
_DataStack_DropN ( 2 ) ;
if ( CompileMode )
{
CfrTil_BeginCombinator ( 2 ) ;
_Compile_Block ( ( byte* ) testBlock, 1, 1 ) ;
_Compile_Block ( ( byte* ) doBlock, 0, 0 ) ;
CfrTil_CalculateAndSetPreviousJmpOffset_ToHere ( ) ;
CfrTil_EndCombinator ( 2, 1 ) ;
}
else
{
_Block_Eval ( testBlock ) ;
if ( _DataStack_Pop ( ) ) _Block_Eval ( doBlock ) ;
}
}
void
CfrTil_Combinator_LinRec ( )
{
block else2Block = ( block ) TOS, else1Block = ( block ) Dsp [ - 1 ],
thenBlock = ( block ) Dsp [ - 2 ], ifBlock = ( block ) Dsp [ - 3 ] ;
_DataStack_DropN ( 4 ) ;
if ( CompileMode )
{
CfrTil_BeginCombinator ( 4 ) ;
byte * start = Here ;
_Compile_Block ( ( byte* ) ifBlock, 3, 1 ) ;
_Compile_Block ( ( byte* ) thenBlock, 2, 0 ) ;
CfrTil_Else ( ) ;
_Compile_Block ( ( byte* ) else1Block, 1, 0 ) ;
Compile_Call ( ( byte* ) start ) ;
_Compile_Block ( ( byte* ) else2Block, 0, 0 ) ;
CfrTil_EndIf ( ) ;
CfrTil_EndCombinator ( 4, 1 ) ;
RET ( ) ;
}
else ilinrec ( ifBlock, thenBlock, else1Block, else2Block ) ;
}
void
CfrTil_LoopCombinator ( )
{
block loopBlock = ( block ) TOS ;
_DataStack_DropN ( 1 ) ;
if ( CompileMode )
{
CfrTil_BeginCombinator ( 1 ) ;
byte * start = Here ;
_Context_->Compiler0->ContinuePoint = start ;
_Compile_Block ( ( byte* ) loopBlock, 0, 0 ) ;
_Compile_JumpToAddress ( start ) ; // runtime
_Context_->Compiler0->BreakPoint = Here ;
CfrTil_EndCombinator ( 1, 1 ) ;
}
else while ( 1 ) _Block_Eval ( loopBlock ) ;
}
void
CfrTil_BlockRun ( )
{
block doBlock = ( block ) TOS ;
if ( CompileMode )
{
_DataStack_DropN ( 1 ) ;
CfrTil_BeginCombinator ( 1 ) ;
_Compile_Block ( ( byte* ) doBlock, 0, 0 ) ;
CfrTil_EndCombinator ( 1, 1 ) ;
}
else
{
_Block_Eval ( doBlock ) ;
//_DataStack_DropN ( 1 ) ; // needs to be here to correctly run lisp blocks from LO_EndBlock ( ) ?!?
}
}
void
_CfrTil_BlockRun ( Boolean flag )
{
block doBlock = ( block ) TOS ;
_DataStack_DropN ( 1 ) ;
if ( flag & FORCE_RUN )
{
_Block_Eval ( doBlock ) ;
}
else //if ( flag & FORCE_COMPILE )
{
CfrTil_BeginCombinator ( 1 ) ;
_Compile_Block ( ( byte* ) doBlock, 0, 0 ) ;
CfrTil_EndCombinator ( 1, 1 ) ;
//return doBlock ;
}
}
void
CfrTil_NLoopCombinator ( )
{
int32 count = Dsp [ - 1 ] ;
block loopBlock = ( block ) TOS ;
_DataStack_DropN ( 2 ) ;
#if 0
if ( CompileMode )
{
CfrTil_BeginCombinator ( 1 ) ;
byte * start = Here ;
_Context_->Compiler0->ContinuePoint = start ;
_Compile_Block ( ( byte* ) loopBlock ) ;
_Compile_JumpToAddress ( start ) ; // runtime
_Context_->Compiler0->BreakPoint = Here ;
CfrTil_EndCombinator ( 1 ) ;
}
#endif
while ( count -- )
_Block_Eval ( loopBlock ) ;
}
void
CfrTil_If1Combinator ( )
{
block doBlock = ( block ) TOS ;
_DataStack_DropN ( 1 ) ;
if ( CompileMode )
{
CfrTil_BeginCombinator ( 1 ) ;
Compile_GetLogicFromTOS ( 0 ) ;
_Compile_UninitializedJumpEqualZero ( ) ;
Stack_PointerToJmpOffset_Set ( ) ;
_Compile_Block ( ( byte* ) doBlock, 0, 0 ) ;
CfrTil_CalculateAndSetPreviousJmpOffset_ToHere ( ) ;
CfrTil_EndCombinator ( 1, 1 ) ;
}
else
{
if ( _DataStack_Pop ( ) ) _Block_Eval ( doBlock ) ;
}
}