smif.c

强大的数学工具包

#include "SMif.h"

/* erzeugen von SMif Workspace: Init. von SMifptr ClientData 
   Definition von SMif-Befehlen... */
   
int SMif_Init (SMifinfo * SMifptr, char* infile) 
{
   FILE * infileptr;
   char line[MAXLINESIZE+1];
   int mm;
   SMifptr->interp = Tcl_CreateInterp();
   SMifptr->envinfo = (EnvInfo) malloc (sizeof(struct EnvInfoItem));
   InitEnvinfo (SMifptr->envinfo,(EnvInfo)NULL);
   Tcl_DStringInit (&(SMifptr->result));
      
   /* fbuffer */
   infileptr = fopen (infile,"r");
   if (infileptr == NULL) {
	  (void)fprintf (stderr, "cannot access %s\n", infile);
	  free (SMifptr);
	  exit (1);
   }
   SMifptr->fbuffer.eof = 0;
   SMifptr->fbuffer.linecount = 0;
   SMifptr->fbuffer.curline   = 0;
   while (!feof(infileptr)) {
	  (void)fgets (line,MAXLINESIZE,infileptr);
	  SMifptr->fbuffer.linecount ++;
   }
   SMifptr->fbuffer.linecount --; 
   (void)fseek (infileptr,0,SEEK_SET);
   SMifptr->fbuffer.lines = (LineBuffer*) malloc (sizeof(LineBuffer)*
							 SMifptr->fbuffer.linecount);
   for (mm = 0; mm < SMifptr->fbuffer.linecount; mm++) {
	  (void)fgets (line, MAXLINESIZE,infileptr);
	  if ( line[strlen(line)-1] == '\n')
		 line[strlen(line)-1] = '\0';
	  SMifptr->fbuffer.lines[mm].length = strlen (line);
	  SMifptr->fbuffer.lines[mm].curpos = 0;
	  SMifptr->fbuffer.lines[mm].line = (char*)malloc(sizeof(char)*
						(SMifptr->fbuffer.lines[mm].length+1) );
	  strcpy(SMifptr->fbuffer.lines[mm].line, line);
   }
	    
   (void)fclose (infileptr);
   
   /* commands */
   Tcl_CreateCommand (SMifptr->interp, "SKIP", (Tcl_CmdProc*) SKIPCmd, 
					  (ClientData)SMifptr, (Tcl_CmdDeleteProc*) NULL );
   Tcl_CreateCommand (SMifptr->interp, "GET", (Tcl_CmdProc*) GETCmd, 
					  (ClientData)SMifptr, (Tcl_CmdDeleteProc*) NULL);
   Tcl_CreateCommand (SMifptr->interp, "REPEAT", (Tcl_CmdProc*) REPEATCmd, 
					  (ClientData)SMifptr, (Tcl_CmdDeleteProc*) NULL);
   Tcl_CreateCommand (SMifptr->interp, "IGNORE", (Tcl_CmdProc*) IGNORECmd, 
					  (ClientData)SMifptr, (Tcl_CmdDeleteProc*) NULL);					  					  					
   Tcl_CreateCommand (SMifptr->interp, "SETITEM", (Tcl_CmdProc*) SETITEMCmd, 
					  (ClientData)SMifptr, (Tcl_CmdDeleteProc*) NULL);					  
   Tcl_CreateCommand (SMifptr->interp, "NOPOWER", (Tcl_CmdProc*) NOPOWERCmd, 
					  (ClientData)SMifptr, (Tcl_CmdDeleteProc*) NULL);
   Tcl_CreateCommand (SMifptr->interp, "STOPGET", (Tcl_CmdProc*) STOPGETCmd, 
					  (ClientData)SMifptr, (Tcl_CmdDeleteProc*) NULL);				  
   Tcl_CreateCommand (SMifptr->interp, "IF", (Tcl_CmdProc*) IFCmd, 
					  (ClientData)SMifptr,(Tcl_CmdDeleteProc*) NULL);
   Tcl_CreateCommand (SMifptr->interp, "SWITCH", (Tcl_CmdProc*) SWITCHCmd, 
					  (ClientData)SMifptr, (Tcl_CmdDeleteProc*) NULL);
   return TCL_OK;
}


/* Definition des SMif-Befehls: SWITCH */

int SWITCHCmd (ClientData clientData, Tcl_Interp *interp, int argc, char* argv[])
{
   SMifinfo * smifptr = (SMifinfo*) clientData;
   FileBuffer *fbptr = &(smifptr->fbuffer);
   SMif_table *temptabarr = NULL, *ignotabptr = &(smifptr->envinfo->ignotable); 
   char * curword = NULL;
   int mm, condcount;
   int otherwise = 0;
   int result = TCL_OK;
   
   if ( argc < 4 || strcmp(argv[1],"NEXTOBJ")!=0 || 
		(int)(argc / 2) *2 != argc ||
		argc == 4 && strcmp(argv[2],"OTHERWISE")==0 ) {
	  Tcl_AppendResult (interp, argv[0], ": wrong # args: should be \"SWITCH ",
			" NEXTOBJ {...} {subscript1} {...} {subscript2}  ... (OTHERWISE "
			"{subscriptn})\"",(char*)NULL);
	  return TCL_ERROR;
   }
   if (strcmp(argv[argc-2],"OTHERWISE") == 0) 
	  otherwise = 1;

   condcount = argc/2-1-otherwise;	  
   temptabarr = (SMif_table*)malloc(sizeof(SMif_table)*condcount);
   for (mm=0; mm < condcount; mm++) {
	  temptabarr[mm].wordtable = NULL;
	  temptabarr[mm].chartable = NULL;
	  if ( !ModifySMif_table(argv[mm*2+2],temptabarr+mm,MODIFYTABLE_ADD)) {	 
		 Tcl_AppendResult (interp, argv[0], " --- ",argv[mm*2+3],": wrong format: ",
						   "should be { [CHAR] ch1 ch2 ... [WORD] word1 word2 ... }\n",
						   (char*)NULL);
		 return TCL_ERROR;
	  }
   }
   
   curword = GetNextWord (fbptr, ignotabptr, (int*)NULL);
   if (!fbptr->eof) {
	  for (mm = 0; mm < condcount; mm++)
		 if (isinwordtable (curword, temptabarr[mm].wordtable) ||
			 isinchartable (curword[0],temptabarr[mm].chartable) ) {
			result = Tcl_Eval (smifptr->interp, argv[mm*2+3]);
			break;
		 }
	  if (mm == condcount &&  otherwise)
		 result = Tcl_Eval (smifptr->interp, argv[argc-1]);
   }
   if (curword!=NULL) free (curword);
   for (mm=0; mm < condcount; mm++) {
	  delchartable (&(temptabarr[mm].chartable));
	  delwordtable (&(temptabarr[mm].wordtable));   
   }
   return result;			 
}

/* Definition des SMif-befehls: IF */

int IFCmd (ClientData clientData, Tcl_Interp *interp, int argc, char* argv[])
{
   SMifinfo * smifptr = (SMifinfo*) clientData;
   SMif_table temptable, *ignotabptr;
   FileBuffer *fbptr = &(smifptr->fbuffer);
   char * curword = NULL;
   int result = TCL_OK;
   
   temptable.chartable = NULL;
   temptable.wordtable = NULL;
   ignotabptr = &(smifptr->envinfo->ignotable);
   
   Tcl_ResetResult (interp);
   if ( !(argc == 4 && strcmp(argv[1],"SEE") == 0) &&
		!(argc == 6 && strcmp(argv[1],"SEE")==0 && strcmp(argv[4],"ELSE")==0))
   {
	  Tcl_AppendResult (interp, argv[0],": wrong # args: should be \"IF SEE",
			" {...} { subscript }\" or \"IF SEE {...} {subscript1} ELSE {sub",
			"script2\"", (char*)NULL);
	  return TCL_ERROR;
   }
   
   if ( !ModifySMif_table(argv[2],&temptable,MODIFYTABLE_ADD)) {	 
	  Tcl_AppendResult (interp, argv[0],": wrong format: should be { [CHAR] ch1 ch2 ",
						"... [WORD] word1 word2 ... }\n",(char*)NULL);
	  return TCL_ERROR;
   }
   
   curword = GetNextWord (fbptr, ignotabptr, (int*)NULL);
   
   if (!fbptr->eof) {
	  if ( isinwordtable (curword, temptable.wordtable) ||
		   isinchartable (curword[0],temptable.chartable) ) 
		 result = Tcl_Eval (smifptr->interp, argv[3]);
	  else if (argc == 6) 
		 result = Tcl_Eval (smifptr->interp, argv[5]);
	  free (curword);
   }
   
   delchartable (&(temptable.chartable));
   delwordtable (&(temptable.wordtable));   
   return (result);
}
   
            
/* Definition des SMif-Befehls: LINESKIP  */

int SKIPCmd (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
   SMifinfo * smifptr = (SMifinfo*) clientData;
   int step, mm, IsDigit = 1, templen;
   SMif_table  temptable, *ignotabptr;
   int  endwhile = 0;
   FileBuffer *fbptr = &(smifptr->fbuffer);
   LineBuffer *lbptr = NULL;
   char *tempword = NULL;
   int seen;
   
   temptable.chartable = NULL;
   temptable.wordtable = NULL;
   ignotabptr = &(smifptr->envinfo->ignotable);
   Tcl_ResetResult (interp);
   if (!(argc == 3 && strcmp(argv[2],"LINE")==0) &&
	   !(argc == 4 && strcmp(argv[1],"UNTIL")== 0 && 
	   (strcmp(argv[2],"SEEN")==0 || strcmp(argv[2],"SEE")==0) ) ) {
	  Tcl_AppendResult (interp, argv[0],": wrong # args:  should be \"SKIP n LINE\" or",
						" \"SKIP UNTIL SEE(N) { ... }\"",(char*)NULL);
	  return TCL_ERROR;
   }
   
   if (smifptr->envinfo->getinfo.subtype == LINENEXT) {
	  smifptr->envinfo->getinfo.err = SKIPERR;
	  return TCL_ERROR;
   } /* invalid in the subscript of GET LIST FOR NEXT ... */
				   
   if (argc == 3) {
	  templen = strlen(argv[1]);
	  if (!isdigit(argv[1][0]) && argv[1][0]!='+' && argv[1][0]!='-') IsDigit = 0;  
	  else
		 for (mm = 1; mm < templen; mm++)
		    if (!isdigit(argv[1][mm])) {
		       IsDigit = 0;
			   break;
			}
	  if (!IsDigit) {
		 Tcl_AppendResult (interp, argv[0],": expected integer but got ", "\"",
						   argv[1], "\"\n",(char*) NULL);
		 return TCL_ERROR;
	  }
	  step = atoi (argv[1]);
	  fbptr->curline+=step;
	  if (fbptr->curline >= fbptr->linecount) {
		 fbptr->curline = fbptr->linecount - 1;
		 fbptr->eof = 1;
	  } else fbptr->eof = 0;
	  if (fbptr->curline < 0) fbptr->curline = 0;
	  fbptr->lines[fbptr->curline].curpos = 0;
	  return TCL_OK;
   }
   else {
   
	  if ( !ModifySMif_table(argv[3],&temptable,MODIFYTABLE_ADD)) {	 
		 Tcl_AppendResult (interp, argv[0],": wrong format: should be { [CHAR] ch1 ch2 ",
						"... [WORD] word1 word2 ... }\n",(char*)NULL);
		 return TCL_ERROR;
	  }
	  if (strcmp(argv[2],"SEE")==0) seen = 0;
	  else seen = 1;
	  	  
	  while (!endwhile) {
		 tempword = GetNextWord(fbptr, ignotabptr, (int*)NULL);
		 lbptr = &(fbptr->lines[fbptr->curline]);
		 if (fbptr->eof || IsObjInTab(tempword,&(lbptr->curpos),&(temptable),seen) )
			endwhile = 1;
		 else
			lbptr->curpos += strlen(tempword);
		 free (tempword);
		 tempword = NULL;
	  }
	  
	  delchartable (&(temptable.chartable));
	  delwordtable (&(temptable.wordtable));
	  return TCL_OK;
   }
}


/* Definition des SMif-Befehls: REPEATCmd */
int REPEATCmd (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[]) 
{
   SMifinfo * smifptr = (SMifinfo*) clientData;
   char *curword = NULL;
   SMif_table * repeattabptr = &(smifptr->envinfo->repeattable);
   FileBuffer * fbptr = &(smifptr->fbuffer);
   SMif_table * ignotabptr = &(smifptr->envinfo->ignotable);
   SMif_table * stoptabptr = &(smifptr->envinfo->stoptable);
   int endwhile = 0;
   
   Tcl_ResetResult (smifptr->interp);
   if (argc != 5 || strcmp (argv[1],"UNTIL") != 0 || 
	   strcmp (argv[2],"SEE") != 0 ) {
	  Tcl_AppendResult (interp, argv[0],": wrong args: should be \"UNTIL SEE {...}",
						" { Script }\"\n", (char*)NULL);
	  return TCL_ERROR;
   }
   if (ModifySMif_table (argv[3],repeattabptr,MODIFYTABLE_ADD)==0) {
	  Tcl_AppendResult (interp, argv[0],": wrong format: should be { [CHAR] ch1",
						" ch2 ... [WORD] word1 word2 ...}\n",(char*)NULL);
	  return TCL_ERROR;
   }
   
   while (!endwhile) {
	  curword = GetNextWord (fbptr, ignotabptr, (int*)NULL);
	  if ( fbptr->eof ||   /* curword == NULL */
		   isinwordtable (curword,repeattabptr->wordtable) ||
		   isinchartable (curword[0],repeattabptr->chartable) ||
		   isinwordtable (curword,stoptabptr->wordtable)   ||
		   isinchartable (curword[0],stoptabptr->chartable) )
		 endwhile = 1;
	  else
		 if (Tcl_Eval (smifptr->interp, argv[4])==TCL_ERROR) return TCL_ERROR;
		 	  
	  if (curword!=NULL) free(curword);
	  curword = NULL;
   }
   
   (void)ModifySMif_table (argv[3], repeattabptr, MODIFYTABLE_DEL);
   return TCL_OK;							     
}


int GETCmd (ClientData clientData, Tcl_Interp *interp, int argc, char *argv[])
{
   SMifinfo *smifptr = (SMifinfo*) clientData;
   GetInfo * getinfoptr = &(smifptr->envinfo->getinfo);
   EnvInfo   envinfonew = NULL;
   int mm, tempint;
   int option = UNDEFINED;
   int isdigit = 1, endwhile = 0, islevel0 = 0;
   Tcl_DString *polptr = NULL;
   char *poltemp = NULL;
            
   Tcl_ResetResult (interp);
   
   /* syntax checking */
   if (argc >= 2) {
	  if (strcmp(argv[1], "SINGLE") == 0) {
		 option = SMif_GETSINGLE;
		 if ( argc != 3 ) {
			Tcl_AppendResult (interp, "GET SINGLE: wrong #args: should be \"GET SINGLE",
							  " { script }\"\n", (char*)NULL);
			return TCL_ERROR;
		 }
	  }		 
	  else if (strcmp(argv[1], "LIST") == 0) {
		 option = SMif_GETLIST;
		 if (!( argc == 3 || 
				strcmp(argv[2],"FOR") ==0 && strcmp (argv[3], "NEXT") == 0 && 
				( argc == 6 && 
				  (strcmp (argv[4],"ITEM") ==0 || strcmp (argv[4], "LINE") == 0) ||
				  argc == 7 && 
				  (strcmp (argv[5],"ITEM") ==0 || strcmp (argv[5], "LINE") == 0) ) 
			  ) ) 
		 {
			Tcl_AppendResult (interp,"GET LIST: wrong args: should be \"GET LIST",
							  " { script }\"  or\n        \"GET LIST FOR NEXT (n) ",
							  "ITEM(LINE)	{ script }\"\n",(char*)NULL);
			return TCL_ERROR;
		 }	  
	  }
	  else if (strcmp(argv[1], "POL") == 0) {
		 option = SMif_GETPOL;
		 if ( !( argc == 3 ||
				 strcmp(argv[2],"FOR") == 0 && strcmp (argv[3],"NEXT")==0 &&
				 ( argc == 6 && strcmp (argv[4], "LINE") == 0 ||
				   argc == 7 && strcmp (argv[5], "LINE") == 0 )
			   ) )
		 {
			Tcl_AppendResult (interp, "GET POL: wrong args: should be \"GET POL",
							  " { script }\" or\n        \"GET POL FOR NEXT (n) ",
							  "LINE { script }\"\n", (char*)NULL);
			return TCL_ERROR;
		 }
	  }
	  else if (strcmp(argv[1], "INT") == 0) {
		 option = SMif_GETINT;
		 if ( argc != 3 ) {
			Tcl_AppendResult (interp, "GET INT: wrong #args: should be \"GET INT",
							  " { script }\"\n", (char*)NULL);
			return TCL_ERROR;
		 }
	  }
	  else {
		 Tcl_AppendResult (interp, "GET : bad option \"",argv[1],"\": should be",
						"SINGLE, LIST, POL or INT",(char*)NULL);
		 return TCL_ERROR;
	  }
   }
   else {
	  Tcl_AppendResult (interp, "GET : wrong # args, shold be \"GET option",
						" ? arg arg ... ?\"", (char*)NULL);
	  return TCL_ERROR;
   }
   
   /* semantik checking */
   if (getinfoptr->type == UNDEFINED) islevel0 = 1;
   if (!( islevel0 ||
		  getinfoptr->type == SMif_GETLIST && option == SMif_GETLIST)) 
   {
	  getinfoptr->err = TYPEERR;
	  return TCL_ERROR;
   }
   
   if (getinfoptr->type == SMif_GETLIST && getinfoptr->subtype != UNDEFINED)
   {
	  getinfoptr->err = SUBTYPEERR;
	  return TCL_ERROR;
   } /* invalid: run GET LIST under GET LIST FOR NEXT ... */
   
   /* create new level */
   envinfonew = (EnvInfo) malloc (sizeof(struct EnvInfoItem));
   InitEnvinfo (envinfonew,smifptr->envinfo);
   smifptr->envinfo = envinfonew;
   getinfoptr = &(smifptr->envinfo->getinfo);
   getinfoptr->type = option;
   
   if (argc == 6) {  /* GET LIST or GET POL */
	  if (option == SMif_GETLIST) {
		 if (strcmp (argv[4],"ITEM") == 0)
			getinfoptr->subtype = ITEMNEXT;
		 else getinfoptr->subtype = LINENEXT;
	  } else 
		 getinfoptr->subtype = LINENEXT; /* GET POL */
	  getinfoptr->count = 1;