comments in symbol files, viewable by showdef browser.

This commit is contained in:
Norayr Chilingarian 2025-06-24 17:44:19 +04:00
parent 2f1ce08aff
commit dac6504f12
6 changed files with 348 additions and 97 deletions

View file

@ -8,6 +8,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
CONST
OptionChar* = "-";
MaxCommentLen* = 256;
(* compiler option flag bits; don't change the encoding *)
inxchk* = 0; (* index check on *)
@ -76,15 +77,16 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
BFext = ".c"; (* body file extension *)
HFext = ".h"; (* header file extension *)
SFtag = 0F7X; (* symbol file tag *)
SFver = 083X; (* symbol file version. Increment if symbol file format is changed. *)
SFver = 084X; (* symbol file version. Increment if symbol file format is changed. *)
TYPE
FileName = ARRAY 32 OF CHAR;
VAR
currentComment: ARRAY MaxCommentLen OF CHAR;
hasComment: BOOLEAN;
SourceFileName : ARRAY 256 OF CHAR;
GlobalModel, Model*: ARRAY 10 OF CHAR; (* 2: S8/I16/L32, C: S16/I32/L64, V:S8/I32/L64 *)
@ -150,6 +152,33 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
LogW(".");
END LogCompiling;
(* for exported comments *)
PROCEDURE StoreComment*(text: ARRAY OF CHAR);
VAR i: INTEGER;
BEGIN
i := 0;
WHILE (i < MaxCommentLen - 1) & (text[i] # 0X) DO
currentComment[i] := text[i]; INC(i)
END;
currentComment[i] := 0X;
hasComment := TRUE;
END StoreComment;
PROCEDURE GetComment*(VAR text: ARRAY OF CHAR);
VAR i: INTEGER;
BEGIN
IF hasComment THEN
i := 0;
WHILE (i < LEN(text)) & (i < MaxCommentLen) & (currentComment[i] # 0X) DO
text[i] := currentComment[i]; INC(i)
END;
text[i] := 0X;
hasComment := FALSE
ELSE
text[0] := 0X
END;
END GetComment;
(* Integer size support *)
@ -830,4 +859,7 @@ BEGIN
MinReal := -MaxReal;
MinLReal := -MaxLReal;
FindInstallDir;
hasComment := FALSE;
currentComment[0] := 0X;
END OPM.

View file

@ -190,22 +190,92 @@ MODULE OPS; (* NW, RC 6.3.89 / 18.10.92 *) (* object model 3.6.92 *)
PROCEDURE Get*(VAR sym: SHORTINT);
VAR s: SHORTINT;
PROCEDURE Comment; (* do not read after end of file *)
BEGIN OPM.Get(ch);
LOOP
LOOP
WHILE ch = "(" DO OPM.Get(ch);
IF ch = "*" THEN Comment END
END ;
IF ch = "*" THEN OPM.Get(ch); EXIT END ;
IF ch = OPM.Eot THEN EXIT END ;
OPM.Get(ch)
END ;
IF ch = ")" THEN OPM.Get(ch); EXIT END ;
IF ch = OPM.Eot THEN err(5); EXIT END
PROCEDURE Comment;
VAR
isExported: BOOLEAN;
commentText: ARRAY OPM.MaxCommentLen OF CHAR;
i: INTEGER;
nestLevel: INTEGER;
prevCh, nextCh: CHAR;
BEGIN
FOR i := 0 TO LEN(commentText) - 1 DO
commentText[i] := 0X
END;
isExported := FALSE;
i := 0;
nestLevel := 1;
prevCh := 0X;
OPM.Get(ch);
IF ch = "*" THEN
isExported := TRUE;
OPM.Get(ch);
IF ch = ")" THEN
(* Empty exported comment (**), handle and return *)
commentText[0] := 0X;
OPM.StoreComment(commentText);
OPM.Get(ch); (* consume character after closing comment *)
RETURN
END
END;
WHILE (nestLevel > 0) & (ch # OPM.Eot) DO
IF (prevCh = "(") & (ch = "*") THEN
INC(nestLevel);
prevCh := 0X
ELSIF (prevCh = "*") & (ch = ")") THEN
DEC(nestLevel);
IF nestLevel = 0 THEN
OPM.Get(ch); (* move past ')' *)
ELSE
prevCh := 0X
END
ELSE
IF isExported & (nestLevel = 1) & (prevCh # 0X) THEN
IF i < OPM.MaxCommentLen - 1 THEN
commentText[i] := prevCh; INC(i)
END
END;
prevCh := ch
END;
IF nestLevel > 0 THEN OPM.Get(ch) END
END;
IF ch = OPM.Eot THEN
err(5)
END;
(*
IF isExported & (nestLevel = 0) & (prevCh # 0X) & (prevCh # "*") & (i < OPM.MaxCommentLen - 2) THEN
commentText[i] := prevCh;
INC(i)
END;
*)
IF isExported & (nestLevel = 0) & (prevCh # 0X) & (prevCh # "*") THEN
IF i < OPM.MaxCommentLen - 1 THEN
commentText[i] := prevCh;
INC(i)
ELSE
OPM.LogWStr("Truncating final comment character"); OPM.LogWLn
END
END;
IF isExported THEN
IF i >= OPM.MaxCommentLen THEN
OPM.LogWStr("Warning: commentText overflow"); OPM.LogWLn;
i := OPM.MaxCommentLen - 1
END;
commentText[i] := 0X;
OPM.StoreComment(commentText)
END;
END Comment;
BEGIN
OPM.errpos := OPM.curpos-1;
WHILE ch <= " " DO (*ignore control characters*)

View file

@ -46,7 +46,8 @@ TYPE
typ*: Struct;
conval*: Const;
adr*, linkadr*: LONGINT;
x*: INTEGER (* linkadr and x can be freely used by the backend *)
x*: INTEGER; (* linkadr and x can be freely used by the backend *)
comment*: ConstExt;
END;
CONST
@ -178,6 +179,7 @@ CONST
Shdptr* = 27; Shdpro* = 28; Stpro* = 29; Shdtpro* = 30; Sxpro* = 31;
Sipro* = 32; Scpro* = 33; Sstruct* = 34; Ssys* = 35; Sptr* = 36;
Sarr* = 37; Sdarr* = 38; Srec* = 39; Spro* = 40; Slink* = 37;
Scomment* = 41;
TYPE
ImpCtxt = RECORD
@ -367,7 +369,15 @@ END NewConst;
PROCEDURE NewObj*(): Object;
VAR obj: Object;
BEGIN NEW(obj); RETURN obj
BEGIN
NEW(obj);
(* lets fully init pointers *)
obj^.typ := NIL;
obj^.conval := NIL;
obj^.comment := NIL;
obj^.name := "";
RETURN obj
END NewObj;
PROCEDURE NewStr*(form, comp: SHORTINT): Struct;
@ -468,8 +478,16 @@ BEGIN
END FindField;
PROCEDURE Insert*(VAR name: OPS.Name; VAR obj: Object);
VAR ob0, ob1: Object; left: BOOLEAN; mnolev: SHORTINT;
BEGIN ob0 := topScope; ob1 := ob0^.right; left := FALSE;
VAR
ob0, ob1: Object;
left: BOOLEAN;
mnolev: SHORTINT;
commentText: ARRAY OPM.MaxCommentLen OF CHAR;
j: INTEGER;
BEGIN
ob0 := topScope;
ob1 := ob0^.right;
left := FALSE;
LOOP
IF ob1 # NIL THEN
IF name < ob1^.name THEN ob0 := ob1; ob1 := ob0^.left; left := TRUE
@ -480,13 +498,24 @@ BEGIN ob0 := topScope; ob1 := ob0^.right; left := FALSE;
IF left THEN ob0^.left := ob1 ELSE ob0^.right := ob1 END;
ob1^.left := NIL; ob1^.right := NIL; COPY(name, ob1^.name);
mnolev := topScope^.mnolev; ob1^.mnolev := mnolev;
(* Attach pending comment *)
OPM.GetComment(commentText);
IF commentText[0] # 0X THEN
NEW(ob1^.comment);
(*COPY(commentText, ob1^.comment^);*)
j := 0;
WHILE (j < OPM.MaxCommentLen - 1) & (commentText[j] # 0X) DO
ob1^.comment^[j] := commentText[j];
INC(j)
END;
ob1^.comment^[j] := 0X;
END;
EXIT
END
END;
obj := ob1
END Insert;
(*-------------------------- Fingerprinting --------------------------*)
(* Fingerprints prevent structural type equivalence. *)
@ -791,13 +820,25 @@ PROCEDURE InSign(mno: SHORTINT; VAR res: Struct; VAR par: Object);
VAR last, new: Object; tag: LONGINT;
BEGIN
InStruct(res);
tag := OPM.SymRInt(); last := NIL;
tag := OPM.SymRInt();
last := NIL;
WHILE tag # Send DO
new := NewObj(); new^.mnolev := -mno;
(* Add bounds checking *)
IF (tag < 0) OR (tag > 100) THEN
OPM.LogWStr("ERROR: Invalid tag value in InSign: "); OPM.LogWNum(tag, 0); OPM.LogWLn;
OPM.err(155); (* symbol file corrupted *)
RETURN
END;
new := NewObj();
new^.mnolev := -mno;
IF last = NIL THEN par := new ELSE last^.link := new END;
IF tag = Svalpar THEN new^.mode := Var ELSE new^.mode := VarPar END;
InStruct(new^.typ); new^.adr := OPM.SymRInt(); InName(new^.name);
last := new; tag := OPM.SymRInt()
InStruct(new^.typ);
new^.adr := OPM.SymRInt(); InName(new^.name);
last := new;
tag := OPM.SymRInt();
END
END InSign;
@ -973,11 +1014,46 @@ BEGIN
END
END InStruct;
PROCEDURE InObj(mno: SHORTINT): Object; (* first number in impCtxt.nextTag *)
VAR i, s: INTEGER; ch: CHAR; obj, old: Object; typ: Struct;
tag: LONGINT; ext: ConstExt;
commentText: OPS.Name;
hasComment : BOOLEAN;
j: INTEGER;
len: LONGINT;
BEGIN
tag := impCtxt.nextTag;
hasComment := FALSE;
(* checking for comment first, but not processing it yet *)
WHILE tag = Scomment DO (* Handle multiple consecutive comments *)
len := OPM.SymRInt(); (* read length *)
(* Ensure length is within bounds *)
IF len < 0 THEN len := 0 END;
IF len > OPS.MaxStrLen - 1 THEN len := OPS.MaxStrLen - 1 END;
i := 0;
WHILE i < len DO
OPM.SymRCh(commentText[i]); INC(i)
END;
commentText[i] := 0X;
hasComment := TRUE; (* Only keep the last comment if there are multiple *)
tag := OPM.SymRInt(); (* continue stream *)
END;
(* Now tag should be a valid object tag *)
impCtxt.nextTag := tag;
(* Validate tag value *)
IF (tag < 0) OR (tag > 50) THEN
OPM.LogWStr("ERROR: Invalid tag in InObj: "); OPM.LogWNum(tag, 0); OPM.LogWLn;
OPM.err(155); (* Symbol file error *)
RETURN NIL
END;
IF tag = Stype THEN
InStruct(typ); obj := typ^.strobj;
IF ~impCtxt.self THEN obj^.vis := external END (* type name visible now, obj^.fprint already done *)
@ -986,7 +1062,7 @@ BEGIN
IF tag <= Pointer THEN (* Constant *)
obj^.mode := Con; obj^.conval := NewConst(); InConstant(tag, obj^.conval);
obj^.typ := InTyp(tag)
ELSIF tag >= Sxpro THEN
ELSIF (tag >= Sxpro) & (tag <= Scpro) THEN (* Procedure tags *)
obj^.conval := NewConst();
obj^.conval^.intval := -1;
InSign(mno, obj^.typ, obj^.link);
@ -998,16 +1074,33 @@ BEGIN
s := SHORT(OPM.SymRInt()); ext^[0] := CHR(s); i := 1;
WHILE i <= s DO OPM.SymRCh(ext^[i]); INC(i) END
ELSE OPM.LogWStr("unhandled case at InObj, tag = "); OPM.LogWNum(tag, 0); OPM.LogWLn;
OPM.err(155); RETURN NIL
END
ELSIF tag = Salias THEN
obj^.mode := Typ; InStruct(obj^.typ)
ELSE
ELSIF (tag = Svar) OR (tag = Srvar) THEN
obj^.mode := Var;
IF tag = Srvar THEN obj^.vis := externalR END;
InStruct(obj^.typ)
ELSE
OPM.LogWStr("ERROR: Unexpected tag in InObj: "); OPM.LogWNum(tag, 0); OPM.LogWLn;
OPM.err(155); (* Symbol file error *)
RETURN NIL
END;
InName(obj^.name)
END;
(* attaching exported comment after the object was created *)
IF hasComment & (obj # NIL) THEN
NEW(obj^.comment);
j := 0;
WHILE (j < OPM.MaxCommentLen - 1) & (j < len) & (commentText[j] # 0X) DO
obj^.comment^[j] := commentText[j];
INC(j)
END;
obj^.comment^[j] := 0X;
END;
FPrintObj(obj);
IF (obj^.mode = Var) & ((obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "")) THEN
(* compute a global fingerprint to avoid structural type equivalence for anonymous types *)
@ -1040,6 +1133,8 @@ BEGIN
RETURN obj
END InObj;
PROCEDURE Import*(aliasName: OPS.Name; VAR name: OPS.Name; VAR done: BOOLEAN);
VAR obj: Object; mno: SHORTINT; (* done used in Browser *)
BEGIN
@ -1226,12 +1321,38 @@ END Import;
END
END OutConstant;
PROCEDURE OutObj(obj: Object);
PROCEDURE OutTruncatedName(text: ARRAY OF CHAR);
VAR i: INTEGER;
BEGIN
i := 0;
WHILE (i < OPS.MaxStrLen - 1) & (text[i] # 0X) DO
OPM.SymWCh(text[i]); INC(i)
END;
OPM.SymWCh(0X)
END OutTruncatedName;
PROCEDURE OutObj(obj: Object);
VAR i, j: INTEGER; ext: ConstExt;
BEGIN
k, l: INTEGER;
BEGIN
IF obj # NIL THEN
OutObj(obj^.left);
IF obj^.mode IN {Con, Typ, Var, LProc, XProc, CProc, IProc} THEN
(* Write comment BEFORE the object *)
IF obj^.comment # NIL THEN
OPM.SymWInt(Scomment);
(* Calculate actual length of comment text *)
k := 0;
WHILE (k < OPM.MaxCommentLen - 1) & (obj^.comment^[k] # 0X) DO INC(k) END;
OPM.SymWInt(k); (* length prefix *)
(* Write comment data as individual characters *)
l := 0;
WHILE l < k DO
OPM.SymWCh(obj^.comment^[l]); INC(l)
END
END;
IF obj^.history = removed THEN FPrintErr(obj, 250)
ELSIF obj^.vis # internal THEN
CASE obj^.history OF
@ -1264,7 +1385,7 @@ END Import;
END;
OutObj(obj^.right)
END
END OutObj;
END OutObj;
PROCEDURE Export*(VAR ext, new: BOOLEAN);
VAR i: INTEGER; nofmod: SHORTINT; done: BOOLEAN;

View file

@ -23,25 +23,25 @@ IMPORT
TYPE
ConvResults*= Conv.ConvResults;
(* possible values: strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
(** possible values: strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
CONST
strAllRight*=Conv.strAllRight;
(* the string format is correct for the corresponding conversion *)
(** the string format is correct for the corresponding conversion *)
strOutOfRange*=Conv.strOutOfRange;
(* the string is well-formed but the value cannot be represented *)
(** the string is well-formed but the value cannot be represented *)
strWrongFormat*=Conv.strWrongFormat;
(* the string is in the wrong format for the conversion *)
(** the string is in the wrong format for the conversion *)
strEmpty*=Conv.strEmpty;
(* the given string is empty *)
(** the given string is empty *)
(* the string form of a signed whole number is
(** the string form of a signed whole number is
["+" | "-"] decimal_digit {decimal_digit}
*)
PROCEDURE StrToInt*(str: ARRAY OF CHAR; VAR int: LONGINT; VAR res: ConvResults);
(* Ignores any leading spaces in `str'. If the subsequent characters in `str'
(** Ignores any leading spaces in `str'. If the subsequent characters in `str'
are in the format of a signed whole number, assigns a corresponding value to
`int'. Assigns a value indicating the format of `str' to `res'. *)
BEGIN
@ -53,7 +53,7 @@ END StrToInt;
PROCEDURE Reverse (VAR str : ARRAY OF CHAR; start, end : INTEGER);
(* Reverses order of characters in the interval [start..end]. *)
(** Reverses order of characters in the interval [start..end]. *)
VAR
h : CHAR;
BEGIN
@ -65,7 +65,7 @@ END Reverse;
PROCEDURE IntToStr*(int: LONGINT; VAR str: ARRAY OF CHAR);
(* Converts the value of `int' to string form and copies the possibly truncated
(** Converts the value of `int' to string form and copies the possibly truncated
result to `str'. *)
CONST
maxLength = 11; (* maximum number of digits representing a LONGINT value *)

View file

@ -1,4 +1,7 @@
MODULE Out; (* DCW Brown. 2016-09-27 *)
(** Module Out provides a set of basic routines
for formatted output of characters, numbers, and strings.
It assumes a standard output stream to which the symbols are written. *)
IMPORT SYSTEM, Platform, Heap;
@ -16,11 +19,11 @@ BEGIN
IF in > 0 THEN error := Platform.Write(Platform.StdOut, SYSTEM.ADR(buf), in) END;
in := 0;
END Flush;
(** Initializes the output stream. In this library does nothing, safe to never use. *)
PROCEDURE Open*;
BEGIN
END Open;
(** Writes the character to the end of the output stream. *)
PROCEDURE Char*(ch: CHAR);
BEGIN
IF in >= LEN(buf) THEN Flush END;
@ -32,7 +35,7 @@ PROCEDURE Length(VAR s: ARRAY OF CHAR): LONGINT;
VAR l: LONGINT;
BEGIN l := 0; WHILE (l < LEN(s)) & (s[l] # 0X) DO INC(l) END; RETURN l
END Length;
(** Writes the null-terminated character sequence str to the end of the output stream (without 0X). *)
PROCEDURE String*(str: ARRAY OF CHAR);
VAR l: LONGINT; error: Platform.ErrorCode;
BEGIN
@ -46,7 +49,10 @@ BEGIN
END
END String;
(** Writes the integer number x to the end of the output stream.
If the textual representation of x requires m characters,
x is right adjusted in a field of Max(n, m) characters
padded with blanks at the left end. a plus sign is not written. *)
PROCEDURE Int*(x, n: HUGEINT);
CONST zero = ORD('0');
VAR s: ARRAY 22 OF CHAR; i: INTEGER; negative: BOOLEAN;
@ -82,7 +88,7 @@ BEGIN
ELSE Char(CHR((x MOD 16) - 10 + ORD('A'))) END
END
END Hex;
(** Writes an end-of-line symbol to the end of the output stream *)
PROCEDURE Ln*;
BEGIN String(Platform.NL); Flush;
END Ln;
@ -117,14 +123,15 @@ END Ten;
PROCEDURE -Entier64(x: LONGREAL): SYSTEM.INT64 "(INT64)(x)";
PROCEDURE RealP(x: LONGREAL; n: INTEGER; long: BOOLEAN);
(* RealP(x, n) writes the long real number x to the end of the output stream using an
(** RealP(x, n) writes the long real number x to the end of the output stream using an
exponential form. If the textual representation of x requires m characters (including a
three-digit signed exponent), x is right adjusted in a eld of Max(n, m) characters padded
with blanks at the left end. A plus sign of the mantissa is not written.
LONGREAL is 1/sign, 11/exponent, 52/significand *)
PROCEDURE RealP(x: LONGREAL; n: INTEGER; long: BOOLEAN);
VAR
e: INTEGER; (* Exponent field *)
f: HUGEINT; (* Fraction field *)
@ -212,11 +219,18 @@ BEGIN
WHILE i < LEN(s) DO Char(s[i]); INC(i) END
END RealP;
(** Writes the real number x to the end of the output stream using an exponential
form. If the textual representation of x requires m characters (including a
two-digit signed exponent), x is right adjusted in a field of Max(n, m) characters
padded with blanks at the left end. A plus sign of the mantissa is not written.*)
PROCEDURE Real*(x: REAL; n: INTEGER);
BEGIN RealP(x, n, FALSE);
END Real;
(** Writes the long real number x to the end of the output stream using an exponential form.
If the textual representation of x requires m characters (including a three-digit
signed exponent), x is right adjusted in a field of Max(n, m) characters padded
with blanks at the left end. A plus sign of the mantissa is not written. *)
PROCEDURE LongReal*(x: LONGREAL; n: INTEGER);
BEGIN RealP(x, n, TRUE);
END LongReal;
@ -224,4 +238,10 @@ END LongReal;
BEGIN
IsConsole := Platform.IsConsole(Platform.StdOut);
in := 0
(** This module originally was designed by Martin Reiser
for the book "Programming in Oberon".
the specification was proposed by H. Moessenbock *)
END Out.

View file

@ -63,6 +63,14 @@ MODULE BrowserCmd; (* RC 29.10.93 *) (* object model 4.12.93, command line ver
IF obj # NIL THEN
Objects(obj^.left, mode);
IF obj^.mode IN mode THEN
(* Output comment if present *)
IF obj^.comment # NIL THEN
Indent(1);
Ws("(** ");
Ws(obj^.comment^);
Ws(" *)");
Wln
END;
CASE obj^.mode OF
|OPT.Con: Indent(2); Ws(obj^.name); Ws(" = ");
CASE obj^.typ^.form OF