G:/ScriptBasic/source/commands/function.c

Go to the documentation of this file.

/*function.c

--GNU LGPL
This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 2.1 of the License, or (at your option) any later version.

This library is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
Lesser General Public License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

*/


#include <stdlib.h>
#include <stdio.h>

#include "../command.h"

/*POD
=H Function and sub commands

This code implements the start and the end of a function.

When the program execution reaches the code that was generated from the code

=verbatim
     fun(x,y,z)     
=noverbatim

if saves some of the state variables, like the function result pointer, local variable pointer,
program counter, error resume and erroro goto values. The function evaluation does NOT allocate
local variables, and does not evaluate the function arguments. Instead it calls the executor
function recursively to perform execution starting at the node, which was generated from

=verbatim
        FUNCTION fname(a,b,c)
=noverbatim

The code of the command should evaluate the arguments (it gets the expression list node in a
class variable), and should allocate the local variables and put the values into the local
variables.

Note that the implementation of the command T<FUNCTION> is very sophisticated, and uses many
features of the execution system, which is usually not needed by other commands. Note that for this
reasons it accesses variables directly without using the hiding macros supplied via T<command.c>

The code implementing T<FUNCTION> should access the global variables, the local variables
of the caller and the local variables of the just starting function, at the same time.

Also note that the parameter evaluation is special. It first checks the expression. If this is a normal,
compound expression it does evaluate it the normal way and puts the result to the respective local variable.
However if the expression is a variable then it generates a referring variable. Whenever value is assigned to
a variable that holds a referring value the instruction T<LET> searches for the referred variable and the
assignment is done using that variable.

This means that all variables are passed by reference. If you want to pass a variable by value you should
apply some tricks, like:

=verbatim
a=1
call f(a+0)
print a
print
call f(a)
print a
print
function f(x)
 x=x+1
end function
=noverbatim

CUT*/

COMMAND(FUNCTION)
#if NOTIMP_FUNCTION
NOTIMPLEMENTED;
#else

  IDENTICAL_COMMAND(FUNCTIONARG)

#endif
END

/*POD
=section FUNCTIONARG
=H FUNCTIONARG

This command implements the function head.

CUT*/
void COMMAND_FUNCTIONARG(pExecuteObject pEo
  ){
#if NOTIMP_FUNCTIONARG
NOTIMPLEMENTED;
#else
  MortalList _ThisCommandMortals=NULL;
  pMortalList _pThisCommandMortals = &_ThisCommandMortals;
  unsigned long _ActualNode=pEo->ProgramCounter;
  int iErrorCode;
  NODE nItem,nExpression;
  unsigned long i;
  unsigned long NumberOfArguments;
  long Opcode;
  pFixSizeMemoryObject ItemResult;

/* note that this code should allocate and put values into the function local variables, but
   should evaluate expressions and code using the caller local variables. Therefore we store
   the caller local variables pointer in CallerLocalVariables and whenever we need a call
   using the caller local variables we swap the two pointers for the shortest time possible.
*/
  pFixSizeMemoryObject CallerLocalVariables,SwapLVP;
/* This macro is used to maintain readability when the variables are swapped. */
#define NewFunLocalVariables CallerLocalVariables
#define SWAP_LOCAL_VARIABLES SwapLVP = CallerLocalVariables; \
                             CallerLocalVariables = pEo->LocalVariables;\
                             pEo->LocalVariables = SwapLVP;

  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->fWeAreCallingFuction ){
    SETPROGRAMCOUNTER(CDR(nItem));
    return;
    }

  CallerLocalVariables = pEo->LocalVariables;
  if( pEo->cLocalVariables ){
    pEo->LocalVariables = memory_NewArray(pEo->pMo,1,pEo->cLocalVariables);
    if( pEo->LocalVariables == NULL ){
      pEo->fStop = fStopSTOP;
      return;
      }
    }else pEo->LocalVariables = NULL; /* it should have been null anyway */

  nItem = pEo->FunctionArgumentsNode;
  i = 0;
  while( nItem ){
    i++ ;
    nExpression = CAR(nItem);
    switch( OPCODE(nExpression) ){

      case eNTYPE_ARR:
        SWAP_LOCAL_VARIABLES;
        if( i <= NumberOfArguments ){
          NewFunLocalVariables->Value.aValue[i-1] = memory_NewRef(pEo->pMo);
          memory_SetRef(pEo->pMo,NewFunLocalVariables->Value.aValue+i-1,execute_LeftValueArray(pEo,nExpression,_pThisCommandMortals,&iErrorCode));
          }else execute_LeftValueArray(pEo,nExpression,_pThisCommandMortals,&iErrorCode);
        SWAP_LOCAL_VARIABLES;
        break;

      case eNTYPE_SAR:
        SWAP_LOCAL_VARIABLES;
        if( i <= NumberOfArguments ){
          NewFunLocalVariables->Value.aValue[i-1] = memory_NewRef(pEo->pMo);
          memory_SetRef(pEo->pMo,NewFunLocalVariables->Value.aValue+i-1,execute_LeftValueSarray(pEo,nExpression,_pThisCommandMortals,&iErrorCode));
          }else execute_LeftValueSarray(pEo,nExpression,_pThisCommandMortals,&iErrorCode);
        SWAP_LOCAL_VARIABLES;
        break;

      case eNTYPE_LVR:
        SWAP_LOCAL_VARIABLES;
        if( i <= NumberOfArguments ){
          NewFunLocalVariables->Value.aValue[i-1] = memory_NewRef(pEo->pMo);
          memory_SetRef(pEo->pMo,NewFunLocalVariables->Value.aValue+i-1,&(pEo->LocalVariables->Value.aValue[pEo->CommandArray[nExpression-1].Parameter.Variable.Serial-1]));
          }
        SWAP_LOCAL_VARIABLES;
        break;

      case eNTYPE_GVR:
        if( i <= NumberOfArguments ){
          pEo->LocalVariables->Value.aValue[i-1] = memory_NewRef(pEo->pMo);
          memory_SetRef(pEo->pMo,pEo->LocalVariables->Value.aValue+i-1,&(pEo->GlobalVariables->Value.aValue[pEo->CommandArray[nExpression-1].Parameter.Variable.Serial-1]));
          }
        break;

      default:
        SWAP_LOCAL_VARIABLES;
        ItemResult = EVALUATEEXPRESSION(nExpression);
        SWAP_LOCAL_VARIABLES;
        ASSERTOKE;
        if( ItemResult)
          memory_Immortalize(ItemResult,_pThisCommandMortals);
        if( i <= NumberOfArguments )
          pEo->LocalVariables->Value.aValue[i-1] = ItemResult;
        break;
      }

    nItem = CDR(nItem);
    }

  memory_ReleaseMortals(pEo->pMo,&_ThisCommandMortals);
  /* and finally we start to execute the function when executing the next command */
  pEo->lFunctionLevel++;
  /* some macros need this label */
#endif
_FunctionFinishLabel: ;
  }

/*

This structure is used to maintain the return gosub stack. This structure
becomes empty when there is no any GOSUB/RETURN pairs pending. If some
of the GOSUB-s did not return when the code finishes the memory is released
when the segment is released. We do leak here memory at this level, because
upper levels release this memory before exiting the interpreter.

*/
typedef struct _GosubStack {
  struct _GosubStack *next;
  long lFunctionLevel;
  NODE nReturnNode;
  } GosubStack , *pGosubStack;

#define GosubStackRoot ((pGosubStack)PARAMPTR(CMD_GOSUB))

COMMAND(GOSUB)
#if NOTIMP_GOSUB
NOTIMPLEMENTED;
#else

  pGosubStack pGSS;

  pGSS = ALLOC(sizeof(GosubStack));
  if( pGSS == NULL )ERROR(COMMAND_ERROR_MEMORY_LOW);
  pGSS->lFunctionLevel = pEo->lFunctionLevel;
  pGSS->nReturnNode = pEo->CommandArray[pEo->ProgramCounter-1].Parameter.NodeList.rest;
  pGSS->next = GosubStackRoot;
  GosubStackRoot = pGSS;
  SETPROGRAMCOUNTER(PARAMETERNODE);

#endif
END

COMMAND(RETURNC)
#if NOTIMP_RETURNC
NOTIMPLEMENTED;
#else

  pGosubStack pGSS;

  pGSS = GosubStackRoot;
  if( pGSS == NULL || pGSS->lFunctionLevel < pEo->lFunctionLevel )ERROR(COMMAND_ERROR_RETURN_WITHOUT_GOSUB);
  GosubStackRoot = GosubStackRoot->next;
  SETPROGRAMCOUNTER(pGSS->nReturnNode);
  FREE(pGSS);
#endif
END

COMMAND(POP)
#if NOTIMP_POP
NOTIMPLEMENTED;
#else

  pGosubStack pGSS;

  pGSS = GosubStackRoot;
  if( pGSS == NULL || pGSS->lFunctionLevel < pEo->lFunctionLevel )ERROR(COMMAND_ERROR_RETURN_WITHOUT_GOSUB);
  GosubStackRoot = GosubStackRoot->next;
  /* this is what POP does not do as opposed to RETURN */
/*SETPROGRAMCOUNTER(pGSS->nReturnNode);*/
  FREE(pGSS);
#endif
END

COMMAND(EXITFUNC)
#if NOTIMP_EXITFUNC
NOTIMPLEMENTED;
#else

  pGosubStack pGSS;

  /* step back the function level because we are leaving the function */
  pEo->lFunctionLevel--;

  /* clean up the gosub stack */
  pGSS = GosubStackRoot;
  while( pGSS && pGSS->lFunctionLevel > pEo->lFunctionLevel ){
    GosubStackRoot = GosubStackRoot->next;
    FREE(pGSS);
    pGSS = GosubStackRoot;
    }
  pEo->fStop = fStopRETURN;
  
#endif
END

COMMAND(ENDFUNC)
#if NOTIMP_ENDFUNC
NOTIMPLEMENTED;
#else

  IDENTICAL_COMMAND(EXITFUNC)
  
#endif
END

COMMAND(FLET)
#if NOTIMP_FLET
NOTIMPLEMENTED;
#else


  VARIABLE ItemResult;

  /* here we get a mortal value as result. This should be mortal, because it is immortalized and
     the code later assumes that this is an immortal memory piece that is assigned only to this
     "variable"
  */
  ItemResult = _EVALUATEEXPRESSION_A(PARAMETERNODE);
  ASSERTOKE;

  if( ItemResult && TYPE(ItemResult) == VTYPE_ARRAY )ERROR(COMMAND_ERROR_NOARRAY);

  ItemResult = memory_DupMortalize(pEo->pMo,ItemResult,_pThisCommandMortals,&iErrorCode);

  if( pEo->pFunctionResult )
    memory_ReleaseVariable(pEo->pMo,pEo->pFunctionResult);
  if( ItemResult )IMMORTALIZE(ItemResult);
  pEo->pFunctionResult = ItemResult;

#endif
END

COMMAND(ADDRESSF)
#if NOTIMP_ADDRESSF
NOTIMPLEMENTED;
#else

  NODE z;

  USE_CALLER_MORTALS;
  z = PARAMETERLIST;

  if( OPCODE(CAR(z)) != eNTYPE_FUN )ERROR(COMMAND_ERROR_INVALID_ARGUMENT_FOR_FUNCTION_ADDRESS);

  RESULT = NEWMORTALLONG;
  ASSERTNULL(RESULT)
  LONGVALUE(RESULT) = CAR(pEo->CommandArray[z-1].Parameter.UserFunction.NodeId);

#endif
END

COMMAND(ICALLFUN)
#if NOTIMP_ICALLFUN
NOTIMPLEMENTED;
#else

  NODE nItem;
  VARIABLE ItemResult;
  pFixSizeMemoryObject ThisFunctionResultPointer;
  unsigned long SaveProgramCounter,SaveStepCounter;
  unsigned long SavefErrorGoto,SaveErrorGoto,SaveErrorResume;
  pFixSizeMemoryObject SaveLocalVariablesPointer;
  pFixSizeMemoryObject SaveFunctionResultPointer;
  long CommandOpCode;

  USE_CALLER_MORTALS;

  if( pEo->FunctionLevelLimit && pEo->lFunctionLevel > pEo->FunctionLevelLimit )
    ERROR(EXE_ERROR_TOO_DEEP_CALL);

  SaveLocalVariablesPointer = pEo->LocalVariables;
  SaveProgramCounter = pEo->ProgramCounter;

  nItem = PARAMETERLIST;
  ItemResult = CONVERT2LONG(EVALUATEEXPRESSION(CAR(nItem)));
  ASSERTOKE;
  pEo->ProgramCounter = LONGVALUE(ItemResult);

  CommandOpCode = pEo->CommandArray[pEo->CommandArray[pEo->ProgramCounter-1].Parameter.NodeList.actualm-1].OpCode;
  if( CommandOpCode < START_CMD || CommandOpCode > END_CMD ){
    ERROR(EXE_ERROR_USERFUN_UNDEFINED);
    }
  if( CommandOpCode != CMD_FUNCTION &&
      CommandOpCode != CMD_FUNCTIONARG &&
      CommandOpCode != CMD_SUB &&
      CommandOpCode != CMD_SUBARG ){
    ERROR(EXE_ERROR_USERFUN_UNDEFINED);
    }

  pEo->FunctionArgumentsNode = CDR(nItem);
  SaveFunctionResultPointer = pEo->pFunctionResult;
  pEo->pFunctionResult = NULL;
  SaveStepCounter = pEo->lStepCounter;
  pEo->lStepCounter = 0;
  pEo->fWeAreCallingFuction = 1;
  SaveErrorGoto = pEo->ErrorGoto;
  pEo->ErrorGoto = 0;
  SaveErrorResume = pEo->ErrorResume;
  pEo->ErrorResume = 0;
  SavefErrorGoto = pEo->fErrorGoto;
  pEo->fErrorGoto = ONERROR_NOTHING;
  if( pEo->pHookers->HOOK_ExecCall && 
      (iErrorCode = pEo->pHookers->HOOK_ExecCall(pEo)) )
    ERROR(iErrorCode);
  /* function entering code needs access to the caller local variables, therefore
     WE SHOULD NOT NULL pEo->LocalVariables */
  execute_Execute_r(pEo,&iErrorCode);
  if( pEo->pHookers->HOOK_ExecReturn &&
      (iErrorCode = pEo->pHookers->HOOK_ExecReturn(pEo)) )
    ERROR(iErrorCode);

  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;
  ThisFunctionResultPointer = pEo->pFunctionResult;
  pEo->pFunctionResult = SaveFunctionResultPointer;
  /* Functions return their value as immortal values assigned to the very global
     variable pEo->pFunctionResult. Here this variable is restored to point to the
     saved value and the value returned should be mortalized.                   */
  if( ThisFunctionResultPointer && ! IsMortal(ThisFunctionResultPointer) )
    memory_Mortalize(ThisFunctionResultPointer,_pThisCommandMortals);

  pEo->ErrorGoto = SaveErrorGoto;
  pEo->fErrorGoto = SavefErrorGoto;
  pEo->ErrorResume = SaveErrorResume;
  if( iErrorCode )ERROR(iErrorCode);

  RESULT = ThisFunctionResultPointer;
#endif
END

COMMAND(ICALL)
#if NOTIMP_ICALL
NOTIMPLEMENTED;
#else

  VARIABLE ItemResult;
  unsigned long SaveProgramCounter,SaveStepCounter;
  unsigned long SavefErrorGoto,SaveErrorGoto,SaveErrorResume;
  pFixSizeMemoryObject SaveLocalVariablesPointer;
  pFixSizeMemoryObject SaveFunctionResultPointer;
  long CommandOpCode;

  if( pEo->FunctionLevelLimit && pEo->lFunctionLevel > pEo->FunctionLevelLimit )
    ERROR(EXE_ERROR_TOO_DEEP_CALL);

  SaveLocalVariablesPointer = pEo->LocalVariables;
  SaveProgramCounter = pEo->ProgramCounter;

  ItemResult = EVALUATEEXPRESSION(CAR(PARAMETERNODE));
  ASSERTOKE;
  pEo->ProgramCounter = GETLONGVALUE(ItemResult);

  CommandOpCode = pEo->CommandArray[pEo->CommandArray[pEo->ProgramCounter-1].Parameter.NodeList.actualm-1].OpCode;
  if( CommandOpCode < START_CMD || CommandOpCode > END_CMD ){
    ERROR(EXE_ERROR_USERFUN_UNDEFINED);
    }
  if( CommandOpCode != CMD_FUNCTION &&
      CommandOpCode != CMD_FUNCTIONARG &&
      CommandOpCode != CMD_SUB &&
      CommandOpCode != CMD_SUBARG ){
    ERROR(EXE_ERROR_USERFUN_UNDEFINED);
    }

  pEo->FunctionArgumentsNode = CDR(PARAMETERNODE);
  SaveFunctionResultPointer = pEo->pFunctionResult;
  pEo->pFunctionResult = NULL;
  SaveStepCounter = pEo->lStepCounter;
  pEo->lStepCounter = 0;
  pEo->fWeAreCallingFuction = 1;
  SaveErrorGoto = pEo->ErrorGoto;
  pEo->ErrorGoto = 0;
  SaveErrorResume = pEo->ErrorResume;
  pEo->ErrorResume = 0;
  SavefErrorGoto = pEo->fErrorGoto;
  pEo->fErrorGoto = ONERROR_NOTHING;
  if( pEo->pHookers->HOOK_ExecCall && 
      (iErrorCode = pEo->pHookers->HOOK_ExecCall(pEo)) )
    ERROR(iErrorCode);
  /* function entering code needs access to the caller local variables, therefore
     WE SHOULD NOT NULL pEo->LocalVariables */
  execute_Execute_r(pEo,&iErrorCode);
  if( pEo->pHookers->HOOK_ExecReturn &&
      (iErrorCode = pEo->pHookers->HOOK_ExecReturn(pEo)) )
    ERROR(iErrorCode);

  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;
  memory_ReleaseVariable(pEo->pMo,pEo->pFunctionResult);
  pEo->pFunctionResult = SaveFunctionResultPointer;

  pEo->ErrorGoto = SaveErrorGoto;
  pEo->fErrorGoto = SavefErrorGoto;
  pEo->ErrorResume = SaveErrorResume;
  if( iErrorCode )ERROR(iErrorCode);

#endif
END

COMMAND(CALL)
#if NOTIMP_CALL
NOTIMPLEMENTED;
#else


  _EVALUATEEXPRESSION(PARAMETERNODE);
  ASSERTOKE;

#endif
END

COMMAND(SUB)
#if NOTIMP_SUB
NOTIMPLEMENTED;
#else

  IDENTICAL_COMMAND(FUNCTIONARG)

#endif
END

/*POD
=section SUBARG
=H SUBARG

Same as R<FUNCTIONARG>

CUT*/
COMMAND(SUBARG)
#if NOTIMP_SUBARG
NOTIMPLEMENTED;
#else

  IDENTICAL_COMMAND(FUNCTIONARG)

#endif
END


COMMAND(EXITSUB)
#if NOTIMP_EXITSUB
NOTIMPLEMENTED;
#else

  IDENTICAL_COMMAND(EXITFUNC)

#endif
END


COMMAND(ENDSUB)
#if NOTIMP_ENDSUB
NOTIMPLEMENTED;
#else

  IDENTICAL_COMMAND(EXITFUNC)

#endif
END

---