vishapoberon/compiler
1
0
Fork 0
mirror of https://github.com/vishapoberon/compiler.git synced 2026-04-05 23:22:25 +00:00
Code Issues Projects Releases Packages Wiki Activity Actions

Document compilation; remove OpenBSD debugging.

Browse source
This commit is contained in:
David Brown 2016-12-20 15:16:18 +00:00
parent c6388006b9
commit 412a8c3337
11 changed files with 110 additions and 319 deletions
Download patch file Download diff file Expand all files Collapse all files

7
ReadMe.md
View file

@ -14,8 +14,8 @@ default libraries complying with the Oakwood Guidelines for Oberon-2 compilers.
### Contents ### Contents
&nbsp;&nbsp;&nbsp;&nbsp;[**Installation**](#installation)<br> &nbsp;&nbsp;&nbsp;&nbsp;[**Installation**](#installation)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**A 'Hello' application**](#a-hello-application)<br> &nbsp;&nbsp;&nbsp;&nbsp;[**Compiling a 'Hello' application**](#a-hello-application)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Licensing**](#licensing)<br> &nbsp;&nbsp;&nbsp;&nbsp;[**License**](#license)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Platform support and porting**](#platform-support-and-porting)<br> &nbsp;&nbsp;&nbsp;&nbsp;[**Platform support and porting**](#platform-support-and-porting)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**Language support and libraries**](#language-support-and-libraries)<br> &nbsp;&nbsp;&nbsp;&nbsp;[**Language support and libraries**](#language-support-and-libraries)<br>
&nbsp;&nbsp;&nbsp;&nbsp;[**History**](#history)<br> &nbsp;&nbsp;&nbsp;&nbsp;[**History**](#history)<br>
@ -138,6 +138,7 @@ executable binary.
Execute as usual on Linux (`./hello`) or Windows (`hello`). Execute as usual on Linux (`./hello`) or Windows (`hello`).
For more details on compilation, see [**Compiling**](/doc/Compiling.md).
### Viewing the interfaces of included modules. ### Viewing the interfaces of included modules.
@ -163,7 +164,7 @@ END Out.
``` ```
## Licensing ## License
Vishap Oberon's frontend and C backend engine is a fork of Josef Templ’s Ofront, which has been released Vishap Oberon's frontend and C backend engine is a fork of Josef Templ’s Ofront, which has been released
under the FreeBSD License. Unlike Ofront, Vishap Oberon does not include the Oberon v4 GUI environment. under the FreeBSD License. Unlike Ofront, Vishap Oberon does not include the Oberon v4 GUI environment.

82
doc/Compiling.md Normal file
View file

@ -0,0 +1,82 @@
## Compiling
An Oberon command line program is built from one or more modules. One module must be designated a main module.
### Files generated
From each non-main module the following files are generated in the current directory:
| Filename | Purpose |
| ---------- | --------------------------------------------------------------------- |
| ```module.sym``` | Oberon symbols required to ```IMPORT``` this module in another compilation.|
| ```module.c``` | C source code for compilation by gcc, clang or msc. |
| ```module.h``` | C header files required by C compiler when importing this module. |
Note that the filename of the .sym, .c and .h files is the name of the module from the ```MODULE``` statement at the start of the source file. It is not the name of the .mod file.
If the compilation is successful, the Oberon compiler will automatically invoke the C compiler. The compiler option ```-V``` will cause the compiler to display the C compiler command used.
### Successful compilation report
For a successful compilation, the compiler displays a single line comprising
* The name of the file being compiled
* The name of the module from the ```MODULE``` statment
* Compiler configuration (only if the ```-V``` verbose option is selected)
* A possible symbol update status message
* The number of characters compiled
If a symbols file already exists, the compiler will check whether the new compilation changes the symbols, and if so whether the change is just an extension, or a more serious compatability threatening modification. If there is a change the compiler displays either ```Extended symbol file``` or ```New symbol file```.
For example:
```
$ voc test.mod
test.mod Compiling test. New symbol file. 364 chars.
```
### Symbol file changes
By default the compiler will refuse to compile a module if its symbols are different from those in the .sym file present from a previous compilation. To allow the compiler to change the symbols, one of the following options must be used.
| Compiler option | Use |
| :-------------: | --------------------------- |
| ```-e``` | Allow extension of symbols. Do not allow changes to existing symbols. |
| ```-s``` | Allow changes to and extensions of symbols. |
| ```-F``` | Force generation of new symbol file.* |
\* A new symbol file may be forced to guarantee that a symbol file is generated for a module that has the same name as an installed library module.
### Main module
The main module should be the last module compiled as it imports all other modules.
The program logic should be started from the main module's initialisation code.
The following options designate the main module:
| Compiler option | Use |
| :-------------: | --------------------------- |
| ```-m``` | Generate loadable binary using dynamic library loading (on systems that support it). |
| ```-M``` | Generate loadable binary with all library references statically linked. |
For a main module, no .sym or .h files are generated, and the C compiler is called with additional parameters to generate the execututable binary, linking the object files needed for imported modules.
### Separate compilation
Each module may be compiled by a separate command line, although the imports of a module must be compiled before the module is compiled. All three generated files (.sym, .c and .h) must be retained at least until all modules dependent on this module have been compiled.
Multiple modules may be compiled on a single compiler command line.
Options on the command line that preceed all module file names will be used as global settings: each module will be compiled with these settings except as overriden on a per file basis.
Options on the command line that follow a module file name are specific to that module.
For example:
```
voc -s alpha.mod beta.mod main.mod -m
```
Will apply the ```-s``` option to all modules (allow changes to and extension of symbols), and will apply the ```-m``` option (main program) only to ```main.mod```.

2
doc/Features.md
View file

@ -1,4 +1,4 @@
### Features ## Features
#### 32 bit and 64 bit systems vs integer, set and address size. #### 32 bit and 64 bit systems vs integer, set and address size.

2
src/compiler/Compiler.Mod
View file

@ -99,7 +99,7 @@ MODULE Compiler; (* J. Templ 3.2.95 *)
Strings.Append(fn, objectnames) Strings.Append(fn, objectnames)
ELSE ELSE
(* Found symbol file but no object file. *) (* Found symbol file but no object file. *)
OPM.LogVT100(VT100.Yellow); OPM.LogVT100(VT100.LightRed);
OPM.LogWStr("Link warning: a local symbol file is present for module "); OPM.LogWStr(l.name); OPM.LogWStr("Link warning: a local symbol file is present for module "); OPM.LogWStr(l.name);
OPM.LogWStr(", but local object file '"); OPM.LogWStr(fn); OPM.LogWStr("' is missing."); OPM.LogWStr(", but local object file '"); OPM.LogWStr(fn); OPM.LogWStr("' is missing.");
OPM.LogVT100(VT100.ResetAll); OPM.LogWLn OPM.LogVT100(VT100.ResetAll); OPM.LogWLn

36
src/compiler/OPM.Mod
View file

@ -137,6 +137,18 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END END
END LogVT100; END LogVT100;
PROCEDURE LogCompiling*(modname: ARRAY OF CHAR);
BEGIN
LogWStr("Compiling "); LogWStr(modname);
IF verbose IN Options THEN
LogWStr(", s:"); LogWNum(ShortintSize*8,1);
LogWStr( " i:"); LogWNum(IntegerSize*8,1);
LogWStr( " l:"); LogWNum(LongintSize*8,1);
LogWStr( " adr:"); LogWNum(AddressSize*8,1);
LogWStr( " algn:"); LogWNum(Alignment*8,1)
END;
LogW(".");
END LogCompiling;
(* Integer size support *) (* Integer size support *)
@ -299,20 +311,6 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
END OpenPar; END OpenPar;
PROCEDURE VerboseListSizes;
BEGIN
LogWLn;
LogWStr("Type Size"); LogWLn;
LogWStr("SHORTINT "); LogWNum(ShortintSize, 4); LogWLn;
LogWStr("INTEGER "); LogWNum(IntegerSize, 4); LogWLn;
LogWStr("LONGINT "); LogWNum(LongintSize, 4); LogWLn;
LogWStr("SET "); LogWNum(LongintSize, 4); LogWLn;
LogWStr("ADDRESS "); LogWNum(AddressSize, 4); LogWLn;
LogWLn;
LogWStr("Alignment: "); LogWNum(Alignment, 4); LogWLn;
END VerboseListSizes;
PROCEDURE InitOptions*; (* get the options for one translation *) PROCEDURE InitOptions*; (* get the options for one translation *)
VAR s: ARRAY 256 OF CHAR; searchpath, modules: ARRAY 1024 OF CHAR; VAR s: ARRAY 256 OF CHAR; searchpath, modules: ARRAY 1024 OF CHAR;
MODULES: ARRAY 1024 OF CHAR; MODULES: ARRAY 1024 OF CHAR;
@ -336,7 +334,7 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
ELSE ShortintSize := 1; IntegerSize := 2; LongintSize := 4 ELSE ShortintSize := 1; IntegerSize := 2; LongintSize := 4
END; END;
IF verbose IN Options THEN VerboseListSizes END; (*IF verbose IN Options THEN VerboseListSizes END;*)
ResourceDir := InstallDir; ResourceDir := InstallDir;
IF ResourceDir[0] # 0X THEN IF ResourceDir[0] # 0X THEN
@ -392,14 +390,6 @@ MODULE OPM; (* RC 6.3.89 / 28.6.89, J.Templ 10.7.89 / 22.7.96 *)
curpos := Texts.Pos(inR); curpos := Texts.Pos(inR);
Texts.Read(inR, ch); Texts.Read(inR, ch);
(* OpenBSD intermittent file read error debugging. *)
IF (curpos = 0) & inR.eot THEN
LogWLn; LogWStr("DEBUG: OPM.Get returned inR.eot at curpos = 0, ch = ");
LogWNum(ORD(ch),1); LogW(".");
Texts.DumpReader(inR);
LogWLn; LogWStr("Heap dump:"); LogWLn;
Out.DumpHeap
END;
(* TODO, remove curpos var, and provide fn returning Texts.Pos(inR) - 1. *) (* TODO, remove curpos var, and provide fn returning Texts.Pos(inR) - 1. *)
(* Or, better still, record symbol position in OPS. *) (* Or, better still, record symbol position in OPS. *)

2
src/compiler/OPP.Mod
View file

@ -1007,7 +1007,7 @@ MODULE OPP; (* NW, RC 6.3.89 / 10.2.94 *) (* object model 4.12.93 *)
OPS.Init; LoopLevel := 0; level := 0; OPS.Get(sym); OPS.Init; LoopLevel := 0; level := 0; OPS.Get(sym);
IF sym = OPS.module THEN OPS.Get(sym) ELSE err(16) END; IF sym = OPS.module THEN OPS.Get(sym) ELSE err(16) END;
IF sym = OPS.ident THEN IF sym = OPS.ident THEN
OPM.LogWStr("compiling "); OPM.LogWStr(OPS.name); OPM.LogW("."); OPM.LogCompiling(OPS.name);
OPT.Init(OPS.name, opt); OPS.Get(sym); CheckSym(OPS.semicolon); OPT.Init(OPS.name, opt); OPS.Get(sym); CheckSym(OPS.semicolon);
IF sym = OPS.import THEN OPS.Get(sym); IF sym = OPS.import THEN OPS.Get(sym);
LOOP LOOP

4
src/compiler/extTools.Mod
View file

@ -49,7 +49,7 @@ PROCEDURE Assemble*(moduleName: ARRAY OF CHAR);
Strings.Append("-c ", cmd); Strings.Append("-c ", cmd);
Strings.Append(moduleName, cmd); Strings.Append(moduleName, cmd);
Strings.Append(".c", cmd); Strings.Append(".c", cmd);
execute("Assemble: ", cmd); execute("C compile: ", cmd);
END Assemble; END Assemble;
@ -73,7 +73,7 @@ PROCEDURE LinkMain*(VAR moduleName: ARRAY OF CHAR; statically: BOOLEAN; addition
Strings.Append('-O', cmd); Strings.Append('-O', cmd);
Strings.Append(OPM.Model, cmd); Strings.Append(OPM.Model, cmd);
Strings.Append(Configuration.libext, cmd); Strings.Append(Configuration.libext, cmd);
execute("Assemble and link: ", cmd); execute("C compile and link: ", cmd);
END LinkMain; END LinkMain;

75
src/runtime/Files.Mod
View file

@ -70,44 +70,6 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
SearchPath: POINTER TO ARRAY OF CHAR; SearchPath: POINTER TO ARRAY OF CHAR;
(* Debugging intermittent OpenBSD failure. *)
PROCEDURE Spaces(i: INTEGER); BEGIN WHILE i>0 DO Out.String(" "); DEC(i) END END Spaces;
PROCEDURE DumpFile*(f: File; indent: INTEGER);
BEGIN
Spaces(indent); Out.String("workName: "); Out.String(f.workName); Out.Ln;
Spaces(indent); Out.String("registerName: "); Out.String(f.registerName); Out.Ln;
Spaces(indent); Out.String("tempFile: "); IF f.tempFile THEN Out.String("TRUE") ELSE Out.String("FALSE") END; Out.Ln;
Spaces(indent); Out.String("identity: "); Out.String("..."); Out.Ln; (* TBD *)
Spaces(indent); Out.String("fd: "); Out.Int(f.fd,1); Out.Ln;
Spaces(indent); Out.String("len, "); Out.Int(f.len,1); Out.Ln;
Spaces(indent); Out.String("pos: "); Out.Int(f.pos,1); Out.Ln;
Spaces(indent); Out.String("bufs: "); Out.String("..."); Out.Ln; (* TBD *)
Spaces(indent); Out.String("swapper: "); Out.Int(f.swapper,1); Out.Ln;
Spaces(indent); Out.String("state: "); Out.Int(f.state,1); Out.Ln;
Spaces(indent); Out.String("next: "); Out.Hex(SYSTEM.VAL(SYSTEM.ADDRESS,f.next),1); Out.Ln;
END DumpFile;
PROCEDURE DumpBuffer*(b: Buffer; indent: INTEGER);
BEGIN
Spaces(indent); Out.String("chg: "); IF b.chg THEN Out.String("TRUE") ELSE Out.String("FALSE") END; Out.Ln;
Spaces(indent); Out.String("org: "); Out.Int(b.org,1); Out.Ln;
Spaces(indent); Out.String("size: "); Out.Int(b.size,1); Out.Ln;
Spaces(indent); Out.String("data: "); Out.Ln; Out.HexDump(b.data);
Spaces(indent); Out.String("f: "); IF b.f = NIL THEN Out.String("<NIL>"); Out.Ln ELSE Out.Ln; DumpFile(b.f, indent+1) END;
END DumpBuffer;
PROCEDURE DumpRider*(r: Rider; indent: INTEGER);
BEGIN
Spaces(indent); Out.String("res: "); Out.Int(r.res,1); Out.Ln;
Spaces(indent); Out.String("eof: "); IF r.eof THEN Out.String("TRUE") ELSE Out.String("FALSE") END; Out.Ln;
Spaces(indent); Out.String("org: "); Out.Int(r.org,1); Out.Ln;
Spaces(indent); Out.String("offset: "); Out.Int(r.offset,1); Out.Ln;
Spaces(indent); Out.String("buf: "); IF r.buf = NIL THEN Out.String("<NIL>"); Out.Ln ELSE Out.Ln; DumpBuffer(r.buf, indent+1) END;
END DumpRider;
PROCEDURE -IdxTrap "__HALT(-1)"; PROCEDURE -IdxTrap "__HALT(-1)";
PROCEDURE^ Finalize(o: SYSTEM.PTR); PROCEDURE^ Finalize(o: SYSTEM.PTR);
@ -203,13 +165,6 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
error: Platform.ErrorCode; error: Platform.ErrorCode;
err: ARRAY 32 OF CHAR; err: ARRAY 32 OF CHAR;
BEGIN BEGIN
(*
Out.String("Files.Create fd = "); Out.Int(f.fd,1);
Out.String(", registerName = "); Out.String(f.registerName);
Out.String(", workName = "); Out.String(f.workName);
Out.String(", state = "); Out.Int(f.state,1);
Out.Ln;
*)
IF f.fd = NoDesc THEN IF f.fd = NoDesc THEN
IF f.state = create THEN IF f.state = create THEN
(* New file with enough data written to exceed buffers, so we need to (* New file with enough data written to exceed buffers, so we need to
@ -248,19 +203,9 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
f: File; f: File;
(* identity: Platform.FileIdentity; *) (* identity: Platform.FileIdentity; *)
BEGIN BEGIN
(*
Out.String("Files.Flush buf.f.registername = "); Out.String(buf.f.registerName);
Out.String(", buf.f.fd = "); Out.Int(buf.f.fd,1);
Out.String(", buffer at $"); Out.Hex(SYSTEM.ADR(buf.data));
Out.String(", size "); Out.Int(buf.size,1); Out.Ln;
*)
IF buf.chg THEN f := buf.f; Create(f); IF buf.chg THEN f := buf.f; Create(f);
IF buf.org # f.pos THEN IF buf.org # f.pos THEN
error := Platform.Seek(f.fd, buf.org, Platform.SeekSet); error := Platform.Seek(f.fd, buf.org, Platform.SeekSet);
(*
Out.String("Seeking to "); Out.Int(buf.org,1);
Out.String(", error code "); Out.Int(error,1); Out.Ln;
*)
END; END;
error := Platform.Write(f.fd, SYSTEM.ADR(buf.data), buf.size); error := Platform.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
IF error # 0 THEN Err("error writing file", f, error) END; IF error # 0 THEN Err("error writing file", f, error) END;
@ -271,11 +216,9 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
END END
END Flush; END Flush;
PROCEDURE Close* (f: File); PROCEDURE Close* (f: File);
VAR VAR
i: LONGINT; i: LONGINT; error: Platform.ErrorCode;
error: Platform.ErrorCode;
BEGIN BEGIN
IF (f.state # create) OR (f.registerName # "") THEN IF (f.state # create) OR (f.registerName # "") THEN
Create(f); i := 0; Create(f); i := 0;
@ -429,13 +372,6 @@ MODULE Files; (* J. Templ 1.12. 89/12.4.95 Oberon files mapped onto Unix files
VAR org, offset, i, n: LONGINT; buf: Buffer; error: Platform.ErrorCode; VAR org, offset, i, n: LONGINT; buf: Buffer; error: Platform.ErrorCode;
BEGIN BEGIN
IF f # NIL THEN IF f # NIL THEN
(*
Out.String("Files.Set rider on fd = "); Out.Int(f.fd,1);
Out.String(", registerName = "); Out.String(f.registerName);
Out.String(", workName = "); Out.String(f.workName);
Out.String(", state = "); Out.Int(f.state,1);
Out.Ln;
*)
IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END; IF pos > f.len THEN pos := f.len ELSIF pos < 0 THEN pos := 0 END;
offset := pos MOD BufSize; org := pos - offset; i := 0; offset := pos MOD BufSize; org := pos - offset; i := 0;
WHILE (i < NumBufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END; WHILE (i < NumBufs) & (f.bufs[i] # NIL) & (org # f.bufs[i].org) DO INC(i) END;
@ -597,10 +533,6 @@ Especially Length would become fairly complex.
oldidentity, newidentity: Platform.FileIdentity; oldidentity, newidentity: Platform.FileIdentity;
buf: ARRAY 4096 OF CHAR; buf: ARRAY 4096 OF CHAR;
BEGIN BEGIN
(*
Out.String("Files.Rename old = "); Out.String(old);
Out.String(", new = "); Out.String(new); Out.Ln;
*)
error := Platform.IdentifyByName(old, oldidentity); error := Platform.IdentifyByName(old, oldidentity);
IF error = 0 THEN IF error = 0 THEN
error := Platform.IdentifyByName(new, newidentity); error := Platform.IdentifyByName(new, newidentity);
@ -798,11 +730,6 @@ Especially Length would become fairly complex.
VAR f: File; res: LONGINT; VAR f: File; res: LONGINT;
BEGIN BEGIN
f := SYSTEM.VAL(File, o); f := SYSTEM.VAL(File, o);
(*
Out.String("Files.Finalize f.fd = "); Out.Int(f.fd,1);
Out.String(", f.registername = "); Out.String(f.registerName);
Out.String(", f.workName = "); Out.String(f.workName); Out.Ln;
*)
IF f.fd >= 0 THEN IF f.fd >= 0 THEN
CloseOSFile(f); CloseOSFile(f);
IF f.tempFile THEN res := Platform.Unlink(f.workName) END IF f.tempFile THEN res := Platform.Unlink(f.workName) END

153
src/runtime/Out.Mod
View file

@ -68,10 +68,13 @@ BEGIN
WHILE i > 0 DO DEC(i); Char(s[i]) END WHILE i > 0 DO DEC(i); Char(s[i]) END
END Int; END Int;
PROCEDURE Hex*(x, n: HUGEINT); PROCEDURE Hex*(x, n: HUGEINT);
BEGIN BEGIN
IF n < 1 THEN n := 1 ELSIF n > 16 THEN n := 16 END; IF n < 1 THEN n := 1 ELSIF n > 16 THEN n := 16 END;
WHILE (n < 16) & (SYSTEM.LSH(x, -4*n) # 0) DO INC(n) END; IF x >= 0 THEN
WHILE (n < 16) & (SYSTEM.LSH(x, -4*n) # 0) DO INC(n) END
END;
x := SYSTEM.ROT(x, 4*(16-n)); x := SYSTEM.ROT(x, 4*(16-n));
WHILE n > 0 DO WHILE n > 0 DO
x := SYSTEM.ROT(x,4); DEC(n); x := SYSTEM.ROT(x,4); DEC(n);
@ -84,154 +87,6 @@ PROCEDURE Ln*;
BEGIN String(Platform.NL); Flush; BEGIN String(Platform.NL); Flush;
END Ln; END Ln;
PROCEDURE HexDumpAdr*(adr: SYSTEM.ADDRESS; offset: HUGEINT; length: LONGINT);
VAR i: INTEGER; n, lim: SYSTEM.ADDRESS; c: CHAR;
BEGIN
lim := SYSTEM.VAL(SYSTEM.ADDRESS, adr+length);
WHILE adr < lim DO
IF adr+16 < lim THEN n := 16 ELSE n := lim-adr END;
Hex(offset,8); Char(" ");
i := 0; WHILE i < n DO
IF i MOD 4 = 0 THEN Char(" ") END;
SYSTEM.GET(adr+i, c); Hex(ORD(c), 2); Char(" ");
INC(i)
END;
WHILE i < 16 DO
IF i MOD 4 = 0 THEN Char(" ") END; String(" ");
INC(i)
END;
String(" ");
i := 0; WHILE i < n DO
SYSTEM.GET(adr+i, c);
IF (ORD(c) < 32) OR (ORD(c) > 126) THEN Char(".") ELSE Char(c) END;
INC(i)
END;
INC(adr,n); INC(offset,n); Ln
END
END HexDumpAdr;
PROCEDURE HexDump*(VAR m: ARRAY OF SYSTEM.BYTE);
BEGIN HexDumpAdr(SYSTEM.ADR(m), 0, LEN(m))
END HexDump;
PROCEDURE DumpModule(m: Heap.Module);
BEGIN
String(" next: "); Hex(SYSTEM.VAL(SYSTEM.ADDRESS, m.next),1); Ln;
String(" name: "); String(m.name); Ln;
String(" refcnt: "); Hex(m.refcnt,1); Ln;
String(" cmds: "); Hex(SYSTEM.VAL(SYSTEM.ADDRESS, m.cmds),1); Ln;
String(" types: "); Hex(m.types,1); Ln;
String(" enumPtrs: "); Hex(SYSTEM.VAL(SYSTEM.ADDRESS, m.enumPtrs),1); Ln;
END DumpModule;
PROCEDURE DumpTag*(addr: SYSTEM.ADDRESS);
TYPE
typedesc = RECORD
(* Array of type bound procedure addresses preceeds this. *)
tag: SYSTEM.ADDRESS;
next: SYSTEM.ADDRESS;
level: SYSTEM.ADDRESS;
module: SYSTEM.ADDRESS;
name: ARRAY 24 OF CHAR;
bases: ARRAY 16 OF SYSTEM.ADDRESS;
reserved: SYSTEM.ADDRESS;
blksz: SYSTEM.ADDRESS;
ptr0: SYSTEM.ADDRESS; (* Offset of first pointer. Others follow this. *)
END;
tag = POINTER [1] TO typedesc;
VAR
desc: tag;
i: INTEGER;
BEGIN
String(" obj tag: "); Hex(addr,1); Ln;
DEC(addr, addr MOD 2); (* Work OK with incremented tags. *)
desc := SYSTEM.VAL(tag, addr - (21*SIZE(SYSTEM.ADDRESS) + 24));
String(" desc at: "); Hex(SYSTEM.VAL(SYSTEM.ADDRESS, desc),1); Ln;
String(" desc contains:"); Ln;
String(" tag: "); Hex(desc.tag, 1); Ln;
String(" next: "); Hex(desc.next, 1); Ln;
String(" level: "); Hex(desc.level, 1); Ln;
String(" module: "); Hex(desc.module, 1); Ln;
IF desc.module # 0 THEN DumpModule(SYSTEM.VAL(Heap.Module, desc.module)) END;
String(" name: "); String(desc.name); Ln;
String(" bases: ");
i := 0; WHILE i < 16 DO
Hex(desc.bases[i], SIZE(SYSTEM.ADDRESS) * 2);
IF i MOD 4 = 3 THEN Ln; String(" ") ELSE Char(" ") END;
INC(i)
END; Ln;
String(" reserved: "); Hex(desc.reserved, 1); Ln;
String(" blksz: "); Hex(desc.blksz, 1); Ln;
String(" ptr0: "); Hex(desc.ptr0, 1); Ln;
END DumpTag;
PROCEDURE DumpType*(VAR o: ARRAY OF SYSTEM.BYTE);
VAR addr: SYSTEM.ADDRESS;
BEGIN
SYSTEM.GET(SYSTEM.ADR(o) - SIZE(SYSTEM.ADDRESS), addr);
DumpTag(addr);
END DumpType;
PROCEDURE -externheap "extern ADDRESS Heap_heap;";
PROCEDURE -getheap(): SYSTEM.ADDRESS "Heap_heap";
PROCEDURE DumpHeap*;
TYPE
adrptr = POINTER [1] TO ARRAY 1 OF SYSTEM.ADDRESS;
block = POINTER [1] TO blockdesc;
blockdesc = RECORD
tag: SYSTEM.ADDRESS;
size: SYSTEM.ADDRESS;
sentinel: SYSTEM.ADDRESS;
next: SYSTEM.ADDRESS;
END;
chunk = POINTER [1] TO chunkdesc;
chunkdesc = RECORD
next: SYSTEM.ADDRESS;
end: SYSTEM.ADDRESS;
reserved: SYSTEM.ADDRESS;
firstblock: blockdesc;
END;
VAR
caddr: SYSTEM.ADDRESS; c: chunk;
baddr: SYSTEM.ADDRESS; b: block;
tag: adrptr;
BEGIN
caddr := Heap.heap;
WHILE caddr # 0 DO
String("Chunk at: "); Hex(caddr, 1); Ln;
c := SYSTEM.VAL(chunk, caddr);
String(" next: "); Hex(c.next, 1); Ln;
String(" end: "); Hex(c.end, 1); String(" => size: "); Hex(c.end - caddr,1 ); Ln;
String(" rsvd: "); Hex(c.reserved, 1); Ln;
baddr := SYSTEM.ADR(c.firstblock);
WHILE c.end - baddr > 0 DO
String(" Block at: "); Hex(baddr, 1); Ln;
b := SYSTEM.VAL(block, baddr);
tag := SYSTEM.VAL(adrptr, b.tag - (b.tag MOD 2)); (* mask out heap management flag in bit 0. *)
String(" tag: "); Hex(b.tag, 1); IF b.tag MOD 2 # 0 THEN String(" <--- ODD! ---") END; Ln;
String(" tag^: "); Hex(tag^[0], 1); Ln;
String(" size: "); Hex(b.size, 1); Ln;
String(" sentinel: "); Hex(b.sentinel, 1); Ln;
String(" next: "); Hex(b.next, 1); Ln;
IF b.tag # SYSTEM.ADR(b.size) THEN
(* There is a type descriptor. *)
DumpTag(b.tag)
END;
INC(baddr, tag^[0]);
Ln;
END;
caddr := c.next;
Ln;
END
END DumpHeap;
(* Real and Longreal display *) (* Real and Longreal display *)

64
src/runtime/Texts.Mod
View file

@ -120,70 +120,6 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
del: Buffer; del: Buffer;
FontsDefault: FontsFont; FontsDefault: FontsFont;
(* Debugging intermittent OpenBSD failure. *)
PROCEDURE DumpText(t: Text);
BEGIN
Out.String(" len: "); Out.Int(t.len,1); Out.Ln;
Out.String(" notify: "); Out.Hex(SYSTEM.VAL(SYSTEM.ADDRESS, t.notify),1); Out.Ln;
Out.String(" head: "); Out.Hex(SYSTEM.VAL(SYSTEM.ADDRESS, t.head),1); Out.Ln;
Out.String(" cache: "); Out.Hex(SYSTEM.VAL(SYSTEM.ADDRESS, t.cache),1); Out.Ln;
Out.String(" corg: "); Out.Int(t.corg,1); Out.Ln;
END DumpText;
PROCEDURE DumpRun(ru: Run);
BEGIN
Out.String(" Run at "); Out.Hex(SYSTEM.VAL(SYSTEM.ADDRESS, ru),1); Out.Ln;
Out.String(" prev: "); Out.Hex(SYSTEM.VAL(SYSTEM.ADDRESS, ru.prev),1); Out.Ln;
Out.String(" next: "); Out.Hex(SYSTEM.VAL(SYSTEM.ADDRESS, ru.next),1); Out.Ln;
Out.String(" len: "); Out.Int(ru.len,1); Out.Ln;
Out.String(" fnt: "); IF ru.fnt # NIL THEN Out.String(ru.fnt.name) ELSE Out.String("<NIL>") END; Out.Ln;
Out.String(" col: "); Out.Int(ru.col,1); Out.Ln;
Out.String(" voff: "); Out.Int(ru.voff,1); Out.Ln;
Out.String(" ascii: "); IF ru.ascii THEN Out.String("TRUE") ELSE Out.String("FALSE") END; Out.Ln;
END DumpRun;
PROCEDURE DumpElem(e: Elem);
BEGIN
DumpRun(e);
Out.String(" -- Elem --"); Out.Ln;
Out.String(" W: "); Out.Int(e.W,1); Out.Ln;
Out.String(" H: "); Out.Int(e.H,1); Out.Ln;
Out.String(" handle: "); Out.Hex(SYSTEM.VAL(SYSTEM.ADDRESS, e.handle),1); Out.Ln;
Out.String(" base: "); IF e.base = NIL THEN Out.String("<NIL>"); Out.Ln ELSE Out.Ln; DumpText(e.base) END;
END DumpElem;
PROCEDURE DumpPiece(p: Piece);
BEGIN
DumpRun(p);
Out.String(" -- Piece --"); Out.Ln;
Out.String(" file: "); IF p.file = NIL THEN Out.String("<NIL>"); Out.Ln ELSE Out.Ln; Files.DumpFile(p.file, 3) END;
Out.String(" org: "); Out.Int(p.org,1); Out.Ln;
END DumpPiece;
PROCEDURE DumpReader*(re: Reader);
BEGIN
Out.String("Reader:"); Out.Ln;
Out.String(" eot: "); IF re.eot THEN Out.String("TRUE") ELSE Out.String("FALSE") END; Out.Ln;
Out.String(" fnt: "); IF re.fnt # NIL THEN Out.String(re.fnt.name) ELSE Out.String("<NIL>") END; Out.Ln;
Out.String(" col: "); Out.Int(re.col,1); Out.Ln;
Out.String(" voff: "); Out.Int(re.voff,1); Out.Ln;
Out.String(" org: "); Out.Int(re.org,1); Out.Ln;
Out.String(" off: "); Out.Int(re.off,1); Out.Ln;
Out.String(" elem: "); IF re.elem = NIL THEN Out.String("<NIL>"); Out.Ln ELSE Out.Ln; DumpElem(re.elem) END;
Out.String(" rider: "); Out.Ln; Files.DumpRider(re.rider,2);
Out.String(" run: ");
IF re.run = NIL THEN Out.String("<NIL>"); Out.Ln
ELSE Out.Ln;
IF re.run IS Piece THEN DumpPiece(re.run(Piece))
ELSIF re.run IS Elem THEN DumpElem(re.run(Elem))
ELSE DumpRun(re.run)
END
END;
Out.DumpType(re.run^);
END DumpReader;
PROCEDURE FontsThis(VAR name: ARRAY OF CHAR): FontsFont; PROCEDURE FontsThis(VAR name: ARRAY OF CHAR): FontsFont;
VAR F: FontsFont; VAR F: FontsFont;
BEGIN BEGIN

2
src/test/confidence/intsyntax/expected
View file

@ -1,4 +1,4 @@
IntSyntax.mod compiling IntSyntax. IntSyntax.mod Compiling IntSyntax.
14: i := l; (* Bad, INTEGER shorter than LONGINT *) 14: i := l; (* Bad, INTEGER shorter than LONGINT *)
^ ^