src/lslparse.c

   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 }