[splint.git] / src / lslparse.c

/*
** LCLint - annotation-assisted static program checker
** Copyright (C) 1994-2000 University of Virginia,
**         Massachusetts Institute of Technology
**
** This program is free software; you can redistribute it and/or modify it
** under the terms of the GNU General Public License as published by the
** Free Software Foundation; either version 2 of the License, or (at your
** option) any later version.
** 
** This program 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
** General Public License for more details.
** 
** The GNU General Public License is available from http://www.gnu.org/ or
** the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
** MA 02111-1307, USA.
**
** For information on lclint: lclint-request@cs.virginia.edu
** To report a bug: lclint-bug@cs.virginia.edu
** For more information: http://lclint.cs.virginia.edu
*/
/*
** lslparse.c
**
** Module for calling LSL checker.
**
**  AUTHOR:
**	Yang Meng Tan,
**         Massachusetts Institute of Technology
*/

# include "lclintMacros.nf"
# include "llbasic.h"
# include "lclscan.h"
# include "signature.h"
# include "signature2.h"
# include "scan.h"
# include "scanline.h"
# include "syntable.h"
# include "tokentable.h"
# include "lslinit.h"
# include "lslparse.h"
# include "llmain.h"

/*@+ignorequals@*/

/*@dependent@*/ /*@null@*/ lslOp g_importedlslOp = NULL;
bool g_lslParsingTraits = FALSE;

static void invokeLSL (char *p_infile, char *p_outfile, bool p_deletep);

int
parseSignatures (cstring infile)
{
  char *cinfile = cstring_toCharsSafe (infile);
  tsource *sourceFile;
  ltoken *id = (ltoken *) dmalloc (sizeof (*id));
  int status = 0;

  /* parse traits */
  *id = LSLInsertToken (LST_SIMPLEID, lsymbol_fromChars (cinfile), 0, FALSE);
  ltoken_setFileName (*id, cinfile);
  ltoken_setLine (*id, 0);
  ltoken_setCol (*id, 0);

  sourceFile = tsource_create (cinfile, "", FALSE);

  if (!tsource_getPath (cstring_toCharsSafe (context_getLarchPath ()), sourceFile))
    {
      lclplainerror 
	(message ("LSL signature parsing: can't find file %s containing trait",
		  cstring_fromChars (tsource_fileName (sourceFile))));
      status = 1;

      sfree (id);
      tsource_free (sourceFile);
      return status;
    }

  if (!tsource_open (sourceFile))
    {
      lclplainerror 
	(cstring_makeLiteral ("LSL parsing: can't open file containing trait"));
      status = 2;
      sfree (id);
      tsource_free (sourceFile);

      return status;
    }

  lsldebug = 0;
  g_lslParsingTraits = TRUE;
  LSLScanReset (sourceFile);
  LSLReportEolTokens (FALSE);

  status = lslparse ();

  /* symtable_dump (symtab, stdout, TRUE); */
  g_lslParsingTraits = FALSE;

  (void) tsource_close (sourceFile);
  tsource_free (sourceFile);

  sfree (id);

  
  return status;
}

/*@only@*/ lslOp
parseOpLine (char *fname, char *line)
{
  tsource *sourceFile;
  bool status;

  sourceFile = tsource_fromString (fname, line);
  
  if (check (tsource_open (sourceFile)))
    {
      LSLScanReset (sourceFile);
      LSLReportEolTokens (FALSE); /* 0 by default, lslParsingTraits = 0; */
      
      /*
      ** lsl parsing and importing .lcs files are expected to be mutually
      ** exclusive. 
      **
      ** lslparse sets importedlslOp
      */
      
      status = (lslparse () != 0);
      
      if (status)
	{
	  lclplainfatalerror (message ("Error in parsing line: %s", 
				       cstring_fromChars (line)));
	}
      
      (void) tsource_close (sourceFile);
    }

  tsource_free (sourceFile);
  
  llassert (g_importedlslOp != NULL);
  return (lslOp_copy (g_importedlslOp));
}

lsymbol
processTraitSortId (lsymbol sortid)
{
  lsymbol out = lsymbol_sortFromType (g_symtab, sortid);
  if (out == sortid)
    { /* may be a new sort */
      (void) sort_fromLsymbol (sortid);
    }
  return out;
}

/* formerly from check.c module */

static /*@only@*/ cstring
printTypeName2 (typeNameNode n)
{
  cstring s = cstring_undefined;
  sortNode sn;
  lsymbol lclSort;
  ltoken err;

  if (n != (typeNameNode) 0)
    {
      if (n->isTypeName)
	{
	  /* does not process opForm renaming, pass on to LSL
	     and hope that it works for now. */
	  typeNamePack p = n->typename;

	  llassert (p != NULL);

	  /* get the LCL type, assume LCL type has already been mentioned. */
	  lclSort = lclTypeSpecNode2sort (p->type);
	  lclSort = sort_getUnderlying (lclSort);
	  /* lclsource = LCLSLScanSource (); */
	  if (!sort_isValidSort (lclSort))
	    {
	      err = lclTypeSpecNode_errorToken (p->type);
	      /* errorShowPoint (tsource_thisLine (lclsource), ltoken_getCol (err)); */
	      lclerror (err, message ("Unrecognized type in uses: %q", 
				      typeNameNode_unparse (n)));
	    }
	  else
	    {
	      /* 
              ** Below is necessary because this is one place where an LCL mutable
	      ** type name is mapped directly into its value sort, not obj sort.
	      ** Allows us to support only one qualifying "obj", rather
	      ** than "val" as well. 
	      */
	      
	      lclSort = typeExpr2ptrSort (lclSort, p->abst);
	      lclSort = sort_makeVal (lclSort);
	      
	      /*
	      ** Check that lclSort is not a HOFSort ...
	      ** Propagation of HOFSort should stop here.  
	      */

	      if (sort_isHOFSortKind (lclSort))
		{
		  err = lclTypeSpecNode_errorToken (p->type);
		  
		  lclfatalerror
		    (err, 
		     cstring_makeLiteral 
		     ("LCL uses cannot handle higher-order types"));
		}
	      if (p->isObj)
		lclSort = sort_makeObj (lclSort);
	      
	      /*	if (!p->isObj) {
			lclSort = sort_makeVal (lclSort);
			} */
	      
	      sn = sort_lookup (lclSort);
	      s = cstring_copy (cstring_fromChars (lsymbol_toChars (sn.name)));
	      /* s = string_paste (s, AbstDeclaratorNode_unparse (p->abst)); */
	    }
	}
      else
	{
	  /* s = OpFormNode_unparse (n->opform); */
	  if (n->opform != 0)
	    {
	      lclfatalerror 
		(n->opform->tok,
		 cstring_makeLiteral ("Attempt to rename operator with uses: "
				     "use LSL includes renaming facility"));
	    }
	  else
	    {		
	      BADEXIT;
	    }
	}
    }
  return s;
}

static /*@only@*/ cstring
replaceNode_unparseAlt (replaceNode x)
{
  cstring s = cstring_undefined;

  if (x != (replaceNode) 0)
    {
      s = printTypeName2 (x->typename);
      s = cstring_concatChars (s, " for ");

      if (x->isCType)
	{
	  s = cstring_concatFree1 (s, ltoken_unparse (x->content.ctype));
	}
      else
	{
	  s = cstring_concatFree (s, nameNode_unparse (x->content.renamesortname.name));
	  s = cstring_concatFree (s, 
				  sigNode_unparse (x->content.renamesortname.signature));
	}
    }

  return s;
}

static /*@only@*/ cstring
replaceNodeList_unparseAlt (replaceNodeList x)
{
  cstring s = cstring_undefined;
  bool first = TRUE;

  replaceNodeList_elements (x, i)
    {
      if (first)
	{
	  s = replaceNode_unparseAlt (i);
	  first = FALSE;
	}
      else
	{
	  s = message ("%q, %q", s, replaceNode_unparseAlt (i));
	}
    } end_replaceNodeList_elements;

  return s;
}

static /*@only@*/ cstring
printNameList2 (typeNameNodeList x)
{
  /* printing a list of typeNameNode's, not nameNode's */
  bool first = TRUE;
  cstring s = cstring_undefined;

  typeNameNodeList_elements (x, i)
  {
    if (first)
      {
	s = printTypeName2 (i);
	first = FALSE;
      }
    else
      {
	s = message ("%q, %q", s, printTypeName2 (i));
      }
    } end_typeNameNodeList_elements; 

  return s;
}

static /*@only@*/ cstring
printRenamingNode2 (renamingNode x)
{
  cstring s = cstring_undefined;

  if (x != (renamingNode) 0)
    {
      if (x->is_replace)
	{
	  replaceNodeList r = x->content.replace;
	  s = replaceNodeList_unparseAlt (r);
	}
      else
	{
	  nameAndReplaceNode n = x->content.name;
	  bool printComma = TRUE;
	  if (typeNameNodeList_size (n->namelist) == 0)
	    {
	      printComma = FALSE;
	    }
	  s = printNameList2 (n->namelist);
	  if (printComma)
	    if (replaceNodeList_isDefined (n->replacelist) &&
		replaceNodeList_size (n->replacelist) != 0)
	      {
		s = cstring_appendChar (s, ',');
		s = cstring_appendChar (s, ' ');
	      }
	  s = cstring_concatFree (s, replaceNodeList_unparseAlt (n->replacelist));
	}
    }
  return s;
}

static /*@only@*/ cstring
printTraitRefList2 (traitRefNodeList x)
{
  cstring s = cstring_undefined;

  traitRefNodeList_elements (x, i)
  {
    s = message ("%qincludes (%q)", s, printRawLeaves2 (i->traitid));

    if (i->rename != 0)
      {
	s = message ("%q(%q)", s, printRenamingNode2 (i->rename));
      }
    s = message ("%q\n", s);
  } end_traitRefNodeList_elements;

  return s;
}

void
callLSL (/*@unused@*/ char *specfile, /*@only@*/ char *text)
{
  /* specfile is the name of the LCL file that contains "uses"
     Create an intermediate file named
     specfile_<TEMP_LSL_SUFFIX>.<TEMP_LSL_IN_SUFFIX>.
     put text in the file, run lsl on it and direct
     output to specfile_<TEMP_LSL_SUFFIX>.<TEMP_LSL_OUT_SUFFIX>.
     specfile can be a full pathname.
     Note: LSL does not support traitnames that are pathnames, only
     symbols. 
     */

  char *infile, *outfile;
  char *tmp1, *tmp2;
  FILE *inptr;

  infile = cstring_toCharsSafe (fileName (fileTable_addltemp (context_fileTable ())));
  
  inptr = fopen (infile, "w");
  
  if (inptr == NULL)
    {
      /* fopen fails */
      llfatalerror (message ("Unable to write intermediate file: %s", 
			     cstring_fromChars (infile)));
    }
  
  tmp1 = removePath (infile);
  tmp2 = removeAnyExtension (tmp1);

  fprintf (inptr, "%s : trait\n", tmp2);
  sfree (tmp1);
  sfree (tmp2);

  fprintf (inptr, "%s", text);
  check (fclose (inptr) == 0);

  /* the default is to delete the input file */

  outfile = cstring_toCharsSafe (fileName (fileTable_addltemp (context_fileTable ())));
  invokeLSL (infile, outfile, context_getFlag (FLG_KEEP));
  sfree (text);
}

static void invokeLSL (char *infile, char *outfile, bool deletep)
{
  /* run lsl on infile and leave result in outfile */
  FILE *outptr;
  filestatus status;
  int callstatus;
  cstring call;
  char *returnPath = NULL;
  
  /*
  ** Ensures that outfile can be written into, should find a better
  ** way to do this. 
  */
  
  outptr = fopen (outfile, "w");

  if (outptr == NULL)
    {			
      /* fopen fails */
      llfatalerror (message ("Unable to write intermediate file: %s", 
			     cstring_fromChars (outfile)));
    }
  
  check (fclose (outptr) == 0);

  /* set call to the right command */
  status = osd_getExePath ("PATH", "lsl", &returnPath);
    

  if (status == OSD_FILEFOUND)
    {
      call = message ("%s -syms %s > %s", cstring_fromChars (returnPath), 
		      cstring_fromChars (infile), cstring_fromChars (outfile));
      
      /* before calling, make sure old file is removed */
      (void) osd_unlink (outfile);

      callstatus = osd_system (cstring_toCharsSafe (call));
      
      cstring_free (call);

      if (callstatus != CALL_SUCCESS)
	{
	  /*
	  ** lsl errors: call lsl again without -syms, sending output to stdout
          */
	  cstring syscal = message ("%s %s", cstring_fromChars (returnPath), 
				    cstring_fromChars (infile));

	  (void) osd_system (cstring_toCharsSafe (syscal));
	  cstring_free (syscal);

	  llfatalerror (cstring_makeLiteral ("LSL trait used contains errors.")); 
	}
      else
	{			/* ok, go ahead */
	 /* Now parse the LSL output and store info in symbol table */
	  callstatus = parseSignatures (cstring_fromChars (outfile));

	  if (callstatus == 0)
	    {	
	      /* all went well */
	      if (!context_getFlag (FLG_KEEP))
		{
		  /* delete temporary files */
		  if (deletep)
		    {
		      (void) osd_unlink (infile);
		    }
		  
		  (void) osd_unlink (outfile);
		}
	    }
	}
    }
  else if (status == OSD_FILENOTFOUND)
    {
      llfatalerror 
	(cstring_makeLiteral ("Cannot find LSL checker: check your command search path."));
    }
  else				/* must be (status == OSD_PATHTOOLONG) */
    {
      lclfatalbug ("invokeLSL: lsl plus directory from search path is too long");
    }
}

/* callLSL ("MySet", "includes Set (CC for C, EE for E)");  */

void
readlsignatures (interfaceNode n)
{
  /* assume n->kind = usesKIND */
  char *content;
  
  content = cstring_toCharsSafe (printTraitRefList2 (n->content.uses));
  callLSL (cstring_toCharsSafe (g_currentSpec), content);
}
Commit	Line	Data
616915dd	1	/*
	2	** LCLint - annotation-assisted static program checker
	3	** Copyright (C) 1994-2000 University of Virginia,
	4	** Massachusetts Institute of Technology
	5	**
	6	** This program is free software; you can redistribute it and/or modify it
	7	** under the terms of the GNU General Public License as published by the
	8	** Free Software Foundation; either version 2 of the License, or (at your
	9	** option) any later version.
	10	**
	11	** This program is distributed in the hope that it will be useful, but
	12	** WITHOUT ANY WARRANTY; without even the implied warranty of
	13	** MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
	14	** General Public License for more details.
	15	**
	16	** The GNU General Public License is available from http://www.gnu.org/ or
	17	** the Free Software Foundation, Inc., 59 Temple Place - Suite 330, Boston,
	18	** MA 02111-1307, USA.
	19	**
	20	** For information on lclint: lclint-request@cs.virginia.edu
	21	** To report a bug: lclint-bug@cs.virginia.edu
	22	** For more information: http://lclint.cs.virginia.edu
	23	*/
	24	/*
	25	** lslparse.c
	26	**
	27	** Module for calling LSL checker.
	28	**
	29	** AUTHOR:
	30	** Yang Meng Tan,
	31	** Massachusetts Institute of Technology
	32	*/
	33
	34	# include "lclintMacros.nf"
	35	# include "llbasic.h"
	36	# include "lclscan.h"
	37	# include "signature.h"
	38	# include "signature2.h"
	39	# include "scan.h"
	40	# include "scanline.h"
	41	# include "syntable.h"
	42	# include "tokentable.h"
	43	# include "lslinit.h"
	44	# include "lslparse.h"
	45	# include "llmain.h"
	46
	47	/@+ignorequals@/
	48
	49	/@dependent@/ /@null@/ lslOp g_importedlslOp = NULL;
	50	bool g_lslParsingTraits = FALSE;
	51
	52	static void invokeLSL (char p_infile, char p_outfile, bool p_deletep);
	53
	54	int
	55	parseSignatures (cstring infile)
	56	{
	57	char *cinfile = cstring_toCharsSafe (infile);
	58	tsource *sourceFile;
	59	ltoken id = (ltoken ) dmalloc (sizeof (*id));
	60	int status = 0;
	61
	62	/* parse traits */
	63	*id = LSLInsertToken (LST_SIMPLEID, lsymbol_fromChars (cinfile), 0, FALSE);
	64	ltoken_setFileName (*id, cinfile);
65	ltoken_setLine (*id, 0);
66	ltoken_setCol (*id, 0);
67
68	sourceFile = tsource_create (cinfile, "", FALSE);
69
70	if (!tsource_getPath (cstring_toCharsSafe (context_getLarchPath ()), sourceFile))
71	{
72	lclplainerror
73	(message ("LSL signature parsing: can't find file %s containing trait",
74	cstring_fromChars (tsource_fileName (sourceFile))));
75	status = 1;
76
77	sfree (id);
78	tsource_free (sourceFile);
79	return status;
80	}
81
82	if (!tsource_open (sourceFile))
83	{
84	lclplainerror
85	(cstring_makeLiteral ("LSL parsing: can't open file containing trait"));
86	status = 2;
87	sfree (id);
88	tsource_free (sourceFile);
89
90	return status;
91	}
92
93	lsldebug = 0;
94	g_lslParsingTraits = TRUE;
95	LSLScanReset (sourceFile);
96	LSLReportEolTokens (FALSE);
97
98	status = lslparse ();
99
100	/* symtable_dump (symtab, stdout, TRUE); */
101	g_lslParsingTraits = FALSE;
102
103	(void) tsource_close (sourceFile);
104	tsource_free (sourceFile);
105
106	sfree (id);
107
108
109	return status;
110	}
111
112	/@only@/ lslOp
113	parseOpLine (char fname, char line)
114	{
115	tsource *sourceFile;
116	bool status;
117
118	sourceFile = tsource_fromString (fname, line);
119
120	if (check (tsource_open (sourceFile)))
121	{
122	LSLScanReset (sourceFile);
123	LSLReportEolTokens (FALSE); /* 0 by default, lslParsingTraits = 0; */
124
125	/*
126	** lsl parsing and importing .lcs files are expected to be mutually
127	** exclusive.
128	**
129	** lslparse sets importedlslOp
130	*/
131
132	status = (lslparse () != 0);
133
134	if (status)
135	{
136	lclplainfatalerror (message ("Error in parsing line: %s",
137	cstring_fromChars (line)));
138	}
139
140	(void) tsource_close (sourceFile);
141	}
142
143	tsource_free (sourceFile);
144
145	llassert (g_importedlslOp != NULL);
146	return (lslOp_copy (g_importedlslOp));
147	}
148
149	lsymbol
150	processTraitSortId (lsymbol sortid)
151	{
152	lsymbol out = lsymbol_sortFromType (g_symtab, sortid);
153	if (out == sortid)
154	{ /* may be a new sort */
155	(void) sort_fromLsymbol (sortid);
156	}
157	return out;
158	}
159
160	/* formerly from check.c module */
161
162	static /@only@/ cstring
163	printTypeName2 (typeNameNode n)
164	{
165	cstring s = cstring_undefined;
166	sortNode sn;
167	lsymbol lclSort;
168	ltoken err;
169
170	if (n != (typeNameNode) 0)
171	{
172	if (n->isTypeName)
173	{
174	/* does not process opForm renaming, pass on to LSL
175	and hope that it works for now. */
176	typeNamePack p = n->typename;
177
178	llassert (p != NULL);
179
180	/* get the LCL type, assume LCL type has already been mentioned. */
181	lclSort = lclTypeSpecNode2sort (p->type);
182	lclSort = sort_getUnderlying (lclSort);
183	/* lclsource = LCLSLScanSource (); */
184	if (!sort_isValidSort (lclSort))
185	{
186	err = lclTypeSpecNode_errorToken (p->type);
187	/* errorShowPoint (tsource_thisLine (lclsource), ltoken_getCol (err)); */
188	lclerror (err, message ("Unrecognized type in uses: %q",
189	typeNameNode_unparse (n)));
190	}
191	else
192	{
193	/*
194	** Below is necessary because this is one place where an LCL mutable
195	** type name is mapped directly into its value sort, not obj sort.
196	** Allows us to support only one qualifying "obj", rather
197	** than "val" as well.
198	*/
199
200	lclSort = typeExpr2ptrSort (lclSort, p->abst);
201	lclSort = sort_makeVal (lclSort);
202
203	/*
204	** Check that lclSort is not a HOFSort ...
205	** Propagation of HOFSort should stop here.
206	*/
207
208	if (sort_isHOFSortKind (lclSort))
209	{
210	err = lclTypeSpecNode_errorToken (p->type);
211
212	lclfatalerror
213	(err,
214	cstring_makeLiteral
215	("LCL uses cannot handle higher-order types"));
216	}
217	if (p->isObj)
218	lclSort = sort_makeObj (lclSort);
219
220	/* if (!p->isObj) {
221	lclSort = sort_makeVal (lclSort);
222	} */
223
224	sn = sort_lookup (lclSort);
225	s = cstring_copy (cstring_fromChars (lsymbol_toChars (sn.name)));
226	/* s = string_paste (s, AbstDeclaratorNode_unparse (p->abst)); */
227	}
228	}
229	else
230	{
231	/* s = OpFormNode_unparse (n->opform); */
232	if (n->opform != 0)
233	{
234	lclfatalerror
235	(n->opform->tok,
236	cstring_makeLiteral ("Attempt to rename operator with uses: "
237	"use LSL includes renaming facility"));
238	}
239	else
240	{
241	BADEXIT;
242	}
243	}
244	}
245	return s;
246	}
247
248	static /@only@/ cstring
249	replaceNode_unparseAlt (replaceNode x)
250	{
251	cstring s = cstring_undefined;
252
253	if (x != (replaceNode) 0)
254	{
255	s = printTypeName2 (x->typename);
256	s = cstring_concatChars (s, " for ");
257
258	if (x->isCType)
259	{
260	s = cstring_concatFree1 (s, ltoken_unparse (x->content.ctype));
261	}
262	else
263	{
264	s = cstring_concatFree (s, nameNode_unparse (x->content.renamesortname.name));
265	s = cstring_concatFree (s,
266	sigNode_unparse (x->content.renamesortname.signature));
267	}
268	}
269
270	return s;
271	}
272
273	static /@only@/ cstring
274	replaceNodeList_unparseAlt (replaceNodeList x)
275	{
276	cstring s = cstring_undefined;
277	bool first = TRUE;
278
279	replaceNodeList_elements (x, i)
280	{
281	if (first)
282	{
283	s = replaceNode_unparseAlt (i);
284	first = FALSE;
285	}
286	else
287	{
288	s = message ("%q, %q", s, replaceNode_unparseAlt (i));
289	}
290	} end_replaceNodeList_elements;
291
292	return s;
293	}
294
295	static /@only@/ cstring
296	printNameList2 (typeNameNodeList x)
297	{
298	/* printing a list of typeNameNode's, not nameNode's */
299	bool first = TRUE;
300	cstring s = cstring_undefined;
301
302	typeNameNodeList_elements (x, i)
303	{
304	if (first)
305	{
306	s = printTypeName2 (i);
307	first = FALSE;
308	}
309	else
310	{
311	s = message ("%q, %q", s, printTypeName2 (i));
312	}
313	} end_typeNameNodeList_elements;
314
315	return s;
316	}
317
318	static /@only@/ cstring
319	printRenamingNode2 (renamingNode x)
320	{
321	cstring s = cstring_undefined;
322
323	if (x != (renamingNode) 0)
324	{
325	if (x->is_replace)
326	{
327	replaceNodeList r = x->content.replace;
328	s = replaceNodeList_unparseAlt (r);
329	}
330	else
331	{
332	nameAndReplaceNode n = x->content.name;
333	bool printComma = TRUE;
334	if (typeNameNodeList_size (n->namelist) == 0)
335	{
336	printComma = FALSE;
337	}
338	s = printNameList2 (n->namelist);
339	if (printComma)
340	if (replaceNodeList_isDefined (n->replacelist) &&
341	replaceNodeList_size (n->replacelist) != 0)
342	{
343	s = cstring_appendChar (s, ',');
344	s = cstring_appendChar (s, ' ');
345	}
346	s = cstring_concatFree (s, replaceNodeList_unparseAlt (n->replacelist));
347	}
348	}
349	return s;
350	}
351
352	static /@only@/ cstring
353	printTraitRefList2 (traitRefNodeList x)
354	{
355	cstring s = cstring_undefined;
356
357	traitRefNodeList_elements (x, i)
358	{
359	s = message ("%qincludes (%q)", s, printRawLeaves2 (i->traitid));
360
361	if (i->rename != 0)
362	{
363	s = message ("%q(%q)", s, printRenamingNode2 (i->rename));
364	}
365	s = message ("%q\n", s);
366	} end_traitRefNodeList_elements;
367
368	return s;
369	}
370
371	void
372	callLSL (/@unused@/ char specfile, /@only@/ char text)
373	{
374	/* specfile is the name of the LCL file that contains "uses"
375	Create an intermediate file named
376	specfile_<TEMP_LSL_SUFFIX>.<TEMP_LSL_IN_SUFFIX>.
377	put text in the file, run lsl on it and direct
378	output to specfile_<TEMP_LSL_SUFFIX>.<TEMP_LSL_OUT_SUFFIX>.
379	specfile can be a full pathname.
380	Note: LSL does not support traitnames that are pathnames, only
381	symbols.
382	*/
383
384	char infile, outfile;
385	char tmp1, tmp2;
386	FILE *inptr;
387
388	infile = cstring_toCharsSafe (fileName (fileTable_addltemp (context_fileTable ())));
389
390	inptr = fopen (infile, "w");
391
392	if (inptr == NULL)
393	{
394	/* fopen fails */
395	llfatalerror (message ("Unable to write intermediate file: %s",
396	cstring_fromChars (infile)));
397	}
398
399	tmp1 = removePath (infile);
400	tmp2 = removeAnyExtension (tmp1);
401
402	fprintf (inptr, "%s : trait\n", tmp2);
403	sfree (tmp1);
404	sfree (tmp2);
405
406	fprintf (inptr, "%s", text);
407	check (fclose (inptr) == 0);
408
409	/* the default is to delete the input file */
410
411	outfile = cstring_toCharsSafe (fileName (fileTable_addltemp (context_fileTable ())));
412	invokeLSL (infile, outfile, context_getFlag (FLG_KEEP));
413	sfree (text);
414	}
415
416	static void invokeLSL (char infile, char outfile, bool deletep)
417	{
418	/* run lsl on infile and leave result in outfile */
419	FILE *outptr;
420	filestatus status;
421	int callstatus;
422	cstring call;
423	char *returnPath = NULL;
424
425	/*
426	** Ensures that outfile can be written into, should find a better
427	** way to do this.
428	*/
429
430	outptr = fopen (outfile, "w");
431
432	if (outptr == NULL)
433	{
434	/* fopen fails */
435	llfatalerror (message ("Unable to write intermediate file: %s",
436	cstring_fromChars (outfile)));
437	}
438
439	check (fclose (outptr) == 0);
440
441	/* set call to the right command */
442	status = osd_getExePath ("PATH", "lsl", &returnPath);
443
444
445	if (status == OSD_FILEFOUND)
446	{
447	call = message ("%s -syms %s > %s", cstring_fromChars (returnPath),
448	cstring_fromChars (infile), cstring_fromChars (outfile));
449
450	/* before calling, make sure old file is removed */
451	(void) osd_unlink (outfile);
452
453	callstatus = osd_system (cstring_toCharsSafe (call));
454
455	cstring_free (call);
456
457	if (callstatus != CALL_SUCCESS)
458	{
459	/*
460	** lsl errors: call lsl again without -syms, sending output to stdout
461	*/
462	cstring syscal = message ("%s %s", cstring_fromChars (returnPath),
463	cstring_fromChars (infile));
464
465	(void) osd_system (cstring_toCharsSafe (syscal));
466	cstring_free (syscal);
467
468	llfatalerror (cstring_makeLiteral ("LSL trait used contains errors."));
469	}
470	else
471	{ /* ok, go ahead */
472	/* Now parse the LSL output and store info in symbol table */
473	callstatus = parseSignatures (cstring_fromChars (outfile));
474
475	if (callstatus == 0)
476	{
477	/* all went well */
478	if (!context_getFlag (FLG_KEEP))
479	{
480	/* delete temporary files */
481	if (deletep)
482	{
483	(void) osd_unlink (infile);
484	}
485
486	(void) osd_unlink (outfile);
487	}
488	}
489	}
490	}
491	else if (status == OSD_FILENOTFOUND)
492	{
493	llfatalerror
494	(cstring_makeLiteral ("Cannot find LSL checker: check your command search path."));
495	}
496	else /* must be (status == OSD_PATHTOOLONG) */
497	{
498	lclfatalbug ("invokeLSL: lsl plus directory from search path is too long");
499	}
500	}
501
502	/* callLSL ("MySet", "includes Set (CC for C, EE for E)"); */
503
504	void
505	readlsignatures (interfaceNode n)
506	{
507	/* assume n->kind = usesKIND */
508	char *content;
509
510	content = cstring_toCharsSafe (printTraitRefList2 (n->content.uses));
511	callLSL (cstring_toCharsSafe (g_currentSpec), content);
512	}