| (* Copyright (C) 2015-2025 Free Software Foundation, Inc. *) |
| (* This file is part of GNU Modula-2. |
| |
| GNU Modula-2 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 3, or (at your option) any later |
| version. |
| |
| GNU Modula-2 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. |
| |
| You should have received a copy of the GNU General Public License |
| along with GCC; see the file COPYING3. If not see |
| <http://www.gnu.org/licenses/>. *) |
| |
| IMPLEMENTATION MODULE mcMetaError ; |
| |
| |
| FROM nameKey IMPORT Name, keyToCharStar, NulName ; |
| FROM StrLib IMPORT StrLen ; |
| FROM mcLexBuf IMPORT getTokenNo ; |
| FROM mcError IMPORT error, newError, newWarning, errorString, internalError, chainError, flushErrors ; |
| FROM FIO IMPORT StdOut, WriteLine ; |
| FROM SFIO IMPORT WriteS ; |
| FROM StringConvert IMPORT ctos ; |
| FROM varargs IMPORT vararg ; |
| |
| IMPORT varargs ; |
| |
| FROM DynamicStrings IMPORT String, InitString, InitStringCharStar, |
| ConCat, ConCatChar, Mark, string, KillString, |
| Dup, char, Length, Mult ; |
| |
| FROM decl IMPORT node, isType, isTemporary, getType, getSymName, getScope, isDef, |
| isExported, isZtype, isRtype, skipType, getDeclaredMod, getDeclaredDef, |
| getFirstUsed, isLiteral, isConst, isConstSet, isArray, isVar, |
| isEnumeration, isEnumerationField, isUnbounded, isProcType, isProcedure, |
| isPointer, isParameter, isVarParam, isRecord, isRecordField, |
| isVarient, isModule, isImp, isSet, isSubrange ; |
| |
| TYPE |
| errorType = (newerror, newwarning, chained) ; |
| |
| |
| (* |
| ebnf := { percent |
| | lbra |
| | any % copy ch % |
| } |
| =: |
| |
| percent := '%' anych % copy anych % |
| =: |
| |
| lbra := '{' [ '!' ] percenttoken '}' =: |
| |
| percenttoken := '%' ( |
| '1' % doOperand(1) % |
| op |
| | '2' % doOperand(2) % |
| op |
| | '3' % doOperand(3) % |
| op |
| | '4' % doOperand(4) % |
| op |
| ) |
| } =: |
| |
| op := {'a'|'q'|'t'|'d'|'n'|'s'|'D'|'I'|'U'|'E'|'W'} then =: |
| |
| then := [ ':' ebnf ] =: |
| *) |
| |
| |
| (* |
| internalFormat - produces an informative internal error. |
| *) |
| |
| PROCEDURE internalFormat (s: String; i: INTEGER; m: ARRAY OF CHAR) ; |
| VAR |
| e: error ; |
| BEGIN |
| e := newError (getTokenNo()) ; |
| s := WriteS (StdOut, s) ; |
| WriteLine (StdOut) ; |
| s := KillString (s) ; |
| IF i>0 |
| THEN |
| DEC(i) |
| END ; |
| s := Mult (InitString (' '), i) ; |
| s := ConCatChar (s, '^') ; |
| s := WriteS (StdOut, s) ; |
| WriteLine (StdOut) ; |
| internalError (m, __FILE__, __LINE__) |
| END internalFormat ; |
| |
| |
| (* |
| x - checks to see that a=b. |
| *) |
| |
| PROCEDURE x (a, b: String) : String ; |
| BEGIN |
| IF a#b |
| THEN |
| internalError('different string returned', __FILE__, __LINE__) |
| END ; |
| RETURN a |
| END x ; |
| |
| |
| (* |
| isWhite - returns TRUE if, ch, is a space. |
| *) |
| |
| PROCEDURE isWhite (ch: CHAR) : BOOLEAN ; |
| BEGIN |
| RETURN ch=' ' |
| END isWhite ; |
| |
| |
| (* |
| then := [ ':' ebnf ] =: |
| *) |
| |
| PROCEDURE then (VAR e: error; VAR t: errorType; |
| VAR r: String; s: String; |
| sym: vararg; |
| VAR i: INTEGER; l: INTEGER; |
| o: String; positive: BOOLEAN) ; |
| BEGIN |
| IF char (s, i) = ':' |
| THEN |
| INC (i) ; |
| ebnf (e, t, r, s, sym, i, l) ; |
| IF (i<l) AND (char (s, i) # '}') |
| THEN |
| internalFormat (s, i, 'expecting to see }') |
| END |
| END |
| END then ; |
| |
| |
| (* |
| doNumber - |
| *) |
| |
| PROCEDURE doNumber (bol: CARDINAL; |
| sym: vararg; o: String; |
| VAR quotes: BOOLEAN) : String ; |
| VAR |
| c: CARDINAL ; |
| BEGIN |
| IF Length(o) > 0 |
| THEN |
| RETURN o |
| ELSE |
| quotes := FALSE ; |
| varargs.next (sym, bol) ; |
| varargs.arg (sym, c) ; |
| RETURN ConCat (o, ctos (c, 0, ' ')) |
| END |
| END doNumber ; |
| |
| |
| (* |
| doCount - |
| *) |
| |
| PROCEDURE doCount (bol: CARDINAL; |
| sym: vararg; o: String; |
| VAR quotes: BOOLEAN) : String ; |
| VAR |
| c: CARDINAL ; |
| BEGIN |
| IF Length(o) > 0 |
| THEN |
| RETURN o |
| ELSE |
| quotes := FALSE ; |
| varargs.next (sym, bol) ; |
| varargs.arg (sym, c) ; |
| o := ConCat (o, ctos (c, 0, ' ')) ; |
| CASE c MOD 100 OF |
| |
| 11..13: o := ConCat (o, Mark (InitString ('th'))) |
| |
| ELSE |
| CASE c MOD 10 OF |
| |
| 1: o := ConCat (o, Mark (InitString ('st'))) | |
| 2: o := ConCat (o, Mark (InitString ('nd'))) | |
| 3: o := ConCat (o, Mark (InitString ('rd'))) |
| |
| ELSE |
| o := ConCat (o, Mark (InitString ('th'))) |
| END |
| END ; |
| RETURN o |
| END |
| END doCount ; |
| |
| |
| PROCEDURE doAscii (bol: CARDINAL; sym: vararg; o: String) : String ; |
| VAR |
| n: node ; |
| BEGIN |
| varargs.next (sym, bol) ; |
| varargs.arg (sym, n) ; |
| IF (Length (o) > 0) OR isTemporary (n) |
| THEN |
| RETURN o |
| ELSE |
| RETURN ConCat (o, InitStringCharStar (keyToCharStar (getSymName (n)))) |
| END |
| END doAscii ; |
| |
| |
| PROCEDURE doName (bol: CARDINAL; sym: vararg; o: String; VAR quotes: BOOLEAN) : String ; |
| VAR |
| n: node ; |
| BEGIN |
| varargs.next (sym, bol) ; |
| varargs.arg (sym, n) ; |
| IF (Length (o) > 0) OR isTemporary (n) |
| THEN |
| RETURN o |
| ELSE |
| IF isZtype (n) |
| THEN |
| quotes := FALSE ; |
| RETURN ConCat (o, Mark (InitString ('the ZType'))) |
| ELSIF isRtype (n) |
| THEN |
| quotes := FALSE ; |
| RETURN ConCat (o, Mark (InitString ('the RType'))) |
| ELSIF getSymName (n) # NulName |
| THEN |
| RETURN ConCat (o, InitStringCharStar (keyToCharStar (getSymName (n)))) |
| ELSE |
| RETURN o |
| END |
| END |
| END doName ; |
| |
| |
| PROCEDURE doQualified (bol: CARDINAL; sym: vararg; o: String) : String ; |
| VAR |
| s, n: node ; |
| mod : vararg ; |
| BEGIN |
| varargs.next (sym, bol) ; |
| varargs.arg (sym, n) ; |
| IF (Length (o) > 0) OR isTemporary (n) |
| THEN |
| RETURN o |
| ELSE |
| s := getScope (n) ; |
| mod := varargs.start1 (s) ; |
| IF isDef(s) AND isExported(n) |
| THEN |
| o := x (o, doAscii (0, mod, o)) ; |
| o := x (o, ConCatChar (o, '.')) ; |
| o := x (o, ConCat (o, InitStringCharStar (keyToCharStar (getSymName (n))))) |
| ELSE |
| o := x (o, doAscii (bol, sym, o)) |
| END ; |
| varargs.end (mod) ; |
| RETURN o |
| END |
| END doQualified ; |
| |
| |
| (* |
| doType - returns a string containing the type name of |
| sym. It will skip pseudonym types. It also |
| returns the type symbol found. |
| *) |
| |
| PROCEDURE doType (bol: CARDINAL; |
| VAR sym: vararg; o: String) : String ; |
| VAR |
| n: node ; |
| BEGIN |
| varargs.next (sym, bol) ; |
| varargs.arg (sym, n) ; |
| IF (Length (o) > 0) OR (getType (n) = NIL) |
| THEN |
| RETURN o |
| ELSE |
| n := skipType (getType (n)) ; |
| varargs.next (sym, bol) ; |
| varargs.replace (sym, n) ; |
| RETURN x (o, doAscii (bol, sym, o)) |
| END |
| END doType ; |
| |
| |
| (* |
| doSkipType - will skip all pseudonym types. It also |
| returns the type symbol found and name. |
| *) |
| |
| PROCEDURE doSkipType (bol: CARDINAL; VAR sym: vararg; o: String) : String ; |
| VAR |
| n: node ; |
| BEGIN |
| varargs.next (sym, bol) ; |
| varargs.arg (sym, n) ; |
| IF Length (o) > 0 |
| THEN |
| RETURN o |
| ELSE |
| n := skipType (getType (n)) ; |
| varargs.next (sym, bol) ; |
| varargs.replace (sym, n) ; |
| IF getSymName(n) = NulName |
| THEN |
| RETURN o |
| ELSE |
| RETURN x (o, doAscii (bol, sym, o)) |
| END |
| END |
| END doSkipType ; |
| |
| |
| PROCEDURE doKey (bol: CARDINAL; sym: vararg; o: String) : String ; |
| VAR |
| n: Name ; |
| BEGIN |
| IF Length (o) > 0 |
| THEN |
| RETURN o |
| ELSE |
| varargs.next (sym, bol) ; |
| varargs.arg (sym, n) ; |
| RETURN ConCat (o, InitStringCharStar (keyToCharStar (n))) |
| END |
| END doKey ; |
| |
| |
| (* |
| doError - creates and returns an error note. |
| *) |
| |
| PROCEDURE doError (e: error; t: errorType; tok: CARDINAL) : error ; |
| BEGIN |
| CASE t OF |
| |
| chained: IF e=NIL |
| THEN |
| internalError ('should not be chaining an error onto an empty error note', __FILE__, __LINE__) |
| ELSE |
| e := chainError (tok, e) |
| END | |
| newerror: IF e=NIL |
| THEN |
| e := newError (tok) |
| END | |
| newwarning: IF e=NIL |
| THEN |
| e := newWarning (tok) |
| END |
| |
| ELSE |
| internalError ('unexpected enumeration value', __FILE__, __LINE__) |
| END ; |
| RETURN e |
| END doError ; |
| |
| |
| (* |
| doDeclaredDef - creates an error note where sym[bol] was declared. |
| *) |
| |
| PROCEDURE doDeclaredDef (e: error; t: errorType; |
| bol: CARDINAL; |
| sym: vararg) : error ; |
| VAR |
| n: node ; |
| BEGIN |
| IF bol <= varargs.nargs (sym) |
| THEN |
| varargs.next (sym, bol) ; |
| varargs.arg (sym, n) ; |
| e := doError (e, t, getDeclaredDef (n)) |
| END ; |
| RETURN e |
| END doDeclaredDef ; |
| |
| |
| (* |
| doDeclaredMod - creates an error note where sym[bol] was declared. |
| *) |
| |
| PROCEDURE doDeclaredMod (e: error; t: errorType; |
| bol: CARDINAL; |
| sym: vararg) : error ; |
| VAR |
| n: node ; |
| BEGIN |
| IF bol <= varargs.nargs (sym) |
| THEN |
| varargs.next (sym, bol) ; |
| varargs.arg (sym, n) ; |
| e := doError (e, t, getDeclaredMod (n)) |
| END ; |
| RETURN e |
| END doDeclaredMod ; |
| |
| |
| (* |
| doUsed - creates an error note where sym[bol] was first used. |
| *) |
| |
| PROCEDURE doUsed (e: error; t: errorType; |
| bol: CARDINAL; |
| sym: vararg) : error ; |
| VAR |
| n: node ; |
| BEGIN |
| IF bol <= varargs.nargs (sym) |
| THEN |
| varargs.next (sym, bol) ; |
| varargs.arg (sym, n) ; |
| e := doError (e, t, getFirstUsed (n)) |
| END ; |
| RETURN e |
| END doUsed ; |
| |
| |
| (* |
| ConCatWord - joins sentances, a, b, together. |
| *) |
| |
| PROCEDURE ConCatWord (a, b: String) : String ; |
| BEGIN |
| IF (Length(a) = 1) AND (char (a, 0) = 'a') |
| THEN |
| a := x (a, ConCatChar (a, 'n')) |
| ELSIF (Length(a) > 1) AND (char (a, -1) = 'a') AND isWhite (char (a, -2)) |
| THEN |
| a := x (a, ConCatChar (a, 'n')) |
| END ; |
| IF (Length(a) > 0) AND (NOT isWhite (char (a, -1))) |
| THEN |
| a := x (a, ConCatChar (a, ' ')) |
| END ; |
| RETURN x (a, ConCat (a, b)) |
| END ConCatWord ; |
| |
| |
| (* |
| symDesc - |
| *) |
| |
| PROCEDURE symDesc (n: node; o: String) : String ; |
| BEGIN |
| IF isLiteral (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('literal'))) |
| ELSIF isConstSet (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('constant set'))) |
| (* |
| ELSIF IsConstructor(n) |
| THEN |
| RETURN( ConCatWord (o, Mark (InitString ('constructor'))) ) |
| *) |
| ELSIF isConst (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('constant'))) |
| ELSIF isArray (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('array'))) |
| ELSIF isVar (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('variable'))) |
| ELSIF isEnumeration (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('enumeration type'))) |
| ELSIF isEnumerationField (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('enumeration field'))) |
| ELSIF isUnbounded (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('unbounded parameter'))) |
| ELSIF isProcType (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('procedure type'))) |
| ELSIF isProcedure (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('procedure'))) |
| ELSIF isPointer (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('pointer'))) |
| ELSIF isParameter (n) |
| THEN |
| IF isVarParam (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('var parameter'))) |
| ELSE |
| RETURN ConCatWord (o, Mark (InitString ('parameter'))) |
| END |
| ELSIF isType (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('type'))) |
| ELSIF isRecord (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('record'))) |
| ELSIF isRecordField (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('record field'))) |
| ELSIF isVarient (n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('varient record'))) |
| ELSIF isModule(n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('module'))) |
| ELSIF isDef(n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('definition module'))) |
| ELSIF isImp(n) |
| THEN |
| RETURN ConCatWord (o, Mark (InitString ('implementation module'))) |
| ELSIF isSet (n) |
| THEN |
| RETURN ConCatWord(o, Mark (InitString ('set'))) |
| ELSIF isSubrange (n) |
| THEN |
| RETURN ConCatWord(o, Mark (InitString ('subrange'))) |
| ELSE |
| RETURN o |
| END |
| END symDesc ; |
| |
| |
| (* |
| doDesc - |
| *) |
| |
| PROCEDURE doDesc (bol: CARDINAL; |
| sym: vararg; o: String; |
| VAR quotes: BOOLEAN) : String ; |
| VAR |
| n: node ; |
| BEGIN |
| IF Length (o) = 0 |
| THEN |
| varargs.next (sym, bol) ; |
| varargs.arg (sym, n) ; |
| o := symDesc (n, o) ; |
| IF Length (o) > 0 |
| THEN |
| quotes := FALSE |
| END |
| END ; |
| RETURN o |
| END doDesc ; |
| |
| |
| (* |
| addQuoted - if, o, is not empty then add it to, r. |
| *) |
| |
| PROCEDURE addQuoted (r, o: String; quotes: BOOLEAN) : String ; |
| BEGIN |
| IF Length (o) > 0 |
| THEN |
| IF NOT isWhite (char (r, -1)) |
| THEN |
| r := x (r, ConCatChar (r, " ")) |
| END ; |
| IF quotes |
| THEN |
| r := x (r, ConCatChar (r, "'")) |
| END ; |
| r := x (r, ConCat (r, o)) ; |
| IF quotes |
| THEN |
| r := x (r, ConCatChar (r, "'")) |
| END |
| END ; |
| RETURN r |
| END addQuoted ; |
| |
| |
| (* |
| op := {'a'|'q'|'t'|'d'|'k'|'n'|'s'|'D'|'I'|'U'|'E'|'W'} then =: |
| *) |
| |
| PROCEDURE op (VAR e: error; VAR t: errorType; |
| VAR r: String; s: String; |
| sym: vararg; |
| VAR i: INTEGER; l: INTEGER; |
| bol: CARDINAL; positive: BOOLEAN) ; |
| VAR |
| o : String ; |
| c : vararg ; |
| quotes: BOOLEAN ; |
| BEGIN |
| c := varargs.copy (sym) ; |
| o := InitString ('') ; |
| quotes := TRUE ; |
| WHILE (i<l) AND (char (s, i)#'}') DO |
| CASE char(s, i) OF |
| |
| 'a': o := x(o, doName (bol, sym, o, quotes)) | |
| 'q': o := x(o, doQualified (bol, sym, o)) | |
| 't': o := x(o, doType (bol, sym, o)) | |
| 'd': o := x(o, doDesc (bol, sym, o, quotes)) | |
| 'n': o := x(o, doNumber (bol, sym, o, quotes)) | |
| 'N': o := x(o, doCount (bol, sym, o, quotes)) | |
| 's': o := x(o, doSkipType (bol, sym, o)) | |
| 'k': o := x(o, doKey (bol, sym, o)) | |
| 'D': e := doDeclaredDef (e, t, bol, sym) | |
| 'M': e := doDeclaredMod (e, t, bol, sym) | |
| 'U': e := doUsed (e, t, bol, sym) | |
| 'E': t := newerror | |
| 'W': t := newwarning | |
| ':': varargs.end (sym) ; |
| sym := varargs.copy (c) ; |
| then (e, t, r, s, sym, i, l, o, positive) ; |
| o := KillString (o) ; |
| o := InitString ('') ; |
| IF (i<l) AND (char (s, i) # '}') |
| THEN |
| internalFormat (s, i, 'expecting to see }') |
| END ; |
| DEC (i) |
| |
| ELSE |
| internalFormat (s, i, 'expecting one of [aqtdnNsDUEW:]') |
| END ; |
| INC (i) ; |
| END ; |
| r := x (r, addQuoted (r, o, quotes)) ; |
| o := KillString (o) |
| END op ; |
| |
| |
| (* |
| percenttoken := '%' ( |
| '1' % doOperand(1) % |
| op |
| | '2' % doOperand(2) % |
| op |
| | '3' % doOperand(3) % |
| op |
| | '4' % doOperand(4) % |
| op |
| ) |
| } =: |
| *) |
| |
| PROCEDURE percenttoken (VAR e: error; t: errorType; |
| VAR r: String; s: String; |
| sym: vararg; |
| VAR i: INTEGER; l: INTEGER; positive: BOOLEAN) ; |
| BEGIN |
| IF char (s, i) = '%' |
| THEN |
| INC (i) ; |
| CASE char (s, i) OF |
| |
| '1': INC (i) ; |
| op (e, t, r, s, sym, i, l, 0, positive) | |
| '2': INC (i) ; |
| op (e, t, r, s, sym, i, l, 1, positive) | |
| '3': INC (i) ; |
| op (e, t, r, s, sym, i, l, 2, positive) | |
| '4': INC (i) ; |
| op (e, t, r, s, sym, i, l, 3, positive) |
| |
| ELSE |
| internalFormat (s, i, 'expecting one of [123]') |
| END ; |
| IF (i<l) AND (char (s, i) # '}') |
| THEN |
| internalFormat (s, i, 'expecting to see }') |
| END |
| END |
| END percenttoken ; |
| |
| |
| (* |
| percent := '%' anych % copy anych % |
| =: |
| *) |
| |
| PROCEDURE percent (VAR r: String; s: String; |
| sym: vararg; |
| VAR i: INTEGER; l: INTEGER) ; |
| BEGIN |
| IF char(s, i)='%' |
| THEN |
| INC (i) ; |
| IF i<l |
| THEN |
| r := x (r, ConCatChar (r, char (s, i))) ; |
| INC (i) |
| END |
| END |
| END percent ; |
| |
| |
| (* |
| lbra := '{' [ '!' ] percenttoken '}' =: |
| *) |
| |
| PROCEDURE lbra (VAR e: error; VAR t: errorType; |
| VAR r: String; s: String; |
| sym: vararg; |
| VAR i: INTEGER; l: INTEGER) ; |
| VAR |
| positive: BOOLEAN ; |
| BEGIN |
| IF char (s, i) = '{' |
| THEN |
| positive := TRUE ; |
| INC (i) ; |
| IF char (s, i) = '!' |
| THEN |
| positive := FALSE ; |
| INC (i) ; |
| END ; |
| IF char (s, i) # '%' |
| THEN |
| internalFormat (s, i, 'expecting to see %') |
| END ; |
| percenttoken (e, t, r, s, sym, i, l, positive) ; |
| IF (i<l) AND (char (s, i) # '}') |
| THEN |
| internalFormat (s, i, 'expecting to see }') |
| END |
| END |
| END lbra ; |
| |
| |
| PROCEDURE stop ; BEGIN END stop ; |
| |
| (* |
| ebnf := { percent |
| | lbra |
| | any % copy ch % |
| } |
| =: |
| *) |
| |
| PROCEDURE ebnf (VAR e: error; VAR t: errorType; |
| VAR r: String; s: String; |
| sym: vararg; |
| VAR i: INTEGER; l: INTEGER) ; |
| BEGIN |
| WHILE i<l DO |
| CASE char(s, i) OF |
| |
| '%': percent (r, s, sym, i, l) | |
| '{': lbra (e, t, r, s, sym, i, l) ; |
| IF (i<l) AND (char (s, i) # '}') |
| THEN |
| internalFormat (s, i, 'expecting to see }') |
| END | |
| '}': RETURN |
| |
| ELSE |
| IF ((isWhite (char(s, i)) AND (Length (r) > 0) AND (NOT isWhite (char (r, -1)))) OR |
| (NOT isWhite (char (s, i)))) |
| THEN |
| r := x (r, ConCatChar (r, char (s, i))) |
| END |
| END ; |
| INC (i) |
| END |
| END ebnf ; |
| |
| |
| (* |
| doFormat - |
| *) |
| |
| PROCEDURE doFormat (VAR e: error; VAR t: errorType; |
| s: String; sym: vararg) : String ; |
| VAR |
| r : String ; |
| i, l: INTEGER ; |
| BEGIN |
| r := InitString ('') ; |
| i := 0 ; |
| l := Length (s) ; |
| ebnf (e, t, r, s, sym, i, l) ; |
| s := KillString (s) ; |
| RETURN r |
| END doFormat ; |
| |
| |
| PROCEDURE metaErrorStringT1 (tok: CARDINAL; m: String; s: ARRAY OF BYTE) ; |
| VAR |
| str: String ; |
| e : error ; |
| sym: vararg ; |
| t : errorType ; |
| BEGIN |
| e := NIL ; |
| sym := varargs.start1 (s) ; |
| t := newerror ; |
| str := doFormat (e, t, m, sym) ; |
| e := doError (e, t, tok) ; |
| errorString (e, str) ; |
| varargs.end (sym) |
| END metaErrorStringT1 ; |
| |
| |
| PROCEDURE metaErrorT1 (tok: CARDINAL; m: ARRAY OF CHAR; s: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorStringT1 (tok, InitString (m), s) |
| END metaErrorT1 ; |
| |
| |
| PROCEDURE metaErrorStringT2 (tok: CARDINAL; m: String; s1, s2: ARRAY OF BYTE) ; |
| VAR |
| str: String ; |
| e : error ; |
| sym: vararg ; |
| t : errorType ; |
| BEGIN |
| e := NIL ; |
| sym := varargs.start2 (s1, s2) ; |
| t := newerror ; |
| str := doFormat (e, t, m, sym) ; |
| e := doError (e, t, tok) ; |
| errorString (e, str) ; |
| varargs.end (sym) |
| END metaErrorStringT2 ; |
| |
| |
| PROCEDURE metaErrorT2 (tok: CARDINAL; m: ARRAY OF CHAR; s1, s2: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorStringT2 (tok, InitString (m), s1, s2) |
| END metaErrorT2 ; |
| |
| |
| PROCEDURE metaErrorStringT3 (tok: CARDINAL; m: String; s1, s2, s3: ARRAY OF BYTE) ; |
| VAR |
| str: String ; |
| e : error ; |
| sym: vararg ; |
| t : errorType ; |
| BEGIN |
| e := NIL ; |
| sym := varargs.start3 (s1, s2, s3) ; |
| t := newerror ; |
| str := doFormat (e, t, m, sym) ; |
| e := doError (e, t, tok) ; |
| errorString (e, str) ; |
| varargs.end (sym) |
| END metaErrorStringT3 ; |
| |
| |
| PROCEDURE metaErrorT3 (tok: CARDINAL; m: ARRAY OF CHAR; s1, s2, s3: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorStringT3 (tok, InitString (m), s1, s2, s3) |
| END metaErrorT3 ; |
| |
| |
| PROCEDURE metaErrorStringT4 (tok: CARDINAL; m: String; s1, s2, s3, s4: ARRAY OF BYTE) ; |
| VAR |
| str: String ; |
| e : error ; |
| sym: vararg ; |
| t : errorType ; |
| BEGIN |
| e := NIL ; |
| sym := varargs.start4 (s1, s2, s3, s4) ; |
| t := newerror ; |
| str := doFormat (e, t, m, sym) ; |
| e := doError (e, t, tok) ; |
| errorString (e, str) ; |
| varargs.end (sym) |
| END metaErrorStringT4 ; |
| |
| |
| PROCEDURE metaErrorT4 (tok: CARDINAL; m: ARRAY OF CHAR; |
| s1, s2, s3, s4: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorStringT4 (tok, InitString (m), s1, s2, s3, s4) |
| END metaErrorT4 ; |
| |
| |
| PROCEDURE metaError1 (m: ARRAY OF CHAR; s: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorT1 (getTokenNo (), m, s) |
| END metaError1 ; |
| |
| |
| PROCEDURE metaError2 (m: ARRAY OF CHAR; s1, s2: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorT2 (getTokenNo (), m, s1, s2) |
| END metaError2 ; |
| |
| |
| PROCEDURE metaError3 (m: ARRAY OF CHAR; s1, s2, s3: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorT3 (getTokenNo (), m, s1, s2, s3) |
| END metaError3 ; |
| |
| |
| PROCEDURE metaError4 (m: ARRAY OF CHAR; s1, s2, s3, s4: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorT4 (getTokenNo (), m, s1, s2, s3, s4) |
| END metaError4 ; |
| |
| |
| (* |
| wrapErrors - |
| *) |
| |
| PROCEDURE wrapErrors (tok: CARDINAL; |
| m1, m2: ARRAY OF CHAR; |
| sym: vararg) ; |
| VAR |
| e, f: error ; |
| str : String ; |
| t : errorType ; |
| BEGIN |
| e := NIL ; |
| t := newerror ; |
| str := doFormat (e, t, InitString(m1), sym) ; |
| e := doError (e, t, tok) ; |
| errorString (e, str) ; |
| f := e ; |
| t := chained ; |
| str := doFormat (f, t, InitString (m2), sym) ; |
| IF e=f |
| THEN |
| t := chained ; |
| f := doError (e, t, tok) |
| END ; |
| errorString (f, str) |
| END wrapErrors ; |
| |
| |
| PROCEDURE metaErrorsT1 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s: ARRAY OF BYTE) ; |
| VAR |
| sym: vararg ; |
| BEGIN |
| sym := varargs.start1 (s) ; |
| wrapErrors (tok, m1, m2, sym) ; |
| varargs.end (sym) |
| END metaErrorsT1 ; |
| |
| |
| PROCEDURE metaErrorsT2 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2: ARRAY OF BYTE) ; |
| VAR |
| sym: vararg ; |
| BEGIN |
| sym := varargs.start2 (s1, s2) ; |
| wrapErrors (tok, m1, m2, sym) ; |
| varargs.end (sym) |
| END metaErrorsT2 ; |
| |
| |
| PROCEDURE metaErrorsT3 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2, s3: ARRAY OF BYTE) ; |
| VAR |
| sym: vararg ; |
| BEGIN |
| sym := varargs.start3 (s1, s2, s3) ; |
| wrapErrors (tok, m1, m2, sym) ; |
| varargs.end (sym) |
| END metaErrorsT3 ; |
| |
| |
| PROCEDURE metaErrorsT4 (tok: CARDINAL; m1, m2: ARRAY OF CHAR; s1, s2, s3, s4: ARRAY OF BYTE) ; |
| VAR |
| sym: vararg ; |
| BEGIN |
| sym := varargs.start4 (s1, s2, s3, s4) ; |
| wrapErrors (tok, m1, m2, sym) ; |
| varargs.end (sym) |
| END metaErrorsT4 ; |
| |
| |
| PROCEDURE metaErrors1 (m1, m2: ARRAY OF CHAR; s: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorsT1 (getTokenNo (), m1, m2, s) |
| END metaErrors1 ; |
| |
| |
| PROCEDURE metaErrors2 (m1, m2: ARRAY OF CHAR; s1, s2: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorsT2 (getTokenNo (), m1, m2, s1, s2) |
| END metaErrors2 ; |
| |
| |
| PROCEDURE metaErrors3 (m1, m2: ARRAY OF CHAR; s1, s2, s3: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorsT3 (getTokenNo (), m1, m2, s1, s2, s3) |
| END metaErrors3 ; |
| |
| |
| PROCEDURE metaErrors4 (m1, m2: ARRAY OF CHAR; s1, s2, s3, s4: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorsT4 (getTokenNo (), m1, m2, s1, s2, s3, s4) |
| END metaErrors4 ; |
| |
| |
| PROCEDURE metaErrorString1 (m: String; s: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorStringT1 (getTokenNo (), m, s) |
| END metaErrorString1 ; |
| |
| |
| PROCEDURE metaErrorString2 (m: String; s1, s2: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorStringT2 (getTokenNo (), m, s1, s2) |
| END metaErrorString2 ; |
| |
| |
| PROCEDURE metaErrorString3 (m: String; s1, s2, s3: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorStringT3 (getTokenNo (), m, s1, s2, s3) |
| END metaErrorString3 ; |
| |
| |
| PROCEDURE metaErrorString4 (m: String; s1, s2, s3, s4: ARRAY OF BYTE) ; |
| BEGIN |
| metaErrorStringT4 (getTokenNo (), m, s1, s2, s3, s4) |
| END metaErrorString4 ; |
| |
| |
| END mcMetaError. |
