int32
_OVT_ShowPermanentMemList ( int32 flag )
{
int32 size ;
if ( _Q_ )
{
int32 diff ;
dlnode * node, *nodeNext ;
if ( flag > 1 ) printf ( "\nMemChunk List :: " ) ;
if ( flag ) Printf ( ( byte* ) c_dd ( "\nformat :: Type Name or Chunk Pointer : Type : Size, ...\n" ) ) ;
for ( size = 0, node = dllist_First ( (dllist*) &_Q_->PermanentMemList ) ; node ; node = nodeNext )
{
nodeNext = dlnode_Next ( node ) ;
if ( flag ) MemChunk_Show ( ( MemChunk * ) node ) ;
size += ( ( MemChunk * ) node )->S_ChunkSize ;
}
diff = _Q_->Mmap_TotalMemoryAllocated - size ;
if ( flag )
{
printf ( "\nTotal Size = %9d : _Q_->Mmap_TotalMemoryAllocated = %9d :: diff = %6d", size, _Q_->Mmap_TotalMemoryAllocated, diff ) ;
fflush ( stdout ) ;
}
}
_Q_->PermanentMemListAccounted = size ;
return size ;
}
void
_ShellEscape ( char * str )
{
int returned = system ( str ) ;
if ( _Q_->Verbosity > 1 ) Printf ( c_dd ( "\nCfrTil : system ( \"%s\" ) returned %d.\n" ), str, returned ) ;
D0 ( CfrTil_PrintDataStack ( ) ) ;
Interpreter_SetState ( _Context_->Interpreter0, DONE, true ) ; //
}
void
Namespace_PrettyPrint ( Namespace* ns, int32 indentFlag, int32 indentLevel )
{
if ( indentFlag )
{
Printf ( ( byte* ) "\n" ) ;
while ( indentLevel -- ) Printf ( ( byte* ) "\t" ) ;
}
if ( ns->State & NOT_USING ) Printf ( ( byte* ) " - %s", c_dd ( ns->Name ) ) ;
else Printf ( ( byte* ) " - %s", ns->Name ) ;
_Context_->NsCount ++ ;
}
void
CfrTil_CheckInitDataStack ( )
{
CfrTil_SyncStackPointerFromDsp ( _CfrTil_ ) ;
if ( Stack_Depth ( _DataStack_ ) < 0 )
{
_Stack_PrintHeader ( _DataStack_, "DataStack" ) ;
Printf ( ( byte* ) c_dd( "\nReseting DataStack.\n") ) ;
_CfrTil_DataStack_Init ( _CfrTil_ ) ;
_Stack_PrintHeader ( _DataStack_, "DataStack" ) ;
}
Printf ( ( byte* ) "\n" ) ;
}
int32
_MemList_GetCurrentMemAllocated ( DLList * list, int32 flag )
{
DLNode * node, *nodeNext ;
int32 memAllocated = 0 ;
if ( flag ) Printf ( c_dd ( "\nformat :: Type Name or Chunk Pointer : Type : Size, ...\n" ) ) ;
for ( node = DLList_First ( list ) ; node ; node = nodeNext )
{
MemChunk * mchunk = (MemChunk*) node ;
nodeNext = DLNode_Next ( node ) ;
if ( mchunk->S_ChunkSize )
{
memAllocated += mchunk->S_ChunkSize ;
if ( flag ) _Printf ( "0x%08x : 0x%08llx : %d, ", (uint) mchunk, mchunk->S_AType, mchunk->S_ChunkSize ) ;
}
}
return memAllocated ;
}
void
_CfrTil_Source ( Word *word, int32 addToHistoryFlag )
{
if ( word )
{
char * name = c_dd ( word->Name ) ;
uint64 category = word->CType ;
if ( word->ContainingNamespace ) Printf ( ( byte* ) "\n%s.", word->ContainingNamespace->Name ) ;
if ( category & OBJECT )
{
Printf ( ( byte* ) "%s <:> %s", name, "object" ) ;
}
else if ( category & NAMESPACE )
{
Printf ( ( byte* ) "%s <:> %s", name, "namespace" ) ;
}
else if ( category & TEXT_MACRO )
{
Printf ( ( byte* ) "%s <:> %s", name, "macro" ) ;
}
else if ( category & LOCAL_VARIABLE )
{
Printf ( ( byte* ) "%s <:> %s", name, "local variable" ) ;
}
else if ( category & STACK_VARIABLE )
{
Printf ( ( byte* ) "%s <:> %s", name, "stack variable" ) ;
}
else if ( category & VARIABLE )
{
Printf ( ( byte* ) "%s <:> %s", name, "variable" ) ;
}
else if ( category & CONSTANT )
{
Printf ( ( byte* ) "%s <:> %s", name, "constant" ) ;
}
else if ( category & ALIAS )
{
Word * aword = Word_GetFromCodeAddress_NoAlias ( ( byte* ) ( block ) word->Definition ) ;
if ( aword )
{
Printf ( ( byte* ) "%s alias for %s", name, ( char* ) c_dd ( aword->Name ) ) ;
word = aword ;
}
}
else if ( category & CPRIMITIVE )
{
Printf ( ( byte* ) "%s <:> %s", name, "primitive" ) ;
}
else if ( word->LType & T_LISP_COMPILED_WORD )
{
Printf ( ( byte* ) "%s <:> %s", name, "lambdaCalculus compiled word" ) ;
}
else if ( category & CFRTIL_WORD )
{
Printf ( ( byte* ) "%s <:> %s", name, "cfrTil compiled word" ) ;
}
else if ( word->LType & T_LISP_DEFINE )
{
Printf ( ( byte* ) "%s <:> %s", name, "lambdaCalculus defined word" ) ;
}
else if ( category & BLOCK )
{
Printf ( ( byte* ) "%s <:> %s", name, "cfrTil compiled code block" ) ;
}
// else CfrTil_Exception ( 0, QUIT ) ;
if ( category & INLINE ) Printf ( ( byte* ) ", %s", "inline" ) ;
if ( category & IMMEDIATE ) Printf ( ( byte* ) ", %s", "immediate" ) ;
if ( category & PREFIX ) Printf ( ( byte* ) ", %s", "prefix" ) ;
if ( category & C_PREFIX ) Printf ( ( byte* ) ", %s", "c_prefix" ) ;
if ( category & C_RETURN ) Printf ( ( byte* ) ", %s", "c_return" ) ;
if ( category & INFIXABLE ) Printf ( ( byte* ) ", %s", "infixable" ) ;
if ( category & INFIXABLE ) Printf ( ( byte* ) ", %s", "infixable" ) ;
if ( word->W_pwd_WordData )
{
__Word_ShowSourceCode ( word ) ; // source code has newlines for multiline history
if ( addToHistoryFlag ) _OpenVmTil_AddStringToHistoryList ( word->SourceCode ) ;
if ( word->Filename ) Printf ( ( byte* ) "\nSource code file location of %s : \"%s\" at %d.%d", name, word->Filename, word->LineNumber, word->CursorPosition ) ;
if ( ! ( category & CPRIMITIVE ) ) Printf ( ( byte* ) "\nCompiled with : %s%s%s", GetState ( word, COMPILED_OPTIMIZED ) ? "optimizeOn" : "optimizeOff", GetState ( word, COMPILED_INLINE ) ? ", inlineOn" : ", inlineOff",
GetState (_Context_, C_SYNTAX )? ", c_syntaxOn" : "", GetState (_Context_, INFIX_MODE )? ", infixOn" : "" ) ;
if ( word->S_CodeSize ) Printf ( ( byte* ) " -- starting at address : 0x%x -- code size = %d bytes", word->Definition, word->S_CodeSize ) ;
else Printf ( ( byte* ) " -- starting at address : 0x%x", word->Definition ) ;
}
Printf ( ( byte* ) "\n" ) ;
}
}
void
CfrTil_Namespaces_PrettyPrintTreeWithWords ( )
{
_Context_->NsCount = 0 ;
_Context_->WordCount = 0 ;
SetState ( _Q_->psi_PrintStateInfo, PSI_PROMPT, false ) ;
Printf ( ( byte* ) "%s%s%s%s%s%s%s", "\nNamespaceTree - All Namespaces : ", "using", " : ", c_dd ( "not using" ), " :: ", "with", c_ud ( " : words" ) ) ;
_Namespace_MapAny_2Args ( ( MapSymbolFunction2 ) Symbol_SetNonTREED, 0, 0 ) ;
_Namespace_MapAny_2Args ( ( MapSymbolFunction2 ) Symbol_Namespaces_PrintTraverseWithWords, ( int32 ) _Q_->OVT_CfrTil->Namespaces, 1 ) ;
Printf ( ( byte* ) "\nTotal namespaces = %d :: Total words = %d\n", _Context_->NsCount, _Context_->WordCount ) ;
}