ð'Oberon10.Scn.FntOberon10i.Scn.Fnt †Oberon10b.Scn.FntcÑ¿h t¼¸ £_`,,,,,,=‰MODULE System; (* jg, nw, jt, rc, js 7.10.93 *) (*---------------------------------------------------------* * Copyright (c) 1990-1996 ETH Z…rich. All Rights Reserved. * Oberon is a trademark of Institut f…r Computersysteme, ETH Z…rich. *---------------------------------------------------------*) IMPORT SYSTEM, Unix, Out := Console, Kernel, X11, Modules, Files, Input, Display, Viewers, MenuViewers, Oberon, Fonts, Texts, TextFrames; CONST StandardMenu = "System.Close System.Copy System.Grow Edit.Search Edit.Store "; LogMenu = "System.Close System.Grow Edit.Locate Edit.Store "; (* structure forms *) Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Pointer = 13; ProcTyp = 14; Comp = 15; (* register usage *) SP = 30; FP = 18; RP = 2; SL = 29; Xreg = {RP, FP, SL}; TYPE ADDRESS = LONGINT; VAR errorMsg*: ARRAY 64 OF CHAR; L, H: SHORTINT; TrapT: Texts.Text; W: Texts.Writer; PWD: ARRAY 64 OF CHAR; PROCEDURE DumpVar(VAR name: ARRAY OF CHAR; fp, sp, f, vadr: LONGINT; local, varPar: BOOLEAN; scp: Unix.SigContextPtr; VAR ok: BOOLEAN); VAR ch: CHAR; sival: SHORTINT; ival, i: INTEGER; lival: LONGINT; rval: REAL; lrval: LONGREAL; reg: BOOLEAN; BEGIN reg := FALSE; IF local THEN IF ((fp MOD 8) # 0) OR ((sp MOD 8) # 0) OR (fp = 0) OR (sp = 0) THEN Texts.WriteString(W, " -- invalid stack frame"); Texts.WriteString(W, " : sp = "); Texts.WriteHex (W, sp); Texts.WriteString(W, ", fp = "); Texts.WriteHex (W, fp); Texts.WriteLn(W); ok := FALSE; RETURN END; IF varPar THEN IF (vadr >= 0) & (vadr < 32) THEN vadr := scp.sl.ss.grs[vadr] ELSIF vadr < 0 THEN SYSTEM.GET(fp + vadr, vadr) ELSE SYSTEM.GET(fp + vadr - 64, vadr) END ELSE IF (vadr >= 0) & (vadr < 64) THEN reg := TRUE; IF vadr < 32 THEN vadr := SYSTEM.ADR(scp.sl.ss.grs[vadr]) ELSE vadr := SYSTEM.ADR(scp.sl.ss.frs[vadr-32]) END ELSIF vadr < 0 THEN INC(vadr, fp) ELSE INC(vadr, fp - 64) END END ELSE IF vadr < 0 THEN INC(vadr, fp) ELSE INC(vadr, fp - 64) END; END; Texts.WriteString(W, " "); Texts.WriteString(W, name); Texts.WriteString(W, " = "); IF (f = Int) & ODD(vadr) OR (f IN {LInt, Pointer, ProcTyp, Set, Real, LReal}) & (vadr MOD 4 # 0) THEN Texts.WriteString(W, "unaligned address") ELSE CASE f OF | Byte: IF reg THEN SYSTEM.GET(vadr, lival) ELSE SYSTEM.GET(vadr, ch); lival := ORD(ch) END; Texts.WriteInt(W, lival, 0) | SInt: IF reg THEN SYSTEM.GET(vadr, lival) ELSE SYSTEM.GET(vadr, sival); lival := sival END; Texts.WriteInt(W, lival, 0) | Int: IF reg THEN SYSTEM.GET(vadr, lival) ELSE SYSTEM.GET(vadr, ival); lival := ival END; Texts.WriteInt(W, lival, 0) | LInt: SYSTEM.GET(vadr, lival); Texts.WriteInt(W, lival, 0) | Bool: IF reg THEN SYSTEM.GET(vadr, lival) ELSE SYSTEM.GET(vadr, sival); lival := sival END; IF lival = 0 THEN Texts.WriteString(W, "FALSE") ELSIF lival = 1 THEN Texts.WriteString(W, "TRUE") ELSE Texts.WriteString(W, "undef") END | Char: IF reg THEN SYSTEM.GET(vadr, lival) ELSE SYSTEM.GET(vadr, ch); lival := ORD(ch) END; IF (lival < ORD(" ")) OR (lival > ORD("~")) THEN Texts.WriteString(W, "CHR("); Texts.WriteInt(W, lival, 0); Texts.Write(W, ")") ELSE Texts.Write(W, 22X); Texts.Write(W, CHR(lival)); Texts.Write(W, 22X) END | Pointer, ProcTyp, Set: SYSTEM.GET(vadr, lival); Texts.WriteHex(W, lival); Texts.Write(W, "H") | Real: SYSTEM.GET(vadr, rval); Texts.Write(W, "["); Texts.WriteRealHex(W, rval); Texts.WriteString(W, "] "); Texts.WriteReal(W, rval, 15) | LReal: SYSTEM.GET(vadr, lrval); Texts.Write(W, "["); Texts.WriteLongRealHex(W, lrval); Texts.WriteString(W, "] "); Texts.WriteLongReal(W, lrval, 24) | Comp: Texts.Write(W, 22X); i := 0; LOOP SYSTEM.GET(vadr+i, ch); IF (ch < " ") OR (ch >= 90X) OR (i = 32) THEN EXIT END; Texts.Write(W, ch); INC(i) END; IF i = 32 THEN Texts.WriteString(W, "..") ELSE Texts.Write(W, 22X) END ELSE Texts.WriteString(W, "unknown type "); Texts.WriteInt(W, f, 0) END END; Texts.WriteLn(W) END DumpVar; PROCEDURE RInt(VAR refs: LONGINT; VAR k: LONGINT); VAR n: LONGINT; shift: SHORTINT; x: CHAR; BEGIN shift := 0; n := 0; SYSTEM.GET(refs, x); INC(refs); WHILE ORD(x) >= 128 DO INC(n, ASH(ORD(x) MOD 128, shift)); INC(shift, 7); SYSTEM.GET(refs, x); INC(refs) END; k := n + ASH(ORD(x) MOD 64, shift) - ASH(ORD(x) DIV 64, shift) * 64 END RInt; PROCEDURE RSet(VAR refs: LONGINT; VAR s: SET); VAR b: ARRAY 4 OF CHAR; s2: SET; i: LONGINT; BEGIN SYSTEM.GET(refs, b[0]); INC(refs); SYSTEM.GET(refs, b[1]); INC(refs); SYSTEM.GET(refs, b[2]); INC(refs); SYSTEM.GET(refs, b[3]); INC(refs); s2 := SYSTEM.VAL(SET, LONG(ORD(b[0])) + LONG(ORD(b[1]))*100H + LONG(ORD(b[2]))*10000H +LONG(ORD(b[3]))*1000000H); i := 0; s := {}; WHILE i < 32 DO IF i IN s2 THEN INCL(s, 31-i) END; INC(i) END; END RSet; PROCEDURE RName(VAR refs: LONGINT; VAR name: ARRAY OF CHAR); VAR i: INTEGER; ch: CHAR; BEGIN i := 0; REPEAT SYSTEM.GET(refs, ch); name[i] := ch; INC(i); INC(refs) UNTIL ch = 0X; END RName; PROCEDURE DumpRegs(scp: Unix.SigContextPtr); VAR i: LONGINT; BEGIN i := 0; WHILE i < 32 DO Texts.WriteString(W, " R["); Texts.WriteInt(W, i, 0); Texts.WriteString(W, "] = "); Texts.WriteInt(W, scp.sl.ss.grs[i], 0); Texts.WriteString(W, " = "); Texts.WriteHex(W, scp.sl.ss.grs[i]); Texts.Write(W, "H"); Texts.WriteLn(W); INC(i) END END DumpRegs; PROCEDURE DumpStack(sp, n: LONGINT); VAR i, val: LONGINT; BEGIN i := -n; WHILE i <= 0 DO Texts.WriteHex(W, sp - i); Texts.WriteString(W, " "); Texts.WriteInt(W, i, 0); Texts.WriteString(W, "(sp) = "); SYSTEM.GET(sp + i, val); Texts.WriteInt(W, val, 0); Texts.WriteString(W, " = "); Texts.WriteHex(W, val); Texts.Write(W, "H"); Texts.WriteLn(W); INC(i, 4) END END DumpStack; PROCEDURE OutProcName(pc: LONGINT): BOOLEAN; VAR b: CHAR; codeAdr, refs, refsend, vadr, lastadr, adr, frameSize, callArea: LONGINT; saved : SET; m: Modules.Module; pname: ARRAY 64 OF CHAR; BEGIN m := Modules.modules; WHILE m # NIL DO codeAdr := SYSTEM.ADR(m.code^); IF (pc >= codeAdr) & (pc < codeAdr + LEN(m.code^)*4) THEN (*module found*) refs := SYSTEM.ADR(m.refs^); refsend := refs + LEN(m.refs^); lastadr := 0; INC(refs); WHILE refs < refsend DO RInt(refs, adr); adr := adr*4; RSet(refs, saved); RSet(refs, saved); RInt(refs, frameSize); RInt(refs, callArea); RName(refs, pname); IF (pc < codeAdr + adr) & (pc >= codeAdr + lastadr) THEN Out.Ch(" "); Out.Str(m.name); Out.Ch("."); Out.Str(pname); Out.Ch(" "); Out.Hex(pc - codeAdr, 5); Out.Str("H : "); RETURN TRUE END; LOOP IF refs >= refsend THEN EXIT END; SYSTEM.GET(refs, b); INC(refs); IF ORD(b) = 0F8H THEN EXIT END; (*SYSTEM.GET(refs, f);*) INC(refs); RInt(refs, vadr); RName(refs, pname) END; lastadr := adr END ELSE m := m.next END END; Out.Str ("(PC = 0x"); Out.Hex (pc,8); Out.Str(") outside known procedure : "); RETURN FALSE END OutProcName; PROCEDURE DumpProc(VAR sp, pc: LONGINT; scp: Unix.SigContextPtr; VAR found, ok: BOOLEAN); VAR codeAdr, fp, refs, refsend, vadr, lastadr, adr, frameSize, callArea, i, offset, prevsp: LONGINT; savedr, savedx, savedf: SET; m: Modules.Module; name: ARRAY 64 OF CHAR; f: SHORTINT; b: CHAR; local: BOOLEAN; BEGIN m := Modules.modules; WHILE m # NIL DO codeAdr := SYSTEM.ADR(m.code^); IF (pc >= codeAdr) & (pc < codeAdr + LEN(m.code^)*4) THEN (* module found *) refs := SYSTEM.ADR(m.refs^); refsend := refs + LEN(m.refs^); lastadr := 0; INC(refs); WHILE refs < refsend DO RInt(refs, adr); adr := adr*4; RSet(refs, savedr); savedx := savedr * Xreg; savedr := savedr - Xreg; RSet(refs, savedf); RInt(refs, frameSize); RInt(refs, callArea); RName(refs, name); IF (pc < codeAdr + adr) & (pc >= codeAdr + lastadr) THEN found := TRUE; Texts.WriteString(W, m.name); Texts.Write(W, "."); Texts.WriteString(W, name); Texts.Write(W, 9X); Texts.WriteHex(W, pc - codeAdr); Texts.Write(W, "H"); Texts.WriteLn(W); IF name[0] = "$" THEN local := FALSE; fp := m.sb; offset := sp - callArea - 48; prevsp := sp - frameSize ELSE local := TRUE; IF FP IN savedx THEN fp := scp.sl.ss.grs[FP]; offset := fp + frameSize - callArea - 48 ELSE fp := sp - frameSize; offset := sp - callArea - 48 END; prevsp := fp END; (* IF (scp.badvaddr <= prevsp) & (scp.badvaddr >= sp) THEN Texts.WriteString(W, "STACK OVERFLOW"); Texts.WriteLn(W); ok := FALSE; RETURN END *) ELSE found := FALSE END; LOOP IF refs >= refsend THEN EXIT END; SYSTEM.GET(refs, b); INC(refs); IF ORD(b) = 0F8H THEN EXIT END; SYSTEM.GET(refs, f); INC(refs); RInt(refs, vadr); RName(refs, name); IF found THEN DumpVar(name, fp, sp, f, vadr, local, ORD(b) = 3, scp, ok) END END; IF found THEN (* restore next frame context *) (* DumpRegs(scp); *) IF ok THEN i := 31; WHILE i >= 0 DO IF i IN savedf THEN DEC(offset, 8); SYSTEM.GET(offset, scp.sl.ss.frs[i]); END; DEC(i) END; i := 31; WHILE i >= 0 DO IF i IN savedr THEN DEC (offset, 4); SYSTEM.GET(offset, scp.sl.ss.grs[i]); END; DEC(i) END; IF local THEN sp := fp ELSE DEC(sp, frameSize) END; IF SL IN savedx THEN SYSTEM.GET(sp-16, scp.sl.ss.grs[SL]) END; IF FP IN savedx THEN SYSTEM.GET(sp-4, scp.sl.ss.grs[FP]) END; IF RP IN savedx THEN SYSTEM.GET(sp-20, scp.sl.ss.grs[RP]) END; pc := (scp.sl.ss.grs[RP] DIV 4) * 4 - 8; END; RETURN ELSE lastadr := adr END END ELSE m := m.next END END; found := FALSE END DumpProc; PROCEDURE GetMenu (title, menuFile, menuDefault: ARRAY OF CHAR): TextFrames.Frame; VAR M: TextFrames.Frame; T: Texts.Text; buf: Texts.Buffer; BEGIN IF Files.Old(menuFile) = NIL THEN M := TextFrames.NewMenu(title, menuDefault) ELSE M := TextFrames.NewMenu(title, ""); NEW(T); Texts.Open(T, menuFile); NEW(buf); Texts.OpenBuf(buf); Texts.Save(T, 0, T.len, buf); Texts.Append(M.text, buf) END; RETURN M; END GetMenu; PROCEDURE+ Trap (sig, code: LONGINT; scp: Unix.SigContextPtr); VAR V: Viewers.Viewer; X, Y: INTEGER; oldmask: LONGINT; sp, pc, instr: LONGINT; found, ok: BOOLEAN; PROCEDURE Str(str: ARRAY OF CHAR); BEGIN Out.Str(str); Texts.WriteString(W, str) END Str; PROCEDURE Int(i: LONGINT); BEGIN Out.Int(i); Texts.WriteInt(W, i, 0) END Int; PROCEDURE Hex(i: LONGINT); BEGIN Out.Hex(i, 8); Texts.WriteHex(W, i) END Hex; PROCEDURE Ln; BEGIN Out.Ln; Texts.WriteLn(W) END Ln; BEGIN IF Kernel.TrapHandlingLevel < 2 THEN INC(Kernel.TrapHandlingLevel); Kernel.curSigCtxt := SYSTEM.ADR(scp^); (* GC on system stack also *) (* oldmask := Unix.Sigsetmask(4); *) IF TrapT # NIL THEN Texts.Append(TrapT, W.buf); TrapT := NIL END; IF Kernel.TrapHandlingLevel > 1 THEN X11.LowerWindow(X11.display, X11.primary); X11.DoFlush; Str("*** RECURSIVE TRAP: "); Ln; END; pc := (scp.sl.ss.pcoqHead DIV 4) * 4; sp := scp.sl.ss.grs[SP]; IF ~OutProcName(pc) THEN IF sig = 2 THEN Out.Str("not interrupted"); Out.Ln; Kernel.TrapHandlingLevel := 0; RETURN (* don't interrupt Xlib *) END; END; SYSTEM.GET(pc, instr); CASE sig OF | 2: Str("INTERRUPT") | 4: CASE code OF | 8 : Str("ILLEGAL INSTRUCTION") | 9 : CASE instr DIV 2000H OF | 0: Str("ASSERT FAULT") | 1: Str("HEAP FULL") | 6: Str("OVERFLOW") | 7: Str("DIVIDE BY ZERO OR NEGATIVE") | 8: Str("OUT OF RANGE") | 10: Str("NIL POINTER DEREFERENCED") | 14: Str("INVALID WITH") | 15: Str("INVALID INDEX") | 16: Str("INVALID CASE") | 17: Str("MISSING FUNCTION RETURN") | 18: Str("TYPE GUARD") | 19: Str("IMPLIED TYPE GUARD") ELSE Str("HALT "); Int(instr DIV 2000H) END | 10 : Str("PRIVILEDGED OPERATION") | 11 : Str("PRIVILEDGED REGISTER") END; | 8: Str("FLOATING POINT EXCEPTION : "); CASE code OF | 12 : Str("OVERFLOW") | 13 : Str("CONDITIONAL TRAP") | 14 : Str("ASSIST EXCEPTION") | 22 : Str("ASSIST EMULATION") END; | 10: Str("BUS ERROR") | 11: Str("SEGMENTATION VIOLATION"); ELSE Str("SIGNAL "); Int(sig) END; Out.Str(" PC="); Out.Hex(pc, 8); Out.Str("H SP="); Out.Hex(sp, 8); Out.Ch("H"); Ln; IF errorMsg # "" THEN Str(errorMsg); Ln; errorMsg := "" END; TrapT := TextFrames.Text(""); Oberon.AllocateSystemViewer(0, X, Y); V := MenuViewers.New( TextFrames.NewMenu("System.Trap", StandardMenu), TextFrames.NewText(TrapT, 0), TextFrames.menuH, X, Y); IF V.state > 1 THEN Texts.Append(TrapT, W.buf) ELSE Texts.Append(Oberon.Log, W.buf) END; (* DumpRegs(scp); DumpStack(sp, 128); *) ok := TRUE; DumpProc(sp, pc, scp, found, ok); IF ~found THEN (* second try *) Texts.WriteString(W, "pc outside known procedure"); Texts.WriteLn(W); pc := (scp.sl.ss.grs[RP] DIV 4) * 4 - 8; DumpProc(sp, pc, scp, found, ok) END; WHILE found & ok & ((sp >= Kernel.sysStackTop) & (sp < Kernel.sysStackBot) OR (sp >= Kernel.userStackLimit)) DO DumpProc(sp, pc, scp, found, ok) END; IF ~ok THEN Texts.WriteString(W, "not OK"); Texts.WriteLn(W) END; IF ~found THEN Texts.WriteString(W, "cannot identify caller at PC = "); Texts.WriteHex(W, pc); Texts.Write(W, "H"); Texts.WriteLn(W) END; IF V.state > 1 THEN Texts.Append(TrapT, W.buf) ELSE Texts.Append(Oberon.Log, W.buf) END; ELSE IF Kernel.TrapHandlingLevel < 3 THEN INC(Kernel.TrapHandlingLevel); IF TrapT # NIL THEN Texts.Append(TrapT, W.buf); TrapT := NIL END END; X11.Bell(X11.display, 0) END; Kernel.TrapHandlingLevel := 0; Unix.Siglongjmp(Kernel.jmpBuf, 1) END Trap; PROCEDURE Max (i, j: LONGINT): LONGINT; BEGIN IF i >= j THEN RETURN i ELSE RETURN j END END Max; (* ------------- Toolbox for system control ---------------*) PROCEDURE SetUser*; VAR i: INTEGER; ch: CHAR; user: ARRAY 8 OF CHAR; password: ARRAY 16 OF CHAR; BEGIN i := 0; Input.Read(ch); WHILE (ch # "/") & (i < 7) DO user[i] := ch; INC(i); Input.Read(ch) END; user[i] := 0X; i := 0; Input.Read(ch); WHILE (ch > " ") & (i < 15) DO password[i] := ch; INC(i); Input.Read(ch) END; password[i] := 0X; Oberon.SetUser(user, password) END SetUser; PROCEDURE GetArg(VAR S: Texts.Scanner); VAR T: Texts.Text; beg, end, time: LONGINT; BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, time); IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END END END GetArg; PROCEDURE EndLine; BEGIN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END EndLine; PROCEDURE SetFont*; VAR S: Texts.Scanner; BEGIN GetArg(S); IF S.class = Texts.Name THEN Oberon.SetFont(Fonts.This(S.s)) END END SetFont; PROCEDURE SetColor*; VAR S: Texts.Scanner; BEGIN GetArg(S); IF S.class = Texts.Int THEN Oberon.SetColor(SHORT(SHORT(S.i))) END END SetColor; PROCEDURE SetOffset*; VAR S: Texts.Scanner; BEGIN GetArg(S); IF S.class = Texts.Int THEN Oberon.SetOffset(SHORT(SHORT(S.i))) END END SetOffset; PROCEDURE Time*; VAR par: Oberon.ParList; S: Texts.Scanner; t, d, hr, min, sec, yr, mo, day: LONGINT; BEGIN par := Oberon.Par; Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S); IF S.class = Texts.Int THEN (*set date*) day := S.i; Texts.Scan(S); mo := S.i; Texts.Scan(S); yr := S.i; Texts.Scan(S); hr := S.i; Texts.Scan(S); min := S.i; Texts.Scan(S); sec := S.i; t := (hr*64 + min)*64 + sec; d := (yr*16 + mo)*32 + day; Kernel.SetClock(t, d) ELSE (*read date*) Texts.WriteString(W, "System.Time"); Oberon.GetClock(t, d); Texts.WriteDate(W, t, d); EndLine END END Time; PROCEDURE Collect*; BEGIN Oberon.Collect(0) END Collect; (* ------------- Toolbox for standard display ---------------*) PROCEDURE InitLogText; VAR t, d: LONGINT; name: Unix.Utsname; count, dummy: LONGINT; pattern: ARRAY 32 OF CHAR; BEGIN Texts.WriteString (W, X11.WinName); Unix.dlsym(0, "buildTime", t); Unix.dlsym(0, "buildDate", d); Texts.WriteString(W, " (build"); Texts.WriteDate(W, t, d); Texts.WriteString(W, ")"); Texts.WriteLn (W); CASE Unix.Sysconf(10001) OF | 20BH : Texts.WriteString (W, "HP Precision Architecture Version 1.0"); | 20CH..20FH : Texts.WriteString (W, "HP Precision Architecture Version 1.0.x"); | 210H : Texts.WriteString (W, "HP Precision Architecture Version 1.1"); | 211H : Texts.WriteString (W, "HP Precision Architecture Version 1.2"); | 212H, 213H : Texts.WriteString (W, "HP Precision Architecture Version 1.x"); | 214H : Texts.WriteString (W, "HP Precision Architecture Version 2.0"); | 215H..2FFH : Texts.WriteString (W, "HP Precision Architecture Version x"); END; Texts.WriteLn (W); dummy := Unix.Uname (SYSTEM.ADR(name)); Texts.WriteString (W, "HP "); Texts.WriteString (W, name.machine); Texts.WriteString (W, " ("); Texts.WriteString (W, name.nodename); Texts.WriteString (W, ") "); Texts.WriteString (W, " running "); Texts.WriteString (W, name.sysname); Texts.WriteString (W, " release "); Texts.WriteString (W, name.release); Texts.WriteLn (W); dummy := Unix.Getcwd(SYSTEM.ADR(PWD), LEN(PWD)); Texts.WriteString (W, "Current directory is: "); Texts.WriteString (W, PWD); Texts.WriteLn (W); pattern := "oberon10.scn.fnt"; dummy := X11.ListFonts (X11.display, SYSTEM.ADR(pattern), 100, count); X11.FreeFontNames (dummy); IF count > 0 THEN Texts.WriteString(W, "X-Fonts available") ELSE Texts.WriteString(W, "X-Fonts NOT available") END; Texts.WriteLn(W); Oberon.GetClock(t, d); Texts.WriteString(W, "System.Time"); Texts.WriteDate(W, t, d); EndLine; END InitLogText; PROCEDURE Open*; VAR X, Y: INTEGER; V: Viewers.Viewer; S: Texts.Scanner; BEGIN GetArg(S); IF S.class = Texts.Name THEN Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y); V := MenuViewers.New(GetMenu(S.s, "System.Menu.Text", StandardMenu), TextFrames.NewText(TextFrames.Text(S.s), 0), TextFrames.menuH, X, Y) END END Open; PROCEDURE OpenLog*; VAR logV: Viewers.Viewer; X, Y: INTEGER; BEGIN Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y); logV := MenuViewers.New(GetMenu("System.Log", "Log.Menu.Text", LogMenu), TextFrames.NewText(Oberon.Log, Max(0, Oberon.Log.len - 200)), TextFrames.menuH, X, Y) END OpenLog; PROCEDURE ClearLog*; BEGIN Texts.Delete(Oberon.Log, 0, Oberon.Log^.len) END ClearLog; PROCEDURE Close*; VAR par: Oberon.ParList; V: Viewers.Viewer; BEGIN par := Oberon.Par; IF par.frame = par.vwr.dsc THEN V := par.vwr ELSE V := Oberon.MarkedViewer() END; Viewers.Close(V) END Close; PROCEDURE CloseTrack*; VAR V: Viewers.Viewer; BEGIN V := Oberon.MarkedViewer(); Viewers.CloseTrack(V.X) END CloseTrack; PROCEDURE Recall*; VAR V: Viewers.Viewer; M: Viewers.ViewerMsg; BEGIN Viewers.Recall(V); IF (V#NIL) & (V.state = 0) THEN Viewers.Open(V, V.X, V.Y + V.H); M.id := Viewers.restore; V.handle(V, M) END END Recall; PROCEDURE Copy*; VAR V, V1: Viewers.Viewer; M: Oberon.CopyMsg; N: Viewers.ViewerMsg; BEGIN V := Oberon.Par.vwr; V.handle(V, M); V1 := M.F(Viewers.Viewer); Viewers.Open(V1, V.X, V.Y + V.H DIV 2); N.id := Viewers.restore; V1.handle(V1, N) END Copy; PROCEDURE Grow*; VAR V, V1: Viewers.Viewer; M: Oberon.CopyMsg; N: Viewers.ViewerMsg; DW, DH: INTEGER; BEGIN V := Oberon.Par.vwr; DW := Oberon.DisplayWidth(V.X); DH := Oberon.DisplayHeight(V.X); IF V.H < DH - Viewers.minH THEN Oberon.OpenTrack(V.X, V.W) ELSIF V.W < DW THEN Oberon.OpenTrack(Oberon.UserTrack(V.X), DW) END; IF (V.H < DH - Viewers.minH) OR (V.W < DW) THEN V.handle(V, M); V1 := M.F(Viewers.Viewer); Viewers.Open(V1, V.X, DH); N.id := Viewers.restore; V1.handle(V1, N) END END Grow; (* ------------- Toolbox for module management ---------------*) PROCEDURE Free1(VAR S: Texts.Scanner); BEGIN Texts.WriteString(W, S.s); Texts.WriteString(W, " unloading"); Texts.Append(Oberon.Log, W.buf); IF S.nextCh # "*" THEN Modules.Free(S.s, FALSE) ELSE Modules.Free(S.s, TRUE); Texts.Scan(S); Texts.WriteString(W, " all") END; IF Modules.res # 0 THEN Texts.WriteString(W, " failed: "); IF Modules.res = 6 THEN Texts.WriteString(W, " not loaded") ELSIF Modules.res = 8 THEN Texts.WriteString(W, " still referenced") END END; EndLine END Free1; PROCEDURE Free*; VAR T: Texts.Text; beg, end, time: LONGINT; S: Texts.Scanner; BEGIN Texts.WriteString(W, "System.Free"); EndLine; Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(T, beg, end, time); IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S); IF S.class = Texts.Name THEN Free1(S) END END ELSE WHILE S.class = Texts.Name DO Free1(S); Texts.Scan(S) END END END Free; PROCEDURE Watch*; VAR T: Texts.Text; V: Viewers.Viewer; M: Modules.Module; X, Y: INTEGER; avail: LONGINT; BEGIN T := TextFrames.Text(""); Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y); V := MenuViewers.New( TextFrames.NewMenu("System.Watch", StandardMenu), TextFrames.NewText(T, 0), TextFrames.menuH, X, Y); avail := Kernel.Available(); Texts.WriteString(W, "heap size: "); Texts.WriteInt(W, Kernel.heapSize, 0); Texts.WriteString(W, " bytes"); Texts.WriteLn(W); Texts.WriteString(W, "allocated: "); Texts.WriteInt(W, Kernel.heapSize - avail, 0); Texts.WriteLn(W); Texts.WriteString(W, "available: "); Texts.WriteInt(W, avail, 0); Texts.WriteLn(W); Texts.WriteString(W, "largest free block: "); Texts.WriteInt(W, Kernel.LargestAvailable(), 0); Texts.WriteLn(W); Texts.WriteString(W, "open file(s): "); Texts.WriteInt(W, Kernel.nofiles, 0); Texts.WriteLn(W); Texts.Append(T, W.buf) END Watch; PROCEDURE ShowModules*; VAR T: Texts.Text; V: Viewers.Viewer; X, Y: INTEGER; PROCEDURE Out(m: Modules.Module); VAR i: INTEGER; BEGIN IF m # NIL THEN Out(m.next); Texts.WriteString(W, m.name); i := 0; WHILE m.name[i] # 0X DO INC(i) END; i := 32-i; WHILE i > 0 DO Texts.Write(W, " "); DEC(i) END; Texts.WriteString(W, "codesize = "); Texts.WriteInt(W, LEN(m.code^)*4, 5); Texts.WriteString(W, " entry = "); Texts.WriteHex(W, SYSTEM.ADR(m.code[0])); Texts.WriteString(W, "H refcnt = "); Texts.WriteInt(W, m.refcnt, 0); Texts.WriteLn(W) END END Out; BEGIN T := TextFrames.Text(""); Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y); V := MenuViewers.New( TextFrames.NewMenu("System.ShowModules", StandardMenu), TextFrames.NewText(T, 0), TextFrames.menuH, X, Y); Out(Modules.modules); Texts.Append(T, W.buf) END ShowModules; PROCEDURE Argument(VAR S: Texts.Scanner); VAR text: Texts.Text; beg, end, time: LONGINT; BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); IF S.line = 0 THEN IF (S.class = Texts.Char) & (S.c = "^") THEN Oberon.GetSelection(text, beg, end, time); IF time >= 0 THEN Texts.OpenScanner(S, text, beg); Texts.Scan(S) END END END END Argument; PROCEDURE ShowCommands*; VAR m: Modules.Module; S: Texts.Scanner; i: LONGINT; T: Texts.Text; V: Viewers.Viewer; X, Y: INTEGER; BEGIN Argument(S); IF S.class = Texts.Name THEN T := TextFrames.Text(""); Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y); V := MenuViewers.New( TextFrames.NewMenu("System.ShowCommands", StandardMenu), TextFrames.NewText(T, 0), TextFrames.menuH, X, Y); m := Modules.ThisMod(S.s); IF m # NIL THEN i := 0; WHILE i < LEN(m.cmds^) DO Texts.WriteString(W, S.s); Texts.Write(W, "."); Texts.WriteString(W, m.cmds[i].name); Texts.WriteLn(W); INC(i) END ELSE Texts.WriteString(W, " not loaded") END; Texts.Append(T, W.buf) END END ShowCommands; PROCEDURE State*; VAR t: Texts.Text; S: Texts.Scanner; V: Viewers.Viewer; mod: Modules.Module; X, Y: INTEGER; refs, refsend, adr: LONGINT; ok: BOOLEAN; f: SHORTINT; b: CHAR; name: ARRAY 32 OF CHAR; BEGIN Argument(S); Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y); t := TextFrames.Text(""); V := MenuViewers.New( TextFrames.NewMenu("System.State", StandardMenu), TextFrames.NewText(t, 0), TextFrames.menuH, X, Y); WHILE S.class = Texts.Name DO Texts.WriteString(W, S.s); mod := Modules.modules; WHILE (mod # NIL) & (mod.name # S.s) DO mod := mod.next END; IF mod # NIL THEN Texts.WriteString(W, " SB = "); Texts.WriteInt(W, mod.sb, 0); Texts.WriteLn(W); Texts.Append(t, W.buf); refs := SYSTEM.ADR(mod.refs^); refsend := refs + LEN(mod.refs^); INC(refs); RInt(refs, adr); INC(refs,8); RInt(refs, adr); RInt(refs, adr); RName(refs, name); LOOP IF refs >= refsend THEN EXIT END; SYSTEM.GET(refs, b); INC(refs); IF ORD(b) = 0F8H THEN EXIT END; SYSTEM.GET(refs, f); INC(refs); RInt(refs, adr); RName(refs, name); IF adr > 0 THEN DumpVar(name, mod.sb, 0, f, adr, FALSE, ORD(b) = 3, NIL, ok) END END ELSE Texts.WriteString(W, " not loaded") END; Texts.WriteLn(W); Texts.Append(t, W.buf); Texts.Scan(S) END END State; (* ------------- Toolbox of file system ---------------*) PROCEDURE ChangeDirectory*; VAR par: Oberon.ParList; R: Texts.Reader; T: Texts.Text; path: ARRAY 256 OF CHAR; i, res: INTEGER; ch: CHAR; beg, end, time: LONGINT; BEGIN par := Oberon.Par; Texts.OpenReader(R, par.text, par.pos); Texts.Read(R, ch); WHILE ch = " " DO Texts.Read(R, ch) END; IF (ch = "^") OR (ch = 0DX) THEN Oberon.GetSelection(T, beg, end, time); IF time >= 0 THEN Texts.OpenReader(R, T, beg); Texts.Read(R, ch); WHILE ch <= " " DO Texts.Read(R, ch) END END END; i := 0; WHILE (ch > " ") & (i < 255) DO path[i] := ch; INC(i); Texts.Read(R, ch) END; path[i] := 0X; Texts.WriteString(W, "System.ChangeDirectory "); Texts.WriteString(W, path); Files.ChangeDirectory(path, res); IF res # 0 THEN Texts.WriteString(W, " -- failed") END; EndLine END ChangeDirectory; PROCEDURE CopyFile(name: ARRAY OF CHAR; VAR S: Texts.Scanner); VAR f, g: Files.File; Rf, Rg: Files.Rider; ch: CHAR; BEGIN Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = "=") THEN Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = ">") THEN Texts.Scan(S); IF S.class = Texts.Name THEN Texts.WriteString(W, name); Texts.WriteString(W, " => "); Texts.WriteString(W, S.s); Texts.WriteString(W, " copying"); Texts.Append(Oberon.Log, W.buf); f := Files.Old(name); IF f # NIL THEN g := Files.New(S.s); Files.Set(Rf, f, 0); Files.Set(Rg, g, 0); Files.Read(Rf, ch); WHILE ~Rf.eof DO Files.Write(Rg, ch); Files.Read(Rf, ch) END; Files.Register(g) ELSE Texts.WriteString(W, " failed") END; EndLine END END END END CopyFile; PROCEDURE CopyFiles*; VAR S: Texts.Scanner; BEGIN GetArg(S); Texts.WriteString(W, "System.CopyFiles"); EndLine; WHILE S.class = Texts.Name DO CopyFile(S.s, S); Texts.Scan(S) END END CopyFiles; PROCEDURE RenameFile (name: ARRAY OF CHAR; VAR S: Texts.Scanner); VAR res: INTEGER; BEGIN Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = "=") THEN Texts.Scan(S); IF (S.class = Texts.Char) & (S.c = ">") THEN Texts.Scan(S); IF S.class = Texts.Name THEN Texts.WriteString(W, name); Texts.WriteString(W, " => "); Texts.WriteString(W, S.s); Texts.WriteString(W, " renaming"); Files.Rename(name, S.s, res); IF res > 1 THEN Texts.WriteString(W, " failed") END; EndLine END END END END RenameFile; PROCEDURE RenameFiles*; VAR S: Texts.Scanner; BEGIN GetArg(S); Texts.WriteString(W, "System.RenameFiles"); EndLine; WHILE S.class = Texts.Name DO RenameFile(S.s, S); Texts.Scan(S) END END RenameFiles; PROCEDURE DeleteFile (VAR name: ARRAY OF CHAR); VAR res: INTEGER; BEGIN Texts.WriteString(W, name); Texts.WriteString(W, " deleting"); Texts.Append(Oberon.Log, W.buf); Files.Delete(name, res); IF res # 0 THEN Texts.WriteString(W, " failed") END; EndLine; END DeleteFile; PROCEDURE DeleteFiles*; VAR S: Texts.Scanner; BEGIN GetArg(S); Texts.WriteString(W, "System.DeleteFiles"); EndLine; WHILE S.class = Texts.Name DO DeleteFile(S.s); Texts.Scan(S) END END DeleteFiles; PROCEDURE Quit*; BEGIN Unix.Exit(0); END Quit; PROCEDURE Execute*; VAR par: Oberon.ParList; t: Texts.Text; R: Texts.Reader; V: Viewers.Viewer; i, bufsize, beg, end, time, stdin, stdout, stderr, fd: LONGINT; bold, italic: Fonts.Font; cmd: ARRAY 4096 OF CHAR; buf: ARRAY 32000 OF CHAR; X, Y: INTEGER; ch: CHAR; res : LONGINT; BEGIN par := Oberon.Par; Oberon.AllocateSystemViewer(par.vwr.X, X, Y); Texts.OpenReader(R, par.text, par.pos); i := 0; cmd := ""; Texts.Read(R, ch); WHILE ch = " " DO Texts.Read(R, ch) END; WHILE (ch >= " ") & (ch # "^") DO cmd[i] := ch; INC(i); Texts.Read(R, ch) END; IF (i = 0) OR (ch = "^") THEN Oberon.GetSelection(t, beg, end, time); IF time >= 0 THEN Texts.OpenReader(R, t, beg); Texts.Read(R, ch); WHILE Texts.Pos(R) <= end DO IF ch = 0DX THEN ch := " " END; cmd[i] := ch; INC(i); Texts.Read(R, ch) END END END; cmd[i] := 0X; stdin := Unix.Dup(Unix.stdin); stdout := Unix.Dup(Unix.stdout); stderr := Unix.Dup(Unix.stderr); res := Unix.Close(Unix.stdin); res := Unix.Close(Unix.stdout); res := Unix.Close(Unix.stderr); fd := Unix.Open(SYSTEM.ADR("/dev/null"), Unix.rdwr, -1); fd := Unix.Open(SYSTEM.ADR("/tmp/System.Execute"), Unix.rdwr + Unix.creat + Unix.trunc, -1); res := Unix.Unlink(SYSTEM.ADR("/tmp/System.Execute")); fd := Unix.Dup(fd); Unix.System(SYSTEM.ADR(cmd), LEN(cmd)); bold := Fonts.This("Syntax10b.Scn.Fnt"); italic := Fonts.This("Syntax10i.Scn.Fnt"); res := Unix.Lseek(Unix.stdout, 0, 0); bufsize := Unix.Read(Unix.stdout, SYSTEM.ADR(buf), LEN(buf)); IF bufsize > 0 THEN t := TextFrames.Text(""); V := MenuViewers.New( TextFrames.NewMenu("System.Execute", StandardMenu), TextFrames.NewText(t, 0), TextFrames.menuH, X, Y); REPEAT i := 0; WHILE i < bufsize DO ch := buf[i]; IF ch = 0AX THEN ch := 0DX END; (* LF -> CR *) IF (i < bufsize-2) & (buf[i+1] = 08X) THEN (* -almost- correct (consider buf limit...) *) IF ch = "_"(*underscore*) THEN Texts.SetFont(W, italic) ELSE Texts.SetFont(W, bold) END; REPEAT INC(i, 2); ch := buf[i]; UNTIL (i >= bufsize-2) OR (buf[i+1] # 08X); Texts.Write(W, ch); Texts.SetFont(W, Fonts.Default); INC(i) ELSE Texts.Write(W, ch); INC(i) END END; Texts.Append(t, W.buf); bufsize := Unix.Read(Unix.stdout, SYSTEM.ADR(buf), LEN(buf)) UNTIL bufsize = 0; res := Unix.Ftruncate(Unix.stdout, 0); res := Unix.Lseek(Unix.stdout, 0, 0) END; res := Unix.Close(Unix.stdin); res :=Unix.Close(Unix.stdout); res := Unix.Close(Unix.stderr); fd := Unix.Dup(stdin); fd := Unix.Dup(stdout); fd := Unix.Dup(stderr); res := Unix.Close(stdin); res := Unix.Close(stdout); res := Unix.Close(stderr); END Execute; PROCEDURE Directory*; VAR T: Texts.Text; cmd: ARRAY 256 OF CHAR; i: INTEGER; ch: CHAR; R: Texts.Reader; t, beg, end: LONGINT; cmdLen: INTEGER; BEGIN cmd := "ls -dpq "; i := 0; WHILE cmd[i] # 0X DO INC(i) END; DEC(i, 2); cmdLen := i; Texts.OpenReader(R, Oberon.Par.text, Oberon.Par.pos); Texts.Read(R, ch); WHILE (ch = " ") OR (ch = 09X) DO Texts.Read(R, ch) END; IF ch = "-" THEN Texts.Read(R, ch) ELSE cmd[i] := " "; INC(i) END; WHILE ch >= " " DO cmd[i] := ch; INC(i); Texts.Read(R, ch) END; cmd[i] := 0X; IF (i = cmdLen) OR (cmd[cmdLen+1] = "^") THEN Oberon.GetSelection(T, beg, end, t); IF t >= 0 THEN Texts.OpenReader(R, T, beg); REPEAT Texts.Read(R, ch) UNTIL ch # 09X; i := cmdLen; IF ch = "-" THEN Texts.Read(R, ch) ELSE cmd[i] := " "; INC(i) END; WHILE ch >= " " DO cmd[i] := ch; INC(i); Texts.Read(R, ch) END; cmd[i] := 0X END END; T := TextFrames.Text(""); Texts.Append(Oberon.Log, W.buf); (*clear*) Texts.WriteString(W, cmd); Texts.Append(T, W.buf); Oberon.Par.text := T; Oberon.Par.pos := 0; Execute END Directory; PROCEDURE Init; VAR test: INTEGER; lo: CHAR; var: Unix.EnvVar; sigstack: Unix.SigStack; vec: Unix.SigVector; userVar : ARRAY 64 OF CHAR; res : LONGINT; p: Unix.SignalHandler; handler: LONGINT; BEGIN errorMsg := ""; L := 4; H := 0; (* Big Endian *) sigstack.sp := Kernel.sysStackTop; sigstack.onstack := 1; Unix.Sigstack(SYSTEM.ADR(sigstack), 0); p := Trap; SYSTEM.GET (SYSTEM.ADR(p), handler); vec.handler := (handler DIV 4) * 4; vec.mask := 0; vec.flags := 1; (* executes on system stack *) Unix.Sigvector(2, SYSTEM.ADR(vec), 0); (* keyboard interrupt *) Unix.Sigvector(4, SYSTEM.ADR(vec), 0); (* illegal instruction *) Unix.Sigvector(5, SYSTEM.ADR(vec), 0); (* trace trap *) Unix.Sigvector(8, SYSTEM.ADR(vec), 0); (* floating point exception *) Unix.Sigvector(10, SYSTEM.ADR(vec), 0); (* bus error *) Unix.Sigvector(11, SYSTEM.ADR(vec), 0); (* segmentation violation *) userVar := "USER"; var := Unix.Getenv(SYSTEM.ADR(userVar), LEN(userVar)); IF var # NIL THEN COPY(var^.name, Oberon.User) ELSE Oberon.User := "" END; res := Unix.Getcwd(SYSTEM.ADR(PWD), LEN(PWD)); X11.SetErrorHandler(X11.MyErrorHandler); END Init; PROCEDURE OpenViewers; VAR logV, toolV: Viewers.Viewer; X, Y: INTEGER; T: Texts.Text; M: TextFrames.Frame; buf: Texts.Buffer; BEGIN Oberon.AllocateSystemViewer(0, X, Y); logV := MenuViewers.New(GetMenu("System.Log", "Log.Menu.Text", LogMenu), TextFrames.NewText(Oberon.Log, 0), TextFrames.menuH, X, Y); Oberon.AllocateSystemViewer(0, X, Y); toolV := MenuViewers.New(GetMenu("System.Tool", "System.Menu.Text", StandardMenu), TextFrames.NewText(TextFrames.Text("System.Tool"), 0), TextFrames.menuH, X, Y) END OpenViewers; BEGIN Texts.OpenWriter(W); Init; Oberon.Log := TextFrames.Text(""); InitLogText; NEW(Oberon.Par); IF Unix.Sigsetjmp(Kernel.jmpBuf, 1) = 0 THEN IF Modules.ThisMod("Configuration") = NIL THEN OpenViewers; END END; IF Modules.ThisMod("FKeys") = NIL THEN END END System.