/*FUNCTION*/
void memory_ReleaseMortals(pMemoryObject pMo,
pMortalList pMortal
){
/*noverbatim
CUT*/
MortalList p;
if( pMortal == NULL )return; /* this is to help lasy callers */
while( p=*pMortal ){
*pMortal = p->next;
memory_ReleaseVariable(pMo,p);
}
*pMortal = NULL;
}
/*FUNCTION*/
int memory_ReplaceVariable(pMemoryObject pMo,
pFixSizeMemoryObject *Lval,
pFixSizeMemoryObject NewValue,
pMortalList pMortal,
int iDupFlag
){
/*noverbatim
CUT*/
int iErrorCode;
iErrorCode = 0;
/* This is quite common that a variable is used to hold the same type of value. Changing the value
only and not allocating a new variable and releasing the old speeds up execution a bit. I could
see some speed improvement when running the program mandel1.bas */
if( memory_IsUndef(*Lval) && memory_IsUndef(NewValue) )return COMMAND_ERROR_SUCCESS;
if( *Lval && NewValue ){
if( NewValue->vType == VTYPE_LONG && (*Lval)->vType == VTYPE_LONG ){
LONGVALUE(*Lval) = LONGVALUE(NewValue);
return COMMAND_ERROR_SUCCESS;
}
if( NewValue->vType == VTYPE_DOUBLE && (*Lval)->vType == VTYPE_DOUBLE ){
DOUBLEVALUE(*Lval) = DOUBLEVALUE(NewValue);
return COMMAND_ERROR_SUCCESS;
}
}
/* after the references have been looked after we duplicate the result to have an own copy of the value. */
if( NewValue && iDupFlag ){
NewValue = memory_DupMortalize(pMo,NewValue,pMortal,&iErrorCode);
if( iErrorCode )return iErrorCode;
}
/* if the result of the expression is not undef then immortalize */
if( NewValue )
/* we immortalize the new variable if it is a variable and not NULL meaning undef */
memory_Immortalize(NewValue,pMortal);
/* if there are other variables that reference this variable and the value is undef then we need a
stored undef */
if( *Lval && (*Lval)->link.rprev && NewValue == NULL )NewValue = memory_NewUndef(pMo);
/* The new value will hold the same reference information as the former value.
The former on the other hand is going to be unhooked. */
if( *Lval && (*Lval)->link.rprev ){
NewValue->link.rprev = (*Lval)->link.rprev;
if( NewValue->link.rprev )(*(NewValue->link.rprev))->next = NewValue;
(*Lval)->link.rprev = NULL;
NewValue->next = (*Lval)->next;
(*Lval)->next = NULL;
}
/* if this variable had value assigned to it then release that value */
if( *Lval )memory_ReleaseVariable(pMo,*Lval);
/* and finally assign the code to the variable */
*Lval = NewValue;
return COMMAND_ERROR_SUCCESS;
}
/*FUNCTION*/
int memory_ReleaseVariable(pMemoryObject pMo,
pFixSizeMemoryObject p
){
/*noverbatim
CUT*/
long i;
int atype; /* from which we allocate */
pFixSizeMemoryObject *pRefHead,*pRef,pSwap;
#ifdef _DEBUG
pFixSizeMemoryObject q;
static int dbgc=0;
#endif
/* ease the life of caller if it does not check that the value is undef. */
if( p == NULL )return 0;
#ifdef _DEBUG
if( p->sType != LARGE_BLOCK_TYPE ){
q = pMo->MemoryObjectsFreeList[p->sType];
while( q ){
if( q == p ){
printf("A released memory location is rereleased.\n");
exit(666);
}
q = q->next;
}
}
#endif
/* if there is any variable referring to this value then we need this value
we will swap the two variables. */
if( p->State == STATE_IMMORTAL && p->link.rprev && p->vType != VTYPE_REF){
/* change the two variables so that the variable being released will point to
the REF structure and the first in the list referring to this variable will point
to the actual value. */
pRefHead = p->link.rprev;
/* save this pointer, we will need it after the swap */
pRef = (*pRefHead)->link.rprev;
/* perform the swapping and the REF variable will be released (but w/o unlinking!!!!)*/
pSwap = p;
p = *pRefHead;
*pRefHead = pSwap;
/* The value should start the link correctly, instead of pointing to itself. Before the swap
the pointer (pRefHead)->link.rprev pointed to the second element (or NULL). This pointer is
in p->link.rprev after the swap. This has to be placed "back" to the structure pointed by
*pRefHead */
(*pRefHead)->link.rprev = pRef;
/* this is not a reference anymore thus there is no next anymore */
(*pRefHead)->next = NULL;
if( pRef )(*pRef)->next = *pRefHead;
/* alter all other references so that they reference the new head */
while( pRef ){
(*pRef)->Value.aValue = pRefHead;
pRef = (*pRef)->link.rprev;
}
}else{/* if a reference variable is deleted then we have to unlink it
but this is an "else" branch and we do not perform this unlinking when
releasing a reference variable that was released because it was swapped
with a non-ref variable Such a ref variable is released the normal way
just as if it was a long. */
if( p->State == STATE_IMMORTAL && p->vType == VTYPE_REF ){
if( p->next )
p->next->link.rprev = p->link.rprev;
if( p->link.rprev )
(*(p->link.rprev))->next = p->next;
p->link.rprev = NULL;
p->next = NULL;
}
}
/* if the variable is an array then all the elements should be released */
if( p->vType == VTYPE_ARRAY ){
for( i = p->ArrayLowLimit ; i<= p->ArrayHighLimit ; i++ )
if( p->Value.aValue[i - p->ArrayLowLimit] )
memory_ReleaseVariable(pMo,p->Value.aValue[i - p->ArrayLowLimit]);
}
/* if it is a large block, then release it */
if( p->sType == LARGE_BLOCK_TYPE ){
if( p->Value.pValue )
alloc_Free(p->Value.pValue,pMo->pMemorySegment);
alloc_Free(p,pMo->pMemorySegment);
return 0;
}
/* if the type is so that it does not use extra memory to store the value, like
long, double or constant string then use only one list. No matter which, but
only one. */
if( p->sType < MAX_FIX_TYPE )
atype = FIX_TYPE_ALLOC;
else
atype = p->sType;
/* link the item into the free list */
p->next = pMo->MemoryObjectsFreeList[atype];
p->link.prev = NULL;
if( p->next )
p->next->link.prev = p;
p->State = STATE_FREE;
pMo->MemoryObjectsFreeList[atype] = p;
return 0;
}
/*FUNCTION*/
int hook_CallScribaFunction(pExecuteObject pEo,
unsigned long lStartNode,
pFixSizeMemoryObject *pArgument,
unsigned long NumberOfPassedArguments,
pFixSizeMemoryObject *pFunctionResult
){
/*noverbatim
CUT*/
int iError;
unsigned long SaveProgramCounter,SaveStepCounter;
unsigned long SavefErrorGoto,SaveErrorGoto,SaveErrorResume;
pFixSizeMemoryObject SaveLocalVariablesPointer;
pFixSizeMemoryObject SaveFunctionResultPointer;
MortalList _ThisCommandMortals=NULL;
pMortalList _pThisCommandMortals = &_ThisCommandMortals;
unsigned long _ActualNode=pEo->ProgramCounter;
int iErrorCode;
NODE nItem;
unsigned long i;
unsigned long NumberOfArguments;
long Opcode;
SaveLocalVariablesPointer = pEo->LocalVariables;
SaveProgramCounter = pEo->ProgramCounter;
pEo->ProgramCounter = lStartNode;
if( pEo->ProgramCounter == 0 )return EXE_ERROR_USERFUN_UNDEFINED;
SaveFunctionResultPointer = pEo->pFunctionResult;
pEo->pFunctionResult = NULL;
SaveStepCounter = pEo->lStepCounter;
pEo->lStepCounter = 0;
SaveErrorGoto = pEo->ErrorGoto;
pEo->ErrorGoto = 0;
SaveErrorResume = pEo->ErrorResume;
pEo->ErrorResume = 0;
SavefErrorGoto = pEo->fErrorGoto;
pEo->fErrorGoto = ONERROR_NOTHING;
nItem = pEo->CommandArray[pEo->ProgramCounter-1].Parameter.NodeList.actualm ;
Opcode = pEo->CommandArray[nItem-1].OpCode;
pEo->cLocalVariables = pEo->CommandArray[nItem-1].Parameter.CommandArgument.Argument.lLongValue;
nItem = pEo->CommandArray[nItem-1].Parameter.CommandArgument.next;
NumberOfArguments = pEo->CommandArray[nItem-1].Parameter.CommandArgument.Argument.lLongValue;
nItem = pEo->CommandArray[nItem-1].Parameter.CommandArgument.next;
nItem = pEo->CommandArray[nItem-1].Parameter.CommandArgument.Argument.lLongValue;
if( pEo->cLocalVariables ){
pEo->LocalVariables = memory_NewArray(pEo->pMo,1,pEo->cLocalVariables);
if( pEo->LocalVariables == NULL )return COMMAND_ERROR_MEMORY_LOW;
}else pEo->LocalVariables = NULL; /* it should have been null anyway */
for( i=0 ; pArgument && i < NumberOfPassedArguments && i < NumberOfArguments ; i++ ){
pEo->LocalVariables->Value.aValue[i]
= memory_DupVar(pEo->pMo,
pArgument[i],
_pThisCommandMortals,
&iError);
if( iError )return iError;
}
while( i < (unsigned)pEo->cLocalVariables ){
pEo->LocalVariables->Value.aValue[i] = NULL;
i++;
}
/* and finally we start to execute the function when executing the next command */
pEo->lFunctionLevel++;
/* some macros need this label */
// _FunctionFinishLabel: ;
pEo->ProgramCounter = pEo->CommandArray[pEo->ProgramCounter-1].Parameter.NodeList.rest;
execute_Execute_r(pEo,&iErrorCode);
/* restore variables */
pEo->lStepCounter = SaveStepCounter;
if( pEo->LocalVariables )/* this is null if the function did not have arguments and no local variables */
memory_ReleaseVariable(pEo->pMo,pEo->LocalVariables);
pEo->ProgramCounter = SaveProgramCounter;
pEo->LocalVariables = SaveLocalVariablesPointer;
(*pFunctionResult) = pEo->pFunctionResult;
pEo->pFunctionResult = SaveFunctionResultPointer;
pEo->ErrorGoto = SaveErrorGoto;
pEo->fErrorGoto = SavefErrorGoto;
pEo->ErrorResume = SaveErrorResume;
return iErrorCode;
}
