Exemplo n.º 1
0
globle void WriteNeededConstraints(
  void *theEnv,
  FILE *fp)
  {
   int i;
   unsigned short theIndex = 0;
   unsigned long int numberOfUsedConstraints = 0;
   CONSTRAINT_RECORD *tmpPtr;
   BSAVE_CONSTRAINT_RECORD bsaveConstraints;

   /*================================*/
   /* Get the number of constraints. */
   /*================================*/

   for (i = 0; i < SIZE_CONSTRAINT_HASH; i++)
     {
      for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i];
           tmpPtr != NULL;
           tmpPtr = tmpPtr->next)
        {
         tmpPtr->bsaveIndex = theIndex++;
         numberOfUsedConstraints++;
        }
     }

   /*=============================================*/
   /* If dynamic constraint checking is disabled, */
   /* then no constraints are saved.              */
   /*=============================================*/

   if ((! EnvGetDynamicConstraintChecking(theEnv)) && (numberOfUsedConstraints != 0))
     {
      numberOfUsedConstraints = 0;
      PrintWarningID(theEnv,"CSTRNBIN",1,FALSE);
      EnvPrintRouter(theEnv,WWARNING,"Constraints are not saved with a binary image\n");
      EnvPrintRouter(theEnv,WWARNING,"  when dynamic constraint checking is disabled.\n");
     }

   /*============================================*/
   /* Write out the number of constraints in the */
   /* constraint table followed by each of the   */
   /* constraints in the constraint table.       */
   /*============================================*/

   GenWrite(&numberOfUsedConstraints,(unsigned long) sizeof(unsigned long int),fp);
   if (numberOfUsedConstraints == 0) return;

   for (i = 0 ; i < SIZE_CONSTRAINT_HASH; i++)
     {
      for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i];
           tmpPtr != NULL;
           tmpPtr = tmpPtr->next)
        {
         CopyToBsaveConstraintRecord(theEnv,tmpPtr,&bsaveConstraints);
         GenWrite(&bsaveConstraints,
                  (unsigned long) sizeof(BSAVE_CONSTRAINT_RECORD),fp);
        }
     }
  }
Exemplo n.º 2
0
/***************************************************
  NAME         : RemoveAllDeffunctions
  DESCRIPTION  : Removes all deffunctions
  INPUTS       : None
  RETURNS      : TRUE if all deffunctions
                 removed, FALSE otherwise
  SIDE EFFECTS : Deffunctions removed
  NOTES        : None
 ***************************************************/
static intBool RemoveAllDeffunctions(
  void *theEnv,
  EXEC_STATUS)
  {
   DEFFUNCTION *dptr,*dtmp;
   unsigned oldbusy;
   intBool success = TRUE;

#if BLOAD || BLOAD_AND_BSAVE

   if (Bloaded(theEnv,execStatus) == TRUE)
     return(FALSE);
#endif

   dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,NULL);
   while (dptr != NULL)
     {
      if (dptr->executing > 0)
        {
         DeffunctionDeleteError(theEnv,execStatus,EnvGetDeffunctionName(theEnv,execStatus,(void *) dptr));
         success = FALSE;
        }
      else
        {
         oldbusy = dptr->busy;
         ExpressionDeinstall(theEnv,execStatus,dptr->code);
         dptr->busy = oldbusy;
         ReturnPackedExpression(theEnv,execStatus,dptr->code);
         dptr->code = NULL;
        }
      dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,(void *) dptr);
     }

   dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,NULL);
   while (dptr != NULL)
     {
      dtmp = dptr;
      dptr = (DEFFUNCTION *) EnvGetNextDeffunction(theEnv,execStatus,(void *) dptr);
      if (dtmp->executing == 0)
        {
         if (dtmp->busy > 0)
           {
            PrintWarningID(theEnv,execStatus,"DFFNXFUN",1,FALSE);
            EnvPrintRouter(theEnv,execStatus,WWARNING,"Deffunction ");
            EnvPrintRouter(theEnv,execStatus,WWARNING,EnvGetDeffunctionName(theEnv,execStatus,(void *) dtmp));
            EnvPrintRouter(theEnv,execStatus,WWARNING," only partially deleted due to usage by other constructs.\n");
            SetDeffunctionPPForm((void *) dtmp,NULL);
            success = FALSE;
           }
         else
           {
            RemoveConstructFromModule(theEnv,execStatus,(struct constructHeader *) dtmp);
            RemoveDeffunction(theEnv,execStatus,dtmp);
           }
        }
     }
   return(success);
  }
Exemplo n.º 3
0
static void UpdateHandler(
  void *buf,
  long obji)
  {
   HANDLER *hnd;
   BSAVE_HANDLER *bhnd;

   hnd = (HANDLER *) &handlerArray[obji];
   bhnd = (BSAVE_HANDLER *) buf;
   hnd->system = bhnd->system;
   hnd->type = bhnd->type;
#if (! IMPERATIVE_MESSAGE_HANDLERS)
   if (hnd->type == MAROUND)
     {
      PrintWarningID("OBJBIN",1,FALSE);
      PrintRouter(WWARNING,"Around message-handlers are not\n");
      PrintRouter(WWARNING,"  supported in this environment.");
     }
#endif
#if (! AUXILIARY_MESSAGE_HANDLERS)
   if ((hnd->type == MBEFORE) || (hnd->type == MAFTER))
     {
      PrintWarningID("OBJBIN",2,FALSE);
      PrintRouter(WWARNING,"Before and after message-handlers are not\n");
      PrintRouter(WWARNING,"  supported in this environment.");
     }
#endif
   hnd->minParams = bhnd->minParams;
   hnd->maxParams = bhnd->maxParams;
   hnd->localVarCount = bhnd->localVarCount;
   hnd->cls = DefclassPointer(bhnd->cls);
   hnd->name = SymbolPointer(bhnd->name);
   IncrementSymbolCount(hnd->name);
   hnd->actions = ExpressionPointer(bhnd->actions);
   hnd->ppForm = NULL;
   hnd->busy = 0;
   hnd->mark = 0;
   hnd->usrData = NULL;
#if DEBUGGING_FUNCTIONS
   hnd->trace = WatchHandlers;
#endif
  }
Exemplo n.º 4
0
globle struct lhsParseNode *CreateInitialFactPattern(
  void *theEnv)
  {
   struct lhsParseNode *topNode;
   struct deftemplate *theDeftemplate;
   int count;
   
   /*==================================*/
   /* If the initial-fact deftemplate  */
   /* doesn't exist, then create it.   */
   /*==================================*/

   theDeftemplate = (struct deftemplate *)
                    FindImportedConstruct(theEnv,"deftemplate",NULL,"initial-fact",
                                          &count,TRUE,NULL);
   if (theDeftemplate == NULL)
     {
      PrintWarningID(theEnv,"FACTLHS",1,FALSE);
      EnvPrintRouter(theEnv,WWARNING,"Creating implied initial-fact deftemplate in module ");
      EnvPrintRouter(theEnv,WWARNING,EnvGetDefmoduleName(theEnv,EnvGetCurrentModule(theEnv)));
      EnvPrintRouter(theEnv,WWARNING,".\n");
      EnvPrintRouter(theEnv,WWARNING,"  You probably want to import this deftemplate from the MAIN module.\n");
      CreateImpliedDeftemplate(theEnv,(SYMBOL_HN *) EnvAddSymbol(theEnv,"initial-fact"),FALSE);
     }

   /*====================================*/
   /* Create the (initial-fact) pattern. */
   /*====================================*/

   topNode = GetLHSParseNode(theEnv);
   topNode->type = SF_WILDCARD;
   topNode->index = 0;
   topNode->slotNumber = 1;

   topNode->bottom = GetLHSParseNode(theEnv);
   topNode->bottom->type = SYMBOL;
   topNode->bottom->value = (void *) EnvAddSymbol(theEnv,"initial-fact");

   /*=====================*/
   /* Return the pattern. */
   /*=====================*/

   return(topNode);
  }
Exemplo n.º 5
0
static void UpdateType(
  void *buf,
  long obji)
  {
#if OBJECT_SYSTEM
   typeArray[obji] = (void *) DefclassPointer(* (long *) buf);
#else
   if ((* (long *) buf) > (long) INSTANCE_TYPE_CODE)
     {
      PrintWarningID("GENRCBIN",1,FALSE);
      PrintRouter(WWARNING,"COOL not installed!  User-defined class\n");
      PrintRouter(WWARNING,"  in method restriction substituted with OBJECT.\n");
      typeArray[obji] = (void *) AddLong((long) OBJECT_TYPE_CODE);
     }
   else
     typeArray[obji] = (void *) AddLong(* (long *) buf);
   IncrementIntegerCount((INTEGER_HN *) typeArray[obji]);
#endif
  }
Exemplo n.º 6
0
static void UpdateType(
  void *theEnv,
  void *buf,
  long obji)
  {
#if OBJECT_SYSTEM
   DefgenericBinaryData(theEnv)->TypeArray[obji] = (void *) DefclassPointer(* (long *) buf);
#else
   if ((* (long *) buf) > (long) INSTANCE_TYPE_CODE)
     {
      PrintWarningID(theEnv,(char*)"GENRCBIN",1,FALSE);
      EnvPrintRouter(theEnv,WWARNING,(char*)"COOL not installed!  User-defined class\n");
      EnvPrintRouter(theEnv,WWARNING,(char*)"  in method restriction substituted with OBJECT.\n");
      DefgenericBinaryData(theEnv)->TypeArray[obji] = (void *) EnvAddLong(theEnv,(long long) OBJECT_TYPE_CODE);
     }
   else
     DefgenericBinaryData(theEnv)->TypeArray[obji] = (void *) EnvAddLong(theEnv,* (long *) buf);
   IncrementIntegerCount((INTEGER_HN *) DefgenericBinaryData(theEnv)->TypeArray[obji]);
#endif
  }
Exemplo n.º 7
0
void ArgumentOverUnderflowErrorMessage(
  Environment *theEnv,
  const char *functionName,
  bool error)
  {
   if (error)
     {
      PrintErrorID(theEnv,"PRNTUTIL",17,false);
      WriteString(theEnv,STDERR,"Over or underflow of long long integer in '");
      WriteString(theEnv,STDERR,functionName);
      WriteString(theEnv,STDERR,"' function.\n");
     }
   else
     {
      PrintWarningID(theEnv,"PRNTUTIL",17,false);
      WriteString(theEnv,STDWRN,"Over or underflow of long long integer in '");
      WriteString(theEnv,STDWRN,functionName);
      WriteString(theEnv,STDWRN,"' function.\n");
     }
  }
Exemplo n.º 8
0
globle int ConstraintsToCode(
  void *theEnv,
  char *fileName,
  int fileID,
  FILE *headerFP,
  int imageID,
  int maxIndices)
  {
   int i, j, count;
   int newHeader = TRUE;
   FILE *fp;
   int version = 1;
   int arrayVersion = 1;
   unsigned short numberOfConstraints = 0;
   CONSTRAINT_RECORD *tmpPtr;

   /*===============================================*/
   /* Count the total number of constraint records. */
   /*===============================================*/

   for (i = 0 ; i < SIZE_CONSTRAINT_HASH; i++)
     {
      for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i];
           tmpPtr != NULL;
           tmpPtr = tmpPtr->next)
        { tmpPtr->bsaveIndex = numberOfConstraints++; }
     }

   /*=====================================================*/
   /* If dynamic constraint checking is disabled, then    */
   /* contraints won't be saved. If there are constraints */
   /* which could be saved, then issue a warning message. */
   /*=====================================================*/

   if ((! EnvGetDynamicConstraintChecking(theEnv)) && (numberOfConstraints != 0))
     {
      numberOfConstraints = 0;
      PrintWarningID(theEnv,"CSTRNCMP",1,FALSE);
      EnvPrintRouter(theEnv,WWARNING,"Constraints are not saved with a constructs-to-c image\n");
      EnvPrintRouter(theEnv,WWARNING,"  when dynamic constraint checking is disabled.\n");
     }

   if (numberOfConstraints == 0) return(-1);

   /*=================================================*/
   /* Print the extern definition in the header file. */
   /*=================================================*/

   for (i = 1; i <= (numberOfConstraints / maxIndices) + 1 ; i++)
     { fprintf(headerFP,"extern CONSTRAINT_RECORD C%d_%d[];\n",imageID,i); }

   /*==================*/
   /* Create the file. */
   /*==================*/

   if ((fp = NewCFile(theEnv,fileName,fileID,version,FALSE)) == NULL) return(-1);

   /*===================*/
   /* List the entries. */
   /*===================*/

   j = 0;
   count = 0;

   for (i = 0; i < SIZE_CONSTRAINT_HASH; i++)
     {
      for (tmpPtr = ConstraintData(theEnv)->ConstraintHashtable[i];
           tmpPtr != NULL;
           tmpPtr = tmpPtr->next)
        {
         if (newHeader)
           {
            fprintf(fp,"CONSTRAINT_RECORD C%d_%d[] = {\n",imageID,arrayVersion);
            newHeader = FALSE;
           }

         fprintf(fp,"{%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d,%d",
                 tmpPtr->anyAllowed,
                 tmpPtr->symbolsAllowed,
                 tmpPtr->stringsAllowed,
                 tmpPtr->floatsAllowed,
                 tmpPtr->integersAllowed,
                 tmpPtr->instanceNamesAllowed,
                 tmpPtr->instanceAddressesAllowed,
                 tmpPtr->externalAddressesAllowed,
                 tmpPtr->factAddressesAllowed,
                 0, /* void allowed */
                 tmpPtr->anyRestriction,
                 tmpPtr->symbolRestriction,
                 tmpPtr->stringRestriction,
                 tmpPtr->floatRestriction,
                 tmpPtr->integerRestriction,
                 tmpPtr->instanceNameRestriction,
                 tmpPtr->multifieldsAllowed,
                 tmpPtr->singlefieldsAllowed);

         fprintf(fp,",0,"); /* bsaveIndex */

         PrintHashedExpressionReference(theEnv,fp,tmpPtr->restrictionList,imageID,maxIndices);
         fprintf(fp,",");
         PrintHashedExpressionReference(theEnv,fp,tmpPtr->minValue,imageID,maxIndices);
         fprintf(fp,",");
         PrintHashedExpressionReference(theEnv,fp,tmpPtr->maxValue,imageID,maxIndices);
         fprintf(fp,",");
         PrintHashedExpressionReference(theEnv,fp,tmpPtr->minFields,imageID,maxIndices);
         fprintf(fp,",");
         PrintHashedExpressionReference(theEnv,fp,tmpPtr->maxFields,imageID,maxIndices);

         /* multifield slot */

         fprintf(fp,",NULL");

         /* next slot */

         if (tmpPtr->next == NULL)
           { fprintf(fp,",NULL,"); }
         else
           {
            if ((j + 1) >= maxIndices)
              { fprintf(fp,",&C%d_%d[%d],",imageID,arrayVersion + 1,0); }
            else
              { fprintf(fp,",&C%d_%d[%d],",imageID,arrayVersion,j + 1); }
           }

         fprintf(fp,"%d,%d",tmpPtr->bucket,tmpPtr->count + 1);

         count++;
         j++;

         if ((count == numberOfConstraints) || (j >= maxIndices))
           {
            fprintf(fp,"}};\n");
            GenClose(fp);
            j = 0;
            version++;
            arrayVersion++;
            if (count < numberOfConstraints)
              {
               if ((fp = NewCFile(theEnv,fileName,1,version,FALSE)) == NULL) return(0);
               newHeader = TRUE;
              }
           }
         else
           { fprintf(fp,"},\n"); }
        }
     }

   return(version);
  }
Exemplo n.º 9
0
static intBool GetVariableDefinition(
  void *theEnv,
  char *readSource,
  int *defglobalError,
  int tokenRead,
  struct token *theToken)
  {
   SYMBOL_HN *variableName;
   struct expr *assignPtr;
   DATA_OBJECT assignValue;

   /*========================================*/
   /* Get next token, which should either be */
   /* a closing parenthesis or a variable.   */
   /*========================================*/

   if (! tokenRead) GetToken(theEnv,readSource,theToken);
   if (theToken->type == RPAREN) return(FALSE);

   if (theToken->type == SF_VARIABLE)
     {
      SyntaxErrorMessage(theEnv,"defglobal");
      *defglobalError = TRUE;
      return(FALSE);
     }
   else if (theToken->type != GBL_VARIABLE)
     {
      SyntaxErrorMessage(theEnv,"defglobal");
      *defglobalError = TRUE;
      return(FALSE);
     }

   variableName = (SYMBOL_HN *) theToken->value;

   SavePPBuffer(theEnv," ");

   /*================================*/
   /* Print out compilation message. */
   /*================================*/

#if DEBUGGING_FUNCTIONS
   if ((EnvGetWatchItem(theEnv,"compilations") == ON) && GetPrintWhileLoading(theEnv))
     {
      if (QFindDefglobal(theEnv,variableName) != NULL) 
        {
         PrintWarningID(theEnv,"CSTRCPSR",1,TRUE);
         EnvPrintRouter(theEnv,WDIALOG,"Redefining defglobal: ");
        }
      else EnvPrintRouter(theEnv,WDIALOG,"Defining defglobal: ");
      EnvPrintRouter(theEnv,WDIALOG,ValueToString(variableName));
      EnvPrintRouter(theEnv,WDIALOG,"\n");
     }
   else
#endif
     { if (GetPrintWhileLoading(theEnv)) EnvPrintRouter(theEnv,WDIALOG,":"); }

   /*==================================================================*/
   /* Check for import/export conflicts from the construct definition. */
   /*==================================================================*/

#if DEFMODULE_CONSTRUCT
   if (FindImportExportConflict(theEnv,"defglobal",((struct defmodule *) EnvGetCurrentModule(theEnv)),ValueToString(variableName)))
     {
      ImportExportConflictMessage(theEnv,"defglobal",ValueToString(variableName),NULL,NULL);
      *defglobalError = TRUE;
      return(FALSE);
     }
#endif

   /*==============================*/
   /* The next token must be an =. */
   /*==============================*/

   GetToken(theEnv,readSource,theToken);
   if (strcmp(theToken->printForm,"=") != 0)
     {
      SyntaxErrorMessage(theEnv,"defglobal");
      *defglobalError = TRUE;
      return(FALSE);
     }

   SavePPBuffer(theEnv," ");

   /*======================================================*/
   /* Parse the expression to be assigned to the variable. */
   /*======================================================*/

   assignPtr = ParseAtomOrExpression(theEnv,readSource,NULL);
   if (assignPtr == NULL)
     {
      *defglobalError = TRUE;
      return(FALSE);
     }

   /*==========================*/
   /* Evaluate the expression. */
   /*==========================*/

   if (! ConstructData(theEnv)->CheckSyntaxMode)
     {
      SetEvaluationError(theEnv,FALSE);
      if (EvaluateExpression(theEnv,assignPtr,&assignValue))
        {
         ReturnExpression(theEnv,assignPtr);
         *defglobalError = TRUE;
         return(FALSE);
        }
     }
   else
     { ReturnExpression(theEnv,assignPtr); }

   SavePPBuffer(theEnv,")");

   /*======================================*/
   /* Add the variable to the global list. */
   /*======================================*/

   if (! ConstructData(theEnv)->CheckSyntaxMode)
     { AddDefglobal(theEnv,variableName,&assignValue,assignPtr); }

   /*==================================================*/
   /* Return TRUE to indicate that the global variable */
   /* definition was successfully parsed.              */
   /*==================================================*/

   return(TRUE);
  }
Exemplo n.º 10
0
globle SYMBOL_HN *GetConstructNameAndComment(
  void *theEnv,
  char *readSource,
  struct token *inputToken,
  char *constructName,
  void *(*findFunction)(void *,char *),
  int (*deleteFunction)(void *,void *),
  char *constructSymbol,
  int fullMessageCR,
  int getComment,
  int moduleNameAllowed)
  {
#if (MAC_MCW || WIN_MCW || MAC_XCD) && (! DEBUGGING_FUNCTIONS)
#pragma unused(fullMessageCR)
#endif
   SYMBOL_HN *name, *moduleName;
   int redefining = FALSE;
   void *theConstruct;
   unsigned separatorPosition;
   struct defmodule *theModule;

   /*==========================*/
   /* Next token should be the */
   /* name of the construct.   */
   /*==========================*/

   GetToken(theEnv,readSource,inputToken);
   if (inputToken->type != SYMBOL)
     {
      PrintErrorID(theEnv,"CSTRCPSR",2,TRUE);
      EnvPrintRouter(theEnv,WERROR,"Missing name for ");
      EnvPrintRouter(theEnv,WERROR,constructName);
      EnvPrintRouter(theEnv,WERROR," construct\n");
      return(NULL);
     }

   name = (SYMBOL_HN *) inputToken->value;

   /*===============================*/
   /* Determine the current module. */
   /*===============================*/

   separatorPosition = FindModuleSeparator(ValueToString(name));
   if (separatorPosition)
     {
      if (moduleNameAllowed == FALSE)
        {
         SyntaxErrorMessage(theEnv,"module specifier");
         return(NULL);
        }

      moduleName = ExtractModuleName(theEnv,separatorPosition,ValueToString(name));
      if (moduleName == NULL)
        {
         SyntaxErrorMessage(theEnv,"construct name");
         return(NULL);
        }

      theModule = (struct defmodule *) EnvFindDefmodule(theEnv,ValueToString(moduleName));
      if (theModule == NULL)
        {
         CantFindItemErrorMessage(theEnv,"defmodule",ValueToString(moduleName));
         return(NULL);
        }

      EnvSetCurrentModule(theEnv,(void *) theModule);
      name = ExtractConstructName(theEnv,separatorPosition,ValueToString(name));
      if (name == NULL)
        {
         SyntaxErrorMessage(theEnv,"construct name");
         return(NULL);
        }
     }

   /*=====================================================*/
   /* If the module was not specified, record the current */
   /* module name as part of the pretty-print form.       */
   /*=====================================================*/

   else
     {
      theModule = ((struct defmodule *) EnvGetCurrentModule(theEnv));
      if (moduleNameAllowed)
        {
         PPBackup(theEnv);
         SavePPBuffer(theEnv,EnvGetDefmoduleName(theEnv,theModule));
         SavePPBuffer(theEnv,"::");
         SavePPBuffer(theEnv,ValueToString(name));
        }
     }

   /*==================================================================*/
   /* Check for import/export conflicts from the construct definition. */
   /*==================================================================*/

#if DEFMODULE_CONSTRUCT
   if (FindImportExportConflict(theEnv,constructName,theModule,ValueToString(name)))
     {
      ImportExportConflictMessage(theEnv,constructName,ValueToString(name),NULL,NULL);
      return(NULL);
     }
#endif

   /*========================================================*/
   /* Remove the construct if it is already in the knowledge */
   /* base and we're not just checking syntax.               */
   /*========================================================*/

   if ((findFunction != NULL) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      theConstruct = (*findFunction)(theEnv,ValueToString(name));
      if (theConstruct != NULL)
        {
         redefining = TRUE;
         if (deleteFunction != NULL)
           {
            if ((*deleteFunction)(theEnv,theConstruct) == FALSE)
              {
               PrintErrorID(theEnv,"CSTRCPSR",4,TRUE);
               EnvPrintRouter(theEnv,WERROR,"Cannot redefine ");
               EnvPrintRouter(theEnv,WERROR,constructName);
               EnvPrintRouter(theEnv,WERROR," ");
               EnvPrintRouter(theEnv,WERROR,ValueToString(name));
               EnvPrintRouter(theEnv,WERROR," while it is in use.\n");
               return(NULL);
              }
           }
        }
     }

   /*=============================================*/
   /* If compilations are being watched, indicate */
   /* that a construct is being compiled.         */
   /*=============================================*/

#if DEBUGGING_FUNCTIONS
   if ((EnvGetWatchItem(theEnv,"compilations") == TRUE) &&
       GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode))
     {
      if (redefining) 
        {
         PrintWarningID(theEnv,"CSTRCPSR",1,TRUE);
         EnvPrintRouter(theEnv,WDIALOG,"Redefining ");
        }
      else EnvPrintRouter(theEnv,WDIALOG,"Defining ");

      EnvPrintRouter(theEnv,WDIALOG,constructName);
      EnvPrintRouter(theEnv,WDIALOG,": ");
      EnvPrintRouter(theEnv,WDIALOG,ValueToString(name));

      if (fullMessageCR) EnvPrintRouter(theEnv,WDIALOG,"\n");
      else EnvPrintRouter(theEnv,WDIALOG," ");
     }
   else
#endif
     {
      if (GetPrintWhileLoading(theEnv) && (! ConstructData(theEnv)->CheckSyntaxMode))
        { EnvPrintRouter(theEnv,WDIALOG,constructSymbol); }
     }

   /*===============================*/
   /* Get the comment if it exists. */
   /*===============================*/

   GetToken(theEnv,readSource,inputToken);
   if ((inputToken->type == STRING) && getComment)
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv," ");
      SavePPBuffer(theEnv,inputToken->printForm);
      GetToken(theEnv,readSource,inputToken);
      if (inputToken->type != RPAREN)
        {
         PPBackup(theEnv);
         SavePPBuffer(theEnv,"\n   ");
         SavePPBuffer(theEnv,inputToken->printForm);
        }
     }
   else if (inputToken->type != RPAREN)
     {
      PPBackup(theEnv);
      SavePPBuffer(theEnv,"\n   ");
      SavePPBuffer(theEnv,inputToken->printForm);
     }

   /*===================================*/
   /* Return the name of the construct. */
   /*===================================*/

   return(name);
  }
Exemplo n.º 11
0
globle void ConstructsToCCommand()
  {
   char *fileName;
   DATA_OBJECT theArg;
   int argCount;
   int id, max;
#if VAX_VMS || IBM_MSC || IBM_TBC || IBM_ICB || IBM_ZTC || IBM_SC
   int i;
#endif

   /*============================================*/
   /* Check for appropriate number of arguments. */
   /*============================================*/

   if ((argCount = ArgRangeCheck("constructs-to-c",2,3)) == -1) return;

   /*====================================================*/
   /* Get the name of the file in which to place C code. */
   /*====================================================*/

   if (ArgTypeCheck("constructs-to-c",1,SYMBOL_OR_STRING,&theArg) == FALSE)
     { return; }

   fileName = DOToString(theArg);

   /*================================*/
   /* File names for the VAX and IBM */
   /* PCs can't contain a period.    */
   /*================================*/

#if VAX_VMS || IBM_MSC || IBM_TBC || IBM_ICB || IBM_ZTC || IBM_SC
   for (i = 0 ; *(fileName+i) ; i++)
     {
      if (*(fileName+i) == '.')
        {
         PrintErrorID("CONSCOMP",1,FALSE);
         PrintRouter(WERROR,"Invalid file name ");
         PrintRouter(WERROR,fileName);
         PrintRouter(WERROR," contains \'.\'\n");
         return;
        }
      }
#endif

   /*===========================================*/
   /* If the base file name is greater than 3   */
   /* characters, issue a warning that the file */
   /* name lengths may exceed what is allowed   */
   /* under some operating systems.             */
   /*===========================================*/

   if (((int) strlen(fileName)) > 3)
     {
      PrintWarningID("CONSCOMP",1,FALSE);
      PrintRouter(WWARNING,"Base file name exceeds 3 characters.\n");
      PrintRouter(WWARNING,"  This may cause files to be overwritten if file name length\n");
      PrintRouter(WWARNING,"  is limited on your platform.\n");
     }

   /*====================================*/
   /* Get the runtime image ID argument. */
   /*====================================*/

   if (ArgTypeCheck("constructs-to-c",2,INTEGER,&theArg) == FALSE)
     { return; }

   id = DOToInteger(theArg);
   if (id < 0)
     {
      ExpectedTypeError1("constructs-to-c",2,"positive integer");
      return;
     }

   /*===========================================*/
   /* Get the maximum number of data structures */
   /* to store per file argument (if supplied). */
   /*===========================================*/

   if (argCount == 3)
     {
      if (ArgTypeCheck("constructs-to-c",3,INTEGER,&theArg) == FALSE)
        { return; }

      max = DOToInteger(theArg);

      if (max < 0)
        {
         ExpectedTypeError1("constructs-to-c",3,"positive integer");
         return;
        }
     }
   else
     { max = 10000; }

   /*============================*/
   /* Call the driver routine to */
   /* generate the C code.       */
   /*============================*/

   ConstructsToC(fileName,id,max);
  }
Exemplo n.º 12
0
globle FILE *OpenFileIfNeeded(
  FILE *theFile,
  char *fileName,
  int fileID,
  int imageID,
  int *fileCount,
  int arrayVersion,
  FILE *headerFP,
  char *structureName,
  char *structPrefix,
  int reopenOldFile,
  struct CodeGeneratorFile *codeFile)
  {
   char arrayName[80];
   char *newName;
   int newID, newVersion;

   /*===========================================*/
   /* If a file is being reopened, use the same */
   /* version number, name, and ID as before.   */
   /*===========================================*/

   if (reopenOldFile)
     {
      if (codeFile == NULL)
        {
         SystemError("CONSCOMP",5);
         ExitRouter(EXIT_FAILURE);
        }

      newName = codeFile->filePrefix;
      newID = codeFile->id;
      newVersion = codeFile->version;
     }

   /*=====================================================*/
   /* Otherwise, use the specified version number, name,  */
   /* and ID. If the appropriate argument is supplied,    */
   /* remember these values for later reopening the file. */
   /*=====================================================*/

   else
     {
      newName = fileName;
      newVersion = *fileCount;
      newID = fileID;

      if (codeFile != NULL)
        {
         codeFile->version = newVersion;
         codeFile->filePrefix = newName;
         codeFile->id = newID;
        }
     }

   /*=========================================*/
   /* If the file is already open, return it. */
   /*=========================================*/

   if (theFile != NULL)
     {
      fprintf(theFile,",\n");
      return(theFile);
     }

   /*================*/
   /* Open the file. */
   /*================*/

   if ((theFile = NewCFile(newName,newID,newVersion,reopenOldFile)) == NULL)
     { return(NULL); }

   /*=========================================*/
   /* If this is the first time the file has  */
   /* been opened, write out the beginning of */
   /* the array variable definition.          */
   /*=========================================*/

   if (reopenOldFile == FALSE)
     {
      (*fileCount)++;
      sprintf(arrayName,"%s%d_%d",structPrefix,imageID,arrayVersion);

#if SHORT_LINK_NAMES
      if (strlen(arrayName) > 6)
        {
         PrintWarningID("CONSCOMP",2,FALSE);
         PrintRouter(WWARNING,"Array name ");
         PrintRouter(WWARNING,arrayName);
         PrintRouter(WWARNING,"exceeds 6 characters in length.\n");
         PrintRouter(WWARNING,"   This variable may be indistinguishable from another by the linker.\n");
        }
#endif
      fprintf(theFile,"%s %s[] = {\n",structureName,arrayName);
      fprintf(headerFP,"extern %s %s[];\n",structureName,arrayName);
     }
   else
     { fprintf(theFile,",\n"); }

   /*==================*/
   /* Return the file. */
   /*==================*/

   return(theFile);
  }