void
File_Seek ( )
{
int32 offset = _DataStack_Pop ( ) ;
FILE * file = ( FILE * ) _DataStack_Pop ( ) ;
fseek ( file, offset, SEEK_SET ) ;
}
void
_CfrTil_Dump ( int32 dumpMod )
{
int32 number = _DataStack_Pop ( ) ;
int32 address = _DataStack_Pop ( ) ;
__CfrTil_Dump ( address, number, dumpMod ) ;
}
void
CfrTil_dlsym ( )
{
char * sym = ( char* ) _DataStack_Pop ( ) ;
char * lib = ( char* ) _DataStack_Pop ( ) ;
_DataStack_Push ( ( int ) _dlsym ( lib, sym ) ) ;
}
void
CfrTil_Multiply ( ) // *
{
if ( CompileMode )
{
Compile_IMultiply ( _Context_->Compiler0 ) ;
}
else
{
#if 0
_DataStack_SetTop ( _DataStack_Pop ( ) * _DataStack_GetTop ( ) ) ;
#elif 0
Interpreter * interp = _Context_->Interpreter0 ;
if ( interp->CurrentPrefixWord )
{
int i, prod = 0, *ssp ;
for ( ssp = interp->PrefixWord_SaveSP + 1 ; ssp <= Dsp ; ssp ++ )
{
if ( prod ) prod *= * ssp ;
else prod = * ssp ;
}
Dsp = interp->PrefixWord_SaveSP + 1 ;
*Dsp = prod ;
}
else _DataStack_SetTop ( _DataStack_Pop ( ) * _DataStack_GetTop ( ) ) ;
#elif 1
Dsp [ - 1 ] = Dsp [ 0 ] * Dsp-- [ - 1 ] ;
#endif
}
}
void
CfrTil_Property_New ( )
{
byte * name = ( byte * ) _DataStack_Pop ( ) ;
int32 value = ( int32 ) _DataStack_Pop ( ) ;
Property * property = _Property_New ( name, value ) ;
_CfrTil_AddSymbol ( (Symbol*) property ) ;
}
void
CfrTil_Compile_Jcc ( )
{
int32 ttt = _DataStack_Pop ( ) ;
int32 n = _DataStack_Pop ( ) ;
Compile_JCC ( n, ttt, 0 ) ; // we do need to store and get this logic set by various conditions by the compiler : _Compile_SET_tttn_REG
Stack_PointerToJmpOffset_Set ( ) ;
}
void
File_Write ( )
{
int32 size = _DataStack_Pop ( ) ;
byte * ptr = ( byte * ) _DataStack_Pop ( ) ;
FILE * file = ( FILE * ) _DataStack_Pop ( ) ;
fwrite ( ptr, size, 1, file ) ;
}
void
CompileStackNToReg ( )
{
cell reg, n ;
reg = _DataStack_Pop ( ) ;
n = _DataStack_Pop ( ) ;
CompileStackNToReg ( n, reg ) ;
}
void
CfrTil_Jcc_Label ( )
{
int32 ttt = _DataStack_Pop ( ) ;
int32 n = _DataStack_Pop ( ) ;
GotoInfo * gotoInfo = ( GotoInfo * ) _GotoInfo_Allocate ( ) ;
Compile_JCC ( n, ttt, 0 ) ;
gotoInfo->pb_JmpOffsetPointer = Here - 4 ; // after the call opcode
gotoInfo->GI_CProperty = GI_CALL_LABEL ;
gotoInfo->pb_LabelName = (byte*) _DataStack_Pop () ;
dllist_AddNodeToTail ( _Context_->Compiler0->GotoList, ( dlnode* ) gotoInfo ) ;
}
void
File_Tell ( )
{
FILE * file = ( FILE * ) _DataStack_Pop ( ) ;
int32 result = ftell ( file ) ;
_DataStack_Push ( result ) ;
}
void
CfrTil_Debug_AtAddress ( )
{
byte * address ;
address = ( byte* ) _DataStack_Pop ( ) ;
_CfrTil_Debug_AtAddress ( address ) ;
}
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 ;
}
void
CfrTil_ShiftRight_Equal ( ) // +=
{
if ( GetState( _Context_->Compiler0, BLOCK_MODE ) )
{
Compile_X_Shift ( _Context_->Compiler0, SHR, 0 ) ;
}
else
{
int32 *x, n ;
n = _DataStack_Pop ( ) ;
x = ( int32* ) _DataStack_Pop ( ) ;
*x = * x >> n ;
//_DataStack_SetTop ( Dsp, _DataStack_Pop () + _DataStack_GetTop ( Dsp ) ) ;
}
}
void
CfrTil_Emit ( )
{
int32 c = _DataStack_Pop ( ) ;
if ( ( c >= 0 ) && ( c < 256 ) ) Printf ( ( byte* ) "%c", c ) ;
else Printf ( ( byte* ) "%c", ( ( CString ) c )[0] ) ;
}
void
CfrTil_Namespace_New ( )
{
Namespace * ns = Namespace_FindOrNew_SetUsing ( ( byte* ) _DataStack_Pop ( ), _CfrTil_Namespace_InNamespaceGet ( ), 1 ) ;
_Namespace_DoNamespace ( ns, 1 ) ;
}
void
CfrTil_BitWise_OrEqual ( ) // -=
{
if ( CompileMode )
{
Compile_Group1_X_OpEqual ( _Context_->Compiler0, OR ) ;
}
else
{
int32 *x, n ;
n = _DataStack_Pop ( ) ;
x = ( int32* ) _DataStack_Pop ( ) ;
*x = ( * x ) | n ;
//_DataStack_SetTop ( Dsp, _DataStack_Pop () + _DataStack_GetTop ( Dsp ) ) ;
}
}
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 ) ;
}
}
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 ) ;
}
}
}
void
CfrTil_LogWrite ( )
{
byte * logFilename = ( byte* ) _DataStack_Pop ( ) ;
_Q_->OVT_CfrTil->LogFILE = fopen ( ( char* ) logFilename, "w" ) ;
CfrTil_LogOn ( ) ;
}
void
CfrTil_DivideEqual ( ) // +=
{
if ( CompileMode )
{
Compile_DivideEqual ( _Context_->Compiler0 ) ;
}
else
{
int32 *x, n ;
n = _DataStack_Pop ( ) ;
x = ( int32* ) _DataStack_Pop ( ) ;
*x = * x / n ;
//_DataStack_SetTop ( Dsp, _DataStack_Pop () + _DataStack_GetTop ( Dsp ) ) ;
}
}
void
CfrTil_PrintNReturnStack ( )
{
// Intel SoftwareDevelopersManual-253665.pdf section 6.2 : a push decrements ESP, a pop increments ESP
// therefore TOS is in lower mem addresses, bottom of stack is in higher memory addresses
int32 size = _DataStack_Pop ( ) ;
_CfrTil_PrintNReturnStack ( size ) ;
}
void
CfrTil_Parse ( )
{
Lexer * lexer = _Context_->Lexer0 ;
byte * token = ( byte* ) _DataStack_Pop ( ) ;
Lexer_ParseObject ( lexer, token ) ;
_DataStack_Push ( lexer->Literal ) ;
}
void
CfrTil_MultiplyEqual ( ) // *=
{
if ( CompileMode )
{
Compile_MultiplyEqual ( _Context_->Compiler0 ) ;
}
else
{
int32 *x, n ;
n = _DataStack_Pop ( ) ;
x = ( int32* ) _DataStack_Pop ( ) ;
*x = * x * n ;
//_DataStack_SetTop ( Dsp, _DataStack_Pop () + _DataStack_GetTop ( Dsp ) ) ;
}
}
void
CfrTil_PlusEqual ( ) // +=
{
if ( CompileMode )
{
Compile_Group1_X_OpEqual ( _Context_->Compiler0, ADD ) ;
}
else
{
int32 *x, n ;
n = _DataStack_Pop ( ) ;
x = ( int32* ) _DataStack_Pop ( ) ;
*x = * x + n ;
//_DataStack_SetTop ( Dsp, _DataStack_Pop () + _DataStack_GetTop ( Dsp ) ) ;
}
}
void
CfrTil_Namespace_UsingFirst ( )
{
Namespace * ns = Namespace_Find ( ( byte* ) _DataStack_Pop ( ) ) ;
if ( ns )
{
_Namespace_AddToUsingList ( ns ) ;
}
}
void
CfrTil_Source_AddToHistory ( )
{
Word *word = ( Word* ) _DataStack_Pop ( ) ;
if ( word )
{
_CfrTil_Source ( word, 1 ) ;
}
else CfrTil_Exception ( NOT_A_KNOWN_OBJECT, QUIT ) ;
}
void
CfrTil_TimerInit ( )
{
int32 timer = _DataStack_Pop ( ) ;
if ( timer < 8 )
{
_System_TimerInit ( _Context_->System0, timer ) ;
}
else Throw ( ( byte* ) "Error: timer index must be less than 8", QUIT ) ;
}
void
File_Read ( )
{
int32 size = _DataStack_Pop ( ) ;
byte * ptr = ( byte * ) _DataStack_Pop ( ) ;
FILE * file = ( FILE * ) _DataStack_Pop ( ) ;
int32 result = fread ( ptr, size, 1, file ) ;
_DataStack_Push ( result ) ;
if ( result != size )
{
if ( ! feof ( file ) )
{
if ( ferror ( file ) )
{
perror ( "\nFile_Read error : " ) ;
CfrTil_Quit ( ) ;
}
}
}
}
void
File_Open ( )
{
byte * filename = ( byte* ) _DataStack_Pop ( ) ;
FILE * file = fopen ( ( char* ) filename, "r" ) ;
if ( file == NULL )
{
perror ( "\nFile_Open error : " ) ;
CfrTil_Quit ( ) ;
}
else _DataStack_Push ( ( int32 ) file ) ;
}
void
ilinrec ( block ifBlock, block thenBlock, block else1Block, block else2Block )
{
_Block_Eval ( ifBlock ) ;
if ( _DataStack_Pop ( ) )
{
_Block_Eval ( thenBlock ) ;
}
else
{
_Block_Eval ( else1Block ) ;
D0 ( CfrTil_PrintDataStack ( ) ) ;
ilinrec ( ifBlock, thenBlock, else1Block, else2Block ) ;
_Block_Eval ( else2Block ) ;
}
}
