121637Sdist /*
2*61987Sbostic * Copyright (c) 1980, 1993
3*61987Sbostic * The Regents of the University of California. All rights reserved.
434664Sbostic *
542683Sbostic * %sccs.include.redist.c%
621637Sdist */
721637Sdist
821637Sdist #ifndef lint
9*61987Sbostic static char sccsid[] = "@(#)pi.c 8.1 (Berkeley) 06/06/93";
1034664Sbostic #endif /* not lint */
1121637Sdist
121458Sroot #include <stdio.h>
131458Sroot #include <ctype.h>
1446694Sbostic #include <string.h>
151458Sroot #include "error.h"
161458Sroot
171458Sroot extern char *currentfilename;
181458Sroot static char *c_linenumber;
191458Sroot static char *unk_hdr[] = {"In", "program", "???"};
201458Sroot static char **c_header = &unk_hdr[0];
211458Sroot
221458Sroot /*
231458Sroot * Attempt to handle error messages produced by pi (and by pc)
241458Sroot *
251458Sroot * problem #1: There is no file name available when a file does not
261458Sroot * use a #include; this will have to be given to error
271458Sroot * in the command line.
281458Sroot * problem #2: pi doesn't always tell you what line number
291458Sroot * a error refers to; for example during the tree
301458Sroot * walk phase of code generation and error detection,
311458Sroot * an error can refer to "variable foo in procedure bletch"
321458Sroot * without giving a line number
331458Sroot * problem #3: line numbers, when available, are attached to
341458Sroot * the source line, along with the source line itself
351458Sroot * These line numbers must be extracted, and
361458Sroot * the source line thrown away.
371458Sroot * problem #4: Some error messages produce more than one line number
381458Sroot * on the same message.
391458Sroot * There are only two (I think):
401458Sroot * %s undefined on line%s
411458Sroot * %s improperly used on line%s
421458Sroot * here, the %s makes line plural or singular.
431458Sroot *
441458Sroot * Here are the error strings used in pi version 1.2 that can refer
451458Sroot * to a file name or line number:
461458Sroot *
471458Sroot * Multiply defined label in case, lines %d and %d
481458Sroot * Goto %s from line %d is into a structured statement
491458Sroot * End matched %s on line %d
501458Sroot * Inserted keyword end matching %s on line %d
511458Sroot *
521458Sroot * Here are the general pi patterns recognized:
531458Sroot * define piptr == -.*^-.*
541458Sroot * define msg = .*
551458Sroot * define digit = [0-9]
561458Sroot * definename = .*
571458Sroot * define date_format letter*3 letter*3 (digit | (digit digit))
581458Sroot * (digit | (digit digit)):digit*2 digit*4
591458Sroot *
601458Sroot * {e,E} (piptr) (msg) Encounter an error during textual scan
611458Sroot * E {digit}* - (msg) Have an error message that refers to a new line
621458Sroot * E - msg Have an error message that refers to current
631458Sroot * function, program or procedure
641458Sroot * (date_format) (name): When switch compilation files
651458Sroot * ... (msg) When refer to the previous line
661458Sroot * 'In' ('procedure'|'function'|'program') (name):
671458Sroot * pi is now complaining about 2nd pass errors.
681458Sroot *
691458Sroot * Here is the output from a compilation
701458Sroot *
711458Sroot *
721458Sroot * 2 var i:integer;
731458Sroot * e --------------^--- Inserted ';'
741458Sroot * E 2 - All variables must be declared in one var part
751458Sroot * E 5 - Include filename must end in .i
761458Sroot * Mon Apr 21 15:56 1980 test.h:
771458Sroot * 2 begin
781458Sroot * e ------^--- Inserted ';'
791458Sroot * Mon Apr 21 16:06 1980 test.p:
801458Sroot * E 2 - Function type must be specified
811458Sroot * 6 procedure foo(var x:real);
821458Sroot * e ------^--- Inserted ';'
831458Sroot * In function bletch:
841458Sroot * E - No assignment to the function variable
851458Sroot * w - variable x is never used
861458Sroot * E 6 - foo is already defined in this block
871458Sroot * In procedure foo:
881458Sroot * w - variable x is neither used nor set
891458Sroot * 9 z : = 23;
901458Sroot * E --------------^--- Undefined variable
911458Sroot * 10 y = [1];
921458Sroot * e ----------------^--- Inserted ':'
931458Sroot * 13 z := 345.;
941458Sroot * e -----------------------^--- Digits required after decimal point
951458Sroot * E 10 - Constant set involved in non set context
961458Sroot * E 11 - Type clash: real is incompatible with integer
971458Sroot * ... Type of expression clashed with type of variable in assignment
981458Sroot * E 12 - Parameter type not identical to type of var parameter x of foo
991458Sroot * In program mung:
1001458Sroot * w - variable y is never used
1011458Sroot * w - type foo is never used
1021458Sroot * w - function bletch is never used
1031458Sroot * E - z undefined on lines 9 13
1041458Sroot */
1051458Sroot char *Months[] = {
1061458Sroot "Jan", "Feb", "Mar", "Apr", "May", "Jun",
1071458Sroot "Jul", "Aug", "Sep", "Oct","Nov", "Dec",
1081458Sroot 0
1091458Sroot };
1101458Sroot char *Days[] = {
1111458Sroot "Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat", 0
1121458Sroot };
1131458Sroot char *Piroutines[] = {
1141458Sroot "program", "function", "procedure", 0
1151458Sroot };
1161458Sroot
1171458Sroot
1181458Sroot static boolean structured, multiple;
1191458Sroot
1201458Sroot char *pi_Endmatched[] = {"End", "matched"};
1211458Sroot char *pi_Inserted[] = {"Inserted", "keyword", "end", "matching"};
1221458Sroot
1231458Sroot char *pi_multiple[] = {"Mutiply", "defined", "label", "in", "case,", "line"};
1241458Sroot char *pi_structured[] = {"is", "into", "a", "structured", "statement"};
1251458Sroot
1261458Sroot char *pi_und1[] = {"undefined", "on", "line"};
1271458Sroot char *pi_und2[] = {"undefined", "on", "lines"};
1281458Sroot char *pi_imp1[] = {"improperly", "used", "on", "line"};
1291458Sroot char *pi_imp2[] = {"improperly", "used", "on", "lines"};
1301458Sroot
alldigits(string)1311458Sroot boolean alldigits(string)
1325593Srrh reg char *string;
1331458Sroot {
1341458Sroot for (; *string && isdigit(*string); string++)
1351458Sroot continue;
1361458Sroot return(*string == '\0');
1371458Sroot }
instringset(member,set)1381458Sroot boolean instringset(member, set)
1395593Srrh char *member;
1405593Srrh reg char **set;
1411458Sroot {
1421458Sroot for(; *set; set++){
1431458Sroot if (strcmp(*set, member) == 0)
1441458Sroot return(TRUE);
1451458Sroot }
1461458Sroot return(FALSE);
1471458Sroot }
1481458Sroot
isdateformat(wordc,wordv)1491458Sroot boolean isdateformat(wordc, wordv)
1501458Sroot int wordc;
1511458Sroot char **wordv;
1521458Sroot {
1531458Sroot return(
1541458Sroot (wordc == 5)
1551458Sroot && (instringset(wordv[0], Days))
1561458Sroot && (instringset(wordv[1], Months))
1571458Sroot && (alldigits(wordv[2]))
1581458Sroot && (alldigits(wordv[4])) );
1591458Sroot }
1601458Sroot
piptr(string)1611458Sroot boolean piptr(string)
1625593Srrh reg char *string;
1631458Sroot {
1641458Sroot if (*string != '-')
1651458Sroot return(FALSE);
1661458Sroot while (*string && *string == '-')
1671458Sroot string++;
1681458Sroot if (*string != '^')
1691458Sroot return(FALSE);
1701458Sroot string++;
1711458Sroot while (*string && *string == '-')
1721458Sroot string++;
1731458Sroot return(*string == '\0');
1741458Sroot }
1751458Sroot
1761458Sroot extern int wordc;
1771458Sroot extern char **wordv;
1781458Sroot
pi()1791458Sroot Errorclass pi()
1801458Sroot {
1811458Sroot char **nwordv;
1821458Sroot
18313611Ssam if (wordc < 2)
18413611Ssam return (C_UNKNOWN);
1851458Sroot if ( ( strlen(wordv[1]) == 1)
1861458Sroot && ( (wordv[1][0] == 'e') || (wordv[1][0] == 'E') )
1871458Sroot && ( piptr(wordv[2]) )
1881458Sroot ) {
1891458Sroot boolean longpiptr = 0;
1901458Sroot /*
1911458Sroot * We have recognized a first pass error of the form:
1921458Sroot * letter ------^---- message
1931458Sroot *
1941458Sroot * turn into an error message of the form:
1951458Sroot *
1961458Sroot * file line 'pascal errortype' letter \n |---- message
1971458Sroot * or of the form:
1981458Sroot * file line letter |---- message
1991458Sroot * when there are strlen("(*[pi]") or more
2001458Sroot * preceding '-' on the error pointer.
2011458Sroot *
2021458Sroot * Where the | is intended to be a down arrow, so that
2031458Sroot * the pi error messages can be inserted above the
2041458Sroot * line in error, instead of below. (All of the other
2051458Sroot * langauges put thier messages before the source line,
2061458Sroot * instead of after it as does pi.)
2071458Sroot *
2081458Sroot * where the pointer to the error has been truncated
2091458Sroot * by 6 characters to account for the fact that
2101458Sroot * the pointer points into a tab preceded input line.
2111458Sroot */
2121458Sroot language = INPI;
2135593Srrh (void)substitute(wordv[2], '^', '|');
2141458Sroot longpiptr = position(wordv[2],'|') > (6+8);
2151458Sroot nwordv = wordvsplice(longpiptr ? 2 : 4, wordc, wordv+1);
2161458Sroot nwordv[0] = strsave(currentfilename);
2171458Sroot nwordv[1] = strsave(c_linenumber);
2181458Sroot if (!longpiptr){
2191458Sroot nwordv[2] = "pascal errortype";
2201458Sroot nwordv[3] = wordv[1];
2211458Sroot nwordv[4] = strsave("%%%\n");
2221458Sroot if (strlen(nwordv[5]) > (8-2)) /* this is the pointer */
2231458Sroot nwordv[5] += (8-2); /* bump over 6 characters */
2241458Sroot }
2251458Sroot wordv = nwordv - 1; /* convert to 1 based */
2261458Sroot wordc += longpiptr ? 2 : 4;
2271458Sroot return(C_TRUE);
2281458Sroot }
2291458Sroot if ( (wordc >= 4)
2301458Sroot && (strlen(wordv[1]) == 1)
2311458Sroot && ( (*wordv[1] == 'E') || (*wordv[1] == 'w') || (*wordv[1] == 'e') )
2321458Sroot && (alldigits(wordv[2]))
2331458Sroot && (strlen(wordv[3]) == 1)
2341458Sroot && (wordv[3][0] == '-')
2351458Sroot ){
2361458Sroot /*
2371458Sroot * Message of the form: letter linenumber - message
2381458Sroot * Turn into form: filename linenumber letter - message
2391458Sroot */
2401458Sroot language = INPI;
2411458Sroot nwordv = wordvsplice(1, wordc, wordv + 1);
2421458Sroot nwordv[0] = strsave(currentfilename);
2431458Sroot nwordv[1] = wordv[2];
2441458Sroot nwordv[2] = wordv[1];
2451458Sroot c_linenumber = wordv[2];
2461458Sroot wordc += 1;
2471458Sroot wordv = nwordv - 1;
2481458Sroot return(C_TRUE);
2491458Sroot }
2501458Sroot if ( (wordc >= 3)
2511458Sroot && (strlen(wordv[1]) == 1)
2521458Sroot && ( (*(wordv[1]) == 'E') || (*(wordv[1]) == 'w') || (*(wordv[1]) == 'e') )
2531458Sroot && (strlen(wordv[2]) == 1)
2541458Sroot && (wordv[2][0] == '-')
2551458Sroot ) {
2561458Sroot /*
2571458Sroot * Message of the form: letter - message
2581458Sroot * This happens only when we are traversing the tree
2591458Sroot * during the second pass of pi, and discover semantic
2601458Sroot * errors.
2611458Sroot *
2621458Sroot * We have already (presumably) saved the header message
2631458Sroot * and can now construct a nulled error message for the
2641458Sroot * current file.
2651458Sroot *
2661458Sroot * Turns into a message of the form:
2671458Sroot * filename (header) letter - message
2681458Sroot *
2691458Sroot * First, see if it is a message referring to more than
2701458Sroot * one line number. Only of the form:
2711458Sroot * %s undefined on line%s
2721458Sroot * %s improperly used on line%s
2731458Sroot */
2741458Sroot boolean undefined = 0;
2751458Sroot int wordindex;
2761458Sroot
2771458Sroot language = INPI;
2781458Sroot if ( (undefined = (wordvcmp(wordv+2, 3, pi_und1) == 0) )
2791458Sroot || (undefined = (wordvcmp(wordv+2, 3, pi_und2) == 0) )
2801458Sroot || (wordvcmp(wordv+2, 4, pi_imp1) == 0)
2811458Sroot || (wordvcmp(wordv+2, 4, pi_imp2) == 0)
2821458Sroot ){
2831458Sroot for (wordindex = undefined ? 5 : 6; wordindex <= wordc;
2841458Sroot wordindex++){
2851458Sroot nwordv = wordvsplice(2, undefined ? 2 : 3, wordv+1);
2861458Sroot nwordv[0] = strsave(currentfilename);
2871458Sroot nwordv[1] = wordv[wordindex];
2881458Sroot if (wordindex != wordc)
2891458Sroot erroradd(undefined ? 4 : 5, nwordv,
2901458Sroot C_TRUE, C_UNKNOWN);
2911458Sroot }
2921458Sroot wordc = undefined ? 4 : 5;
2931458Sroot wordv = nwordv - 1;
2941458Sroot return(C_TRUE);
2951458Sroot }
2961458Sroot
2971458Sroot nwordv = wordvsplice(1+3, wordc, wordv+1);
2981458Sroot nwordv[0] = strsave(currentfilename);
2991458Sroot nwordv[1] = strsave(c_header[0]);
3001458Sroot nwordv[2] = strsave(c_header[1]);
3011458Sroot nwordv[3] = strsave(c_header[2]);
3021458Sroot wordv = nwordv - 1;
3031458Sroot wordc += 1 + 3;
3041458Sroot return(C_THISFILE);
3051458Sroot }
3061458Sroot if (strcmp(wordv[1], "...") == 0){
3071458Sroot /*
3081458Sroot * have a continuation error message
3091458Sroot * of the form: ... message
3101458Sroot * Turn into form : filename linenumber message
3111458Sroot */
3121458Sroot language = INPI;
3131458Sroot nwordv = wordvsplice(1, wordc, wordv+1);
3141458Sroot nwordv[0] = strsave(currentfilename);
3151458Sroot nwordv[1] = strsave(c_linenumber);
3161458Sroot wordv = nwordv - 1;
3171458Sroot wordc += 1;
3181458Sroot return(C_TRUE);
3191458Sroot }
3201458Sroot if( (wordc == 6)
3211458Sroot && (lastchar(wordv[6]) == ':')
3221458Sroot && (isdateformat(5, wordv + 1))
3231458Sroot ){
3241458Sroot /*
3251458Sroot * Have message that tells us we have changed files
3261458Sroot */
3271458Sroot language = INPI;
3281458Sroot currentfilename = strsave(wordv[6]);
3291458Sroot clob_last(currentfilename, '\0');
3301458Sroot return(C_SYNC);
3311458Sroot }
3321458Sroot if( (wordc == 3)
3331458Sroot && (strcmp(wordv[1], "In") == 0)
3341458Sroot && (lastchar(wordv[3]) == ':')
3351458Sroot && (instringset(wordv[2], Piroutines))
3361458Sroot ) {
3371458Sroot language = INPI;
3381458Sroot c_header = wordvsplice(0, wordc, wordv+1);
3391458Sroot return(C_SYNC);
3401458Sroot }
3411458Sroot /*
3421458Sroot * now, check for just the line number followed by the text
3431458Sroot */
3441458Sroot if (alldigits(wordv[1])){
3451458Sroot language = INPI;
3461458Sroot c_linenumber = wordv[1];
3471458Sroot return(C_IGNORE);
3481458Sroot }
3491458Sroot /*
3501458Sroot * Attempt to match messages refering to a line number
3511458Sroot *
3521458Sroot * Multiply defined label in case, lines %d and %d
3531458Sroot * Goto %s from line %d is into a structured statement
3541458Sroot * End matched %s on line %d
3551458Sroot * Inserted keyword end matching %s on line %d
3561458Sroot */
3571458Sroot multiple = structured = 0;
3581458Sroot if (
3591458Sroot ( (wordc == 6) && (wordvcmp(wordv+1, 2, pi_Endmatched) == 0))
3601458Sroot || ( (wordc == 8) && (wordvcmp(wordv+1, 4, pi_Inserted) == 0))
3611458Sroot || ( multiple = ((wordc == 9) && (wordvcmp(wordv+1,6, pi_multiple) == 0) ) )
3621458Sroot || ( structured = ((wordc == 10) && (wordvcmp(wordv+6,5, pi_structured) == 0 ) ))
3631458Sroot ){
3641458Sroot language = INPI;
3651458Sroot nwordv = wordvsplice(2, wordc, wordv+1);
3661458Sroot nwordv[0] = strsave(currentfilename);
3671458Sroot nwordv[1] = structured ? wordv [5] : wordv[wordc];
3681458Sroot wordc += 2;
3691458Sroot wordv = nwordv - 1;
3701458Sroot if (!multiple)
3711458Sroot return(C_TRUE);
3721458Sroot erroradd(wordc, nwordv, C_TRUE, C_UNKNOWN);
3731458Sroot nwordv = wordvsplice(0, wordc, nwordv);
3741458Sroot nwordv[1] = wordv[wordc - 2];
3751458Sroot return(C_TRUE);
3761458Sroot }
3771458Sroot return(C_UNKNOWN);
3781458Sroot }
379