Syntax10.Scn.Fnt
ParcElems
Alloc
Syntax24b.Scn.Fnt
Syntax10i.Scn.Fnt
StampElems
Alloc
28 Apr 96
Syntax10b.Scn.Fnt
FoldElems
(* AMIGA *)
MODULE System;	(* JG 25.4.90 / NW 22.4.90, JT 21.01.93, CN/SHML 
	IMPORT SYSTEM, Amiga, Kernel, Modules, Files, Input, Viewers, MenuViewers, Oberon, Fonts, Texts, TextFrames;
	CONST
		copyright = "(c) ETH-Zurich / Claudio Nieder, Stefan Ludwig & Ralf Degner";
		SystemMenu = "System.Close System.Copy System.Grow Edit.Search Edit.Store ";
		SystemMenuText = "System.Menu.Text";
		LogMenu = "System.Close System.Grow Edit.Locate Edit.Store ";
		LogMenuText = "Log.Menu.Text";
		(* 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;
		W: Texts.Writer;
	PROCEDURE Str(s: ARRAY OF CHAR);	BEGIN Texts.WriteString(W, s) END Str;
	PROCEDURE Ch(ch: CHAR);	BEGIN Texts.Write(W, ch) END Ch;
	PROCEDURE Integer(i: LONGINT);	BEGIN Texts.Write(W, " "); Texts.WriteInt(W, i, 0) END Integer;
	PROCEDURE Ln;	BEGIN Texts.WriteLn(W) END Ln;
	PROCEDURE Append(t: Texts.Text);	BEGIN ASSERT(t#NIL); Texts.Append(t, W.buf) END Append;
	PROCEDURE Hex(i: LONGINT);	BEGIN Texts.Write(W, " "); Texts.WriteHex(W, i) END Hex;
	PROCEDURE ScanEnd(VAR s: Texts.Scanner; VAR end: LONGINT);	(* Scan first parameter *)
		VAR sel: Texts.Text; beg, 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(sel, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(s, sel, beg); Texts.Scan(s) END
		ELSE end := Oberon.Par.text.len
		END
	END ScanEnd;
	PROCEDURE ScanFirst(VAR s: Texts.Scanner);	(* Scan first parameter *)
		VAR sel: 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 = "^") OR (s.line # 0) THEN
			Oberon.GetSelection(sel, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(s, sel, beg); Texts.Scan(s) END
		END
	END ScanFirst;
	PROCEDURE MenuFrame(name, fileName, defaultMenu: ARRAY OF CHAR): TextFrames.Frame;
		VAR mf: TextFrames.Frame; t: Texts.Text; buf: Texts.Buffer;
	BEGIN
		IF Files.Old(fileName) = NIL THEN mf := TextFrames.NewMenu(name, defaultMenu)
		ELSE
			mf := TextFrames.NewMenu(name, "");
			NEW(t); Texts.Open(t, fileName);
			NEW(buf); Texts.OpenBuf(buf); Texts.Save(t, 0, t.len, buf); Texts.Append(mf.text, buf)
		END;
		RETURN mf
	END MenuFrame;
	PROCEDURE Strip(VAR s: ARRAY OF CHAR);
		VAR i: INTEGER;
	BEGIN i := -1; REPEAT INC(i) UNTIL (s[i] = 0X) OR (s[i] = "."); s[i] := 0X
	END Strip;
	PROCEDURE DumpVar(T:Texts.Text; VAR name: ARRAY OF CHAR; fp, f, vadr: LONGINT; varPar: BOOLEAN);
		VAR ch: CHAR; sival: SHORTINT; ival, i: INTEGER; lival: LONGINT; rval: REAL; lrval: LONGREAL;
	BEGIN
		IF ((fp MOD 2) # 0) OR (fp<4096) THEN
			Str(" -- invalid stack frame"); Ln; Append(T); RETURN
		END ;
		IF varPar THEN SYSTEM.GET(fp + vadr, vadr)
		ELSE vadr := fp + vadr
		END ;
		Str("   "); Hex(vadr); Str(" "); Str(name); Str(" = ");
		CASE f OF
		| Byte: SYSTEM.GET(vadr, ch); Integer(ORD(ch))
		| SInt: SYSTEM.GET(vadr, sival); Integer(sival)
		| Int: SYSTEM.GET(vadr, ival); Integer(ival)
		| LInt: SYSTEM.GET(vadr, lival); Integer(lival)
		| Bool: SYSTEM.GET(vadr, sival);
			IF sival = 0 THEN Str("FALSE") ELSE Str("TRUE") END
		| Char: SYSTEM.GET(vadr, ch);
			IF (ch < " ") OR (ch > "~") THEN Str("CHR("); Integer(ORD(ch)); Ch(")")
			ELSE Ch(22X); Ch(ch); Ch(22X)
			END
		| Pointer, ProcTyp, Set: SYSTEM.GET(vadr, lival); Texts.WriteHex(W, lival); Ch("H")
		| Real: SYSTEM.GET(vadr, rval); Texts.WriteReal(W, rval, 15)
		| LReal: SYSTEM.GET(vadr, lrval); Texts.WriteLongReal(W, lrval, 24)
		| Comp: Ch(22X); i := 0;
			LOOP SYSTEM.GET(vadr+i, ch);
				IF (ch < " ") OR (ch >= 90X) THEN EXIT END ;
				Ch(ch); INC(i)
			END ;
			Ch(22X)
		ELSE Str("unknown type")
		END ;
		Ln; Append(T)
	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 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 DumpProc(T:Texts.Text; fp, pc: LONGINT);
		VAR m: Kernel.Module; found: BOOLEAN;
			refs, refsend, vadr, lastadr, adr: LONGINT;
			name: ARRAY 64 OF CHAR;
			f: SHORTINT; b: CHAR;
	BEGIN
		m := Kernel.modules;
		WHILE m # NIL DO
			IF (pc >= m.code) & (pc < m.refs) THEN (*module found*)
				refs := m^.refs + 1; refsend := m^.refs + m^.refSize; lastadr := 0;
				WHILE refs < refsend DO
					RInt(refs, adr);
					RName(refs, name);
					IF (pc < m.code + adr) & (pc >= m.code + lastadr) THEN found := TRUE;
						Str(m.name); Ch("."); Str(name);
						Ch(9X); Integer(pc - m.code); Ln; Append(T);
						IF name[0] = "$" THEN fp := m^.data 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(T, name, fp, f, vadr, ORD(b) = 3) END
					END ;
					IF found THEN RETURN ELSE lastadr := adr END
				END
			ELSE m := m.link
			END
		END ;
		Str("unknown"); Ln; Append(T)
	END DumpProc;
	PROCEDURE -RTS 04EH, 075H;
	PROCEDURE Trap;
		VAR errorFrame: Amiga.ErrorFrame; x, y, s: INTEGER; v: Viewers.Viewer; PC, FP: LONGINT; t:Texts.Text;
	BEGIN
		Amiga.RestoreTrapHandler;
		Amiga.GetErrorFrame(errorFrame);
		Str("Trap occurred: PC ="); Integer(errorFrame.PC);
		Str(" SP ="); Integer(errorFrame.SP);
		Str(" type ="); Integer(errorFrame.type);
		Str(" val ="); Integer(errorFrame.val);
		Ln; Append(Oberon.Log);
		t := TextFrames.Text("");
		Oberon.AllocateSystemViewer(Oberon.Mouse.X, x, y);
		v := MenuViewers.New(
			MenuFrame("System.Trap", SystemMenuText, SystemMenu),
			TextFrames.NewText(t, 0),
			TextFrames.menuH, x, y
		PC := errorFrame.PC;
		FP := errorFrame.FP;
		IF v.state > 0 THEN
			Str("TRAP "); Integer(errorFrame.type);
			Str("  code = "); Integer(errorFrame.val);
			Str("  PC = "); Texts.WriteHex(W, PC);
			Str("  FP = "); Texts.WriteHex(W, FP);
			Str("  SP = "); Texts.WriteHex(W, errorFrame.SP);
			Ln; Append(t);
			IF errorFrame.type = Amiga.TrapErr THEN
				CASE errorFrame.val OF
				| 2: Str("Bus error")
				| 3: Str("Address error")
				| 4: Str("Illegal instruction")
				| 5: Str("Zero divide")
				| 6: Str("CHK, CHK2 instruction");
					Texts.WriteLn(W);
					Str("Oberon Trap: Index out of range / Invalid case in WITH statement")
				| 7: Str("TRAPV, TRAPcc, cpTRAPcc instruction");
					SYSTEM.GET(PC-2, s);
					Texts.WriteLn(W);
					Str("Oberon Trap ");Texts.WriteInt(W, s, 1);Str(" : ");
					CASE s OF
						0 : Str("ASSERT fault")
					   |1 : Str("Parity error  (NMI)")
					   |2 : Str("Illegal address (NIL-reference)")
					   |3 : Str("FPU error  (inspect FSR)")
					   |4 : Str("Illegal instruction")
					   |5 : Str("Illegal SVC number")
					   |6 : Str("Division by zero")
					   |7 : Str("Flag trap, invalid index, integer overflow")
					   |9 : Str("Trace trap")
					   |10 : Str("Undefined instruction")
					   |11 : Str("Restartable bus error")
					   |12 : Str("Nonrestartable bus error")
					   |13 : Str("Integer overflow trap or invalid index trap")
					   |14 : Str("Debug trap")
					   |15 : Str("Index out of range / Invalid case in WITH statement")
					   |16 : Str("Invalid case in CASE statement")
					   |17 : Str("Function procedure without RETURN statement")
					   |18 : Str("Type guard check")
					   |19 : Str("Implied type guard check in record assignment")
					   |20 : Str("Disk drive error (unreadable sector)")
					   |21 : Str("Parity error in sector address")
					   |22 : Str("Disk full")
					   |23 : Str("File too long  (> 2.5 MB)")
					   |24 : Str("Abort from keyboard")
					   |25 : Str("ReadBytes/WriteBytes(R, a, n):  LEN(a) < n")
					   |27 : Str("Illegal function argument (Math or MathL)")
					   |30..255 : Str("Programmed HALT")
					ELSE
						Str("unknown")
					END
				| 8: Str("Privilege violation")
				| 9: Str("Trace")
				| 10: Str("Line 1010 emulator")
				| 11: Str("Line 1111 emulator")
				| 13: Str("Coprocessor protocol violation")
				| 14: Str("Format error")
				| 32..47: Str("TRAP instruction"); Integer(errorFrame.val-32)
				ELSE Str("Some error"); Integer(errorFrame.val)
				END
			ELSE Str("Some other error"); Integer(errorFrame.val)
			END;
			Ln; Append(t);
			LOOP
				IF (FP<4096) OR (PC<4096) THEN EXIT; END;
				DumpProc(t, FP, PC);
				Append(t);
				IF FP >= Amiga.stackPtr THEN EXIT; END;
				SYSTEM.GET(FP+4, PC);
				SYSTEM.GET(FP, FP)
			END
		END;
		Amiga.InstallTrapHandler(Trap);
		SYSTEM.PUTREG(15, Amiga.stackPtr); RTS
	END Trap;
	PROCEDURE Max (i, j: LONGINT): LONGINT;
	BEGIN IF i >= j THEN RETURN i ELSE RETURN j END
	END Max;
	PROCEDURE Open*;
		VAR par: Oberon.ParList;
			T: Texts.Text;
			S: Texts.Scanner;
			V: Viewers.Viewer;
			X, Y: INTEGER;
			beg, end, time: LONGINT;
	BEGIN
		par := Oberon.Par;
		Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
		IF (S.class = Texts.Char) & (S.c = "^") OR (S.line # 0) THEN
			Oberon.GetSelection(T, beg, end, time);
			IF time >= 0 THEN Texts.OpenScanner(S, T, beg); Texts.Scan(S) END
		END;
		IF S.class = Texts.Name THEN
			Oberon.AllocateSystemViewer(par.vwr.X, X, Y);
			V := MenuViewers.New(
				MenuFrame(S.s, SystemMenuText, SystemMenu),
				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(
			MenuFrame("System.Log", LogMenuText, LogMenu),
			TextFrames.NewText(Oberon.Log, Max(0, Oberon.Log.len - 200)),
			TextFrames.menuH, X, Y
	END OpenLog;
	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;
	PROCEDURE SetFont*;
		VAR s: Texts.Scanner;
	BEGIN
		ScanFirst(s);
		IF s.class = Texts.Name THEN Oberon.SetFont(Fonts.This(s.s)) END
	END SetFont;
	PROCEDURE SetColor*;
		VAR s: Texts.Scanner;
	BEGIN
		ScanFirst(s);
		IF s.class = Texts.Int THEN Oberon.SetColor(SHORT(SHORT(s.i))) END
	END SetColor;
	PROCEDURE SetOffset*;
		VAR s: Texts.Scanner;
	BEGIN
		ScanFirst(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*)
			Str("System.Time");
			Oberon.GetClock(t, d); Texts.WriteDate(W, t, d); Ln; Append(Oberon.Log)
		END
	END Time;
	PROCEDURE Watch*;
	BEGIN
		Str("System.Watch"); Ln;
		Integer(Kernel.allocated); Str(" bytes allocated from ");
		Integer(Kernel.heapSize); Ln;
		Integer(Kernel.nofiles); Str(" file(s) open"); Ln;
		Append(Oberon.Log)
	END Watch;
	PROCEDURE Collect*;
	BEGIN
		Oberon.Collect(0);
	END Collect;
	PROCEDURE FreeMod(VAR S: Texts.Scanner);
	BEGIN
		Str(S.s); Str(" unloading");
		Append(Oberon.Log);
		IF S.nextCh # "*" THEN Modules.Free(S.s, FALSE)
		ELSE Modules.Free(S.s, TRUE); Texts.Scan(S); Str(" all")
		END;
		IF Modules.res # 0 THEN Str(" failed"); Modules.res := 0 END;
		Ln; Append(Oberon.Log)
	END FreeMod;
	PROCEDURE Free*;
		VAR par: Oberon.ParList;
			T: Texts.Text;
			S: Texts.Scanner;
			beg, end, time: LONGINT;
	BEGIN
		par := Oberon.Par;
		Str("System.Free"); Ln; Append(Oberon.Log);
		Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
		WHILE S.class = Texts.Name DO FreeMod(S); Texts.Scan(S) END;
		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 FreeMod(S) END
			END
		END
	END Free;
	PROCEDURE ShowModules*;
		VAR T: Texts.Text;
			V: Viewers.Viewer;
			M: Kernel.Module;
			X, Y: INTEGER;
	BEGIN
		T := TextFrames.Text("");
		Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
		V := MenuViewers.New(
			MenuFrame("System.ShowModules", SystemMenuText, SystemMenu),
			TextFrames.NewText(T, 0),
			TextFrames.menuH, X, Y
		M := Kernel.modules;
		WHILE M # NIL DO
			Str(M.name); Texts.WriteInt(W, M.refs - M.code, 8);
			Texts.WriteInt(W, M.refcnt, 4); Ln;
			M := M.link
		END;
		Append(T)
	END ShowModules;
	PROCEDURE ShowCommands*;
		VAR M: Kernel.Module; S: Texts.Scanner; i: LONGINT;
			T: Texts.Text; V: Viewers.Viewer; X, Y: INTEGER;
			cmds: POINTER TO ARRAY 1000 OF RECORD
				name: ARRAY 24 OF CHAR;
				offset: LONGINT
			END ;
	BEGIN
		ScanFirst(S);
		IF S.class = Texts.Name THEN
			Strip(S.s); M := Modules.ThisMod(S.s);
			IF M # NIL THEN SYSTEM.GET(SYSTEM.ADR(M.commands), cmds); i := 0;
				Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
				T := TextFrames.Text("");
				V := MenuViewers.New(
					MenuFrame("System.Commands", SystemMenuText, SystemMenu),
					TextFrames.NewText(T, 0),
					TextFrames.menuH, X, Y
				);
				WHILE i < M.nofcoms DO
					Str(M.name); Ch("."); Str(cmds[i].name); Ln;
					INC(i)
				END ;
				Append(T)
			END
		END
	END ShowCommands;
	PROCEDURE State*;
		VAR
			t: Texts.Text;
			S: Texts.Scanner;
			V: Viewers.Viewer;
			mod: Kernel.Module;
			X, Y: INTEGER;
			refs, refsend, adr: LONGINT;
			f: SHORTINT; b: CHAR;
			name: ARRAY 32 OF CHAR;
	BEGIN
		ScanFirst(S);
		Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, X, Y);
		t := TextFrames.Text("");
		V := MenuViewers.New(
			MenuFrame("System.State", SystemMenuText, SystemMenu),
			TextFrames.NewText(t, 0),
			TextFrames.menuH, X, Y
		WHILE S.class = Texts.Name DO
			Strip(S.s);	(*<<*)
			Str(S.s);
			mod := Kernel.modules;
			WHILE (mod # NIL) & (mod.name # S.s) DO mod := mod.link END ;
			IF mod # NIL THEN
				Ln;
				refs := mod^.refs + 1; refsend := mod^.refs + mod^.refSize;
				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(t, name, mod.data, f, adr, ORD(b) = 3) END
				END
			ELSE Str(" not loaded")
			END ;
			Ln; Append(t); Texts.Scan(S)
		END
	END State;
	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 CurrentDirectory*;
	BEGIN
		Str("System.CurrentDirectory "); Str(Files.CurrentDir); Ln; Append(Oberon.Log)
	END CurrentDirectory;
	PROCEDURE ChangeDirectory*;
		VAR
			S: Texts.Scanner;
			res: INTEGER;
	BEGIN
		ScanFirst(S);
		IF (S.class = Texts.Name) & (S.line = 0) THEN
			Str("System.ChangeDirectory "); Str(S.s);
			Files.ChangeDirectory(S.s, res);
			IF res # 0 THEN Str("  -- failed") END ;
			Ln; Append(Oberon.Log)
		END
	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
					Str(name); Str(" => "); Str(S.s);
					Str(" copying");
					Append(Oberon.Log);
					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 Str(" failed")
					END;
					Ln; Append(Oberon.Log)
				END
			END
		END
	END CopyFile;
	PROCEDURE CopyFiles*;
		VAR par: Oberon.ParList;
		T: Texts.Text;
		S: Texts.Scanner;
		beg, end, time: LONGINT;
	BEGIN
		par := Oberon.Par;
		Str("System.CopyFiles"); Ln; Append(Oberon.Log);
		Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
		WHILE S.class = Texts.Name DO CopyFile(S.s, S); Texts.Scan(S) END;
		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 CopyFile(S.s, S) END
			END
		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
					Str(name); Str(" => "); Str(S.s); Str(" renaming"); Append(Oberon.Log);
					Files.Rename(name, S.s, res);
					IF res > 1 THEN Str(" failed") END;
					Ln; Append(Oberon.Log)
				END
			END
		END
	END RenameFile;
	PROCEDURE RenameFiles*;
		VAR par: Oberon.ParList;
			T: Texts.Text;
			S: Texts.Scanner;
			beg, end, time: LONGINT;
	BEGIN
		par := Oberon.Par;
		Str("System.RenameFiles"); Ln; Append(Oberon.Log);
		Texts.OpenScanner(S, par.text, par.pos); Texts.Scan(S);
		WHILE S.class = Texts.Name DO RenameFile(S.s, S); Texts.Scan(S) END;
			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 RenameFile(S.s, S) END
				END
			END
	END RenameFiles;
	PROCEDURE DeleteFiles*;	(** {name} "~" | "^"	Delete file name **)
		VAR S: Texts.Scanner; end: LONGINT; res: INTEGER;
	BEGIN
		ScanEnd(S, end); Str("System.DeleteFiles"); Ln; Append(Oberon.Log);
		LOOP
			IF S.class # Texts.Name THEN EXIT END;
			Str("deleting "); Files.Delete(S.s, res); Str(S.s);
			IF res # 0 THEN Str(" failed") END;
			Ln; Append(Oberon.Log);
			IF Texts.Pos(S) >= end THEN EXIT END;
			Texts.Scan(S)
		END;
		Append(Oberon.Log)
	END DeleteFiles;
	PROCEDURE Quit*;
	BEGIN
		Amiga.Terminate()
	END Quit;
	PROCEDURE ShowFile(title,name:ARRAY OF CHAR);
	CONST
		bufLen=4000;
		blk:LONGINT;
		buf:ARRAY bufLen OF CHAR;
		ch:CHAR;
		f:Files.File;
		i:LONGINT;
		len:LONGINT;
		r:Files.Rider;
		t:Texts.Text;
		v:Viewers.Viewer;
		x,y:INTEGER;
	BEGIN
		f:=Files.Old(name);
		IF f#NIL THEN
			t:=TextFrames.Text("");
			Oberon.AllocateSystemViewer(Oberon.Par.vwr.X,x,y);
			v:=MenuViewers.New(
				MenuFrame(title,SystemMenuText,SystemMenu),
				TextFrames.NewText(t,0),
				TextFrames.menuH,x,y
			);
			len:=Files.Length(f); blk:=len MOD bufLen; Files.Set(r,f,0);
			WHILE len>0 DO
				Files.ReadBytes(r,buf,blk); DEC(len,blk);
				FOR i:=0 TO blk-1 DO
					ch:=buf[i];
					IF ch=0AX THEN ch:=0DX END;	(* LF -> CR *)
					Ch(ch);
				END;
				Append(t);
				blk:=bufLen;
			END;
			Files.Close(f);
			Files.Purge(f)
		END
	END ShowFile;
	PROCEDURE DeleteError(fileName: ARRAY OF CHAR);
	BEGIN
		Str("System.DosCall: Delete "); Str(fileName);
		Str(" failed"); Ln; Append(Oberon.Log);
	END DeleteError;
	PROCEDURE DosCallError(fileName: ARRAY OF CHAR);
	BEGIN
		Str("System.DosCall: "); Str(fileName);
		Str(" failed"); Ln; Append(Oberon.Log);
	END DosCallError;
	PROCEDURE DosCall(cmd,title:ARRAY OF CHAR; sort:BOOLEAN);
	CONST
		SortName="T:System.DosCall.Sort";
		TempName="T:System.DosCall";
		res:INTEGER;
	BEGIN
		Amiga.DosCmd(cmd,TempName,res);
		IF res=0 THEN
			IF (res=0) & sort THEN Amiga.DosCmd("sort T:System.DosCall T:System.DosCall.Sort","NIL:",res) END;
			IF res = 0 THEN
				IF sort THEN ShowFile(title,SortName) ELSE ShowFile(title,TempName) END
			END;
			Kernel.GC(TRUE);
			Files.Delete(TempName,res);
			IF res#0 THEN DeleteError(TempName); END;
			IF sort THEN
				Files.Delete(SortName,res);
				IF res#0 THEN DeleteError(SortName) END
			END
		ELSE
			DosCallError(cmd)
		END
	END DosCall;
	PROCEDURE Execute*;
		VAR par: Oberon.ParList;
			R: Texts.Reader; t: Texts.Text;
			i, beg, end, time: LONGINT;
			cmd: ARRAY 4096 OF CHAR;
			ch: CHAR;
	BEGIN
		par := Oberon.Par;
		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;
		DosCall(cmd,"System.Execute",FALSE);
		Kernel.GC(TRUE)
	END Execute;
	PROCEDURE Directory*;
		CONST CmdText = "list lformat=%f%n "; CmdLen = 18;
		VAR
			text: Texts.Text; cmd: ARRAY 256 OF CHAR;
			i: INTEGER; time, beg, end: LONGINT;
		PROCEDURE ReadParameters(t: Texts.Text; pos: LONGINT);
			VAR r: Texts.Reader; ch: CHAR;
		BEGIN
			Texts.OpenReader(r, t, pos); Texts.Read(r, ch);
			WHILE ~r.eot & ((ch = " ") OR (ch = 09X)) DO Texts.Read(r, ch) END;
			i := CmdLen;
			WHILE ~r.eot & (i < LEN(cmd)-2) & (ch > " ") DO
				IF ch = "*" THEN cmd[i] := "#"; cmd[i+1] := "?"; INC(i, 2) ELSE cmd[i] := ch; INC(i) END;
				Texts.Read(r, ch)
			END;
			cmd[i] := 0X
		END ReadParameters;
	BEGIN
		cmd := CmdText;
		ReadParameters(Oberon.Par.text, Oberon.Par.pos);
		IF (i = CmdLen) OR (cmd[CmdLen] = "^") THEN
			Oberon.GetSelection(text, beg, end, time);
			IF time >= 0 THEN
				ReadParameters(text, beg)
			ELSE
				Str("No Selection !");Ln;Append(Oberon.Log); RETURN
			END
		END;
		DosCall(cmd, "System.Directory", TRUE);
		Kernel.GC(TRUE)
	END Directory;
	PROCEDURE ShowMode*;
		VAR
			displayID:LONGINT; x, y, height, width, depth: INTEGER; oscan:LONGINT;
			autoScroll, WBWindow, PrivateColors: BOOLEAN;
			t: Texts.Text; v: Viewers.Viewer;
	BEGIN
		Amiga.ReadScreenMode(displayID, height, width, depth, oscan, autoScroll, WBWindow, PrivateColors);
		t := TextFrames.Text("");
		Oberon.AllocateSystemViewer(Oberon.Par.vwr.X, x, y);
		v := MenuViewers.New(
			TextFrames.NewMenu("System.ShowMode", "System.Close System.Copy System.Grow System.ChangeMode ^ "),
			TextFrames.NewText(t, 0),
			TextFrames.menuH, x, y
		Str("Width "); Integer(width); Ln;
		Str("Height "); Integer(height); Ln;
		Str("Depth "); Integer(depth); Ln;
		Str("AutoScroll ");
		IF autoScroll THEN Str("TRUE") ELSE Str("FALSE") END;
		Ln; Append(t)
	END ShowMode;
	PROCEDURE ChangeMode*;
		VAR
			res: INTEGER; s: Texts.Scanner;
			displayID:LONGINT; height, width, depth: INTEGER; oscan:LONGINT;
			autoScroll, WBWindow, PrivateColors: BOOLEAN;
		PROCEDURE GetInt(VAR val: INTEGER; min, max: INTEGER);
		BEGIN
			Texts.Scan(s);
			IF (s.class = Texts.Int) & (min <= s.i) & (s.i <= max) THEN val := SHORT(s.i) END;
			Texts.Scan(s)
		END GetInt;
	BEGIN
		Amiga.ChangeMode(res);
		IF res#0 THEN
			Amiga.ReadScreenMode(displayID, height, width, depth, oscan, autoScroll, WBWindow, PrivateColors);
			ScanFirst(s);
			WHILE s.class = Texts.Name DO
				IF s.s = "Width" THEN GetInt(width, 320, 16383)
				ELSIF s.s = "Height" THEN GetInt(height, 200, 16383)
				ELSIF s.s = "Depth" THEN GetInt(depth, 1, 8)
				ELSIF s.s = "AutoScroll" THEN
					Texts.Scan(s);
					IF s.class = Texts.Name THEN
						IF s.s = "TRUE" THEN autoScroll := TRUE; Texts.Scan(s)
						ELSIF s.s = "FALSE" THEN autoScroll := FALSE; Texts.Scan(s)
						END
					END
				ELSE Texts.Scan(s)
				END
			END;
			Amiga.WriteScreenMode(displayID, height, width, depth, oscan, autoScroll, WBWindow, PrivateColors);
			Str("changes take effect after restart!"); Ln;
			Append(Oberon.Log)
		END
	END ChangeMode;
	PROCEDURE ChangePri*;
		VAR s: Texts.Scanner;
		PROCEDURE GetInt(VAR val: SHORTINT; min, max: SHORTINT);
		BEGIN
			IF (s.class = Texts.Int) & (min <= s.i) & (s.i <= max) THEN val := SHORT(SHORT(s.i)) END;
			Texts.Scan(s)
		END GetInt;
	BEGIN
		ScanFirst(s);
		GetInt(Amiga.idlePri, -128, -31);
		GetInt(Amiga.normalPri, Amiga.idlePri, 5);
		Str("System.ChangePri idle normal ="); Integer(Amiga.idlePri); Integer(Amiga.normalPri);
		Ln; Append(Oberon.Log); Amiga.Turbo;
	END ChangePri;
	PROCEDURE AnsiInput*;
	BEGIN
		Amiga.dontConvert:=TRUE;
	END AnsiInput;
	PROCEDURE OberonInput*;
	BEGIN
		Amiga.dontConvert:=FALSE;
	END OberonInput;
	PROCEDURE TwoButtonMouse*;
	BEGIN
		Amiga.useLAltAsMouse:=TRUE;
	END TwoButtonMouse;
	PROCEDURE ThreeButtonMouse*;
	BEGIN
		Amiga.useLAltAsMouse:=FALSE;
	END ThreeButtonMouse;
	PROCEDURE AmigaLoop*;
		VAR s: Texts.Scanner;
	BEGIN
		IF Amiga.TimerOpen THEN
			Amiga.MainLoopType:=TRUE;
			ScanFirst(s);
			IF (s.class=Texts.Int) & (s.i>=1) & (s.i<1000) THEN Amiga.TicsToWait:=1000*s.i END;
		END;
	END AmigaLoop;
	PROCEDURE OberonLoop*;
	BEGIN
		Amiga.MainLoopType:=FALSE;
	END OberonLoop;
	PROCEDURE UseQuitRequester*;
	BEGIN
		Amiga.UseQuitRequester:=TRUE;
	END UseQuitRequester;
	PROCEDURE PictPrintThresh*;
		VAR s: Texts.Scanner;
		PROCEDURE GetInt(VAR val: INTEGER; min, max: INTEGER);
		BEGIN
			IF (s.class = Texts.Int) & (min <= s.i) & (s.i <= max) THEN val := SHORT(s.i) END;
			Texts.Scan(s)
		END GetInt;
	BEGIN
		ScanFirst(s);
		GetInt(Amiga.PictPrintThresh, 0, 255);
	END PictPrintThresh;
	PROCEDURE PrinterName*;
		VAR S: Texts.Scanner;
		(* get parameters from Menu, Text or Selection *)
		PROCEDURE GetPar(VAR S: Texts.Scanner): BOOLEAN;
			VAR
				text: Texts.Text;
				beg, end, time: LONGINT;
		BEGIN
			Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos);
			Texts.Scan(S);
			IF S.class=Texts.Char THEN
				IF S.c="^" THEN
					Oberon.GetSelection(text, beg, end, time);
					IF time=-1 THEN RETURN FALSE; END;
					Texts.OpenScanner(S, text, beg);
					Texts.Scan(S)
				END
			END;
			RETURN TRUE;
		END GetPar;
	BEGIN
		IF GetPar(S) THEN
			IF (S.class=Texts.Name) OR (S.class=Texts.String) THEN
				COPY(S.s, Amiga.PrinterName)
			END
		END;
		Str("Printer Name: ");
		Str(Amiga.PrinterName); Ln; Append(Oberon.Log)
	END PrinterName;
	PROCEDURE Init;
		VAR t, d: LONGINT;
	BEGIN
		Amiga.InstallTrapHandler(Trap);
		Oberon.User := "";
		Oberon.GetClock(t, d);
		Str(Amiga.version); Ln; Str(copyright); Ln;
		Texts.WriteDate(W, t, d); Ln; Append(Oberon.Log);
		CurrentDirectory
	END Init;
	PROCEDURE OpenViewers;
		VAR logV, toolV: Viewers.Viewer; X, Y: INTEGER;
	BEGIN
		Oberon.AllocateSystemViewer(0, X, Y);
		logV := MenuViewers.New(
			MenuFrame("System.Log", LogMenuText, LogMenu),
			TextFrames.NewText(Oberon.Log, 0),
			TextFrames.menuH, X, Y
		Oberon.AllocateSystemViewer(0, X, Y);
		toolV := MenuViewers.New(
			MenuFrame("System.Tool", SystemMenuText, SystemMenu),
			TextFrames.NewText(TextFrames.Text("System.Tool"), 0),
			TextFrames.menuH, X, Y
	END OpenViewers;
BEGIN
	Texts.OpenWriter(W);
	Oberon.Log := TextFrames.Text("");
	Init;
	IF Modules.ThisMod("Configuration") = NIL THEN OpenViewers END;
	Amiga.SystemHere;
END System.