Пример #1
0
void
CfrTil_TrueFalseCombinator3 ( )
{
    block testBlock = ( block ) Dsp [ - 2 ], trueBlock = ( block ) Dsp [ - 1 ],
        falseBlock = ( block ) TOS ;
    _DataStack_DropN ( 3 ) ;
    if ( CompileMode )
    {
        CfrTil_BeginCombinator ( 3 ) ;
        _Compile_Block ( ( byte* ) testBlock, 2, 1 ) ;
        _Compile_Block ( ( byte* ) trueBlock, 1, 0 ) ;
        CfrTil_Else ( ) ;
        _Compile_Block ( ( byte* ) falseBlock, 0, 0 ) ;
        CfrTil_EndIf ( ) ;
        CfrTil_EndCombinator ( 3, 1 ) ;
    }
    else
    {
        _Block_Eval ( testBlock ) ;
        if ( _DataStack_Pop ( ) )
        {
            _Block_Eval ( trueBlock ) ;
        }
        else
        {
            _Block_Eval ( falseBlock ) ;
        }
    }
}
Пример #2
0
void
CfrTil_DoWhileDoCombinator ( )
{
    block testBlock = ( block ) Dsp [ - 1 ], doBlock2 = ( block ) TOS, doBlock1 =
        ( block ) Dsp [ - 2 ] ;
    byte * start ;
    _DataStack_DropN ( 3 ) ;
    if ( CompileMode )
    {
        CfrTil_BeginCombinator ( 3 ) ;
        _Context_->Compiler0->ContinuePoint = Here ;
        start = Here ;
        _Compile_Block ( ( byte* ) doBlock1, 2, 0 ) ;

        _Compile_Block ( ( byte* ) testBlock, 1, 1 ) ;

        _Compile_Block ( ( byte* ) doBlock2, 0, 0 ) ;
        _Compile_JumpToAddress ( start ) ; // runtime
        _Context_->Compiler0->BreakPoint = Here ;
        CfrTil_CalculateAndSetPreviousJmpOffset_ToHere ( ) ;
        CfrTil_EndCombinator ( 3, 1 ) ;
    }
    else
    {
        do
        {
            _Block_Eval ( doBlock1 ) ;
            _Block_Eval ( testBlock ) ;
            if ( ! _DataStack_Pop ( ) )
                break ;
            _Block_Eval ( doBlock2 ) ;
        }
        while ( 1 ) ;
    }
}
Пример #3
0
void
CfrTil_TrueFalseCombinator2 ( )
{
    int32 testCondition = Dsp [ - 2 ] ;
    block trueBlock = ( block ) Dsp [ - 1 ], falseBlock = ( block ) TOS ;
    _DataStack_DropN ( 2 ) ;
    if ( CompileMode )
    {
        CfrTil_BeginCombinator ( 2 ) ;

        Compile_GetLogicFromTOS ( 0 ) ;
        _Compile_UninitializedJumpEqualZero ( ) ;
        Stack_PointerToJmpOffset_Set ( ) ;

        _Compile_Block ( ( byte* ) trueBlock, 1, 0 ) ;
        CfrTil_Else ( ) ;
        _Compile_Block ( ( byte* ) falseBlock, 0, 0 ) ;
        CfrTil_EndIf ( ) ;

        CfrTil_EndCombinator ( 2, 1 ) ;
    }
    else
    {
        if ( testCondition )
        {
            _Block_Eval ( trueBlock ) ;
        }
        else
        {
            _Block_Eval ( falseBlock ) ;
        }
    }
}
Пример #4
0
int32
CfrTil_DoWhileCombinator ( )
{
    block testBlock = ( block ) TOS, doBlock = ( block ) Dsp [ - 1 ] ;
    _DataStack_DropN ( 2 ) ;
    if ( CompileMode )
    {
        CfrTil_BeginCombinator ( 2 ) ;
        byte * start = Here ;
        _Context_->Compiler0->ContinuePoint = Here ;
        _Compile_Block ( ( byte* ) doBlock, 1, 0 ) ;
        //_Compile_Block ( ( byte* ) testBlock, 0, 1 ) ;
        if ( ! _Compile_Block ( ( byte* ) testBlock, 0, 1 ) )
        {
            SetHere ( start ) ;
            return 0 ;
        }
        _Compile_JumpToAddress ( start ) ;
        _Context_->Compiler0->BreakPoint = Here ;
        CfrTil_CalculateAndSetPreviousJmpOffset_ToHere ( ) ;
        CfrTil_EndCombinator ( 2, 1 ) ;
    }
    else
    {
        do
        {
            _Block_Eval ( doBlock ) ;
            _Block_Eval ( testBlock ) ;
            if ( ! _DataStack_Pop ( ) ) break ;
        }
        while ( 1 ) ;
    }
    return 1 ;
}
Пример #5
0
void
CfrTil_DropBlock ( )
{
    _DataStack_DropN ( 1 ) ;
    if ( CompileMode )
    {
        CfrTil_BeginCombinator ( 1 ) ;
        CfrTil_EndCombinator ( 1, 0 ) ;
    }
}
Пример #6
0
void
linrec ( )
{
    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 ) ;
}
Пример #7
0
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 ) ;
}
Пример #8
0
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 ( ) ?!?
    }
}
Пример #9
0
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 ;
    }
}
Пример #10
0
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 ) ;
    }
}
Пример #11
0
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 ) ;
    }
}
Пример #12
0
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 ) ;
}
Пример #13
0
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 ) ;
}
Пример #14
0
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 ) ;
    }
}