src/clipsrules/core/dffnxfun.c Source File

00001    /*******************************************************/
00002    /*      "C" Language Integrated Production System      */
00003    /*                                                     */
00004    /*             CLIPS Version 6.24  06/02/06            */
00005    /*                                                     */
00006    /*                 DEFFUNCTION MODULE                  */
00007    /*******************************************************/
00008 
00009 /*************************************************************/
00010 /* Purpose:                                                  */
00011 /*                                                           */
00012 /* Principal Programmer(s):                                  */
00013 /*      Brian L. Dantes                                      */
00014 /*                                                           */
00015 /* Contributing Programmer(s):                               */
00016 /*      Gary D. Riley                                        */
00017 /*                                                           */
00018 /* Revision History:                                         */
00019 /*      6.23: Correction for FalseSymbol/TrueSymbol. DR0859  */
00020 /*                                                           */
00021 /*            Corrected compilation errors for files         */
00022 /*            generated by constructs-to-c. DR0861           */
00023 /*                                                           */
00024 /*            Changed name of variable log to logName        */
00025 /*            because of Unix compiler warnings of shadowed  */
00026 /*            definitions.                                   */
00027 /*                                                           */
00028 /*      6.24: Renamed BOOLEAN macro type to intBool.         */
00029 /*                                                           */
00030 /*            Corrected code to remove run-time program      */
00031 /*            compiler warning.                              */
00032 /*                                                           */
00033 /*************************************************************/
00034 
00035 /* =========================================
00036    *****************************************
00037                EXTERNAL DEFINITIONS
00038    =========================================
00039    ***************************************** */
00040 #include "setup.h"
00041 
00042 #if DEFFUNCTION_CONSTRUCT
00043 
00044 #if (BLOAD || BLOAD_ONLY || BLOAD_AND_BSAVE)
00045 #include "bload.h"
00046 #include "dffnxbin.h"
00047 #endif
00048 
00049 #if CONSTRUCT_COMPILER && (! RUN_TIME)
00050 #include "dffnxcmp.h"
00051 #endif
00052 
00053 #if (! BLOAD_ONLY) && (! RUN_TIME)
00054 #include "constrct.h"
00055 #include "cstrcpsr.h"
00056 #include "dffnxpsr.h"
00057 #include "modulpsr.h"
00058 #endif
00059 
00060 #include "envrnmnt.h"
00061 
00062 #if (! RUN_TIME)
00063 #include "extnfunc.h"
00064 #endif
00065 
00066 #include "dffnxexe.h"
00067 
00068 #if DEBUGGING_FUNCTIONS
00069 #include "watch.h"
00070 #endif
00071 
00072 #include "argacces.h"
00073 #include "memalloc.h"
00074 #include "cstrccom.h"
00075 #include "router.h"
00076 
00077 #define _DFFNXFUN_SOURCE_
00078 #include "dffnxfun.h"
00079 
00080 /* =========================================
00081    *****************************************
00082       INTERNALLY VISIBLE FUNCTION HEADERS
00083    =========================================
00084    ***************************************** */
00085 
00086 static void PrintDeffunctionCall(void *,char *,void *);
00087 static intBool EvaluateDeffunctionCall(void *,void *,DATA_OBJECT *);
00088 static void DecrementDeffunctionBusyCount(void *,void *);
00089 static void IncrementDeffunctionBusyCount(void *,void *);
00090 static void DeallocateDeffunctionData(void *);
00091 
00092 #if ! RUN_TIME
00093 static void DestroyDeffunctionAction(void *,struct constructHeader *,void *);
00094 static void *AllocateModule(void *);
00095 static void  ReturnModule(void *,void *);
00096 static intBool ClearDeffunctionsReady(void *);
00097 #endif
00098 
00099 #if (! BLOAD_ONLY) && (! RUN_TIME)
00100 static intBool RemoveAllDeffunctions(void *);
00101 static void DeffunctionDeleteError(void *,char *);
00102 static void SaveDeffunctionHeaders(void *,void *,char *);
00103 static void SaveDeffunctionHeader(void *,struct constructHeader *,void *);
00104 static void SaveDeffunctions(void *,void *,char *);
00105 #endif
00106 
00107 #if DEBUGGING_FUNCTIONS
00108 static unsigned DeffunctionWatchAccess(void *,int,unsigned,EXPRESSION *);
00109 static unsigned DeffunctionWatchPrint(void *,char *,int,EXPRESSION *);
00110 #endif
00111 
00112 /* =========================================
00113    *****************************************
00114           EXTERNALLY VISIBLE FUNCTIONS
00115    =========================================
00116    ***************************************** */
00117 
00118 /***************************************************
00119   NAME         : SetupDeffunctions
00120   DESCRIPTION  : Initializes parsers and access
00121                  functions for deffunctions
00122   INPUTS       : None
00123   RETURNS      : Nothing useful
00124   SIDE EFFECTS : Deffunction environment initialized
00125   NOTES        : None
00126  ***************************************************/
00127 globle void SetupDeffunctions(
00128   void *theEnv)
00129   {
00130    ENTITY_RECORD deffunctionEntityRecord =
00131                      { "PCALL", PCALL,0,0,1,
00132                        PrintDeffunctionCall,PrintDeffunctionCall,
00133                        NULL,EvaluateDeffunctionCall,NULL,
00134                        DecrementDeffunctionBusyCount,IncrementDeffunctionBusyCount,
00135                        NULL,NULL,NULL,NULL,NULL };
00136 
00137    AllocateEnvironmentData(theEnv,DEFFUNCTION_DATA,sizeof(struct deffunctionData),DeallocateDeffunctionData);
00138    memcpy(&DeffunctionData(theEnv)->DeffunctionEntityRecord,&deffunctionEntityRecord,sizeof(struct entityRecord));   
00139 
00140    InstallPrimitive(theEnv,&DeffunctionData(theEnv)->DeffunctionEntityRecord,PCALL);
00141 
00142    DeffunctionData(theEnv)->DeffunctionModuleIndex =
00143                 RegisterModuleItem(theEnv,"deffunction",
00144 #if (! RUN_TIME)
00145                                     AllocateModule,ReturnModule,
00146 #else
00147                                     NULL,NULL,
00148 #endif
00149 #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
00150                                     BloadDeffunctionModuleReference,
00151 #else
00152                                     NULL,
00153 #endif
00154 #if CONSTRUCT_COMPILER && (! RUN_TIME)
00155                                     DeffunctionCModuleReference,
00156 #else
00157                                     NULL,
00158 #endif
00159                                     EnvFindDeffunction);
00160 
00161    DeffunctionData(theEnv)->DeffunctionConstruct = AddConstruct(theEnv,"deffunction","deffunctions",
00162 #if (! BLOAD_ONLY) && (! RUN_TIME)
00163                                        ParseDeffunction,
00164 #else
00165                                        NULL,
00166 #endif
00167                                        EnvFindDeffunction,
00168                                        GetConstructNamePointer,GetConstructPPForm,
00169                                        GetConstructModuleItem,EnvGetNextDeffunction,
00170                                        SetNextConstruct,EnvIsDeffunctionDeletable,
00171                                        EnvUndeffunction,
00172 #if (! BLOAD_ONLY) && (! RUN_TIME)
00173                                        RemoveDeffunction
00174 #else
00175                                        NULL
00176 #endif
00177                                        );
00178 #if ! RUN_TIME
00179    AddClearReadyFunction(theEnv,"deffunction",ClearDeffunctionsReady,0);
00180 
00181 #if ! BLOAD_ONLY
00182 #if DEFMODULE_CONSTRUCT
00183    AddPortConstructItem(theEnv,"deffunction",SYMBOL);
00184 #endif
00185    AddSaveFunction(theEnv,"deffunction-headers",SaveDeffunctionHeaders,1000);
00186    AddSaveFunction(theEnv,"deffunctions",SaveDeffunctions,0);
00187    EnvDefineFunction2(theEnv,"undeffunction",'v',PTIEF UndeffunctionCommand,"UndeffunctionCommand","11w");
00188 #endif
00189 
00190 #if DEBUGGING_FUNCTIONS
00191    EnvDefineFunction2(theEnv,"list-deffunctions",'v',PTIEF ListDeffunctionsCommand,"ListDeffunctionsCommand","01");
00192    EnvDefineFunction2(theEnv,"ppdeffunction",'v',PTIEF PPDeffunctionCommand,"PPDeffunctionCommand","11w");
00193 #endif
00194 
00195    EnvDefineFunction2(theEnv,"get-deffunction-list",'m',PTIEF GetDeffunctionListFunction,
00196                    "GetDeffunctionListFunction","01");
00197 
00198    EnvDefineFunction2(theEnv,"deffunction-module",'w',PTIEF GetDeffunctionModuleCommand,
00199                    "GetDeffunctionModuleCommand","11w");
00200 
00201 #if BLOAD_AND_BSAVE || BLOAD || BLOAD_ONLY
00202    SetupDeffunctionsBload(theEnv);
00203 #endif
00204 
00205 #if CONSTRUCT_COMPILER
00206    SetupDeffunctionCompiler(theEnv);
00207 #endif
00208 
00209 #endif
00210 
00211 #if DEBUGGING_FUNCTIONS
00212    AddWatchItem(theEnv,"deffunctions",0,&DeffunctionData(theEnv)->WatchDeffunctions,32,
00213                 DeffunctionWatchAccess,DeffunctionWatchPrint);
00214 #endif
00215 
00216   }
00217   
00218 /******************************************************/
00219 /* DeallocateDeffunctionData: Deallocates environment */
00220 /*    data for the deffunction construct.             */
00221 /******************************************************/
00222 static void DeallocateDeffunctionData(
00223   void *theEnv)
00224   {
00225 #if ! RUN_TIME
00226    struct deffunctionModule *theModuleItem;
00227    void *theModule;
00228 
00229 #if BLOAD || BLOAD_AND_BSAVE
00230    if (Bloaded(theEnv)) return;
00231 #endif
00232 
00233    DoForAllConstructs(theEnv,DestroyDeffunctionAction,DeffunctionData(theEnv)->DeffunctionModuleIndex,FALSE,NULL); 
00234 
00235    for (theModule = EnvGetNextDefmodule(theEnv,NULL);
00236         theModule != NULL;
00237         theModule = EnvGetNextDefmodule(theEnv,theModule))
00238      {
00239       theModuleItem = (struct deffunctionModule *)
00240                       GetModuleItem(theEnv,(struct defmodule *) theModule,
00241                                     DeffunctionData(theEnv)->DeffunctionModuleIndex);
00242       rtn_struct(theEnv,deffunctionModule,theModuleItem);
00243      }
00244 #else
00245 #if MAC_MCW || WIN_MCW || MAC_XCD
00246 #pragma unused(theEnv)
00247 #endif
00248 #endif
00249   }
00250   
00251 #if ! RUN_TIME
00252 /*****************************************************/
00253 /* DestroyDeffunctionAction: Action used to remove   */
00254 /*   deffunctions as a result of DestroyEnvironment. */
00255 /*****************************************************/
00256 #if WIN_BTC
00257 #pragma argsused
00258 #endif
00259 static void DestroyDeffunctionAction(
00260   void *theEnv,
00261   struct constructHeader *theConstruct,
00262   void *buffer)
00263   {
00264 #if MAC_MCW || WIN_MCW || MAC_XCD
00265 #pragma unused(buffer)
00266 #endif
00267 #if (! BLOAD_ONLY) && (! RUN_TIME)
00268    struct deffunctionStruct *theDeffunction = (struct deffunctionStruct *) theConstruct;
00269    
00270    if (theDeffunction == NULL) return;
00271    
00272    ReturnPackedExpression(theEnv,theDeffunction->code);
00273 
00274    DestroyConstructHeader(theEnv,&theDeffunction->header);
00275    
00276    rtn_struct(theEnv,deffunctionStruct,theDeffunction);
00277 #else
00278 #if MAC_MCW || WIN_MCW || MAC_XCD
00279 #pragma unused(theConstruct,theEnv)
00280 #endif
00281 #endif
00282   }
00283 #endif
00284 
00285 /***************************************************
00286   NAME         : EnvFindDeffunction
00287   DESCRIPTION  : Searches for a deffunction
00288   INPUTS       : The name of the deffunction
00289                  (possibly including a module name)
00290   RETURNS      : Pointer to the deffunction if
00291                  found, otherwise NULL
00292   SIDE EFFECTS : None
00293   NOTES        : None
00294  ***************************************************/
00295 globle void *EnvFindDeffunction(
00296   void *theEnv,
00297   char *dfnxModuleAndName)
00298   {
00299    return(FindNamedConstruct(theEnv,dfnxModuleAndName,DeffunctionData(theEnv)->DeffunctionConstruct));
00300   }
00301 
00302 /***************************************************
00303   NAME         : LookupDeffunctionByMdlOrScope
00304   DESCRIPTION  : Finds a deffunction anywhere (if
00305                  module is specified) or in current
00306                  or imported modules
00307   INPUTS       : The deffunction name
00308   RETURNS      : The deffunction (NULL if not found)
00309   SIDE EFFECTS : Error message printed on
00310                   ambiguous references
00311   NOTES        : None
00312  ***************************************************/
00313 globle DEFFUNCTION *LookupDeffunctionByMdlOrScope(
00314   void *theEnv,
00315   char *deffunctionName)
00316   {
00317    return((DEFFUNCTION *) LookupConstruct(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,deffunctionName,TRUE));
00318   }
00319 
00320 /***************************************************
00321   NAME         : LookupDeffunctionInScope
00322   DESCRIPTION  : Finds a deffunction in current or
00323                    imported modules (module
00324                    specifier is not allowed)
00325   INPUTS       : The deffunction name
00326   RETURNS      : The deffunction (NULL if not found)
00327   SIDE EFFECTS : Error message printed on
00328                   ambiguous references
00329   NOTES        : None
00330  ***************************************************/
00331 globle DEFFUNCTION *LookupDeffunctionInScope(
00332   void *theEnv,
00333   char *deffunctionName)
00334   {
00335    return((DEFFUNCTION *) LookupConstruct(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,deffunctionName,FALSE));
00336   }
00337 
00338 /***************************************************
00339   NAME         : EnvUndeffunction
00340   DESCRIPTION  : External interface routine for
00341                  removing a deffunction
00342   INPUTS       : Deffunction pointer
00343   RETURNS      : FALSE if unsuccessful,
00344                  TRUE otherwise
00345   SIDE EFFECTS : Deffunction deleted, if possible
00346   NOTES        : None
00347  ***************************************************/
00348 globle intBool EnvUndeffunction(
00349   void *theEnv,
00350   void *vptr)
00351   {
00352 #if (MAC_MCW || WIN_MCW) && (RUN_TIME || BLOAD_ONLY)
00353 #pragma unused(theEnv,vptr)
00354 #endif
00355 
00356 #if BLOAD_ONLY || RUN_TIME
00357    return(FALSE);
00358 #else
00359 
00360 #if BLOAD || BLOAD_AND_BSAVE
00361 
00362    if (Bloaded(theEnv) == TRUE)
00363      return(FALSE);
00364 #endif
00365    if (vptr == NULL)
00366       return(RemoveAllDeffunctions(theEnv));
00367    if (EnvIsDeffunctionDeletable(theEnv,vptr) == FALSE)
00368      return(FALSE);
00369    RemoveConstructFromModule(theEnv,(struct constructHeader *) vptr);
00370    RemoveDeffunction(theEnv,vptr);
00371    return(TRUE);
00372 #endif
00373   }
00374 
00375 /****************************************************
00376   NAME         : EnvGetNextDeffunction
00377   DESCRIPTION  : Accesses list of deffunctions
00378   INPUTS       : Deffunction pointer
00379   RETURNS      : The next deffunction, or the
00380                  first deffunction (if input is NULL)
00381   SIDE EFFECTS : None
00382   NOTES        : None
00383  ****************************************************/
00384 globle void *EnvGetNextDeffunction(
00385   void *theEnv,
00386   void *ptr)
00387   {
00388    return((void *) GetNextConstructItem(theEnv,(struct constructHeader *) ptr,DeffunctionData(theEnv)->DeffunctionModuleIndex));
00389   }
00390 
00391 /***************************************************
00392   NAME         : EnvIsDeffunctionDeletable
00393   DESCRIPTION  : Determines if a deffunction is
00394                  executing or referenced by another
00395                  expression
00396   INPUTS       : Deffunction pointer
00397   RETURNS      : TRUE if the deffunction can
00398                  be deleted, FALSE otherwise
00399   SIDE EFFECTS : None
00400   NOTES        : None
00401  ***************************************************/
00402 globle int EnvIsDeffunctionDeletable(
00403   void *theEnv,
00404   void *ptr)
00405   {
00406    DEFFUNCTION *dptr;
00407 
00408    if (! ConstructsDeletable(theEnv))
00409      { return FALSE; }
00410 
00411    dptr = (DEFFUNCTION *) ptr;
00412 
00413    return(((dptr->busy == 0) && (dptr->executing == 0)) ? TRUE : FALSE);
00414   }
00415 
00416 #if (! BLOAD_ONLY) && (! RUN_TIME)
00417 
00418 /***************************************************
00419   NAME         : RemoveDeffunction
00420   DESCRIPTION  : Removes a deffunction
00421   INPUTS       : Deffunction pointer
00422   RETURNS      : Nothing useful
00423   SIDE EFFECTS : Deffunction deallocated
00424   NOTES        : Assumes deffunction is not in use!!
00425  ***************************************************/
00426 globle void RemoveDeffunction(
00427   void *theEnv,
00428   void *vdptr)
00429   {
00430    DEFFUNCTION *dptr = (DEFFUNCTION *) vdptr;
00431 
00432    if (dptr == NULL)
00433      return;
00434    DecrementSymbolCount(theEnv,GetDeffunctionNamePointer((void *) dptr));
00435    ExpressionDeinstall(theEnv,dptr->code);
00436    ReturnPackedExpression(theEnv,dptr->code);
00437    SetDeffunctionPPForm((void *) dptr,NULL);
00438    ClearUserDataList(theEnv,dptr->header.usrData);
00439    rtn_struct(theEnv,deffunctionStruct,dptr);
00440   }
00441 
00442 #endif
00443 
00444 /********************************************************
00445   NAME         : UndeffunctionCommand
00446   DESCRIPTION  : Deletes the named deffunction(s)
00447   INPUTS       : None
00448   RETURNS      : Nothing useful
00449   SIDE EFFECTS : Deffunction(s) removed
00450   NOTES        : H/L Syntax: (undeffunction <name> | *)
00451  ********************************************************/
00452 globle void UndeffunctionCommand(
00453   void *theEnv)
00454   {
00455    UndefconstructCommand(theEnv,"undeffunction",DeffunctionData(theEnv)->DeffunctionConstruct);
00456   }
00457 
00458 /****************************************************************
00459   NAME         : GetDeffunctionModuleCommand
00460   DESCRIPTION  : Determines to which module a deffunction belongs
00461   INPUTS       : None
00462   RETURNS      : The symbolic name of the module
00463   SIDE EFFECTS : None
00464   NOTES        : H/L Syntax: (deffunction-module <dfnx-name>)
00465  ****************************************************************/
00466 globle void *GetDeffunctionModuleCommand(
00467   void *theEnv)
00468   {
00469    return(GetConstructModuleCommand(theEnv,"deffunction-module",DeffunctionData(theEnv)->DeffunctionConstruct));
00470   }
00471 
00472 #if DEBUGGING_FUNCTIONS
00473 
00474 /****************************************************
00475   NAME         : PPDeffunctionCommand
00476   DESCRIPTION  : Displays the pretty-print form of a
00477                  deffunction
00478   INPUTS       : None
00479   RETURNS      : Nothing useful
00480   SIDE EFFECTS : Pretty-print form displayed to
00481                  WDISPLAY logical name
00482   NOTES        : H/L Syntax: (ppdeffunction <name>)
00483  ****************************************************/
00484 globle void PPDeffunctionCommand(
00485   void *theEnv)
00486   {
00487    PPConstructCommand(theEnv,"ppdeffunction",DeffunctionData(theEnv)->DeffunctionConstruct);
00488   }
00489 
00490 /***************************************************
00491   NAME         : ListDeffunctionsCommand
00492   DESCRIPTION  : Displays all deffunction names
00493   INPUTS       : None
00494   RETURNS      : Nothing useful
00495   SIDE EFFECTS : Deffunction name sprinted
00496   NOTES        : H/L Interface
00497  ***************************************************/
00498 globle void ListDeffunctionsCommand(
00499   void *theEnv)
00500   {
00501    ListConstructCommand(theEnv,"list-deffunctions",DeffunctionData(theEnv)->DeffunctionConstruct);
00502   }
00503 
00504 /***************************************************
00505   NAME         : EnvListDeffunctions
00506   DESCRIPTION  : Displays all deffunction names
00507   INPUTS       : 1) The logical name of the output
00508                  2) The module
00509   RETURNS      : Nothing useful
00510   SIDE EFFECTS : Deffunction name sprinted
00511   NOTES        : C Interface
00512  ***************************************************/
00513 globle void EnvListDeffunctions(
00514   void *theEnv,
00515   char *logicalName,
00516   struct defmodule *theModule)
00517   {
00518    ListConstruct(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,logicalName,theModule);
00519   }
00520 
00521 #endif
00522 
00523 /***************************************************************
00524   NAME         : GetDeffunctionListFunction
00525   DESCRIPTION  : Groups all deffunction names into
00526                  a multifield list
00527   INPUTS       : A data object buffer to hold
00528                  the multifield result
00529   RETURNS      : Nothing useful
00530   SIDE EFFECTS : Multifield allocated and filled
00531   NOTES        : H/L Syntax: (get-deffunction-list [<module>])
00532  ***************************************************************/
00533 globle void GetDeffunctionListFunction(
00534   void *theEnv,
00535   DATA_OBJECT *returnValue)
00536   {
00537    GetConstructListFunction(theEnv,"get-deffunction-list",returnValue,DeffunctionData(theEnv)->DeffunctionConstruct);
00538   }
00539 
00540 /***************************************************************
00541   NAME         : EnvGetDeffunctionList
00542   DESCRIPTION  : Groups all deffunction names into
00543                  a multifield list
00544   INPUTS       : 1) A data object buffer to hold
00545                     the multifield result
00546                  2) The module from which to obtain deffunctions
00547   RETURNS      : Nothing useful
00548   SIDE EFFECTS : Multifield allocated and filled
00549   NOTES        : External C access
00550  ***************************************************************/
00551 globle void EnvGetDeffunctionList(
00552   void *theEnv,
00553   DATA_OBJECT *returnValue,
00554   struct defmodule *theModule)
00555   {
00556    GetConstructList(theEnv,returnValue,DeffunctionData(theEnv)->DeffunctionConstruct,theModule);
00557   }
00558 
00559 /*******************************************************
00560   NAME         : CheckDeffunctionCall
00561   DESCRIPTION  : Checks the number of arguments
00562                  passed to a deffunction
00563   INPUTS       : 1) Deffunction pointer
00564                  2) The number of arguments
00565   RETURNS      : TRUE if OK, FALSE otherwise
00566   SIDE EFFECTS : Message printed on errors
00567   NOTES        : None
00568  *******************************************************/
00569 globle int CheckDeffunctionCall(
00570   void *theEnv,
00571   void *vdptr,
00572   int args)
00573   {
00574    DEFFUNCTION *dptr;
00575 
00576    if (vdptr == NULL)
00577      return(FALSE);
00578    dptr = (DEFFUNCTION *) vdptr;
00579    if (args < dptr->minNumberOfParameters)
00580      {
00581       if (dptr->maxNumberOfParameters == -1)
00582         ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr),
00583                            AT_LEAST,dptr->minNumberOfParameters);
00584       else
00585         ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr),
00586                            EXACTLY,dptr->minNumberOfParameters);
00587       return(FALSE);
00588      }
00589    else if ((args > dptr->minNumberOfParameters) &&
00590             (dptr->maxNumberOfParameters != -1))
00591      {
00592       ExpectedCountError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr),
00593                          EXACTLY,dptr->minNumberOfParameters);
00594       return(FALSE);
00595      }
00596    return(TRUE);
00597   }
00598 
00599 /* =========================================
00600    *****************************************
00601           INTERNALLY VISIBLE FUNCTIONS
00602    =========================================
00603    ***************************************** */
00604 
00605 /***************************************************
00606   NAME         : PrintDeffunctionCall
00607   DESCRIPTION  : PrintExpression() support function
00608                  for deffunction calls
00609   INPUTS       : 1) The output logical name
00610                  2) The deffunction
00611   RETURNS      : Nothing useful
00612   SIDE EFFECTS : Call expression printed
00613   NOTES        : None
00614  ***************************************************/
00615 #if WIN_BTC
00616 #pragma argsused
00617 #endif
00618 static void PrintDeffunctionCall(
00619   void *theEnv,
00620   char *logName,
00621   void *value)
00622   {
00623 #if DEVELOPER
00624 
00625    EnvPrintRouter(theEnv,logName,"(");
00626    EnvPrintRouter(theEnv,logName,EnvGetDeffunctionName(theEnv,value));
00627    if (GetFirstArgument() != NULL)
00628      {
00629       EnvPrintRouter(theEnv,logName," ");
00630       PrintExpression(theEnv,logName,GetFirstArgument());
00631      }
00632    EnvPrintRouter(theEnv,logName,")");
00633 #else
00634 #if MAC_MCW || WIN_MCW || MAC_XCD
00635 #pragma unused(theEnv)
00636 #pragma unused(logName)
00637 #pragma unused(value)
00638 #endif
00639 #endif
00640   }
00641 
00642 /*******************************************************
00643   NAME         : EvaluateDeffunctionCall
00644   DESCRIPTION  : Primitive support function for
00645                  calling a deffunction
00646   INPUTS       : 1) The deffunction
00647                  2) A data object buffer to hold
00648                     the evaluation result
00649   RETURNS      : FALSE if the deffunction
00650                  returns the symbol FALSE,
00651                  TRUE otherwise
00652   SIDE EFFECTS : Data obejct buffer set and any
00653                  side-effects of calling the deffunction
00654   NOTES        : None
00655  *******************************************************/
00656 static intBool EvaluateDeffunctionCall(
00657   void *theEnv,
00658   void *value,
00659   DATA_OBJECT *result)
00660   {
00661    CallDeffunction(theEnv,(DEFFUNCTION *) value,GetFirstArgument(),result);
00662    if ((GetpType(result) == SYMBOL) &&
00663        (GetpValue(result) == EnvFalseSymbol(theEnv)))
00664      return(FALSE);
00665    return(TRUE);
00666   }
00667 
00668 /***************************************************
00669   NAME         : DecrementDeffunctionBusyCount
00670   DESCRIPTION  : Lowers the busy count of a
00671                  deffunction construct
00672   INPUTS       : The deffunction
00673   RETURNS      : Nothing useful
00674   SIDE EFFECTS : Busy count decremented if a clear
00675                  is not in progress (see comment)
00676   NOTES        : None
00677  ***************************************************/
00678 static void DecrementDeffunctionBusyCount(
00679   void *theEnv,
00680   void *value)
00681   {
00682    /* ==============================================
00683       The deffunctions to which expressions in other
00684       constructs may refer may already have been
00685       deleted - thus, it is important not to modify
00686       the busy flag during a clear.
00687       ============================================== */
00688    if (! ConstructData(theEnv)->ClearInProgress)
00689      ((DEFFUNCTION *) value)->busy--;
00690   }
00691 
00692 /***************************************************
00693   NAME         : IncrementDeffunctionBusyCount
00694   DESCRIPTION  : Raises the busy count of a
00695                  deffunction construct
00696   INPUTS       : The deffunction
00697   RETURNS      : Nothing useful
00698   SIDE EFFECTS : Busy count incremented
00699   NOTES        : None
00700  ***************************************************/
00701 #if WIN_BTC
00702 #pragma argsused
00703 #endif
00704 static void IncrementDeffunctionBusyCount(
00705   void *theEnv,
00706   void *value)
00707   {
00708 #if MAC_MCW || WIN_MCW || MAC_XCD
00709 #pragma unused(theEnv)
00710 #endif
00711 
00712    ((DEFFUNCTION *) value)->busy++;
00713   }
00714 
00715 #if ! RUN_TIME
00716 
00717 /*****************************************************
00718   NAME         : AllocateModule
00719   DESCRIPTION  : Creates and initializes a
00720                  list of deffunctions for a new module
00721   INPUTS       : None
00722   RETURNS      : The new deffunction module
00723   SIDE EFFECTS : Deffunction module created
00724   NOTES        : None
00725  *****************************************************/
00726 static void *AllocateModule(
00727   void *theEnv)
00728   {
00729    return((void *) get_struct(theEnv,deffunctionModule));
00730   }
00731 
00732 /***************************************************
00733   NAME         : ReturnModule
00734   DESCRIPTION  : Removes a deffunction module and
00735                  all associated deffunctions
00736   INPUTS       : The deffunction module
00737   RETURNS      : Nothing useful
00738   SIDE EFFECTS : Module and deffunctions deleted
00739   NOTES        : None
00740  ***************************************************/
00741 static void ReturnModule(
00742   void *theEnv,
00743   void *theItem)
00744   {
00745 #if (! BLOAD_ONLY)
00746    FreeConstructHeaderModule(theEnv,(struct defmoduleItemHeader *) theItem,DeffunctionData(theEnv)->DeffunctionConstruct);
00747 #endif
00748    rtn_struct(theEnv,deffunctionModule,theItem);
00749   }
00750 
00751 /***************************************************
00752   NAME         : ClearDeffunctionsReady
00753   DESCRIPTION  : Determines if it is safe to
00754                  remove all deffunctions
00755                  Assumes *all* constructs will be
00756                  deleted - only checks to see if
00757                  any deffunctions are currently
00758                  executing
00759   INPUTS       : None
00760   RETURNS      : TRUE if no deffunctions are
00761                  executing, FALSE otherwise
00762   SIDE EFFECTS : None
00763   NOTES        : Used by (clear) and (bload)
00764  ***************************************************/
00765 static intBool ClearDeffunctionsReady(
00766   void *theEnv)
00767   {
00768    return((DeffunctionData(theEnv)->ExecutingDeffunction != NULL) ? FALSE : TRUE);
00769   }
00770 
00771 #endif
00772 
00773 #if (! BLOAD_ONLY) && (! RUN_TIME)
00774 
00775 /***************************************************
00776   NAME         : RemoveAllDeffunctions
00777   DESCRIPTION  : Removes all deffunctions
00778   INPUTS       : None
00779   RETURNS      : TRUE if all deffunctions
00780                  removed, FALSE otherwise
00781   SIDE EFFECTS : Deffunctions removed
00782   NOTES        : None
00783  ***************************************************/
00784 static intBool RemoveAllDeffunctions(
00785   void *theEnv)
00786   {
00787    DEFFUNCTION *dptr,*dtmp;
00788    unsigned oldbusy;
00789    intBool success = TRUE;
00790 
00791 #if BLOAD || BLOAD_AND_BSAVE
00792 
00793    if (Bloaded(theEnv) == TRUE)
00794      return(FALSE);
00795 #endif
00796 
00797    dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL);
00798    while (dptr != NULL)
00799      {
00800       if (dptr->executing > 0)
00801         {
00802          DeffunctionDeleteError(theEnv,EnvGetDeffunctionName(theEnv,(void *) dptr));
00803          success = FALSE;
00804         }
00805       else
00806         {
00807          oldbusy = dptr->busy;
00808          ExpressionDeinstall(theEnv,dptr->code);
00809          dptr->busy = oldbusy;
00810          ReturnPackedExpression(theEnv,dptr->code);
00811          dptr->code = NULL;
00812         }
00813       dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,(void *) dptr);
00814      }
00815 
00816    dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,NULL);
00817    while (dptr != NULL)
00818      {
00819       dtmp = dptr;
00820       dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,(void *) dptr);
00821       if (dtmp->executing == 0)
00822         {
00823          if (dtmp->busy > 0)
00824            {
00825             PrintWarningID(theEnv,"DFFNXFUN",1,FALSE);
00826             EnvPrintRouter(theEnv,WWARNING,"Deffunction ");
00827             EnvPrintRouter(theEnv,WWARNING,EnvGetDeffunctionName(theEnv,(void *) dtmp));
00828             EnvPrintRouter(theEnv,WWARNING," only partially deleted due to usage by other constructs.\n");
00829             SetDeffunctionPPForm((void *) dtmp,NULL);
00830             success = FALSE;
00831            }
00832          else
00833            {
00834             RemoveConstructFromModule(theEnv,(struct constructHeader *) dtmp);
00835             RemoveDeffunction(theEnv,dtmp);
00836            }
00837         }
00838      }
00839    return(success);
00840   }
00841 
00842 /****************************************************
00843   NAME         : DeffunctionDeleteError
00844   DESCRIPTION  : Prints out an error message when
00845                  a deffunction deletion attempt fails
00846   INPUTS       : The deffunction name
00847   RETURNS      : Nothing useful
00848   SIDE EFFECTS : Error message printed
00849   NOTES        : None
00850  ****************************************************/
00851 static void DeffunctionDeleteError(
00852   void *theEnv,
00853   char *dfnxName)
00854   {
00855    CantDeleteItemErrorMessage(theEnv,"deffunction",dfnxName);
00856   }
00857 
00858 /***************************************************
00859   NAME         : SaveDeffunctionHeaders
00860   DESCRIPTION  : Writes out deffunction forward
00861                  declarations for (save) command
00862   INPUTS       : The logical output name
00863   RETURNS      : Nothing useful
00864   SIDE EFFECTS : Writes out deffunctions with no
00865                  body of actions
00866   NOTES        : Used for deffunctions which are
00867                  mutually recursive with other
00868                  constructs
00869  ***************************************************/
00870 static void SaveDeffunctionHeaders(
00871   void *theEnv,
00872   void *theModule,
00873   char *logicalName)
00874   {
00875    DoForAllConstructsInModule(theEnv,theModule,SaveDeffunctionHeader,
00876                               DeffunctionData(theEnv)->DeffunctionModuleIndex,
00877                               FALSE,(void *) logicalName);
00878   }
00879 
00880 /***************************************************
00881   NAME         : SaveDeffunctionHeader
00882   DESCRIPTION  : Writes a deffunction forward
00883                  declaration to the save file
00884   INPUTS       : 1) The deffunction
00885                  2) The logical name of the output
00886   RETURNS      : Nothing useful
00887   SIDE EFFECTS : Defffunction header written
00888   NOTES        : None
00889  ***************************************************/
00890 static void SaveDeffunctionHeader(
00891   void *theEnv,
00892   struct constructHeader *theDeffunction,
00893   void *userBuffer)
00894   {
00895    DEFFUNCTION *dfnxPtr = (DEFFUNCTION *) theDeffunction;
00896    char *logicalName = (char *) userBuffer;
00897    register int i;
00898 
00899    if (EnvGetDeffunctionPPForm(theEnv,(void *) dfnxPtr) != NULL)
00900      {
00901       EnvPrintRouter(theEnv,logicalName,"(deffunction ");
00902       EnvPrintRouter(theEnv,logicalName,EnvDeffunctionModule(theEnv,(void *) dfnxPtr));
00903       EnvPrintRouter(theEnv,logicalName,"::");      
00904       EnvPrintRouter(theEnv,logicalName,EnvGetDeffunctionName(theEnv,(void *) dfnxPtr));
00905       EnvPrintRouter(theEnv,logicalName," (");
00906       for (i = 0 ; i < dfnxPtr->minNumberOfParameters ; i++)
00907         {
00908          EnvPrintRouter(theEnv,logicalName,"?p");
00909          PrintLongInteger(theEnv,logicalName,(long long) i);
00910          if (i != dfnxPtr->minNumberOfParameters-1)
00911            EnvPrintRouter(theEnv,logicalName," ");
00912         }
00913       if (dfnxPtr->maxNumberOfParameters == -1)
00914         {
00915          if (dfnxPtr->minNumberOfParameters != 0)
00916            EnvPrintRouter(theEnv,logicalName," ");
00917          EnvPrintRouter(theEnv,logicalName,"$?wildargs))\n\n");
00918         }
00919       else
00920         EnvPrintRouter(theEnv,logicalName,"))\n\n");
00921      }
00922   }
00923 
00924 /***************************************************
00925   NAME         : SaveDeffunctions
00926   DESCRIPTION  : Writes out deffunctions
00927                  for (save) command
00928   INPUTS       : The logical output name
00929   RETURNS      : Nothing useful
00930   SIDE EFFECTS : Writes out deffunctions
00931   NOTES        : None
00932  ***************************************************/
00933 static void SaveDeffunctions(
00934   void *theEnv,
00935   void *theModule,
00936   char *logicalName)
00937   {
00938    SaveConstruct(theEnv,theModule,logicalName,DeffunctionData(theEnv)->DeffunctionConstruct);
00939   }
00940 
00941 #endif
00942 
00943 #if DEBUGGING_FUNCTIONS
00944 
00945 /******************************************************************
00946   NAME         : DeffunctionWatchAccess
00947   DESCRIPTION  : Parses a list of deffunction names passed by
00948                  AddWatchItem() and sets the traces accordingly
00949   INPUTS       : 1) A code indicating which trace flag is to be set
00950                     Ignored
00951                  2) The value to which to set the trace flags
00952                  3) A list of expressions containing the names
00953                     of the deffunctions for which to set traces
00954   RETURNS      : TRUE if all OK, FALSE otherwise
00955   SIDE EFFECTS : Watch flags set in specified deffunctions
00956   NOTES        : Accessory function for AddWatchItem()
00957  ******************************************************************/
00958 #if WIN_BTC
00959 #pragma argsused
00960 #endif
00961 static unsigned DeffunctionWatchAccess(
00962   void *theEnv,
00963   int code,
00964   unsigned newState,
00965   EXPRESSION *argExprs)
00966   {
00967 #if MAC_MCW || WIN_MCW || MAC_XCD
00968 #pragma unused(code)
00969 #endif
00970 
00971    return(ConstructSetWatchAccess(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,newState,argExprs,
00972                                     EnvGetDeffunctionWatch,EnvSetDeffunctionWatch));
00973   }
00974 
00975 /***********************************************************************
00976   NAME         : DeffunctionWatchPrint
00977   DESCRIPTION  : Parses a list of deffunction names passed by
00978                  AddWatchItem() and displays the traces accordingly
00979   INPUTS       : 1) The logical name of the output
00980                  2) A code indicating which trace flag is to be examined
00981                     Ignored
00982                  3) A list of expressions containing the names
00983                     of the deffunctions for which to examine traces
00984   RETURNS      : TRUE if all OK, FALSE otherwise
00985   SIDE EFFECTS : Watch flags displayed for specified deffunctions
00986   NOTES        : Accessory function for AddWatchItem()
00987  ***********************************************************************/
00988 #if WIN_BTC
00989 #pragma argsused
00990 #endif
00991 static unsigned DeffunctionWatchPrint(
00992   void *theEnv,
00993   char *logName,
00994   int code,
00995   EXPRESSION *argExprs)
00996   {
00997 #if MAC_MCW || WIN_MCW || MAC_XCD
00998 #pragma unused(code)
00999 #endif
01000 
01001    return(ConstructPrintWatchAccess(theEnv,DeffunctionData(theEnv)->DeffunctionConstruct,logName,argExprs,
01002                                     EnvGetDeffunctionWatch,EnvSetDeffunctionWatch));
01003   }
01004 
01005 /*********************************************************
01006   NAME         : EnvSetDeffunctionWatch
01007   DESCRIPTION  : Sets the trace to ON/OFF for the
01008                  deffunction
01009   INPUTS       : 1) TRUE to set the trace on,
01010                     FALSE to set it off
01011                  2) A pointer to the deffunction
01012   RETURNS      : Nothing useful
01013   SIDE EFFECTS : Watch flag for the deffunction set
01014   NOTES        : None
01015  *********************************************************/
01016 #if WIN_BTC
01017 #pragma argsused
01018 #endif
01019 globle void EnvSetDeffunctionWatch(
01020   void *theEnv,
01021   unsigned newState,
01022   void *dptr)
01023   {
01024 #if MAC_MCW || WIN_MCW || MAC_XCD
01025 #pragma unused(theEnv)
01026 #endif
01027 
01028    ((DEFFUNCTION *) dptr)->trace = (unsigned short) newState;
01029   }
01030 
01031 /*********************************************************
01032   NAME         : EnvGetDeffunctionWatch
01033   DESCRIPTION  : Determines if trace messages are
01034                  gnerated when executing deffunction
01035   INPUTS       : A pointer to the deffunction
01036   RETURNS      : TRUE if a trace is active,
01037                  FALSE otherwise
01038   SIDE EFFECTS : None
01039   NOTES        : None
01040  *********************************************************/
01041 #if WIN_BTC
01042 #pragma argsused
01043 #endif
01044 globle unsigned EnvGetDeffunctionWatch(
01045   void *theEnv,
01046   void *dptr)
01047   {
01048 #if MAC_MCW || WIN_MCW || MAC_XCD
01049 #pragma unused(theEnv)
01050 #endif
01051 
01052    return(((DEFFUNCTION *) dptr)->trace);
01053   }
01054 
01055 #endif
01056 
01057 #endif
01058 
01059