mirror of
https://github.com/vishapoberon/compiler.git
synced 2026-04-06 09:52:24 +00:00
Document compilation; remove OpenBSD debugging.
This commit is contained in:
David Brown
parent
c6388006b9
commit
412a8c3337
11 changed files with 110 additions and 319 deletions
|
|
@ -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;
|
||||
|
||||
|
||||
(* 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^ 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;
|
||||
err: ARRAY 32 OF CHAR;
|
||||
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.state = create THEN
|
||||
(* 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;
|
||||
(* identity: Platform.FileIdentity; *)
|
||||
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.org # f.pos THEN
|
||||
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;
|
||||
error := Platform.Write(f.fd, SYSTEM.ADR(buf.data), buf.size);
|
||||
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 Flush;
|
||||
|
||||
|
||||
PROCEDURE Close* (f: File);
|
||||
VAR
|
||||
i: LONGINT;
|
||||
error: Platform.ErrorCode;
|
||||
i: LONGINT; error: Platform.ErrorCode;
|
||||
BEGIN
|
||||
IF (f.state # create) OR (f.registerName # "") THEN
|
||||
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;
|
||||
BEGIN
|
||||
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;
|
||||
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;
|
||||
|
|
@ -597,10 +533,6 @@ Especially Length would become fairly complex.
|
|||
oldidentity, newidentity: Platform.FileIdentity;
|
||||
buf: ARRAY 4096 OF CHAR;
|
||||
BEGIN
|
||||
(*
|
||||
Out.String("Files.Rename old = "); Out.String(old);
|
||||
Out.String(", new = "); Out.String(new); Out.Ln;
|
||||
*)
|
||||
error := Platform.IdentifyByName(old, oldidentity);
|
||||
IF error = 0 THEN
|
||||
error := Platform.IdentifyByName(new, newidentity);
|
||||
|
|
@ -798,11 +730,6 @@ Especially Length would become fairly complex.
|
|||
VAR f: File; res: LONGINT;
|
||||
BEGIN
|
||||
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
|
||||
CloseOSFile(f);
|
||||
IF f.tempFile THEN res := Platform.Unlink(f.workName) END
|
||||
|
|
|
|||
|
|
@ -68,10 +68,13 @@ BEGIN
|
|||
WHILE i > 0 DO DEC(i); Char(s[i]) END
|
||||
END Int;
|
||||
|
||||
|
||||
PROCEDURE Hex*(x, n: HUGEINT);
|
||||
BEGIN
|
||||
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));
|
||||
WHILE n > 0 DO
|
||||
x := SYSTEM.ROT(x,4); DEC(n);
|
||||
|
|
@ -84,154 +87,6 @@ PROCEDURE Ln*;
|
|||
BEGIN String(Platform.NL); Flush;
|
||||
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 *)
|
||||
|
||||
|
|
|
|||
|
|
@ -120,70 +120,6 @@ MODULE Texts; (** CAS/HM 23.9.93 -- interface based on Texts by JG/NW 6.12.91**
|
|||
del: Buffer;
|
||||
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;
|
||||
VAR F: FontsFont;
|
||||
BEGIN
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue