mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-05 21:02:26 +00:00
comments in symbol files, viewable by showdef browser.
This commit is contained in:
Norayr Chilingarian
parent
2f1ce08aff
commit
dac6504f12
6 changed files with 348 additions and 97 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
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*)
|
||||
|
|
|
|||
|
|
@ -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,45 +1321,71 @@ END Import;
|
|||
END
|
||||
END OutConstant;
|
||||
|
||||
PROCEDURE OutObj(obj: Object);
|
||||
VAR i, j: INTEGER; ext: ConstExt;
|
||||
BEGIN
|
||||
IF obj # NIL THEN
|
||||
OutObj(obj^.left);
|
||||
IF obj^.mode IN {Con, Typ, Var, LProc, XProc, CProc, IProc} THEN
|
||||
IF obj^.history = removed THEN FPrintErr(obj, 250)
|
||||
ELSIF obj^.vis # internal THEN
|
||||
CASE obj^.history OF
|
||||
| inserted: FPrintErr(obj, 253)
|
||||
| same: (* ok *)
|
||||
| pbmodified: FPrintErr(obj, 252)
|
||||
| pvmodified: FPrintErr(obj, 251)
|
||||
ELSE OPM.LogWStr("unhandled case at OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn;
|
||||
END;
|
||||
CASE obj^.mode OF
|
||||
| Con: OutConstant(obj); OutName(obj^.name)
|
||||
| Typ: IF obj^.typ^.strobj = obj THEN OPM.SymWInt(Stype); OutStr(obj^.typ)
|
||||
ELSE OPM.SymWInt(Salias); OutStr(obj^.typ); OutName(obj^.name)
|
||||
END
|
||||
| Var: IF obj^.vis = externalR THEN OPM.SymWInt(Srvar) ELSE OPM.SymWInt(Svar) END;
|
||||
OutStr(obj^.typ); OutName(obj^.name);
|
||||
IF (obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "") THEN
|
||||
(* compute fingerprint to avoid structural type equivalence *)
|
||||
OPM.FPrint(expCtxt.reffp, obj^.typ^.ref)
|
||||
END
|
||||
| XProc: OPM.SymWInt(Sxpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name)
|
||||
| IProc: OPM.SymWInt(Sipro); OutSign(obj^.typ, obj^.link); OutName(obj^.name)
|
||||
| CProc: OPM.SymWInt(Scpro); OutSign(obj^.typ, obj^.link); ext := obj^.conval^.ext;
|
||||
j := ORD(ext^[0]); i := 1; OPM.SymWInt(j);
|
||||
WHILE i <= j DO OPM.SymWCh(ext^[i]); INC(i) END;
|
||||
OutName(obj^.name)
|
||||
ELSE OPM.LogWStr("unhandled case at OutObj, obj.mode = "); OPM.LogWNum(obj.mode, 0); OPM.LogWLn;
|
||||
END
|
||||
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;
|
||||
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;
|
||||
OutObj(obj^.right)
|
||||
END
|
||||
END OutObj;
|
||||
|
||||
IF obj^.history = removed THEN FPrintErr(obj, 250)
|
||||
ELSIF obj^.vis # internal THEN
|
||||
CASE obj^.history OF
|
||||
| inserted: FPrintErr(obj, 253)
|
||||
| same: (* ok *)
|
||||
| pbmodified: FPrintErr(obj, 252)
|
||||
| pvmodified: FPrintErr(obj, 251)
|
||||
ELSE OPM.LogWStr("unhandled case at OutObj, obj^.history = "); OPM.LogWNum(obj^.history, 0); OPM.LogWLn;
|
||||
END;
|
||||
CASE obj^.mode OF
|
||||
| Con: OutConstant(obj); OutName(obj^.name)
|
||||
| Typ: IF obj^.typ^.strobj = obj THEN OPM.SymWInt(Stype); OutStr(obj^.typ)
|
||||
ELSE OPM.SymWInt(Salias); OutStr(obj^.typ); OutName(obj^.name)
|
||||
END
|
||||
| Var: IF obj^.vis = externalR THEN OPM.SymWInt(Srvar) ELSE OPM.SymWInt(Svar) END;
|
||||
OutStr(obj^.typ); OutName(obj^.name);
|
||||
IF (obj^.typ^.strobj = NIL) OR (obj^.typ^.strobj^.name = "") THEN
|
||||
(* compute fingerprint to avoid structural type equivalence *)
|
||||
OPM.FPrint(expCtxt.reffp, obj^.typ^.ref)
|
||||
END
|
||||
| XProc: OPM.SymWInt(Sxpro); OutSign(obj^.typ, obj^.link); OutName(obj^.name)
|
||||
| IProc: OPM.SymWInt(Sipro); OutSign(obj^.typ, obj^.link); OutName(obj^.name)
|
||||
| CProc: OPM.SymWInt(Scpro); OutSign(obj^.typ, obj^.link); ext := obj^.conval^.ext;
|
||||
j := ORD(ext^[0]); i := 1; OPM.SymWInt(j);
|
||||
WHILE i <= j DO OPM.SymWCh(ext^[i]); INC(i) END;
|
||||
OutName(obj^.name)
|
||||
ELSE OPM.LogWStr("unhandled case at OutObj, obj.mode = "); OPM.LogWNum(obj.mode, 0); OPM.LogWLn;
|
||||
END
|
||||
END
|
||||
END;
|
||||
OutObj(obj^.right)
|
||||
END
|
||||
END OutObj;
|
||||
|
||||
PROCEDURE Export*(VAR ext, new: BOOLEAN);
|
||||
VAR i: INTEGER; nofmod: SHORTINT; done: BOOLEAN;
|
||||
|
|
|
|||
|
|
@ -1,47 +1,47 @@
|
|||
(* $Id: IntStr.Mod,v 1.4 1999/09/02 13:07:47 acken Exp $ *)
|
||||
(* $Id: IntStr.Mod,v 1.4 1999/09/02 13:07:47 acken Exp $ *)
|
||||
MODULE oocIntStr;
|
||||
(* IntStr - Integer-number/string conversions.
|
||||
(* IntStr - Integer-number/string conversions.
|
||||
Copyright (C) 1995 Michael Griebling
|
||||
|
||||
|
||||
This module is free software; you can redistribute it and/or modify
|
||||
it under the terms of the GNU Lesser General Public License as
|
||||
it under the terms of the GNU Lesser General Public License as
|
||||
published by the Free Software Foundation; either version 2 of the
|
||||
License, or (at your option) any later version.
|
||||
|
||||
|
||||
This module 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 Lesser General Public License for more details.
|
||||
|
||||
|
||||
You should have received a copy of the GNU Lesser General Public
|
||||
License along with this program; if not, write to the Free Software
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
*)
|
||||
|
||||
|
||||
IMPORT
|
||||
Conv := oocConvTypes, IntConv := oocIntConv;
|
||||
|
||||
|
||||
TYPE
|
||||
ConvResults*= Conv.ConvResults;
|
||||
(* possible values: strAllRight, strOutOfRange, strWrongFormat, strEmpty *)
|
||||
ConvResults*= Conv.ConvResults;
|
||||
(** 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 string form of a signed whole number is
|
||||
(** the given string is empty *)
|
||||
|
||||
|
||||
(** 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 *)
|
||||
|
|
@ -92,9 +92,9 @@ BEGIN
|
|||
b[e] := 0X;
|
||||
Reverse(b, s, e-1)
|
||||
END;
|
||||
|
||||
|
||||
COPY(b, str) (* truncate output if necessary *)
|
||||
END IntToStr;
|
||||
|
||||
|
||||
END oocIntStr.
|
||||
|
||||
|
|
|
|||
|
|
@ -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 field 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.
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue