├── .gitignore ├── Bootstrap ├── CoreLinker.rsc ├── FileDir.rsc ├── Files.rsc ├── Fonts.rsc ├── InnerCore ├── Kernel.rsc ├── Modules.rsc ├── Norebo.rsc ├── ORB.rsc ├── ORG.rsc ├── ORP.rsc ├── ORS.rsc ├── Oberon.rsc ├── RS232.rsc └── Texts.rsc ├── Makefile ├── Norebo ├── CoreLinker.Mod ├── FileDir.Mod ├── Files.Mod ├── Kernel.Mod ├── Norebo.Mod ├── Oberon.Mod ├── VDisk.Mod ├── VDiskUtil.Mod ├── VFileDir.Mod └── VFiles.Mod ├── Oberon ├── FileDir.Mod ├── Files.Mod ├── Fonts.Mod ├── Kernel.Mod ├── MagicSquares.Mod ├── Modules.Mod ├── ORB.Mod ├── ORG.Mod ├── ORP.Mod ├── ORS.Mod ├── ORTool.Mod ├── Oberon.Mod ├── Oberon10.Scn.Fnt ├── RS232.Mod └── Texts.Mod ├── README.md ├── Runtime ├── norebo.c ├── risc-cpu.c └── risc-cpu.h ├── build-image.py ├── build.sh ├── fetch-sources.py ├── license.txt └── manifest.csv /.gitignore: -------------------------------------------------------------------------------- 1 | /norebo 2 | /build*/ 3 | -------------------------------------------------------------------------------- /Bootstrap/CoreLinker.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/CoreLinker.rsc -------------------------------------------------------------------------------- /Bootstrap/FileDir.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/FileDir.rsc -------------------------------------------------------------------------------- /Bootstrap/Files.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/Files.rsc -------------------------------------------------------------------------------- /Bootstrap/Fonts.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/Fonts.rsc -------------------------------------------------------------------------------- /Bootstrap/InnerCore: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/InnerCore -------------------------------------------------------------------------------- /Bootstrap/Kernel.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/Kernel.rsc -------------------------------------------------------------------------------- /Bootstrap/Modules.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/Modules.rsc -------------------------------------------------------------------------------- /Bootstrap/Norebo.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/Norebo.rsc -------------------------------------------------------------------------------- /Bootstrap/ORB.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/ORB.rsc -------------------------------------------------------------------------------- /Bootstrap/ORG.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/ORG.rsc -------------------------------------------------------------------------------- /Bootstrap/ORP.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/ORP.rsc -------------------------------------------------------------------------------- /Bootstrap/ORS.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/ORS.rsc -------------------------------------------------------------------------------- /Bootstrap/Oberon.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/Oberon.rsc -------------------------------------------------------------------------------- /Bootstrap/RS232.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/RS232.rsc -------------------------------------------------------------------------------- /Bootstrap/Texts.rsc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Bootstrap/Texts.rsc -------------------------------------------------------------------------------- /Makefile: -------------------------------------------------------------------------------- 1 | CFLAGS = -g -O2 -flto -Wall -Wextra -Wconversion -Wno-sign-conversion -Wno-unused-parameter -std=c99 2 | 3 | norebo: Runtime/norebo.c Runtime/risc-cpu.c Runtime/risc-cpu.h 4 | $(CC) -o $@ Runtime/norebo.c Runtime/risc-cpu.c $(CFLAGS) 5 | 6 | clean: 7 | rm -f norebo 8 | rm -rf build1 build2 build3 9 | -------------------------------------------------------------------------------- /Norebo/CoreLinker.Mod: -------------------------------------------------------------------------------- 1 | MODULE CoreLinker; (*derived from NW 20.10.2013*) 2 | IMPORT SYSTEM, Files, Texts, Oberon; 3 | CONST versionkey = 1X; MT = 12; MTOrg = 20H; DescSize = 80; 4 | 5 | TYPE Module = POINTER TO ModDesc; 6 | ModuleName* = ARRAY 32 OF CHAR; 7 | Buffer* = ARRAY 63 * 1024 DIV 4 OF INTEGER; 8 | 9 | ImageModDesc = RECORD 10 | name: ModuleName; 11 | next: INTEGER; 12 | key, num, size, refcnt: INTEGER; 13 | data, code, imp, cmd, ent, ptr, unused: INTEGER; 14 | END ; 15 | 16 | ModDesc = RECORD 17 | next: Module; 18 | addr: INTEGER; 19 | desc: ImageModDesc; 20 | END ; 21 | 22 | VAR W: Texts.Writer; 23 | root: Module; 24 | AllocPtr*, res*: INTEGER; 25 | importing*, imported*: ModuleName; 26 | 27 | PROCEDURE ThisFile(name: ARRAY OF CHAR): Files.File; 28 | VAR i: INTEGER; 29 | filename: ModuleName; 30 | BEGIN i := 0; 31 | WHILE name[i] # 0X DO filename[i] := name[i]; INC(i) END ; 32 | filename[i] := "."; filename[i+1] := "r"; filename[i+2] := "s"; filename[i+3] := "x"; filename[i+4] := 0X; 33 | RETURN Files.Old(filename) 34 | END ThisFile; 35 | 36 | PROCEDURE error(n: INTEGER; name: ARRAY OF CHAR); 37 | BEGIN res := n; importing := name 38 | END error; 39 | 40 | PROCEDURE Check(s: ARRAY OF CHAR); 41 | VAR i: INTEGER; ch: CHAR; 42 | BEGIN ch := s[0]; res := 1; i := 1; 43 | IF (ch >= "A") & (ch <= "Z") OR (ch >= "a") & (ch <= "z") THEN 44 | REPEAT ch := s[i]; INC(i) 45 | UNTIL ~((ch >= "0") & (ch <= "9") OR (ch >= "A") & (ch <= "Z") 46 | OR (ch >= "a") & (ch <= "z") OR (ch = ".")) OR (i = 32); 47 | IF (i < 32) & (ch = 0X) THEN res := 0 END 48 | END 49 | END Check; 50 | 51 | PROCEDURE ReadStringPart(VAR R: Files.Rider; VAR n, cnt: INTEGER); 52 | VAR ch: CHAR; 53 | BEGIN 54 | n := 0; cnt := 0; Files.Read(R, ch); 55 | WHILE (cnt < 4) & (ch # 0X) DO 56 | INC(n, LSL(ORD(ch), cnt * 8)); INC(cnt); 57 | IF cnt < 4 THEN Files.Read(R, ch) END 58 | END 59 | END ReadStringPart; 60 | 61 | PROCEDURE Load(name: ARRAY OF CHAR; VAR buffer: ARRAY OF INTEGER; VAR newmod: Module); 62 | (*search module in list; if not found, load module. 63 | res = 0: already present or loaded; res = 2: file not available; res = 3: key conflict; 64 | res = 4: bad file version; res = 5: corrupted file; res = 7: no space*) 65 | VAR mod, impmod: Module; 66 | i, n, key, impkey, mno, nofimps, size: INTEGER; 67 | p, u, v, w: INTEGER; (*addresses*) 68 | ch: CHAR; 69 | body: INTEGER; 70 | fixorgP, fixorgD, fixorgT: INTEGER; 71 | disp, adr, inst, pno, vno, dest, offset: INTEGER; 72 | name1, impname: ModuleName; 73 | F: Files.File; R: Files.Rider; 74 | import: ARRAY 16 OF Module; 75 | BEGIN mod := root; res := 0; nofimps := 0; 76 | WHILE (mod # NIL) & (name # mod.desc.name) DO mod := mod.next END ; 77 | IF mod = NIL THEN (*load*) 78 | Check(name); 79 | IF res = 0 THEN F := ThisFile(name) ELSE F := NIL END ; 80 | IF F # NIL THEN 81 | Files.Set(R, F, 0); Files.ReadString(R, name1); Files.ReadInt(R, key); Files.Read(R, ch); 82 | Files.ReadInt(R, size); importing := name1; 83 | IF ch = versionkey THEN 84 | Files.ReadString(R, impname); (*imports*) 85 | WHILE (impname[0] # 0X) & (res = 0) DO 86 | Files.ReadInt(R, impkey); 87 | Load(impname, buffer, impmod); import[nofimps] := impmod; importing := name1; 88 | IF res = 0 THEN 89 | IF impmod.desc.key = impkey THEN INC(impmod.desc.refcnt); INC(nofimps) 90 | ELSE error(3, name1); imported := impname 91 | END 92 | END ; 93 | Files.ReadString(R, impname) 94 | END 95 | ELSE error(2, name1) 96 | END 97 | ELSE error(1, name) 98 | END ; 99 | IF res = 0 THEN (*search for a hole in the list allocate and link*) 100 | INC(size, DescSize); 101 | IF AllocPtr + size < LEN(buffer) * 4 THEN 102 | p := AllocPtr DIV 4; 103 | AllocPtr := (AllocPtr + size + 100H) DIV 20H * 20H; 104 | NEW(mod); mod.next := root; root := mod; mod.addr := p * 4; 105 | mod.desc.size := AllocPtr - p * 4; 106 | IF mod.next = NIL THEN 107 | mod.desc.num := 1; mod.desc.next := 0 108 | ELSE 109 | mod.desc.num := mod.next.desc.num + 1; mod.desc.next := mod.next.addr 110 | END 111 | ELSE error(7, name1) 112 | END 113 | END ; 114 | IF res = 0 THEN (*read file*) 115 | INC(p, DescSize DIV 4); (*allocate descriptor*) 116 | (* mod.desc.name := name; *) 117 | n := 0; WHILE name[n] # 0X DO mod.desc.name[n] := name[n]; INC(n); END ; 118 | mod.desc.key := key; mod.desc.refcnt := 0; 119 | mod.desc.data := p * 4; (*data*) 120 | buffer[MTOrg DIV 4 + mod.desc.num] := p * 4; (*module table entry*) 121 | Files.ReadInt(R, n); 122 | WHILE n > 0 DO Files.ReadInt(R, w); buffer[p] := w; INC(p); DEC(n, 4) END ; (*type descriptors*) 123 | Files.ReadInt(R, n); 124 | WHILE n > 0 DO buffer[p] := 0; INC(p); DEC(n, 4) END ; (*variable space*) 125 | Files.ReadInt(R, n); 126 | WHILE n > 0 DO Files.ReadInt(R, w); buffer[p] := w; INC(p); DEC(n, 4) END ; (*strings*) 127 | mod.desc.code := p * 4; (*program*) 128 | Files.ReadInt(R, n); 129 | WHILE n > 0 DO Files.ReadInt(R, w); buffer[p] := w; INC(p); DEC(n) END ; (*program code*) 130 | mod.desc.imp := p * 4; (*copy imports*) 131 | i := 0; 132 | WHILE i < nofimps DO 133 | buffer[p] := import[i].addr; INC(p); INC(i) 134 | END ; 135 | mod.desc.cmd := p * 4; (*commands*) 136 | ReadStringPart(R, w, n); 137 | WHILE n # 0 DO 138 | WHILE n = 4 DO buffer[p] := w; INC(p); ReadStringPart(R, w, n) END ; 139 | buffer[p] := w; INC(p); 140 | Files.ReadInt(R, w); buffer[p] := w; INC(p); 141 | ReadStringPart(R, w, n) 142 | END ; 143 | buffer[p] := 0; INC(p); 144 | mod.desc.ent := p * 4; (*entries*) 145 | Files.ReadInt(R, n); 146 | WHILE n > 0 DO Files.ReadInt(R, w); buffer[p] := w; INC(p); DEC(n) END ; 147 | mod.desc.ptr := p * 4; (*pointer references*) 148 | Files.ReadInt(R, w); 149 | WHILE w >= 0 DO buffer[p] := mod.desc.data + w; INC(p); Files.ReadInt(R, w) END ; 150 | buffer[p] := 0; INC(p); 151 | Files.ReadInt(R, fixorgP); Files.ReadInt(R, fixorgD); Files.ReadInt(R, fixorgT); 152 | Files.ReadInt(R, w); body := mod.desc.code + w; 153 | Files.Read(R, ch); 154 | IF ch # "O" THEN (*corrupted file*) mod := NIL; error(4, name) END 155 | END ; 156 | IF res = 0 THEN (*fixup of BL*) 157 | adr := mod.desc.code + fixorgP*4; 158 | WHILE adr # mod.desc.code DO 159 | inst := buffer[adr DIV 4]; 160 | mno := inst DIV 100000H MOD 10H; 161 | pno := inst DIV 1000H MOD 100H; 162 | disp := inst MOD 1000H; 163 | impmod := import[mno-1]; 164 | dest := buffer[impmod.desc.ent DIV 4 + pno] + impmod.desc.code; 165 | offset := (dest - adr - 4) DIV 4; 166 | buffer[adr DIV 4] := (offset MOD 1000000H) + 0F7000000H; 167 | adr := adr - disp*4 168 | END ; 169 | (*fixup of LDR/STR/ADD*) 170 | adr := mod.desc.code + fixorgD*4; 171 | WHILE adr # mod.desc.code DO 172 | inst := buffer[adr DIV 4]; 173 | mno := inst DIV 100000H MOD 10H; 174 | disp := inst MOD 1000H; 175 | IF mno = 0 THEN (*global*) 176 | buffer[adr DIV 4] := (inst DIV 1000000H * 10H + MT) * 100000H + mod.desc.num * 4; 177 | ELSE (*import*) 178 | impmod := import[mno-1]; v := impmod.desc.num; 179 | buffer[adr DIV 4] := (inst DIV 1000000H * 10H + MT) * 100000H + v*4; 180 | inst := buffer[adr DIV 4 + 1]; vno := inst MOD 100H; 181 | offset := buffer[impmod.desc.ent DIV 4 + vno]; 182 | IF ODD(inst DIV 100H) THEN offset := offset + impmod.desc.code - impmod.desc.data END ; 183 | buffer[adr DIV 4 + 1] := inst DIV 10000H * 10000H + offset; 184 | END ; 185 | adr := adr - disp*4 186 | END ; 187 | (*fixup of type descriptors*) 188 | adr := mod.desc.data + fixorgT*4; 189 | WHILE adr # mod.desc.data DO 190 | inst := buffer[adr DIV 4]; 191 | mno := inst DIV 1000000H MOD 10H; 192 | vno := inst DIV 1000H MOD 1000H; 193 | disp := inst MOD 1000H; 194 | IF mno = 0 THEN (*global*) inst := mod.desc.data + vno 195 | ELSE (*import*) 196 | impmod := import[mno-1]; 197 | offset := buffer[impmod.desc.ent DIV 4 + vno]; 198 | inst := impmod.desc.data + offset 199 | END ; 200 | buffer[adr DIV 4] := inst; adr := adr - disp*4 201 | END ; 202 | buffer[0] := 0E7000000H + body DIV 4 - 1 (*initialize module*) 203 | ELSIF res = 3 THEN importing := name; 204 | WHILE nofimps > 0 DO DEC(nofimps); DEC(import[nofimps].desc.refcnt) END 205 | END 206 | END ; 207 | newmod := mod 208 | END Load; 209 | 210 | PROCEDURE Copy(from, to, words: LONGINT); 211 | VAR x: INTEGER; 212 | BEGIN 213 | WHILE words > 0 DO 214 | SYSTEM.GET(from, x); SYSTEM.PUT(to, x); 215 | INC(from, 4); INC(to, 4); DEC(words) 216 | END 217 | END Copy; 218 | 219 | PROCEDURE Link*(name: ARRAY OF CHAR; VAR buffer: ARRAY OF INTEGER); 220 | VAR mod: Module; 221 | n: LONGINT; 222 | BEGIN 223 | FOR n := 0 TO LEN(buffer) - 1 DO buffer[n] := 0 END ; 224 | AllocPtr := 100H; 225 | Load(name, buffer, mod); 226 | buffer[4] := AllocPtr; 227 | buffer[5] := mod.addr; 228 | buffer[6] := 40000H; (*module limit*) 229 | (*store module descriptors*) 230 | WHILE root # NIL DO 231 | Copy(SYSTEM.ADR(root.desc), SYSTEM.ADR(buffer) + root.addr, DescSize DIV 4); 232 | root := root.next 233 | END 234 | END Link; 235 | 236 | PROCEDURE LinkDiskImage*(modname: ARRAY OF CHAR; corename: ARRAY OF CHAR); 237 | VAR buffer: Buffer; 238 | F: Files.File; R: Files.Rider; 239 | i: INTEGER; 240 | BEGIN 241 | Link(modname, buffer); 242 | IF res = 0 THEN 243 | F := Files.New(corename); Files.Set(R, F, 0); 244 | Files.WriteInt(R, 9B1EA38DH); FOR i := 4 TO 1023 DO Files.WriteByte(R, 0) END ; 245 | FOR i := 0 TO AllocPtr DIV 4 - 1 DO Files.WriteInt(R, buffer[i]) END ; 246 | Files.Register(F) 247 | END 248 | END LinkDiskImage; 249 | 250 | PROCEDURE LinkSerialImage*(modname: ARRAY OF CHAR; corename: ARRAY OF CHAR); 251 | VAR buffer: Buffer; 252 | F: Files.File; R: Files.Rider; 253 | i: INTEGER; 254 | BEGIN 255 | Link(modname, buffer); 256 | IF res = 0 THEN 257 | F := Files.New(corename); Files.Set(R, F, 0); 258 | Files.WriteInt(R, AllocPtr); Files.WriteInt(R, 0); 259 | FOR i := 0 TO AllocPtr DIV 4 - 1 DO Files.WriteInt(R, buffer[i]) END ; 260 | Files.WriteInt(R, 0); Files.Register(F) 261 | END 262 | END LinkSerialImage; 263 | 264 | PROCEDURE LinkCommand(linkProc: PROCEDURE(modname: ARRAY OF CHAR; corename: ARRAY OF CHAR)); 265 | VAR S: Texts.Scanner; 266 | modname, corename: ARRAY 32 OF CHAR; 267 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 268 | IF S.class = Texts.Name THEN modname := S.s; Texts.Scan(S); 269 | IF S.class = Texts.Name THEN corename := S.s; 270 | linkProc(modname, corename); 271 | Texts.WriteString(W, "Linking "); Texts.WriteString(W, corename); 272 | IF res = 0 THEN 273 | Texts.WriteInt(W, AllocPtr, 6) 274 | ELSE 275 | Texts.WriteString(W, " error "); Texts.WriteInt(W, res, 0) 276 | END ; 277 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 278 | END 279 | END 280 | END LinkCommand; 281 | 282 | PROCEDURE LinkDisk*; 283 | BEGIN LinkCommand(LinkDiskImage) 284 | END LinkDisk; 285 | 286 | PROCEDURE LinkSerial*; 287 | BEGIN LinkCommand(LinkSerialImage) 288 | END LinkSerial; 289 | 290 | BEGIN Texts.OpenWriter(W) 291 | END CoreLinker. 292 | -------------------------------------------------------------------------------- /Norebo/FileDir.Mod: -------------------------------------------------------------------------------- 1 | MODULE FileDir; 2 | IMPORT SYSTEM, Norebo; 3 | 4 | CONST FnLength* = 32; 5 | 6 | TYPE FileName* = ARRAY FnLength OF CHAR; 7 | EntryHandler* = PROCEDURE (name: FileName; unused: INTEGER; VAR continue: BOOLEAN); 8 | 9 | PROCEDURE Enumerate*(prefix: ARRAY OF CHAR; proc: EntryHandler); 10 | VAR name: FileName; 11 | continue: BOOLEAN; 12 | i: INTEGER; 13 | pfx, nmx: CHAR; 14 | BEGIN continue := TRUE; 15 | Norebo.SysReq(Norebo.filedirEnumerateBegin, 0, 0, 0); 16 | Norebo.SysReq(Norebo.filedirEnumerateNext, SYSTEM.ADR(name), 0, 0); 17 | WHILE continue & (Norebo.res = 0) DO 18 | i := 0; 19 | REPEAT pfx := prefix[i]; nmx := name[i]; INC(i) 20 | UNTIL (pfx # nmx) OR (pfx = 0X); 21 | IF pfx = 0X THEN proc(name, 0, continue) END; 22 | Norebo.SysReq(Norebo.filedirEnumerateNext, SYSTEM.ADR(name), 0, 0) 23 | END; 24 | Norebo.SysReq(Norebo.filedirEnumerateEnd, 0, 0, 0) 25 | END Enumerate; 26 | 27 | PROCEDURE Init*; 28 | END Init; 29 | 30 | END FileDir. 31 | -------------------------------------------------------------------------------- /Norebo/Files.Mod: -------------------------------------------------------------------------------- 1 | MODULE Files; (*derived from NW 11.1.86 / 22.9.93 / 25.5.95 / 25.12.95 / 15.8.2013*) 2 | IMPORT SYSTEM, Kernel, FileDir, Norebo; 3 | 4 | TYPE File* = POINTER TO FileDesc; 5 | 6 | Rider* = 7 | RECORD eof*: BOOLEAN; 8 | res*: INTEGER; 9 | file: File; 10 | pos: INTEGER; 11 | END ; 12 | 13 | FileDesc = 14 | RECORD handle, pos: INTEGER; 15 | registered: BOOLEAN; 16 | name: FileDir.FileName; 17 | END ; 18 | 19 | PROCEDURE Check(s: ARRAY OF CHAR; 20 | VAR name: FileDir.FileName; VAR res: INTEGER); 21 | VAR i: INTEGER; ch: CHAR; 22 | BEGIN ch := s[0]; i := 0; 23 | IF (ch >= "A") & (ch <= "Z") OR (ch >= "a") & (ch <= "z") THEN 24 | REPEAT name[i] := ch; INC(i); ch := s[i] 25 | UNTIL ~((ch >= "0") & (ch <= "9") OR (ch >= "A") & (ch <= "Z") 26 | OR (ch >= "a") & (ch <= "z") OR (ch = ".")) OR (i = FileDir.FnLength); 27 | IF i = FileDir.FnLength THEN res := 4 28 | ELSIF ch = 0X THEN res := 0; 29 | WHILE i < FileDir.FnLength DO name[i] := 0X; INC(i) END 30 | ELSE res := 5 31 | END 32 | ELSIF ch = 0X THEN name[0] := 0X; res := -1 33 | ELSE res := 3 34 | END 35 | END Check; 36 | 37 | PROCEDURE Old*(name: ARRAY OF CHAR): File; 38 | VAR res: INTEGER; 39 | f: File; 40 | namebuf: FileDir.FileName; 41 | BEGIN f := NIL; Check(name, namebuf, res); 42 | IF res = 0 THEN 43 | Norebo.SysReq(Norebo.filesOld, SYSTEM.ADR(namebuf), 0, 0); 44 | IF Norebo.res >= 0 THEN 45 | NEW(f); f.handle := Norebo.res; f.pos := 0; f.name := namebuf; f.registered := TRUE; 46 | END 47 | END 48 | RETURN f 49 | END Old; 50 | 51 | PROCEDURE New*(name: ARRAY OF CHAR): File; 52 | VAR res: INTEGER; 53 | f: File; 54 | namebuf: FileDir.FileName; 55 | BEGIN f := NIL; Check(name, namebuf, res); 56 | IF res <= 0 THEN 57 | Norebo.SysReq(Norebo.filesNew, SYSTEM.ADR(namebuf), 0, 0); 58 | IF Norebo.res >= 0 THEN 59 | NEW(f); f.handle := Norebo.res; f.pos := 0; f.name := namebuf; f.registered := FALSE 60 | END 61 | END 62 | RETURN f 63 | END New; 64 | 65 | PROCEDURE Register*(f: File); 66 | BEGIN 67 | IF (f # NIL) & (f.name[0] # 0X) & ~f.registered THEN 68 | Norebo.SysReq(Norebo.filesRegister, f.handle, 0, 0); 69 | f.registered := TRUE; f.pos := -1 70 | END 71 | END Register; 72 | 73 | PROCEDURE Close*(f: File); 74 | BEGIN 75 | IF f # NIL THEN Norebo.SysReq(Norebo.filesClose, f.handle, 0, 0) END 76 | END Close; 77 | 78 | PROCEDURE Purge*(f: File); 79 | BEGIN 80 | IF f # NIL THEN Norebo.SysReq(Norebo.filesPurge, f.handle, 0, 0) END 81 | END Purge; 82 | 83 | PROCEDURE Delete*(name: ARRAY OF CHAR; VAR res: INTEGER); 84 | VAR namebuf: FileDir.FileName; 85 | BEGIN Check(name, namebuf, res); 86 | IF res = 0 THEN 87 | Norebo.SysReq(Norebo.filesDelete, SYSTEM.ADR(namebuf), 0, 0); 88 | IF Norebo.res < 0 THEN res := 2 END 89 | END 90 | END Delete; 91 | 92 | PROCEDURE Rename*(old, new: ARRAY OF CHAR; VAR res: INTEGER); 93 | VAR oldbuf, newbuf: FileDir.FileName; 94 | BEGIN Check(old, oldbuf, res); 95 | IF res = 0 THEN 96 | Check(new, newbuf, res); 97 | IF res = 0 THEN 98 | Norebo.SysReq(Norebo.filesRename, SYSTEM.ADR(oldbuf), SYSTEM.ADR(newbuf), 0); 99 | IF Norebo.res < 0 THEN res := 2 END 100 | END 101 | END 102 | END Rename; 103 | 104 | PROCEDURE Length*(f: File): INTEGER; 105 | BEGIN Norebo.SysReq(Norebo.filesLength, f.handle, 0, 0) 106 | RETURN Norebo.res 107 | END Length; 108 | 109 | PROCEDURE Date*(f: File): INTEGER; 110 | BEGIN Norebo.SysReq(Norebo.filesDate, f.handle, 0, 0) 111 | RETURN Norebo.res 112 | END Date; 113 | 114 | (*---------------------------Read---------------------------*) 115 | 116 | PROCEDURE Set*(VAR r: Rider; f: File; pos: INTEGER); 117 | VAR a, b: INTEGER; 118 | BEGIN r.file := f; r.eof := FALSE; r.res := 0; 119 | IF pos >= 0 THEN r.pos := pos ELSE r.pos := 0 END 120 | END Set; 121 | 122 | PROCEDURE Pos*(VAR r: Rider): INTEGER; 123 | BEGIN RETURN r.pos 124 | END Pos; 125 | 126 | PROCEDURE Base*(VAR r: Rider): File; 127 | BEGIN RETURN r.file 128 | END Base; 129 | 130 | PROCEDURE ReadRaw(VAR r: Rider; adr, siz: INTEGER); 131 | BEGIN 132 | IF r.pos # r.file.pos THEN 133 | Norebo.SysReq(Norebo.filesSeek, r.file.handle, r.pos, 0); 134 | END; 135 | Norebo.SysReq(Norebo.filesRead, r.file.handle, adr, siz); 136 | INC(r.pos, Norebo.res); r.file.pos := r.pos; 137 | r.eof := Norebo.res < siz 138 | END ReadRaw; 139 | 140 | PROCEDURE ReadByte*(VAR r: Rider; VAR x: BYTE); 141 | BEGIN ReadRaw(r, SYSTEM.ADR(x), SYSTEM.SIZE(BYTE)) 142 | END ReadByte; 143 | 144 | PROCEDURE ReadBytes*(VAR r: Rider; VAR x: ARRAY OF BYTE; n: INTEGER); 145 | BEGIN ASSERT(n <= LEN(x)); ReadRaw(r, SYSTEM.ADR(x), n) 146 | END ReadBytes; 147 | 148 | PROCEDURE Read*(VAR r: Rider; VAR ch: CHAR); 149 | BEGIN ReadRaw(r, SYSTEM.ADR(ch), SYSTEM.SIZE(CHAR)) 150 | END Read; 151 | 152 | PROCEDURE ReadInt*(VAR r: Rider; VAR x: INTEGER); 153 | BEGIN ReadRaw(r, SYSTEM.ADR(x), SYSTEM.SIZE(INTEGER)) 154 | END ReadInt; 155 | 156 | PROCEDURE ReadSet*(VAR r: Rider; VAR s: SET); 157 | BEGIN ReadInt(r, SYSTEM.VAL(INTEGER, s)) 158 | END ReadSet; 159 | 160 | PROCEDURE ReadReal*(VAR r: Rider; VAR x: REAL); 161 | BEGIN ReadInt(r, SYSTEM.VAL(INTEGER, x)) 162 | END ReadReal; 163 | 164 | PROCEDURE ReadString*(VAR r: Rider; VAR x: ARRAY OF CHAR); 165 | VAR i: INTEGER; ch: CHAR; 166 | BEGIN i := 0; Read(r, ch); 167 | WHILE ch # 0X DO 168 | IF i < LEN(x)-1 THEN x[i] := ch; INC(i) END ; 169 | Read(r, ch) 170 | END ; 171 | x[i] := 0X 172 | END ReadString; 173 | 174 | PROCEDURE ReadNum*(VAR r: Rider; VAR x: INTEGER); 175 | VAR n, y: INTEGER; b: BYTE; 176 | BEGIN n := 32; y := 0; ReadByte(r, b); 177 | WHILE b >= 80H DO y := ROR(y + b-80H, 7); DEC(n, 7); ReadByte(r, b) END ; 178 | IF n <= 4 THEN x := ROR(y + b MOD 10H, 4) ELSE x := ASR(ROR(y + b, 7), n-7) END 179 | END ReadNum; 180 | 181 | (*---------------------------Write---------------------------*) 182 | 183 | PROCEDURE WriteRaw(VAR r: Rider; adr, siz: INTEGER); 184 | BEGIN 185 | IF r.pos # r.file.pos THEN 186 | Norebo.SysReq(Norebo.filesSeek, r.file.handle, r.pos, 0); 187 | END; 188 | Norebo.SysReq(Norebo.filesWrite, r.file.handle, adr, siz); 189 | INC(r.pos, Norebo.res); r.file.pos := r.pos; 190 | r.eof := Norebo.res < siz 191 | END WriteRaw; 192 | 193 | PROCEDURE WriteByte*(VAR r: Rider; x: BYTE); 194 | BEGIN WriteRaw(r, SYSTEM.ADR(x), SYSTEM.SIZE(BYTE)) 195 | END WriteByte; 196 | 197 | PROCEDURE WriteBytes*(VAR r: Rider; x: ARRAY OF BYTE; n: INTEGER); 198 | BEGIN ASSERT(n <= LEN(x)); WriteRaw(r, SYSTEM.ADR(x), n) 199 | END WriteBytes; 200 | 201 | PROCEDURE Write*(VAR r: Rider; ch: CHAR); 202 | BEGIN WriteRaw(r, SYSTEM.ADR(ch), SYSTEM.SIZE(CHAR)) 203 | END Write; 204 | 205 | PROCEDURE WriteInt*(VAR r: Rider; x: INTEGER); 206 | BEGIN WriteRaw(r, SYSTEM.ADR(x), SYSTEM.SIZE(INTEGER)) 207 | END WriteInt; 208 | 209 | PROCEDURE WriteSet*(VAR r: Rider; s: SET); 210 | BEGIN WriteInt(r, ORD(s)) 211 | END WriteSet; 212 | 213 | PROCEDURE WriteReal*(VAR r: Rider; x: REAL); 214 | BEGIN WriteInt(r, ORD(x)) 215 | END WriteReal; 216 | 217 | PROCEDURE WriteString*(VAR r: Rider; x: ARRAY OF CHAR); 218 | VAR i: INTEGER; ch: CHAR; 219 | BEGIN i := 0; 220 | REPEAT ch := x[i]; Write(r, ch); INC(i) UNTIL ch = 0X 221 | END WriteString; 222 | 223 | PROCEDURE WriteNum*(VAR r: Rider; x: INTEGER); 224 | BEGIN 225 | WHILE (x < -40H) OR (x >= 40H) DO WriteByte(r, x MOD 80H + 80H); x := ASR(x, 7) END ; 226 | WriteByte(r, x MOD 80H) 227 | END WriteNum; 228 | 229 | (*---------------------------System use---------------------------*) 230 | 231 | PROCEDURE Init*; 232 | BEGIN Kernel.Init; FileDir.Init 233 | END Init; 234 | 235 | PROCEDURE RestoreList*; (*after mark phase of garbage collection*) 236 | END RestoreList; 237 | 238 | END Files. 239 | -------------------------------------------------------------------------------- /Norebo/Kernel.Mod: -------------------------------------------------------------------------------- 1 | MODULE Kernel; (*derived from NW/PR 11.4.86 / 27.12.95 / 4.2.2014*) 2 | IMPORT SYSTEM, Norebo; 3 | CONST timer = -64; 4 | 5 | VAR allocated*: INTEGER; 6 | heapOrg*, heapLim*: INTEGER; 7 | stackOrg* , stackSize*, MemLim*: INTEGER; 8 | clock: INTEGER; 9 | list0, list1, list2, list3: INTEGER; (*lists of free blocks of size n*256, 128, 64, 32 bytes*) 10 | 11 | (* ---------- New: heap allocation ----------*) 12 | 13 | PROCEDURE GetBlock(VAR p: LONGINT; len: LONGINT); 14 | (*len is multiple of 256*) 15 | VAR q0, q1, q2, size: LONGINT; done: BOOLEAN; 16 | BEGIN q0 := 0; q1 := list0; done := FALSE; 17 | WHILE ~done & (q1 # 0) DO 18 | SYSTEM.GET(q1, size); SYSTEM.GET(q1+8, q2); 19 | IF size < len THEN (*no fit*) q0 := q1; q1 := q2 20 | ELSIF size = len THEN (*extract -> p*) 21 | done := TRUE; p := q1; 22 | IF q0 # 0 THEN SYSTEM.PUT(q0+8, q2) ELSE list0 := q2 END 23 | ELSE (*reduce size*) 24 | done := TRUE; p := q1; q1 := q1 + len; 25 | SYSTEM.PUT(q1, size-len); SYSTEM.PUT(q1+4, -1); SYSTEM.PUT(q1+8, q2); 26 | IF q0 # 0 THEN SYSTEM.PUT(q0+8, q1) ELSE list0 := q1 END 27 | END 28 | END ; 29 | IF ~done THEN p := 0 END 30 | END GetBlock; 31 | 32 | PROCEDURE GetBlock128(VAR p: LONGINT); 33 | VAR q: LONGINT; 34 | BEGIN 35 | IF list1 # 0 THEN p := list1; SYSTEM.GET(list1+8, list1) 36 | ELSE GetBlock(q, 256); SYSTEM.PUT(q+128, 128); SYSTEM.PUT(q+132, -1); SYSTEM.PUT(q+136, list1); 37 | list1 := q + 128; p := q 38 | END 39 | END GetBlock128; 40 | 41 | PROCEDURE GetBlock64(VAR p: LONGINT); 42 | VAR q: LONGINT; 43 | BEGIN 44 | IF list2 # 0 THEN p := list2; SYSTEM.GET(list2+8, list2) 45 | ELSE GetBlock128(q); SYSTEM.PUT(q+64, 64); SYSTEM.PUT(q+68, -1); SYSTEM.PUT(q+72, list2); 46 | list2 := q + 64; p := q 47 | END 48 | END GetBlock64; 49 | 50 | PROCEDURE GetBlock32(VAR p: LONGINT); 51 | VAR q: LONGINT; 52 | BEGIN 53 | IF list3 # 0 THEN p := list3; SYSTEM.GET(list3+8, list3) 54 | ELSE GetBlock64(q); SYSTEM.PUT(q+32, 32); SYSTEM.PUT(q+36, -1); SYSTEM.PUT(q+40, list3); 55 | list3 := q + 32; p := q 56 | END 57 | END GetBlock32; 58 | 59 | PROCEDURE New*(VAR ptr: LONGINT; tag: LONGINT); 60 | (*called by NEW via MT[0]; ptr and tag are pointers*) 61 | VAR p, size, lim: LONGINT; 62 | BEGIN SYSTEM.GET(tag, size); 63 | IF size = 32 THEN GetBlock32(p) 64 | ELSIF size = 64 THEN GetBlock64(p) 65 | ELSIF size = 128 THEN GetBlock128(p) 66 | ELSE GetBlock(p, (size+255) DIV 256 * 256) 67 | END ; 68 | IF p = 0 THEN ptr := 0 69 | ELSE ptr := p+8; SYSTEM.PUT(p, tag); lim := p + size; INC(p, 4); INC(allocated, size); 70 | WHILE p < lim DO SYSTEM.PUT(p, 0); INC(p, 4) END 71 | END 72 | END New; 73 | 74 | (* ---------- Garbage collector ----------*) 75 | 76 | PROCEDURE Mark*(pref: LONGINT); 77 | VAR pvadr, offadr, offset, tag, p, q, r: LONGINT; 78 | BEGIN SYSTEM.GET(pref, pvadr); (*pointers < heapOrg considered NIL*) 79 | WHILE pvadr # 0 DO 80 | SYSTEM.GET(pvadr, p); SYSTEM.GET(p-4, offadr); 81 | IF (p >= heapOrg) & (offadr = 0) THEN q := p; (*mark elements in data structure with root p*) 82 | REPEAT SYSTEM.GET(p-4, offadr); 83 | IF offadr = 0 THEN SYSTEM.GET(p-8, tag); offadr := tag + 16 ELSE INC(offadr, 4) END ; 84 | SYSTEM.PUT(p-4, offadr); SYSTEM.GET(offadr, offset); 85 | IF offset # -1 THEN (*down*) 86 | SYSTEM.GET(p+offset, r); SYSTEM.GET(r-4, offadr); 87 | IF (r >= heapOrg) & (offadr = 0) THEN SYSTEM.PUT(p+offset, q); q := p; p := r END 88 | ELSE (*up*) SYSTEM.GET(q-4, offadr); SYSTEM.GET(offadr, offset); 89 | IF p # q THEN SYSTEM.GET(q+offset, r); SYSTEM.PUT(q+offset, p); p := q; q := r END 90 | END 91 | UNTIL (p = q) & (offset = -1) 92 | END ; 93 | INC(pref, 4); SYSTEM.GET(pref, pvadr) 94 | END 95 | END Mark; 96 | 97 | PROCEDURE Scan*; 98 | VAR p, q, mark, tag, size: LONGINT; 99 | BEGIN p := heapOrg; 100 | REPEAT SYSTEM.GET(p+4, mark); q := p; 101 | WHILE mark = 0 DO 102 | SYSTEM.GET(p, tag); SYSTEM.GET(tag, size); INC(p, size); SYSTEM.GET(p+4, mark) 103 | END ; 104 | size := p - q; DEC(allocated, size); (*size of free block*) 105 | IF size > 0 THEN 106 | IF size MOD 64 # 0 THEN 107 | SYSTEM.PUT(q, 32); SYSTEM.PUT(q+4, -1); SYSTEM.PUT(q+8, list3); list3 := q; INC(q, 32); DEC(size, 32) 108 | END ; 109 | IF size MOD 128 # 0 THEN 110 | SYSTEM.PUT(q, 64); SYSTEM.PUT(q+4, -1); SYSTEM.PUT(q+8, list2); list2 := q; INC(q, 64); DEC(size, 64) 111 | END ; 112 | IF size MOD 256 # 0 THEN 113 | SYSTEM.PUT(q, 128); SYSTEM.PUT(q+4, -1); SYSTEM.PUT(q+8, list1); list1 := q; INC(q, 128); DEC(size, 128) 114 | END ; 115 | IF size > 0 THEN 116 | SYSTEM.PUT(q, size); SYSTEM.PUT(q+4, -1); SYSTEM.PUT(q+8, list0); list0 := q; INC(q, size) 117 | END 118 | END ; 119 | IF mark > 0 THEN SYSTEM.GET(p, tag); SYSTEM.GET(tag, size); SYSTEM.PUT(p+4, 0); INC(p, size) 120 | ELSE (*free*) SYSTEM.GET(p, size); INC(p, size) 121 | END 122 | UNTIL p >= heapLim 123 | END Scan; 124 | 125 | (*-------- Miscellaneous procedures----------*) 126 | 127 | PROCEDURE Time*(): INTEGER; 128 | VAR t: INTEGER; 129 | BEGIN SYSTEM.GET(timer, t); RETURN t 130 | END Time; 131 | 132 | PROCEDURE Clock*(): INTEGER; 133 | BEGIN RETURN clock 134 | END Clock; 135 | 136 | PROCEDURE SetClock*(dt: INTEGER); 137 | BEGIN clock := dt 138 | END SetClock; 139 | 140 | PROCEDURE Install*(Padr, at: INTEGER); 141 | BEGIN SYSTEM.PUT(at, 0E7000000H + (Padr - at) DIV 4 -1) 142 | END Install; 143 | 144 | PROCEDURE Trap(VAR a: INTEGER; b: INTEGER); 145 | VAR u, v, w: INTEGER; 146 | BEGIN u := SYSTEM.REG(15); SYSTEM.GET(u - 4, v); w := v DIV 10H MOD 10H; (*trap number*) 147 | IF w = 0 THEN New(a, b) 148 | ELSE Norebo.Trap(w, 0, 0) 149 | END 150 | END Trap; 151 | 152 | PROCEDURE Init*; 153 | BEGIN Install(SYSTEM.ADR(Trap), 20H); (*install temporary trap*) 154 | SYSTEM.GET(12, MemLim); SYSTEM.GET(24, heapOrg); 155 | stackOrg := heapOrg; stackSize := 8000H; heapLim := MemLim; 156 | list1 := 0; list2 := 0; list3 := 0; list0 := heapOrg; 157 | SYSTEM.PUT(list0, heapLim - heapOrg); SYSTEM.PUT(list0+4, -1); SYSTEM.PUT(list0+8, 0); 158 | allocated := 0; clock := 0; 159 | END Init; 160 | 161 | END Kernel. 162 | -------------------------------------------------------------------------------- /Norebo/Norebo.Mod: -------------------------------------------------------------------------------- 1 | MODULE Norebo; 2 | IMPORT SYSTEM; 3 | 4 | CONST sysreq = -4; sysarg1 = -8; sysarg2 = -12; sysarg3 = -16; 5 | noreboHalt* = 1; 6 | noreboArgc* = 2; 7 | noreboArgv* = 3; 8 | noreboTrap* = 4; 9 | filesNew* = 11; 10 | filesOld* = 12; 11 | filesRegister* = 13; 12 | filesClose* = 14; 13 | filesSeek* = 15; 14 | filesTell* = 16; 15 | filesRead* = 17; 16 | filesWrite* = 18; 17 | filesLength* = 19; 18 | filesDate* = 20; 19 | filesDelete* = 21; 20 | filesPurge* = 22; 21 | filesRename* = 23; 22 | filedirEnumerateBegin* = 31; 23 | filedirEnumerateNext* = 32; 24 | filedirEnumerateEnd* = 33; 25 | 26 | VAR res*: INTEGER; 27 | 28 | PROCEDURE SysReq*(req, arg1, arg2, arg3: INTEGER); 29 | BEGIN 30 | SYSTEM.PUT(sysarg1, arg1); 31 | SYSTEM.PUT(sysarg2, arg2); 32 | SYSTEM.PUT(sysarg3, arg3); 33 | SYSTEM.PUT(sysreq, req); 34 | SYSTEM.GET(sysreq, res) 35 | END SysReq; 36 | 37 | PROCEDURE Halt*(exitcode: INTEGER); 38 | BEGIN SysReq(noreboHalt, exitcode, 0, 0) 39 | END Halt; 40 | 41 | PROCEDURE Trap*(trap, modname, pos: INTEGER); 42 | BEGIN SysReq(noreboTrap, trap, modname, pos); 43 | END Trap; 44 | 45 | PROCEDURE ParamCount*(): INTEGER; 46 | BEGIN SysReq(noreboArgc, 0, 0, 0) 47 | RETURN res 48 | END ParamCount; 49 | 50 | PROCEDURE ParamStr*(n: INTEGER; VAR param: ARRAY OF CHAR); 51 | BEGIN SysReq(noreboArgv, n, SYSTEM.ADR(param), LEN(param)) 52 | END ParamStr; 53 | 54 | END Norebo. 55 | -------------------------------------------------------------------------------- /Norebo/Oberon.Mod: -------------------------------------------------------------------------------- 1 | MODULE Oberon; (*derived from JG 6.9.90 / 23.9.93 / 13.8.94 / NW 14.4.2013 / 22.12.2013*) 2 | IMPORT SYSTEM, Norebo, Kernel, Files, Modules, RS232, Texts; 3 | 4 | CONST (*message ids*) 5 | off = 0; idle = 1; active = 2; (*task states*) 6 | BasicCycle = 20; 7 | 8 | TYPE Task* = POINTER TO TaskDesc; 9 | 10 | Handler* = PROCEDURE; 11 | 12 | TaskDesc* = RECORD 13 | state, nextTime, period*: INTEGER; 14 | next: Task; 15 | handle: Handler 16 | END; 17 | 18 | VAR User*: ARRAY 8 OF CHAR; Password*: LONGINT; 19 | Log*: Texts.Text; 20 | 21 | Par*: RECORD 22 | text*: Texts.Text; 23 | pos*: LONGINT 24 | END; 25 | 26 | NofTasks*: INTEGER; 27 | CurTask: Task; 28 | ActCnt: INTEGER; (*action count for GC*) 29 | Mod: Modules.Module; 30 | 31 | (*user identification*) 32 | 33 | PROCEDURE Code(VAR s: ARRAY OF CHAR): LONGINT; 34 | VAR i: INTEGER; a, b, c: LONGINT; 35 | BEGIN 36 | a := 0; b := 0; i := 0; 37 | WHILE s[i] # 0X DO 38 | c := b; b := a; a := (c MOD 509 + 1) * 127 + ORD(s[i]); 39 | INC(i) 40 | END; 41 | IF b >= 32768 THEN b := b - 65536 END; 42 | RETURN b * 65536 + a 43 | END Code; 44 | 45 | PROCEDURE SetUser* (VAR user, password: ARRAY OF CHAR); 46 | BEGIN User := user; Password := Code(password) 47 | END SetUser; 48 | 49 | PROCEDURE Clock*(): LONGINT; 50 | BEGIN RETURN Kernel.Clock() 51 | END Clock; 52 | 53 | PROCEDURE SetClock* (d: LONGINT); 54 | BEGIN Kernel.SetClock(d) 55 | END SetClock; 56 | 57 | PROCEDURE Time*(): LONGINT; 58 | BEGIN RETURN Kernel.Time() 59 | END Time; 60 | 61 | (*log management*) 62 | 63 | PROCEDURE OutputLog(T: Texts.Text; op: INTEGER; beg, end: LONGINT); 64 | VAR R: Texts.Reader; 65 | B: Texts.Buffer; 66 | ch: CHAR; 67 | BEGIN 68 | IF op = Texts.insert THEN 69 | Texts.OpenReader(R, T, beg); 70 | WHILE beg # end DO 71 | Texts.Read(R, ch); 72 | IF ch = 0DX THEN ch := 0AX END; 73 | RS232.Send(ORD(ch)); 74 | INC(beg) 75 | END; 76 | NEW(B); Texts.OpenBuf(B); Texts.Delete(T, beg, end, B) 77 | END 78 | END OutputLog; 79 | 80 | PROCEDURE OpenLog*; 81 | BEGIN NEW(Log); Log.notify := OutputLog; Texts.Open(Log, "") 82 | END OpenLog; 83 | 84 | (*command interpretation*) 85 | 86 | PROCEDURE SetPar*(T: Texts.Text; pos: LONGINT); 87 | BEGIN Par.text := T; Par.pos := pos 88 | END SetPar; 89 | 90 | PROCEDURE Call* (name: ARRAY OF CHAR; VAR res: INTEGER); 91 | VAR mod: Modules.Module; P: Modules.Command; 92 | i, j: INTEGER; ch: CHAR; 93 | Mname, Cname: ARRAY 32 OF CHAR; 94 | BEGIN i := 0; ch := name[0]; 95 | WHILE (ch # ".") & (ch # 0X) DO Mname[i] := ch; INC(i); ch := name[i] END ; 96 | IF ch = "." THEN 97 | Mname[i] := 0X; INC(i); 98 | Modules.Load(Mname, mod); res := Modules.res; 99 | IF Modules.res = 0 THEN 100 | j := 0; ch := name[i]; INC(i); 101 | WHILE ch # 0X DO Cname[j] := ch; INC(j); ch := name[i]; INC(i) END ; 102 | Cname[j] := 0X; 103 | P := Modules.ThisCommand(mod, Cname); res := Modules.res; 104 | IF Modules.res = 0 THEN P END 105 | END 106 | ELSE res := 5 107 | END 108 | END Call; 109 | 110 | PROCEDURE GetSelection* (VAR text: Texts.Text; VAR beg, end, time: LONGINT); 111 | BEGIN time := -1 112 | END GetSelection; 113 | 114 | PROCEDURE GC; 115 | VAR mod: Modules.Module; 116 | BEGIN 117 | IF (ActCnt = 0) OR (Kernel.allocated >= Kernel.heapLim - Kernel.heapOrg - 10000H) THEN 118 | mod := Modules.root; LED(21H); 119 | WHILE mod # NIL DO 120 | IF mod.name[0] # 0X THEN Kernel.Mark(mod.ptr) END ; 121 | mod := mod.next 122 | END ; 123 | LED(23H); 124 | Files.RestoreList; LED(27H); 125 | Kernel.Scan; LED(20H); 126 | ActCnt := BasicCycle 127 | END 128 | END GC; 129 | 130 | PROCEDURE NewTask*(h: Handler; period: INTEGER): Task; 131 | VAR t: Task; 132 | BEGIN NEW(t); t.state := off; t.next := t; t.handle := h; t.period := period; RETURN t 133 | END NewTask; 134 | 135 | PROCEDURE Install* (T: Task); 136 | BEGIN 137 | IF T.state = off THEN 138 | T.next := CurTask.next; CurTask.next := T; T.state := idle; T.nextTime := 0; INC(NofTasks) 139 | END 140 | END Install; 141 | 142 | PROCEDURE Remove* (T: Task); 143 | VAR t: Task; 144 | BEGIN 145 | IF T.state # off THEN t := T; 146 | WHILE t.next # T DO t := t.next END ; 147 | t.next := T.next; T.state := off; T.next := NIL; CurTask := t; DEC(NofTasks) 148 | END 149 | END Remove; 150 | 151 | PROCEDURE Collect* (count: INTEGER); 152 | BEGIN ActCnt := count 153 | END Collect; 154 | 155 | PROCEDURE Loop*; 156 | VAR t: INTEGER; 157 | BEGIN 158 | REPEAT 159 | CurTask := CurTask.next; t := Kernel.Time(); 160 | IF t >= CurTask.nextTime THEN 161 | CurTask.nextTime := t + CurTask.period; CurTask.state := active; CurTask.handle; CurTask.state := idle 162 | END 163 | UNTIL FALSE 164 | END Loop; 165 | 166 | PROCEDURE Reset*; 167 | BEGIN 168 | IF CurTask.state = active THEN Remove(CurTask) END ; 169 | SYSTEM.LDREG(14, Kernel.stackOrg); (*reset stack pointer*) Loop 170 | END Reset; 171 | 172 | PROCEDURE Ignore(T: Texts.Text; op: INTEGER; beg, end: LONGINT); 173 | END Ignore; 174 | 175 | PROCEDURE ParamCall*; 176 | VAR p: ARRAY 100 OF CHAR; 177 | W: Texts.Writer; 178 | i, c, res: INTEGER; 179 | BEGIN Texts.OpenWriter(W); c := Norebo.ParamCount(); 180 | FOR i := 1 TO c-1 DO 181 | Norebo.ParamStr(i, p); 182 | IF i # 1 THEN Texts.Write(W, " ") END; 183 | Texts.WriteString(W, p); 184 | END; 185 | NEW(Par.text); Texts.Open(Par.text, ""); Par.text.notify := Ignore; 186 | Texts.Append(Par.text, W.buf); Par.pos := 0; 187 | Norebo.ParamStr(0, p); Call(p, res); Norebo.Halt(res) 188 | END ParamCall; 189 | 190 | PROCEDURE Trap(VAR a: INTEGER; b: INTEGER); 191 | VAR u, v, w, pos, name: INTEGER; mod: Modules.Module; 192 | BEGIN u := SYSTEM.REG(15); SYSTEM.GET(u - 4, v); w := v DIV 10H MOD 10H; (*trap number*) 193 | IF w = 0 THEN Kernel.New(a, b) 194 | ELSE (*trap*) pos := v DIV 100H MOD 10000H; mod := Modules.root; 195 | WHILE (mod # NIL) & ((u < mod.code) OR (u >= mod.imp)) DO mod := mod.next END ; 196 | IF mod # NIL THEN name := SYSTEM.ADR(mod.name) ELSE name := 0 END ; 197 | Norebo.Trap(w, name, pos) 198 | END 199 | END Trap; 200 | 201 | BEGIN 202 | Kernel.Install(SYSTEM.ADR(Trap), 20H); 203 | User[0] := 0X; ActCnt := 0; CurTask := NewTask(GC, 1000); Install(CurTask); 204 | OpenLog; ParamCall; 205 | END Oberon. 206 | -------------------------------------------------------------------------------- /Norebo/VDisk.Mod: -------------------------------------------------------------------------------- 1 | MODULE VDisk; (*derived from Kernel.Mod NW/PR 11.4.86 / 27.12.95 / 4.2.2014*) 2 | IMPORT SYSTEM, Files, Texts, Oberon; 3 | 4 | (* Note: On a standard PO2013 system, the maximum file size is not 5 | much more than three megabyte. This module is not very useful in 6 | such an environment. *) 7 | 8 | CONST SectorLength* = 1024; 9 | mapsize = 10000H; (*1K sectors, 64MB*) 10 | 11 | TYPE Sector* = ARRAY SectorLength OF BYTE; 12 | VDisk* = POINTER TO VDiskDesc; 13 | VDiskDesc* = RECORD 14 | file*: Files.File; 15 | NofSectors*: INTEGER; 16 | sectorMap: ARRAY mapsize DIV 32 OF SET; 17 | END; 18 | 19 | VAR W: Texts.Writer; 20 | 21 | PROCEDURE nl; BEGIN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) END nl; 22 | 23 | PROCEDURE InitSecMap*(V: VDisk); 24 | VAR i: INTEGER; 25 | BEGIN V.NofSectors := 0; V.sectorMap[0] := {0 .. 31}; V.sectorMap[1] := {0 .. 31}; 26 | FOR i := 2 TO mapsize DIV 32 - 1 DO V.sectorMap[i] := {} END 27 | END InitSecMap; 28 | 29 | PROCEDURE MarkSector*(V: VDisk; sec: INTEGER); 30 | BEGIN sec := sec DIV 29; ASSERT(SYSTEM.H(0) = 0); 31 | INCL(V.sectorMap[sec DIV 32], sec MOD 32); INC(V.NofSectors) 32 | END MarkSector; 33 | 34 | PROCEDURE FreeSector*(V: VDisk; sec: INTEGER); 35 | BEGIN sec := sec DIV 29; ASSERT(SYSTEM.H(0) = 0); 36 | EXCL(V.sectorMap[sec DIV 32], sec MOD 32); DEC(V.NofSectors) 37 | END FreeSector; 38 | 39 | PROCEDURE AllocSector*(V: VDisk; hint: INTEGER; VAR sec: INTEGER); 40 | VAR s: INTEGER; 41 | BEGIN (*find free sector, starting after hint*) 42 | hint := hint DIV 29; ASSERT(SYSTEM.H(0) = 0); s := hint; 43 | REPEAT INC(s); 44 | IF s = mapsize THEN s := 1 END ; 45 | UNTIL ~(s MOD 32 IN V.sectorMap[s DIV 32]); 46 | INCL(V.sectorMap[s DIV 32], s MOD 32); INC(V.NofSectors); sec := s * 29 47 | END AllocSector; 48 | 49 | PROCEDURE GetSector*(V: VDisk; src: INTEGER; VAR dst: Sector); 50 | VAR R: Files.Rider; 51 | i: INTEGER; 52 | BEGIN src := src DIV 29; ASSERT(SYSTEM.H(0) = 0); 53 | src := (src - 1) * SectorLength; 54 | IF src < Files.Length(V.file) THEN 55 | Files.Set(R, V.file, src); 56 | Files.ReadBytes(R, dst, SectorLength) 57 | ELSE 58 | FOR i := 0 TO SectorLength-1 DO dst[i] := 0 END 59 | END 60 | END GetSector; 61 | 62 | PROCEDURE PutSector*(V: VDisk; dst: INTEGER; VAR src: Sector); 63 | VAR R: Files.Rider; 64 | i: INTEGER; 65 | BEGIN dst := dst DIV 29; ASSERT(SYSTEM.H(0) = 0); 66 | dst := (dst - 1) * SectorLength; 67 | Files.Set(R, V.file, dst); 68 | i := Files.Pos(R); 69 | WHILE i < dst DO Files.WriteByte(R, 0); INC(i); END; 70 | Files.WriteBytes(R, src, SectorLength) 71 | END PutSector; 72 | 73 | (* TODO: ugh, needs initialization from VFileDir *) 74 | PROCEDURE Open*(VAR V: VDisk; F: Files.File); 75 | BEGIN NEW(V); V.file := F; 76 | InitSecMap(V) 77 | END Open; 78 | 79 | BEGIN Texts.OpenWriter(W) 80 | END VDisk. 81 | -------------------------------------------------------------------------------- /Norebo/VDiskUtil.Mod: -------------------------------------------------------------------------------- 1 | MODULE VDiskUtil; 2 | IMPORT Files, VDisk, VFileDir, VFiles, Texts, Oberon; 3 | 4 | VAR W: Texts.Writer; 5 | 6 | PROCEDURE EndLine; 7 | BEGIN Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 8 | END EndLine; 9 | 10 | PROCEDURE OldVDisk*(name: ARRAY OF CHAR): VDisk.VDisk; 11 | VAR V: VDisk.VDisk; 12 | f: Files.File; 13 | BEGIN V := NIL; f := Files.Old(name); 14 | IF f # NIL THEN 15 | VDisk.Open(V, f); 16 | VFileDir.Init(V) 17 | END ; 18 | RETURN V 19 | END OldVDisk; 20 | 21 | PROCEDURE InstallFile*(v: VDisk.VDisk; srcname, dstname: ARRAY OF CHAR); 22 | VAR f: Files.File; 23 | g: VFiles.File; 24 | Rf: Files.Rider; 25 | Rg: VFiles.Rider; 26 | b: BYTE; 27 | BEGIN 28 | Texts.WriteString(W, " copying "); Texts.WriteString(W, srcname); 29 | Texts.WriteString(W, " => "); Texts.WriteString(W, dstname); 30 | Texts.Append(Oberon.Log, W.buf); 31 | f := Files.Old(srcname); 32 | IF f # NIL THEN g := VFiles.New(v, dstname); 33 | Files.Set(Rf, f, 0); VFiles.Set(Rg, g, 0); Files.ReadByte(Rf, b); 34 | WHILE ~Rf.eof DO VFiles.WriteByte(Rg, b); Files.ReadByte(Rf, b) END; 35 | Files.Close(f); VFiles.Register(g); VFiles.Close(g) 36 | ELSE Texts.WriteString(W, " failed") 37 | END; 38 | EndLine 39 | END InstallFile; 40 | 41 | PROCEDURE InstallFiles*; 42 | VAR S: Texts.Scanner; 43 | name: ARRAY 32 OF CHAR; 44 | V: VDisk.VDisk; 45 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 46 | IF S.class = Texts.Name THEN 47 | V := OldVDisk(S.s); 48 | IF V # NIL THEN Texts.Scan(S); 49 | WHILE S.class = Texts.Name DO 50 | name := S.s; Texts.Scan(S); 51 | IF (S.class = Texts.Char) & (S.c = "=") THEN Texts.Scan(S); 52 | IF (S.class = Texts.Char) & (S.c = ">") THEN Texts.Scan(S); 53 | IF S.class = Texts.Name THEN 54 | InstallFile(V, name, S.s); Texts.Scan(S) 55 | END 56 | END 57 | END 58 | END 59 | END 60 | END 61 | END InstallFiles; 62 | 63 | BEGIN Texts.OpenWriter(W) 64 | END VDiskUtil. 65 | -------------------------------------------------------------------------------- /Norebo/VFileDir.Mod: -------------------------------------------------------------------------------- 1 | MODULE VFileDir; (*derived from NW 12.1.86 / 23.8.90 / 15.8.2013*) 2 | IMPORT SYSTEM, VDisk; 3 | 4 | (*File Directory is a B-tree with its root page at DirRootAdr. 5 | Each entry contains a file name and the disk address of the file's head sector*) 6 | 7 | CONST FnLength* = 32; 8 | SecTabSize* = 64; 9 | ExTabSize* = 12; 10 | SectorSize* = 1024; 11 | IndexSize* = SectorSize DIV 4; 12 | HeaderSize* = 352; 13 | DirRootAdr* = 29; 14 | DirPgSize* = 24; 15 | N = DirPgSize DIV 2; 16 | DirMark* = 9B1EA38DH; 17 | HeaderMark* = 9BA71D86H; 18 | FillerSize = 52; 19 | 20 | TYPE DiskAdr = INTEGER; 21 | FileName* = ARRAY FnLength OF CHAR; 22 | SectorTable* = ARRAY SecTabSize OF DiskAdr; 23 | ExtensionTable* = ARRAY ExTabSize OF DiskAdr; 24 | EntryHandler* = PROCEDURE (name: FileName; sec: DiskAdr; VAR continue: BOOLEAN); 25 | 26 | FileHeader* = 27 | RECORD (*first page of each file on disk*) 28 | mark*: INTEGER; 29 | name*: FileName; 30 | aleng*, bleng*, date*: INTEGER; 31 | ext*: ExtensionTable; 32 | sec*: SectorTable; 33 | fill: ARRAY SectorSize - HeaderSize OF BYTE; 34 | END ; 35 | 36 | FileHd* = POINTER TO FileHeader; 37 | IndexSector* = ARRAY IndexSize OF DiskAdr; 38 | DataSector* = ARRAY SectorSize OF BYTE; 39 | 40 | DirEntry* = (*B-tree node*) 41 | RECORD 42 | name*: FileName; 43 | adr*: DiskAdr; (*sec no of file header*) 44 | p*: DiskAdr (*sec no of descendant in directory*) 45 | END ; 46 | 47 | DirPage* = 48 | RECORD mark*: INTEGER; 49 | m*: INTEGER; 50 | p0*: DiskAdr; (*sec no of left descendant in directory*) 51 | fill: ARRAY FillerSize OF BYTE; 52 | e*: ARRAY DirPgSize OF DirEntry 53 | END ; 54 | 55 | (*Exported procedures: Search, Insert, Delete, Enumerate, Init*) 56 | 57 | PROCEDURE Search*(V: VDisk.VDisk; name: FileName; VAR A: DiskAdr); 58 | VAR i, L, R: INTEGER; dadr: DiskAdr; 59 | a: DirPage; 60 | BEGIN dadr := DirRootAdr; A := 0; 61 | REPEAT VDisk.GetSector(V, dadr, a); ASSERT(a.mark = DirMark); 62 | L := 0; R := a.m; (*binary search*) 63 | WHILE L < R DO 64 | i := (L+R) DIV 2; 65 | IF name <= a.e[i].name THEN R := i ELSE L := i+1 END 66 | END ; 67 | IF (R < a.m) & (name = a.e[R].name) THEN A := a.e[R].adr (*found*) 68 | ELSIF R = 0 THEN dadr := a.p0 69 | ELSE dadr := a.e[R-1].p 70 | END ; 71 | UNTIL (dadr = 0) OR (A # 0) 72 | END Search; 73 | 74 | PROCEDURE insert(V: VDisk.VDisk; 75 | name: FileName; 76 | dpg0: DiskAdr; 77 | VAR h: BOOLEAN; 78 | VAR v: DirEntry; 79 | fad: DiskAdr); 80 | (*h = "tree has become higher and v is ascending element"*) 81 | VAR ch: CHAR; 82 | i, j, L, R: INTEGER; 83 | dpg1: DiskAdr; 84 | u: DirEntry; 85 | a: DirPage; 86 | 87 | BEGIN (*~h*) VDisk.GetSector(V, dpg0, a); ASSERT(a.mark = DirMark); 88 | L := 0; R := a.m; (*binary search*) 89 | WHILE L < R DO 90 | i := (L+R) DIV 2; 91 | IF name <= a.e[i].name THEN R := i ELSE L := i+1 END 92 | END ; 93 | IF (R < a.m) & (name = a.e[R].name) THEN 94 | a.e[R].adr := fad; VDisk.PutSector(V, dpg0, a) (*replace*) 95 | ELSE (*not on this page*) 96 | IF R = 0 THEN dpg1 := a.p0 ELSE dpg1 := a.e[R-1].p END ; 97 | IF dpg1 = 0 THEN (*not in tree, insert*) 98 | u.adr := fad; u.p := 0; h := TRUE; j := 0; 99 | REPEAT ch := name[j]; u.name[j] := ch; INC(j) 100 | UNTIL ch = 0X; 101 | WHILE j < FnLength DO u.name[j] := 0X; INC(j) END ; 102 | ELSE 103 | insert(V, name, dpg1, h, u, fad) 104 | END ; 105 | IF h THEN (*insert u to the left of e[R]*) 106 | IF a.m < DirPgSize THEN 107 | h := FALSE; i := a.m; 108 | WHILE i > R DO DEC(i); a.e[i+1] := a.e[i] END ; 109 | a.e[R] := u; INC(a.m) 110 | ELSE (*split page and assign the middle element to v*) 111 | a.m := N; a.mark := DirMark; 112 | IF R < N THEN (*insert in left half*) 113 | v := a.e[N-1]; i := N-1; 114 | WHILE i > R DO DEC(i); a.e[i+1] := a.e[i] END ; 115 | a.e[R] := u; VDisk.PutSector(V, dpg0, a); 116 | VDisk.AllocSector(V, dpg0, dpg0); i := 0; 117 | WHILE i < N DO a.e[i] := a.e[i+N]; INC(i) END 118 | ELSE (*insert in right half*) 119 | VDisk.PutSector(V, dpg0, a); 120 | VDisk.AllocSector(V, dpg0, dpg0); DEC(R, N); i := 0; 121 | IF R = 0 THEN v := u 122 | ELSE v := a.e[N]; 123 | WHILE i < R-1 DO a.e[i] := a.e[N+1+i]; INC(i) END ; 124 | a.e[i] := u; INC(i) 125 | END ; 126 | WHILE i < N DO a.e[i] := a.e[N+i]; INC(i) END 127 | END ; 128 | a.p0 := v.p; v.p := dpg0 129 | END ; 130 | VDisk.PutSector(V, dpg0, a) 131 | END 132 | END 133 | END insert; 134 | 135 | PROCEDURE Insert*(V: VDisk.VDisk; name: FileName; fad: DiskAdr); 136 | VAR oldroot: DiskAdr; 137 | h: BOOLEAN; U: DirEntry; 138 | a: DirPage; 139 | BEGIN h := FALSE; 140 | insert(V, name, DirRootAdr, h, U, fad); 141 | IF h THEN (*root overflow*) 142 | VDisk.GetSector(V, DirRootAdr, a); ASSERT(a.mark = DirMark); 143 | VDisk.AllocSector(V, DirRootAdr, oldroot); VDisk.PutSector(V, oldroot, a); 144 | a.mark := DirMark; a.m := 1; a.p0 := oldroot; a.e[0] := U; 145 | VDisk.PutSector(V, DirRootAdr, a) 146 | END 147 | END Insert; 148 | 149 | 150 | PROCEDURE underflow(V: VDisk.VDisk; 151 | VAR c: DirPage; (*ancestor page*) 152 | dpg0: DiskAdr; 153 | s: INTEGER; (*insertion point in c*) 154 | VAR h: BOOLEAN); (*c undersize*) 155 | VAR i, k: INTEGER; 156 | dpg1: DiskAdr; 157 | a, b: DirPage; (*a := underflowing page, b := neighbouring page*) 158 | BEGIN VDisk.GetSector(V, dpg0, a); ASSERT(a.mark = DirMark); 159 | (*h & a.m = N-1 & dpg0 = c.e[s-1].p*) 160 | IF s < c.m THEN (*b := page to the right of a*) 161 | dpg1 := c.e[s].p; VDisk.GetSector(V, dpg1, b); ASSERT(b.mark = DirMark); 162 | k := (b.m-N+1) DIV 2; (*k = no. of items available on page b*) 163 | a.e[N-1] := c.e[s]; a.e[N-1].p := b.p0; 164 | IF k > 0 THEN 165 | (*move k-1 items from b to a, one to c*) i := 0; 166 | WHILE i < k-1 DO a.e[i+N] := b.e[i]; INC(i) END ; 167 | c.e[s] := b.e[i]; b.p0 := c.e[s].p; 168 | c.e[s].p := dpg1; b.m := b.m - k; i := 0; 169 | WHILE i < b.m DO b.e[i] := b.e[i+k]; INC(i) END ; 170 | VDisk.PutSector(V, dpg1, b); a.m := N-1+k; h := FALSE 171 | ELSE (*merge pages a and b, discard b*) i := 0; 172 | WHILE i < N DO a.e[i+N] := b.e[i]; INC(i) END ; 173 | i := s; DEC(c.m); 174 | WHILE i < c.m DO c.e[i] := c.e[i+1]; INC(i) END ; 175 | a.m := 2*N; h := c.m < N 176 | END ; 177 | VDisk.PutSector(V, dpg0, a) 178 | ELSE (*b := page to the left of a*) DEC(s); 179 | IF s = 0 THEN dpg1 := c.p0 ELSE dpg1 := c.e[s-1].p END ; 180 | VDisk.GetSector(V, dpg1, b); ASSERT(b.mark = DirMark); 181 | k := (b.m-N+1) DIV 2; (*k = no. of items available on page b*) 182 | IF k > 0 THEN 183 | i := N-1; 184 | WHILE i > 0 DO DEC(i); a.e[i+k] := a.e[i] END ; 185 | i := k-1; a.e[i] := c.e[s]; a.e[i].p := a.p0; 186 | (*move k-1 items from b to a, one to c*) b.m := b.m - k; 187 | WHILE i > 0 DO DEC(i); a.e[i] := b.e[i+b.m+1] END ; 188 | c.e[s] := b.e[b.m]; a.p0 := c.e[s].p; 189 | c.e[s].p := dpg0; a.m := N-1+k; h := FALSE; 190 | VDisk.PutSector(V, dpg0, a) 191 | ELSE (*merge pages a and b, discard a*) 192 | c.e[s].p := a.p0; b.e[N] := c.e[s]; i := 0; 193 | WHILE i < N-1 DO b.e[i+N+1] := a.e[i]; INC(i) END ; 194 | b.m := 2*N; DEC(c.m); h := c.m < N 195 | END ; 196 | VDisk.PutSector(V, dpg1, b) 197 | END 198 | END underflow; 199 | 200 | PROCEDURE delete(V: VDisk.VDisk; 201 | name: FileName; 202 | dpg0: DiskAdr; 203 | VAR h: BOOLEAN; 204 | VAR fad: DiskAdr); 205 | (*search and delete entry with key name; if a page underflow arises, 206 | balance with adjacent page or merge; h := "page dpg0 is undersize"*) 207 | 208 | VAR i, L, R: INTEGER; 209 | dpg1: DiskAdr; 210 | a: DirPage; 211 | 212 | PROCEDURE del(V: VDisk.VDisk; VAR a: DirPage; R: INTEGER; dpg1: DiskAdr; VAR h: BOOLEAN); 213 | VAR dpg2: DiskAdr; (*global: a, R*) 214 | b: DirPage; 215 | BEGIN VDisk.GetSector(V, dpg1, b); ASSERT(b.mark = DirMark); dpg2 := b.e[b.m-1].p; 216 | IF dpg2 # 0 THEN del(V, a, R, dpg2, h); 217 | IF h THEN underflow(V, b, dpg2, b.m, h); VDisk.PutSector(V, dpg1, b) END 218 | ELSE 219 | b.e[b.m-1].p := a.e[R].p; a.e[R] := b.e[b.m-1]; 220 | DEC(b.m); h := b.m < N; VDisk.PutSector(V, dpg1, b) 221 | END 222 | END del; 223 | 224 | BEGIN (*~h*) VDisk.GetSector(V, dpg0, a); ASSERT(a.mark = DirMark); 225 | L := 0; R := a.m; (*binary search*) 226 | WHILE L < R DO 227 | i := (L+R) DIV 2; 228 | IF name <= a.e[i].name THEN R := i ELSE L := i+1 END 229 | END ; 230 | IF R = 0 THEN dpg1 := a.p0 ELSE dpg1 := a.e[R-1].p END ; 231 | IF (R < a.m) & (name = a.e[R].name) THEN 232 | (*found, now delete*) fad := a.e[R].adr; 233 | IF dpg1 = 0 THEN (*a is a leaf page*) 234 | DEC(a.m); h := a.m < N; i := R; 235 | WHILE i < a.m DO a.e[i] := a.e[i+1]; INC(i) END 236 | ELSE del(V, a, R, dpg1, h); 237 | IF h THEN underflow(V, a, dpg1, R, h) END 238 | END ; 239 | VDisk.PutSector(V, dpg0, a) 240 | ELSIF dpg1 # 0 THEN 241 | delete(V, name, dpg1, h, fad); 242 | IF h THEN underflow(V, a, dpg1, R, h); VDisk.PutSector(V, dpg0, a) END 243 | ELSE (*not in tree*) fad := 0 244 | END 245 | END delete; 246 | 247 | PROCEDURE Delete*(V: VDisk.VDisk; name: FileName; VAR fad: DiskAdr); 248 | VAR h: BOOLEAN; newroot: DiskAdr; 249 | a: DirPage; 250 | BEGIN h := FALSE; 251 | delete(V, name, DirRootAdr, h, fad); 252 | IF h THEN (*root underflow*) 253 | VDisk.GetSector(V, DirRootAdr, a); ASSERT(a.mark = DirMark); 254 | IF (a.m = 0) & (a.p0 # 0) THEN 255 | newroot := a.p0; VDisk.GetSector(V, newroot, a); ASSERT(a.mark = DirMark); 256 | VDisk.PutSector(V, DirRootAdr, a) (*discard newroot*) 257 | END 258 | END 259 | END Delete; 260 | 261 | PROCEDURE enumerate(V: VDisk.VDisk; 262 | prefix: ARRAY OF CHAR; 263 | dpg: DiskAdr; 264 | proc: EntryHandler; 265 | VAR continue: BOOLEAN); 266 | VAR i, j: INTEGER; pfx, nmx: CHAR; 267 | dpg1: DiskAdr; a: DirPage; 268 | BEGIN VDisk.GetSector(V, dpg, a); ASSERT(a.mark = DirMark); i := 0; 269 | WHILE (i < a.m) & continue DO 270 | j := 0; 271 | REPEAT pfx := prefix[j]; nmx := a.e[i].name[j]; INC(j) 272 | UNTIL (nmx # pfx) OR (pfx = 0X); 273 | IF nmx >= pfx THEN 274 | IF i = 0 THEN dpg1 := a.p0 ELSE dpg1 := a.e[i-1].p END ; 275 | IF dpg1 # 0 THEN enumerate(V, prefix, dpg1, proc, continue) END ; 276 | IF pfx = 0X THEN 277 | IF continue THEN proc(a.e[i].name, a.e[i].adr, continue) END 278 | ELSE continue := FALSE 279 | END 280 | END ; 281 | INC(i) 282 | END ; 283 | IF continue & (i > 0) & (a.e[i-1].p # 0) THEN 284 | enumerate(V, prefix, a.e[i-1].p, proc, continue) 285 | END 286 | END enumerate; 287 | 288 | PROCEDURE Enumerate*(V: VDisk.VDisk; prefix: ARRAY OF CHAR; proc: EntryHandler); 289 | VAR b: BOOLEAN; 290 | BEGIN b := TRUE; enumerate(V, prefix, DirRootAdr, proc, b) 291 | END Enumerate; 292 | 293 | (* ----- initialization ----- *) 294 | 295 | PROCEDURE Init*(V: VDisk.VDisk); 296 | VAR k: INTEGER; 297 | A: ARRAY 2000 OF DiskAdr; 298 | 299 | PROCEDURE MarkSectors(V: VDisk.VDisk; VAR A: ARRAY OF DiskAdr; k: INTEGER); 300 | VAR L, R, i, j, n: INTEGER; x: DiskAdr; 301 | hd: FileHeader; 302 | B: IndexSector; 303 | 304 | PROCEDURE sift(VAR A: ARRAY OF DiskAdr; L, R: INTEGER); 305 | VAR i, j: INTEGER; x: DiskAdr; 306 | BEGIN j := L; x := A[j]; 307 | REPEAT i := j; j := 2*j + 1; 308 | IF (j+1 < R) & (A[j] < A[j+1]) THEN INC(j) END ; 309 | IF (j < R) & (x <= A[j]) THEN A[i] := A[j] END 310 | UNTIL (j >= R) OR (x > A[j]); 311 | A[i] := x 312 | END sift; 313 | 314 | BEGIN L := k DIV 2; R := k; (*heapsort*) 315 | WHILE L > 0 DO DEC(L); sift(A, L, R) END ; 316 | WHILE R > 0 DO 317 | DEC(R); x := A[0]; A[0] := A[R]; A[R] := x; sift(A, L, R) 318 | END ; 319 | WHILE L < k DO 320 | VDisk.GetSector(V, A[L], hd); ASSERT(hd.mark = HeaderMark); 321 | IF hd.aleng < SecTabSize THEN j := hd.aleng + 1; 322 | REPEAT DEC(j); VDisk.MarkSector(V, hd.sec[j]) UNTIL j = 0 323 | ELSE j := SecTabSize; 324 | REPEAT DEC(j); VDisk.MarkSector(V, hd.sec[j]) UNTIL j = 0; 325 | n := (hd.aleng - SecTabSize) DIV 256; i := 0; 326 | WHILE i <= n DO 327 | VDisk.MarkSector(V, hd.ext[i]); 328 | VDisk.GetSector(V, hd.ext[i], B); (*index sector*) 329 | IF i < n THEN j := 256 ELSE j := (hd.aleng - SecTabSize) MOD 256 + 1 END ; 330 | REPEAT DEC(j); VDisk.MarkSector(V, B[j]) UNTIL j = 0; 331 | INC(i) 332 | END 333 | END ; 334 | INC(L) 335 | END 336 | END MarkSectors; 337 | 338 | PROCEDURE TraverseDir(V: VDisk.VDisk; VAR A: ARRAY OF DiskAdr; VAR k: INTEGER; dpg: DiskAdr); 339 | VAR i: INTEGER; a: DirPage; 340 | BEGIN VDisk.GetSector(V, dpg, a); ASSERT(a.mark = DirMark); VDisk.MarkSector(V, dpg); i := 0; 341 | WHILE i < a.m DO 342 | A[k] := a.e[i].adr; INC(k); INC(i); 343 | IF k = 2000 THEN MarkSectors(V, A, k); k := 0 END 344 | END ; 345 | IF a.p0 # 0 THEN 346 | TraverseDir(V, A, k, a.p0); i := 0; 347 | WHILE i < a.m DO 348 | TraverseDir(V, A, k, a.e[i].p); INC(i) 349 | END 350 | END 351 | END TraverseDir; 352 | 353 | BEGIN k := 0; TraverseDir(V, A, k, DirRootAdr); MarkSectors(V, A, k) 354 | END Init; 355 | 356 | END VFileDir. 357 | -------------------------------------------------------------------------------- /Norebo/VFiles.Mod: -------------------------------------------------------------------------------- 1 | MODULE VFiles; (*dervived from NW 11.1.86 / 22.9.93 / 25.5.95 / 25.12.95 / 15.8.2013*) 2 | IMPORT SYSTEM, Kernel, VDisk, VFileDir; 3 | 4 | (*A file consists of a sequence of pages. The first page 5 | contains the header. Part of the header is the page table, an array 6 | of disk addresses to the pages. A file is referenced through riders. 7 | A rider indicates a current position and refers to a file*) 8 | 9 | CONST MaxBufs = 4; 10 | HS = VFileDir.HeaderSize; 11 | SS = VFileDir.SectorSize; 12 | STS = VFileDir.SecTabSize; 13 | XS = VFileDir.IndexSize; 14 | 15 | TYPE DiskAdr = INTEGER; 16 | File* = POINTER TO FileDesc; 17 | Buffer = POINTER TO BufferRecord; 18 | Index = POINTER TO IndexRecord; 19 | 20 | Rider* = 21 | RECORD eof*: BOOLEAN; 22 | res*: INTEGER; 23 | file: File; 24 | apos, bpos: INTEGER; 25 | buf: Buffer 26 | END ; 27 | 28 | FileDesc = 29 | RECORD next: INTEGER; (*list of files invisible to the GC*) 30 | vdisk: VDisk.VDisk; 31 | nofbufs, aleng, bleng: INTEGER; 32 | modH, registered: BOOLEAN; 33 | firstbuf: Buffer; 34 | sechint: DiskAdr; 35 | name: VFileDir.FileName; 36 | date: INTEGER; 37 | ext: ARRAY VFileDir.ExTabSize OF Index; 38 | sec: VFileDir.SectorTable 39 | END ; 40 | 41 | BufferRecord = 42 | RECORD apos, lim: INTEGER; 43 | mod: BOOLEAN; 44 | next: Buffer; 45 | data: VFileDir.DataSector 46 | END ; 47 | 48 | IndexRecord = 49 | RECORD adr: DiskAdr; 50 | mod: BOOLEAN; 51 | sec: VFileDir.IndexSector 52 | END ; 53 | 54 | (*aleng * SS + bleng = length (including header) 55 | apos * SS + bpos = current position 56 | 0 <= bpos <= lim <= SS 57 | 0 <= apos <= aleng < PgTabSize 58 | (apos < aleng) & (lim = SS) OR (apos = aleng) *) 59 | 60 | VAR root: INTEGER (*File*); (*list of open files*) 61 | 62 | PROCEDURE Check(s: ARRAY OF CHAR; 63 | VAR name: VFileDir.FileName; VAR res: INTEGER); 64 | VAR i: INTEGER; ch: CHAR; 65 | BEGIN ch := s[0]; i := 0; 66 | IF (ch >= "A") & (ch <= "Z") OR (ch >= "a") & (ch <= "z") THEN 67 | REPEAT name[i] := ch; INC(i); ch := s[i] 68 | UNTIL ~((ch >= "0") & (ch <= "9") OR (ch >= "A") & (ch <= "Z") 69 | OR (ch >= "a") & (ch <= "z") OR (ch = ".")) OR (i = VFileDir.FnLength); 70 | IF i = VFileDir.FnLength THEN res := 4 71 | ELSIF ch = 0X THEN res := 0; 72 | WHILE i < VFileDir.FnLength DO name[i] := 0X; INC(i) END 73 | ELSE res := 5 74 | END 75 | ELSIF ch = 0X THEN name[0] := 0X; res := -1 76 | ELSE res := 3 77 | END 78 | END Check; 79 | 80 | PROCEDURE Old*(V: VDisk.VDisk; name: ARRAY OF CHAR): File; 81 | VAR i, k, res: INTEGER; 82 | f: File; 83 | header: DiskAdr; 84 | buf: Buffer; 85 | F: VFileDir.FileHd; 86 | namebuf: VFileDir.FileName; 87 | inxpg: Index; 88 | BEGIN f := NIL; Check(name, namebuf, res); 89 | IF res = 0 THEN 90 | VFileDir.Search(V, namebuf, header); 91 | IF header # 0 THEN 92 | f := SYSTEM.VAL(File, root); 93 | WHILE (f # NIL) & ((f.vdisk # V) OR (f.sec[0] # header)) DO 94 | f := SYSTEM.VAL(File, f.next) 95 | END ; 96 | IF f = NIL THEN (*file not yet present*) 97 | NEW(buf); buf.apos := 0; buf.next := buf; buf.mod := FALSE; 98 | F := SYSTEM.VAL(VFileDir.FileHd, SYSTEM.ADR(buf.data)); 99 | VDisk.GetSector(V, header, buf.data); ASSERT(F.mark = VFileDir.HeaderMark); 100 | NEW(f); f.vdisk := V; f.aleng := F.aleng; f.bleng := F.bleng; f.date := F.date; 101 | IF f.aleng = 0 THEN buf.lim := f.bleng ELSE buf.lim := SS END ; 102 | f.firstbuf := buf; f.nofbufs := 1; f.name := namebuf; f.registered := TRUE; 103 | f.sec := F.sec; 104 | k := (f.aleng + (XS-STS)) DIV XS; i := 0; 105 | WHILE i < k DO 106 | NEW(inxpg); inxpg.adr := F.ext[i]; inxpg.mod := FALSE; 107 | VDisk.GetSector(V, inxpg.adr, inxpg.sec); f.ext[i] := inxpg; INC(i) 108 | END ; 109 | WHILE i < VFileDir.ExTabSize DO f.ext[i] := NIL; INC(i) END ; 110 | f.sechint := header; f.modH := FALSE; f.next := root; root := SYSTEM.VAL(INTEGER, f) 111 | END 112 | END 113 | END ; 114 | RETURN f 115 | END Old; 116 | 117 | PROCEDURE New*(V: VDisk.VDisk; name: ARRAY OF CHAR): File; 118 | VAR i, res: INTEGER; 119 | f: File; 120 | buf: Buffer; 121 | F: VFileDir.FileHd; 122 | namebuf: VFileDir.FileName; 123 | BEGIN f := NIL; Check(name, namebuf, res); 124 | IF res <= 0 THEN 125 | NEW(buf); buf.apos := 0; buf.mod := TRUE; buf.lim := HS; buf.next := buf; 126 | F := SYSTEM.VAL(VFileDir.FileHd, SYSTEM.ADR(buf.data)); 127 | F.mark := VFileDir.HeaderMark; 128 | F.aleng := 0; F.bleng := HS; F.name := namebuf; 129 | F.date := Kernel.Clock(); 130 | NEW(f); f.vdisk := V; f.aleng := 0; f.bleng := HS; f.modH := TRUE; 131 | f.registered := FALSE; f.date := F.date; 132 | f.firstbuf := buf; f.nofbufs := 1; f.name := namebuf; f.sechint := 0; 133 | i := 0; 134 | REPEAT f.ext[i] := NIL; F.ext[i] := 0; INC(i) UNTIL i = VFileDir.ExTabSize; 135 | i := 0; 136 | REPEAT f.sec[i] := 0; F.sec[i] := 0; INC(i) UNTIL i = STS 137 | END ; 138 | RETURN f 139 | END New; 140 | 141 | PROCEDURE UpdateHeader(f: File; VAR F: VFileDir.FileHeader); 142 | VAR k: INTEGER; 143 | BEGIN F.aleng := f.aleng; F.bleng := f.bleng; 144 | F.sec := f.sec; k := (f.aleng + (XS-STS)) DIV XS; 145 | WHILE k > 0 DO DEC(k); F.ext[k] := f.ext[k].adr END 146 | END UpdateHeader; 147 | 148 | PROCEDURE ReadBuf(f: File; buf: Buffer; pos: INTEGER); 149 | VAR sec: DiskAdr; 150 | BEGIN 151 | IF pos < STS THEN sec := f.sec[pos] 152 | ELSE sec := f.ext[(pos-STS) DIV XS].sec[(pos-STS) MOD XS] 153 | END ; 154 | VDisk.GetSector(f.vdisk, sec, buf.data); 155 | IF pos < f.aleng THEN buf.lim := SS ELSE buf.lim := f.bleng END ; 156 | buf.apos := pos; buf.mod := FALSE 157 | END ReadBuf; 158 | 159 | PROCEDURE WriteBuf(f: File; buf: Buffer); 160 | VAR i, k: INTEGER; 161 | secadr: DiskAdr; inx: Index; 162 | BEGIN 163 | IF buf.apos < STS THEN 164 | secadr := f.sec[buf.apos]; 165 | IF secadr = 0 THEN 166 | VDisk.AllocSector(f.vdisk, f.sechint, secadr); 167 | f.modH := TRUE; f.sec[buf.apos] := secadr; f.sechint := secadr 168 | END ; 169 | IF buf.apos = 0 THEN 170 | UpdateHeader(f, SYSTEM.VAL(VFileDir.FileHeader, buf.data)); f.modH := FALSE 171 | END 172 | ELSE i := (buf.apos - STS) DIV XS; inx := f.ext[i]; 173 | IF inx = NIL THEN 174 | NEW(inx); inx.adr := 0; inx.sec[0] := 0; f.ext[i] := inx; f.modH := TRUE 175 | END ; 176 | k := (buf.apos - STS) MOD XS; secadr := inx.sec[k]; 177 | IF secadr = 0 THEN 178 | VDisk.AllocSector(f.vdisk, f.sechint, secadr); 179 | f.modH := TRUE; inx.mod := TRUE; inx.sec[k] := secadr; f.sechint := secadr 180 | END 181 | END ; 182 | VDisk.PutSector(f.vdisk, secadr, buf.data); buf.mod := FALSE 183 | END WriteBuf; 184 | 185 | PROCEDURE Buf(f: File; pos: INTEGER): Buffer; 186 | VAR buf: Buffer; 187 | BEGIN buf := f.firstbuf; 188 | WHILE (buf.apos # pos) & (buf.next # f.firstbuf) DO buf := buf.next END ; 189 | IF buf.apos # pos THEN buf := NIL END ; 190 | RETURN buf 191 | END Buf; 192 | 193 | PROCEDURE GetBuf(f: File; pos: INTEGER): Buffer; 194 | VAR buf: Buffer; 195 | BEGIN buf := f.firstbuf; 196 | WHILE (buf.apos # pos) & (buf.next # f.firstbuf) DO buf := buf.next END ; 197 | IF buf.apos # pos THEN 198 | IF f.nofbufs < MaxBufs THEN (*allocate new buffer*) 199 | NEW(buf); buf.next := f.firstbuf.next; f.firstbuf.next := buf; INC(f.nofbufs) 200 | ELSE (*reuse a buffer*) f.firstbuf := buf; 201 | IF buf.mod THEN WriteBuf(f, buf) END 202 | END ; 203 | IF pos <= f.aleng THEN ReadBuf(f, buf, pos) ELSE buf.apos := pos; buf.lim := 0; buf.mod := FALSE END 204 | END ; 205 | RETURN buf 206 | END GetBuf; 207 | 208 | PROCEDURE Unbuffer(f: File); 209 | VAR i, k: INTEGER; 210 | buf: Buffer; 211 | inx: Index; 212 | head: VFileDir.FileHeader; 213 | BEGIN buf := f.firstbuf; 214 | REPEAT 215 | IF buf.mod THEN WriteBuf(f, buf) END ; 216 | buf := buf.next 217 | UNTIL buf = f.firstbuf; 218 | k := (f.aleng + (XS-STS)) DIV XS; i := 0; 219 | WHILE i < k DO 220 | inx := f.ext[i]; INC(i); 221 | IF inx.mod THEN 222 | IF inx.adr = 0 THEN 223 | VDisk.AllocSector(f.vdisk, f.sechint, inx.adr); f.sechint := inx.adr; f.modH := TRUE 224 | END ; 225 | VDisk.PutSector(f.vdisk, inx.adr, inx.sec); inx.mod := FALSE 226 | END 227 | END ; 228 | IF f.modH THEN 229 | VDisk.GetSector(f.vdisk, f.sec[0], head); UpdateHeader(f, head); 230 | VDisk.PutSector(f.vdisk, f.sec[0], head); f.modH := FALSE 231 | END 232 | END Unbuffer; 233 | 234 | PROCEDURE Register*(f: File); 235 | BEGIN 236 | IF (f # NIL) & (f.name[0] # 0X) THEN 237 | Unbuffer(f); 238 | IF ~f.registered THEN 239 | VFileDir.Insert(f.vdisk, f.name, f.sec[0]); f.registered := TRUE; f.next := root; root := SYSTEM.VAL(INTEGER, f) 240 | END 241 | END 242 | END Register; 243 | 244 | PROCEDURE Close*(f: File); 245 | BEGIN 246 | IF f # NIL THEN Unbuffer(f) END 247 | END Close; 248 | 249 | PROCEDURE Purge*(f: File); 250 | VAR a, i, j, k: INTEGER; 251 | ind: VFileDir.IndexSector; 252 | BEGIN 253 | IF f # NIL THEN a := f.aleng + 1; f.aleng := 0; f.bleng := HS; 254 | IF a <= STS THEN i := a; 255 | ELSE i := STS; DEC(a, i); j := (a-1) MOD XS; k := (a-1) DIV XS; 256 | WHILE k >= 0 DO 257 | VDisk.GetSector(f.vdisk, f.ext[k].adr, ind); 258 | REPEAT DEC(j); VDisk.FreeSector(f.vdisk, ind[j]) UNTIL j = 0; 259 | VDisk.FreeSector(f.vdisk, f.ext[k].adr); j := XS; DEC(k) 260 | END 261 | END ; 262 | REPEAT DEC(i); VDisk.FreeSector(f.vdisk, f.sec[i]) UNTIL i = 0 263 | END 264 | END Purge; 265 | 266 | PROCEDURE Delete*(V: VDisk.VDisk; name: ARRAY OF CHAR; VAR res: INTEGER); 267 | VAR adr: DiskAdr; 268 | namebuf: VFileDir.FileName; 269 | BEGIN Check(name, namebuf, res); 270 | IF res = 0 THEN 271 | VFileDir.Delete(V, namebuf, adr); 272 | IF adr = 0 THEN res := 2 END 273 | END 274 | END Delete; 275 | 276 | PROCEDURE Rename*(V: VDisk.VDisk; old, new: ARRAY OF CHAR; VAR res: INTEGER); 277 | VAR adr: DiskAdr; 278 | oldbuf, newbuf: VFileDir.FileName; 279 | head: VFileDir.FileHeader; 280 | BEGIN Check(old, oldbuf, res); 281 | IF res = 0 THEN 282 | Check(new, newbuf, res); 283 | IF res = 0 THEN 284 | VFileDir.Delete(V, oldbuf, adr); 285 | IF adr # 0 THEN 286 | VFileDir.Insert(V, newbuf, adr); 287 | VDisk.GetSector(V, adr, head); head.name := newbuf; VDisk.PutSector(V, adr, head) 288 | ELSE res := 2 289 | END 290 | END 291 | END 292 | END Rename; 293 | 294 | PROCEDURE Length*(f: File): INTEGER; 295 | BEGIN RETURN f.aleng * SS + f.bleng - HS 296 | END Length; 297 | 298 | PROCEDURE Date*(f: File): INTEGER; 299 | BEGIN RETURN f.date 300 | END Date; 301 | 302 | (*---------------------------Read---------------------------*) 303 | 304 | PROCEDURE Set*(VAR r: Rider; f: File; pos: INTEGER); 305 | VAR a, b: INTEGER; 306 | BEGIN r.eof := FALSE; r.res := 0; 307 | IF f # NIL THEN 308 | IF pos < 0 THEN a := 0; b := HS 309 | ELSIF pos < f.aleng * SS + f.bleng - HS THEN 310 | a := (pos + HS) DIV SS; b := (pos + HS) MOD SS; 311 | ELSE a := f.aleng; b := f.bleng 312 | END ; 313 | r.file := f; r.apos := a; r.bpos := b; r.buf := f.firstbuf 314 | ELSE r.file:= NIL 315 | END 316 | END Set; 317 | 318 | PROCEDURE Pos*(VAR r: Rider): INTEGER; 319 | BEGIN RETURN r.apos * SS + r.bpos - HS 320 | END Pos; 321 | 322 | PROCEDURE Base*(VAR r: Rider): File; 323 | BEGIN RETURN r.file 324 | END Base; 325 | 326 | PROCEDURE ReadByte*(VAR r: Rider; VAR x: BYTE); 327 | VAR buf: Buffer; 328 | BEGIN 329 | IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos) END ; 330 | IF r.bpos < r.buf.lim THEN x := r.buf.data[r.bpos]; INC(r.bpos) 331 | ELSIF r.apos < r.file.aleng THEN 332 | INC(r.apos); buf := Buf(r.file, r.apos); 333 | IF buf = NIL THEN 334 | IF r.buf.mod THEN WriteBuf(r.file, r.buf) END ; 335 | ReadBuf(r.file, r.buf, r.apos) 336 | ELSE r.buf := buf 337 | END ; 338 | x := r.buf.data[0]; r.bpos := 1 339 | ELSE x := 0; r.eof := TRUE 340 | END 341 | END ReadByte; 342 | 343 | PROCEDURE ReadBytes*(VAR r: Rider; VAR x: ARRAY OF BYTE; n: INTEGER); 344 | VAR i: INTEGER; 345 | BEGIN i := 0; (*this implementation is to be improved*) 346 | WHILE i < n DO ReadByte(r, x[i]); INC(i) END 347 | END ReadBytes; 348 | 349 | PROCEDURE Read*(VAR r: Rider; VAR ch: CHAR); 350 | VAR buf: Buffer; (*same as ReadByte*) 351 | BEGIN 352 | IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos) END ; 353 | IF r.bpos < r.buf.lim THEN ch := CHR(r.buf.data[r.bpos]); INC(r.bpos) 354 | ELSIF r.apos < r.file.aleng THEN 355 | INC(r.apos); buf := Buf(r.file, r.apos); 356 | IF buf = NIL THEN 357 | IF r.buf.mod THEN WriteBuf(r.file, r.buf) END ; 358 | ReadBuf(r.file, r.buf, r.apos) 359 | ELSE r.buf := buf 360 | END ; 361 | ch := CHR(r.buf.data[0]); r.bpos := 1 362 | ELSE ch := 0X; r.eof := TRUE 363 | END 364 | END Read; 365 | 366 | PROCEDURE ReadInt*(VAR R: Rider; VAR x: INTEGER); 367 | VAR x0, x1, x2, x3: BYTE; 368 | BEGIN ReadByte(R, x0); ReadByte(R, x1); ReadByte(R, x2); ReadByte(R, x3); 369 | x := ((x3 * 100H + x2) * 100H + x1) * 100H + x0 370 | END ReadInt; 371 | 372 | PROCEDURE ReadSet*(VAR R: Rider; VAR s: SET); 373 | VAR n: INTEGER; 374 | BEGIN ReadInt(R, SYSTEM.VAL(INTEGER, s)) 375 | END ReadSet; 376 | 377 | PROCEDURE ReadReal*(VAR R: Rider; VAR x: REAL); 378 | VAR n: INTEGER; 379 | BEGIN ReadInt(R, SYSTEM.VAL(INTEGER, x)) 380 | END ReadReal; 381 | 382 | PROCEDURE ReadString*(VAR R: Rider; VAR x: ARRAY OF CHAR); 383 | VAR i: INTEGER; ch: CHAR; 384 | BEGIN i := 0; Read(R, ch); 385 | WHILE ch # 0X DO 386 | IF i < LEN(x)-1 THEN x[i] := ch; INC(i) END ; 387 | Read(R, ch) 388 | END ; 389 | x[i] := 0X 390 | END ReadString; 391 | 392 | PROCEDURE ReadNum*(VAR R: Rider; VAR x: INTEGER); 393 | VAR n, y: INTEGER; b: BYTE; 394 | BEGIN n := 32; y := 0; ReadByte(R, b); 395 | WHILE b >= 80H DO y := ROR(y + b-80H, 7); DEC(n, 7); ReadByte(R, b) END ; 396 | IF n <= 4 THEN x := ROR(y + b MOD 10H, 4) ELSE x := ASR(ROR(y + b, 7), n-7) END 397 | END ReadNum; 398 | 399 | (*---------------------------Write---------------------------*) 400 | 401 | PROCEDURE NewExt(f: File); 402 | VAR i, k: INTEGER; ext: Index; 403 | BEGIN k := (f.aleng - STS) DIV XS; 404 | NEW(ext); ext.adr := 0; ext.mod := TRUE; f.ext[k] := ext; i := XS; 405 | REPEAT DEC(i); ext.sec[i] := 0 UNTIL i = 0 406 | END NewExt; 407 | 408 | PROCEDURE WriteByte*(VAR r: Rider; x: BYTE); 409 | VAR f: File; buf: Buffer; 410 | BEGIN 411 | IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos); END ; 412 | IF r.bpos >= r.buf.lim THEN 413 | IF r.bpos < SS THEN 414 | INC(r.buf.lim); INC(r.file.bleng); r.file.modH := TRUE 415 | ELSE f := r.file; WriteBuf(f, r.buf); INC(r.apos); buf := Buf(r.file, r.apos); 416 | IF buf = NIL THEN 417 | IF r.apos <= f.aleng THEN ReadBuf(f, r.buf, r.apos) 418 | ELSE r.buf.apos := r.apos; r.buf.lim := 1; f.aleng := f.aleng + 1; f.bleng := 1; f.modH := TRUE; 419 | IF (f.aleng - STS) MOD XS = 0 THEN NewExt(f) END 420 | END 421 | ELSE r.buf := buf 422 | END ; 423 | r.bpos := 0 424 | END 425 | END ; 426 | r.buf.data[r.bpos] := x; INC(r.bpos); r.buf.mod := TRUE 427 | END WriteByte; 428 | 429 | PROCEDURE WriteBytes*(VAR r: Rider; x: ARRAY OF BYTE; n: INTEGER); 430 | VAR i: INTEGER; 431 | BEGIN i := 0; (*this implementation is to be improed*) 432 | WHILE i < n DO WriteByte(r, x[i]); INC(i) END 433 | END WriteBytes; 434 | 435 | PROCEDURE Write*(VAR r: Rider; ch: CHAR); 436 | VAR f: File; buf: Buffer; 437 | BEGIN (*same as WriteByte*) 438 | IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos); END ; 439 | IF r.bpos >= r.buf.lim THEN 440 | IF r.bpos < SS THEN 441 | INC(r.buf.lim); INC(r.file.bleng); r.file.modH := TRUE 442 | ELSE f := r.file; WriteBuf(f, r.buf); INC(r.apos); buf := Buf(r.file, r.apos); 443 | IF buf = NIL THEN 444 | IF r.apos <= f.aleng THEN ReadBuf(f, r.buf, r.apos) 445 | ELSE r.buf.apos := r.apos; r.buf.lim := 1; f.aleng := f.aleng + 1; f.bleng := 1; f.modH := TRUE; 446 | IF (f.aleng - STS) MOD XS = 0 THEN NewExt(f) END 447 | END 448 | ELSE r.buf := buf 449 | END ; 450 | r.bpos := 0 451 | END 452 | END ; 453 | r.buf.data[r.bpos] := ORD(ch); INC(r.bpos); r.buf.mod := TRUE 454 | END Write; 455 | 456 | PROCEDURE WriteInt*(VAR R: Rider; x: INTEGER); 457 | BEGIN WriteByte(R, x MOD 100H); 458 | WriteByte(R, x DIV 100H MOD 100H); 459 | WriteByte(R, x DIV 10000H MOD 100H); 460 | WriteByte(R, x DIV 1000000H MOD 100H) 461 | END WriteInt; 462 | 463 | PROCEDURE WriteSet*(VAR R: Rider; s: SET); 464 | BEGIN WriteInt(R, ORD(s)) 465 | END WriteSet; 466 | 467 | PROCEDURE WriteReal*(VAR R: Rider; x: REAL); 468 | BEGIN WriteInt(R, ORD(x)) 469 | END WriteReal; 470 | 471 | PROCEDURE WriteString*(VAR R: Rider; x: ARRAY OF CHAR); 472 | VAR i: INTEGER; ch: CHAR; 473 | BEGIN i := 0; 474 | REPEAT ch := x[i]; Write(R, ch); INC(i) UNTIL ch = 0X 475 | END WriteString; 476 | 477 | PROCEDURE WriteNum*(VAR R: Rider; x: INTEGER); 478 | BEGIN 479 | WHILE (x < -40H) OR (x >= 40H) DO WriteByte(R, x MOD 80H + 80H); x := ASR(x, 7) END ; 480 | WriteByte(R, x MOD 80H) 481 | END WriteNum; 482 | 483 | (*---------------------------System use---------------------------*) 484 | 485 | PROCEDURE RestoreList*; (*after mark phase of garbage collection*) 486 | VAR f, f0: INTEGER; 487 | 488 | PROCEDURE mark(f: INTEGER): INTEGER; 489 | VAR m: INTEGER; 490 | BEGIN 491 | IF f = 0 THEN m := -1 ELSE SYSTEM.GET(f-4, m) END ; 492 | RETURN m 493 | END mark; 494 | 495 | BEGIN (*field "next" has offset 0*) 496 | WHILE mark(root) = 0 DO SYSTEM.GET(root, root) END ; 497 | f := root; 498 | WHILE f # 0 DO 499 | f0 := f; 500 | REPEAT SYSTEM.GET(f0, f0) UNTIL mark(f0) # 0; 501 | SYSTEM.PUT(f, f0); f := f0 502 | END 503 | END RestoreList; 504 | 505 | BEGIN root := 0 506 | END VFiles. 507 | -------------------------------------------------------------------------------- /Oberon/FileDir.Mod: -------------------------------------------------------------------------------- 1 | MODULE FileDir; (*NW 12.1.86 / 23.8.90 / 15.8.2013*) 2 | IMPORT SYSTEM, Kernel; 3 | 4 | (*File Directory is a B-tree with its root page at DirRootAdr. 5 | Each entry contains a file name and the disk address of the file's head sector*) 6 | 7 | CONST FnLength* = 32; 8 | SecTabSize* = 64; 9 | ExTabSize* = 12; 10 | SectorSize* = 1024; 11 | IndexSize* = SectorSize DIV 4; 12 | HeaderSize* = 352; 13 | DirRootAdr* = 29; 14 | DirPgSize* = 24; 15 | N = DirPgSize DIV 2; 16 | DirMark* = 9B1EA38DH; 17 | HeaderMark* = 9BA71D86H; 18 | FillerSize = 52; 19 | 20 | TYPE DiskAdr = INTEGER; 21 | FileName* = ARRAY FnLength OF CHAR; 22 | SectorTable* = ARRAY SecTabSize OF DiskAdr; 23 | ExtensionTable* = ARRAY ExTabSize OF DiskAdr; 24 | EntryHandler* = PROCEDURE (name: FileName; sec: DiskAdr; VAR continue: BOOLEAN); 25 | 26 | FileHeader* = 27 | RECORD (*first page of each file on disk*) 28 | mark*: INTEGER; 29 | name*: FileName; 30 | aleng*, bleng*, date*: INTEGER; 31 | ext*: ExtensionTable; 32 | sec*: SectorTable; 33 | fill: ARRAY SectorSize - HeaderSize OF BYTE; 34 | END ; 35 | 36 | FileHd* = POINTER TO FileHeader; 37 | IndexSector* = ARRAY IndexSize OF DiskAdr; 38 | DataSector* = ARRAY SectorSize OF BYTE; 39 | 40 | DirEntry* = (*B-tree node*) 41 | RECORD 42 | name*: FileName; 43 | adr*: DiskAdr; (*sec no of file header*) 44 | p*: DiskAdr (*sec no of descendant in directory*) 45 | END ; 46 | 47 | DirPage* = 48 | RECORD mark*: INTEGER; 49 | m*: INTEGER; 50 | p0*: DiskAdr; (*sec no of left descendant in directory*) 51 | fill: ARRAY FillerSize OF BYTE; 52 | e*: ARRAY DirPgSize OF DirEntry 53 | END ; 54 | 55 | (*Exported procedures: Search, Insert, Delete, Enumerate, Init*) 56 | 57 | PROCEDURE Search*(name: FileName; VAR A: DiskAdr); 58 | VAR i, L, R: INTEGER; dadr: DiskAdr; 59 | a: DirPage; 60 | BEGIN dadr := DirRootAdr; A := 0; 61 | REPEAT Kernel.GetSector(dadr, a); ASSERT(a.mark = DirMark); 62 | L := 0; R := a.m; (*binary search*) 63 | WHILE L < R DO 64 | i := (L+R) DIV 2; 65 | IF name <= a.e[i].name THEN R := i ELSE L := i+1 END 66 | END ; 67 | IF (R < a.m) & (name = a.e[R].name) THEN A := a.e[R].adr (*found*) 68 | ELSIF R = 0 THEN dadr := a.p0 69 | ELSE dadr := a.e[R-1].p 70 | END ; 71 | UNTIL (dadr = 0) OR (A # 0) 72 | END Search; 73 | 74 | PROCEDURE insert(name: FileName; 75 | dpg0: DiskAdr; 76 | VAR h: BOOLEAN; 77 | VAR v: DirEntry; 78 | fad: DiskAdr); 79 | (*h = "tree has become higher and v is ascending element"*) 80 | VAR ch: CHAR; 81 | i, j, L, R: INTEGER; 82 | dpg1: DiskAdr; 83 | u: DirEntry; 84 | a: DirPage; 85 | 86 | BEGIN (*~h*) Kernel.GetSector(dpg0, a); ASSERT(a.mark = DirMark); 87 | L := 0; R := a.m; (*binary search*) 88 | WHILE L < R DO 89 | i := (L+R) DIV 2; 90 | IF name <= a.e[i].name THEN R := i ELSE L := i+1 END 91 | END ; 92 | IF (R < a.m) & (name = a.e[R].name) THEN 93 | a.e[R].adr := fad; Kernel.PutSector(dpg0, a) (*replace*) 94 | ELSE (*not on this page*) 95 | IF R = 0 THEN dpg1 := a.p0 ELSE dpg1 := a.e[R-1].p END ; 96 | IF dpg1 = 0 THEN (*not in tree, insert*) 97 | u.adr := fad; u.p := 0; h := TRUE; j := 0; 98 | REPEAT ch := name[j]; u.name[j] := ch; INC(j) 99 | UNTIL ch = 0X; 100 | WHILE j < FnLength DO u.name[j] := 0X; INC(j) END ; 101 | ELSE 102 | insert(name, dpg1, h, u, fad) 103 | END ; 104 | IF h THEN (*insert u to the left of e[R]*) 105 | IF a.m < DirPgSize THEN 106 | h := FALSE; i := a.m; 107 | WHILE i > R DO DEC(i); a.e[i+1] := a.e[i] END ; 108 | a.e[R] := u; INC(a.m) 109 | ELSE (*split page and assign the middle element to v*) 110 | a.m := N; a.mark := DirMark; 111 | IF R < N THEN (*insert in left half*) 112 | v := a.e[N-1]; i := N-1; 113 | WHILE i > R DO DEC(i); a.e[i+1] := a.e[i] END ; 114 | a.e[R] := u; Kernel.PutSector(dpg0, a); 115 | Kernel.AllocSector(dpg0, dpg0); i := 0; 116 | WHILE i < N DO a.e[i] := a.e[i+N]; INC(i) END 117 | ELSE (*insert in right half*) 118 | Kernel.PutSector(dpg0, a); 119 | Kernel.AllocSector(dpg0, dpg0); DEC(R, N); i := 0; 120 | IF R = 0 THEN v := u 121 | ELSE v := a.e[N]; 122 | WHILE i < R-1 DO a.e[i] := a.e[N+1+i]; INC(i) END ; 123 | a.e[i] := u; INC(i) 124 | END ; 125 | WHILE i < N DO a.e[i] := a.e[N+i]; INC(i) END 126 | END ; 127 | a.p0 := v.p; v.p := dpg0 128 | END ; 129 | Kernel.PutSector(dpg0, a) 130 | END 131 | END 132 | END insert; 133 | 134 | PROCEDURE Insert*(name: FileName; fad: DiskAdr); 135 | VAR oldroot: DiskAdr; 136 | h: BOOLEAN; U: DirEntry; 137 | a: DirPage; 138 | BEGIN h := FALSE; 139 | insert(name, DirRootAdr, h, U, fad); 140 | IF h THEN (*root overflow*) 141 | Kernel.GetSector(DirRootAdr, a); ASSERT(a.mark = DirMark); 142 | Kernel.AllocSector(DirRootAdr, oldroot); Kernel.PutSector(oldroot, a); 143 | a.mark := DirMark; a.m := 1; a.p0 := oldroot; a.e[0] := U; 144 | Kernel.PutSector(DirRootAdr, a) 145 | END 146 | END Insert; 147 | 148 | 149 | PROCEDURE underflow(VAR c: DirPage; (*ancestor page*) 150 | dpg0: DiskAdr; 151 | s: INTEGER; (*insertion point in c*) 152 | VAR h: BOOLEAN); (*c undersize*) 153 | VAR i, k: INTEGER; 154 | dpg1: DiskAdr; 155 | a, b: DirPage; (*a := underflowing page, b := neighbouring page*) 156 | BEGIN Kernel.GetSector(dpg0, a); ASSERT(a.mark = DirMark); 157 | (*h & a.m = N-1 & dpg0 = c.e[s-1].p*) 158 | IF s < c.m THEN (*b := page to the right of a*) 159 | dpg1 := c.e[s].p; Kernel.GetSector(dpg1, b); ASSERT(b.mark = DirMark); 160 | k := (b.m-N+1) DIV 2; (*k = no. of items available on page b*) 161 | a.e[N-1] := c.e[s]; a.e[N-1].p := b.p0; 162 | IF k > 0 THEN 163 | (*move k-1 items from b to a, one to c*) i := 0; 164 | WHILE i < k-1 DO a.e[i+N] := b.e[i]; INC(i) END ; 165 | c.e[s] := b.e[i]; b.p0 := c.e[s].p; 166 | c.e[s].p := dpg1; b.m := b.m - k; i := 0; 167 | WHILE i < b.m DO b.e[i] := b.e[i+k]; INC(i) END ; 168 | Kernel.PutSector(dpg1, b); a.m := N-1+k; h := FALSE 169 | ELSE (*merge pages a and b, discard b*) i := 0; 170 | WHILE i < N DO a.e[i+N] := b.e[i]; INC(i) END ; 171 | i := s; DEC(c.m); 172 | WHILE i < c.m DO c.e[i] := c.e[i+1]; INC(i) END ; 173 | a.m := 2*N; h := c.m < N 174 | END ; 175 | Kernel.PutSector(dpg0, a) 176 | ELSE (*b := page to the left of a*) DEC(s); 177 | IF s = 0 THEN dpg1 := c.p0 ELSE dpg1 := c.e[s-1].p END ; 178 | Kernel.GetSector(dpg1, b); ASSERT(b.mark = DirMark); 179 | k := (b.m-N+1) DIV 2; (*k = no. of items available on page b*) 180 | IF k > 0 THEN 181 | i := N-1; 182 | WHILE i > 0 DO DEC(i); a.e[i+k] := a.e[i] END ; 183 | i := k-1; a.e[i] := c.e[s]; a.e[i].p := a.p0; 184 | (*move k-1 items from b to a, one to c*) b.m := b.m - k; 185 | WHILE i > 0 DO DEC(i); a.e[i] := b.e[i+b.m+1] END ; 186 | c.e[s] := b.e[b.m]; a.p0 := c.e[s].p; 187 | c.e[s].p := dpg0; a.m := N-1+k; h := FALSE; 188 | Kernel.PutSector(dpg0, a) 189 | ELSE (*merge pages a and b, discard a*) 190 | c.e[s].p := a.p0; b.e[N] := c.e[s]; i := 0; 191 | WHILE i < N-1 DO b.e[i+N+1] := a.e[i]; INC(i) END ; 192 | b.m := 2*N; DEC(c.m); h := c.m < N 193 | END ; 194 | Kernel.PutSector(dpg1, b) 195 | END 196 | END underflow; 197 | 198 | PROCEDURE delete(name: FileName; 199 | dpg0: DiskAdr; 200 | VAR h: BOOLEAN; 201 | VAR fad: DiskAdr); 202 | (*search and delete entry with key name; if a page underflow arises, 203 | balance with adjacent page or merge; h := "page dpg0 is undersize"*) 204 | 205 | VAR i, L, R: INTEGER; 206 | dpg1: DiskAdr; 207 | a: DirPage; 208 | 209 | PROCEDURE del(VAR a: DirPage; R: INTEGER; dpg1: DiskAdr; VAR h: BOOLEAN); 210 | VAR dpg2: DiskAdr; (*global: a, R*) 211 | b: DirPage; 212 | BEGIN Kernel.GetSector(dpg1, b); ASSERT(b.mark = DirMark); dpg2 := b.e[b.m-1].p; 213 | IF dpg2 # 0 THEN del(a, R, dpg2, h); 214 | IF h THEN underflow(b, dpg2, b.m, h); Kernel.PutSector(dpg1, b) END 215 | ELSE 216 | b.e[b.m-1].p := a.e[R].p; a.e[R] := b.e[b.m-1]; 217 | DEC(b.m); h := b.m < N; Kernel.PutSector(dpg1, b) 218 | END 219 | END del; 220 | 221 | BEGIN (*~h*) Kernel.GetSector(dpg0, a); ASSERT(a.mark = DirMark); 222 | L := 0; R := a.m; (*binary search*) 223 | WHILE L < R DO 224 | i := (L+R) DIV 2; 225 | IF name <= a.e[i].name THEN R := i ELSE L := i+1 END 226 | END ; 227 | IF R = 0 THEN dpg1 := a.p0 ELSE dpg1 := a.e[R-1].p END ; 228 | IF (R < a.m) & (name = a.e[R].name) THEN 229 | (*found, now delete*) fad := a.e[R].adr; 230 | IF dpg1 = 0 THEN (*a is a leaf page*) 231 | DEC(a.m); h := a.m < N; i := R; 232 | WHILE i < a.m DO a.e[i] := a.e[i+1]; INC(i) END 233 | ELSE del(a, R, dpg1, h); 234 | IF h THEN underflow(a, dpg1, R, h) END 235 | END ; 236 | Kernel.PutSector(dpg0, a) 237 | ELSIF dpg1 # 0 THEN 238 | delete(name, dpg1, h, fad); 239 | IF h THEN underflow(a, dpg1, R, h); Kernel.PutSector(dpg0, a) END 240 | ELSE (*not in tree*) fad := 0 241 | END 242 | END delete; 243 | 244 | PROCEDURE Delete*(name: FileName; VAR fad: DiskAdr); 245 | VAR h: BOOLEAN; newroot: DiskAdr; 246 | a: DirPage; 247 | BEGIN h := FALSE; 248 | delete(name, DirRootAdr, h, fad); 249 | IF h THEN (*root underflow*) 250 | Kernel.GetSector(DirRootAdr, a); ASSERT(a.mark = DirMark); 251 | IF (a.m = 0) & (a.p0 # 0) THEN 252 | newroot := a.p0; Kernel.GetSector(newroot, a); ASSERT(a.mark = DirMark); 253 | Kernel.PutSector(DirRootAdr, a) (*discard newroot*) 254 | END 255 | END 256 | END Delete; 257 | 258 | PROCEDURE enumerate(prefix: ARRAY OF CHAR; 259 | dpg: DiskAdr; 260 | proc: EntryHandler; 261 | VAR continue: BOOLEAN); 262 | VAR i, j: INTEGER; pfx, nmx: CHAR; 263 | dpg1: DiskAdr; a: DirPage; 264 | BEGIN Kernel.GetSector(dpg, a); ASSERT(a.mark = DirMark); i := 0; 265 | WHILE (i < a.m) & continue DO 266 | j := 0; 267 | REPEAT pfx := prefix[j]; nmx := a.e[i].name[j]; INC(j) 268 | UNTIL (nmx # pfx) OR (pfx = 0X); 269 | IF nmx >= pfx THEN 270 | IF i = 0 THEN dpg1 := a.p0 ELSE dpg1 := a.e[i-1].p END ; 271 | IF dpg1 # 0 THEN enumerate(prefix, dpg1, proc, continue) END ; 272 | IF pfx = 0X THEN 273 | IF continue THEN proc(a.e[i].name, a.e[i].adr, continue) END 274 | ELSE continue := FALSE 275 | END 276 | END ; 277 | INC(i) 278 | END ; 279 | IF continue & (i > 0) & (a.e[i-1].p # 0) THEN 280 | enumerate(prefix, a.e[i-1].p, proc, continue) 281 | END 282 | END enumerate; 283 | 284 | PROCEDURE Enumerate*(prefix: ARRAY OF CHAR; proc: EntryHandler); 285 | VAR b: BOOLEAN; 286 | BEGIN b := TRUE; enumerate(prefix, DirRootAdr, proc, b) 287 | END Enumerate; 288 | 289 | (* ----- initialization ----- *) 290 | 291 | PROCEDURE Init*; 292 | VAR k: INTEGER; 293 | A: ARRAY 2000 OF DiskAdr; 294 | 295 | PROCEDURE MarkSectors(VAR A: ARRAY OF DiskAdr; k: INTEGER); 296 | VAR L, R, i, j, n: INTEGER; x: DiskAdr; 297 | hd: FileHeader; 298 | B: IndexSector; 299 | 300 | PROCEDURE sift(VAR A: ARRAY OF DiskAdr; L, R: INTEGER); 301 | VAR i, j: INTEGER; x: DiskAdr; 302 | BEGIN j := L; x := A[j]; 303 | REPEAT i := j; j := 2*j + 1; 304 | IF (j+1 < R) & (A[j] < A[j+1]) THEN INC(j) END ; 305 | IF (j < R) & (x <= A[j]) THEN A[i] := A[j] END 306 | UNTIL (j >= R) OR (x > A[j]); 307 | A[i] := x 308 | END sift; 309 | 310 | BEGIN L := k DIV 2; R := k; (*heapsort*) 311 | WHILE L > 0 DO DEC(L); sift(A, L, R) END ; 312 | WHILE R > 0 DO 313 | DEC(R); x := A[0]; A[0] := A[R]; A[R] := x; sift(A, L, R) 314 | END ; 315 | WHILE L < k DO 316 | Kernel.GetSector(A[L], hd); ASSERT(hd.mark = HeaderMark); 317 | IF hd.aleng < SecTabSize THEN j := hd.aleng + 1; 318 | REPEAT DEC(j); Kernel.MarkSector(hd.sec[j]) UNTIL j = 0 319 | ELSE j := SecTabSize; 320 | REPEAT DEC(j); Kernel.MarkSector(hd.sec[j]) UNTIL j = 0; 321 | n := (hd.aleng - SecTabSize) DIV 256; i := 0; 322 | WHILE i <= n DO 323 | Kernel.MarkSector(hd.ext[i]); 324 | Kernel.GetSector(hd.ext[i], B); (*index sector*) 325 | IF i < n THEN j := 256 ELSE j := (hd.aleng - SecTabSize) MOD 256 + 1 END ; 326 | REPEAT DEC(j); Kernel.MarkSector(B[j]) UNTIL j = 0; 327 | INC(i) 328 | END 329 | END ; 330 | INC(L) 331 | END 332 | END MarkSectors; 333 | 334 | PROCEDURE TraverseDir(VAR A: ARRAY OF DiskAdr; VAR k: INTEGER; dpg: DiskAdr); 335 | VAR i: INTEGER; a: DirPage; 336 | BEGIN Kernel.GetSector(dpg, a); ASSERT(a.mark = DirMark); Kernel.MarkSector(dpg); i := 0; 337 | WHILE i < a.m DO 338 | A[k] := a.e[i].adr; INC(k); INC(i); 339 | IF k = 2000 THEN MarkSectors(A, k); k := 0 END 340 | END ; 341 | IF a.p0 # 0 THEN 342 | TraverseDir(A, k, a.p0); i := 0; 343 | WHILE i < a.m DO 344 | TraverseDir(A, k, a.e[i].p); INC(i) 345 | END 346 | END 347 | END TraverseDir; 348 | 349 | BEGIN k := 0; TraverseDir(A, k, DirRootAdr); MarkSectors(A, k) 350 | END Init; 351 | 352 | END FileDir. 353 | -------------------------------------------------------------------------------- /Oberon/Files.Mod: -------------------------------------------------------------------------------- 1 | MODULE Files; (*NW 11.1.86 / 22.9.93 / 25.5.95 / 25.12.95 / 15.8.2013*) 2 | IMPORT SYSTEM, Kernel, FileDir; 3 | 4 | (*A file consists of a sequence of pages. The first page 5 | contains the header. Part of the header is the page table, an array 6 | of disk addresses to the pages. A file is referenced through riders. 7 | A rider indicates a current position and refers to a file*) 8 | 9 | CONST MaxBufs = 4; 10 | HS = FileDir.HeaderSize; 11 | SS = FileDir.SectorSize; 12 | STS = FileDir.SecTabSize; 13 | XS = FileDir.IndexSize; 14 | 15 | TYPE DiskAdr = INTEGER; 16 | File* = POINTER TO FileDesc; 17 | Buffer = POINTER TO BufferRecord; 18 | Index = POINTER TO IndexRecord; 19 | 20 | Rider* = 21 | RECORD eof*: BOOLEAN; 22 | res*: INTEGER; 23 | file: File; 24 | apos, bpos: INTEGER; 25 | buf: Buffer 26 | END ; 27 | 28 | FileDesc = 29 | RECORD next: INTEGER; (*list of files invisible to the GC*) 30 | nofbufs, aleng, bleng: INTEGER; 31 | modH, registered: BOOLEAN; 32 | firstbuf: Buffer; 33 | sechint: DiskAdr; 34 | name: FileDir.FileName; 35 | date: INTEGER; 36 | ext: ARRAY FileDir.ExTabSize OF Index; 37 | sec: FileDir.SectorTable 38 | END ; 39 | 40 | BufferRecord = 41 | RECORD apos, lim: INTEGER; 42 | mod: BOOLEAN; 43 | next: Buffer; 44 | data: FileDir.DataSector 45 | END ; 46 | 47 | IndexRecord = 48 | RECORD adr: DiskAdr; 49 | mod: BOOLEAN; 50 | sec: FileDir.IndexSector 51 | END ; 52 | 53 | (*aleng * SS + bleng = length (including header) 54 | apos * SS + bpos = current position 55 | 0 <= bpos <= lim <= SS 56 | 0 <= apos <= aleng < PgTabSize 57 | (apos < aleng) & (lim = SS) OR (apos = aleng) *) 58 | 59 | VAR root: INTEGER (*File*); (*list of open files*) 60 | 61 | PROCEDURE Check(s: ARRAY OF CHAR; 62 | VAR name: FileDir.FileName; VAR res: INTEGER); 63 | VAR i: INTEGER; ch: CHAR; 64 | BEGIN ch := s[0]; i := 0; 65 | IF (ch >= "A") & (ch <= "Z") OR (ch >= "a") & (ch <= "z") THEN 66 | REPEAT name[i] := ch; INC(i); ch := s[i] 67 | UNTIL ~((ch >= "0") & (ch <= "9") OR (ch >= "A") & (ch <= "Z") 68 | OR (ch >= "a") & (ch <= "z") OR (ch = ".")) OR (i = FileDir.FnLength); 69 | IF i = FileDir.FnLength THEN res := 4 70 | ELSIF ch = 0X THEN res := 0; 71 | WHILE i < FileDir.FnLength DO name[i] := 0X; INC(i) END 72 | ELSE res := 5 73 | END 74 | ELSIF ch = 0X THEN name[0] := 0X; res := -1 75 | ELSE res := 3 76 | END 77 | END Check; 78 | 79 | PROCEDURE Old*(name: ARRAY OF CHAR): File; 80 | VAR i, k, res: INTEGER; 81 | f: File; 82 | header: DiskAdr; 83 | buf: Buffer; 84 | F: FileDir.FileHd; 85 | namebuf: FileDir.FileName; 86 | inxpg: Index; 87 | BEGIN f := NIL; Check(name, namebuf, res); 88 | IF res = 0 THEN 89 | FileDir.Search(namebuf, header); 90 | IF header # 0 THEN 91 | f := SYSTEM.VAL(File, root); 92 | WHILE (f # NIL) & (f.sec[0] # header) DO f := SYSTEM.VAL(File, f.next) END ; 93 | IF f = NIL THEN (*file not yet present*) 94 | NEW(buf); buf.apos := 0; buf.next := buf; buf.mod := FALSE; 95 | F := SYSTEM.VAL(FileDir.FileHd, SYSTEM.ADR(buf.data)); 96 | Kernel.GetSector(header, buf.data); ASSERT(F.mark = FileDir.HeaderMark); 97 | NEW(f); f.aleng := F.aleng; f.bleng := F.bleng; f.date := F.date; 98 | IF f.aleng = 0 THEN buf.lim := f.bleng ELSE buf.lim := SS END ; 99 | f.firstbuf := buf; f.nofbufs := 1; f.name := namebuf; f.registered := TRUE; 100 | f.sec := F.sec; 101 | k := (f.aleng + (XS-STS)) DIV XS; i := 0; 102 | WHILE i < k DO 103 | NEW(inxpg); inxpg.adr := F.ext[i]; inxpg.mod := FALSE; 104 | Kernel.GetSector(inxpg.adr, inxpg.sec); f.ext[i] := inxpg; INC(i) 105 | END ; 106 | WHILE i < FileDir.ExTabSize DO f.ext[i] := NIL; INC(i) END ; 107 | f.sechint := header; f.modH := FALSE; f.next := root; root := SYSTEM.VAL(INTEGER, f) 108 | END 109 | END 110 | END ; 111 | RETURN f 112 | END Old; 113 | 114 | PROCEDURE New*(name: ARRAY OF CHAR): File; 115 | VAR i, res: INTEGER; 116 | f: File; 117 | buf: Buffer; 118 | F: FileDir.FileHd; 119 | namebuf: FileDir.FileName; 120 | BEGIN f := NIL; Check(name, namebuf, res); 121 | IF res <= 0 THEN 122 | NEW(buf); buf.apos := 0; buf.mod := TRUE; buf.lim := HS; buf.next := buf; 123 | F := SYSTEM.VAL(FileDir.FileHd, SYSTEM.ADR(buf.data)); 124 | F.mark := FileDir.HeaderMark; 125 | F.aleng := 0; F.bleng := HS; F.name := namebuf; 126 | F.date := Kernel.Clock(); 127 | NEW(f); f.aleng := 0; f.bleng := HS; f.modH := TRUE; 128 | f.registered := FALSE; f.date := F.date; 129 | f.firstbuf := buf; f.nofbufs := 1; f.name := namebuf; f.sechint := 0; 130 | i := 0; 131 | REPEAT f.ext[i] := NIL; F.ext[i] := 0; INC(i) UNTIL i = FileDir.ExTabSize; 132 | i := 0; 133 | REPEAT f.sec[i] := 0; F.sec[i] := 0; INC(i) UNTIL i = STS 134 | END ; 135 | RETURN f 136 | END New; 137 | 138 | PROCEDURE UpdateHeader(f: File; VAR F: FileDir.FileHeader); 139 | VAR k: INTEGER; 140 | BEGIN F.aleng := f.aleng; F.bleng := f.bleng; 141 | F.sec := f.sec; k := (f.aleng + (XS-STS)) DIV XS; 142 | WHILE k > 0 DO DEC(k); F.ext[k] := f.ext[k].adr END 143 | END UpdateHeader; 144 | 145 | PROCEDURE ReadBuf(f: File; buf: Buffer; pos: INTEGER); 146 | VAR sec: DiskAdr; 147 | BEGIN 148 | IF pos < STS THEN sec := f.sec[pos] 149 | ELSE sec := f.ext[(pos-STS) DIV XS].sec[(pos-STS) MOD XS] 150 | END ; 151 | Kernel.GetSector(sec, buf.data); 152 | IF pos < f.aleng THEN buf.lim := SS ELSE buf.lim := f.bleng END ; 153 | buf.apos := pos; buf.mod := FALSE 154 | END ReadBuf; 155 | 156 | PROCEDURE WriteBuf(f: File; buf: Buffer); 157 | VAR i, k: INTEGER; 158 | secadr: DiskAdr; inx: Index; 159 | BEGIN 160 | IF buf.apos < STS THEN 161 | secadr := f.sec[buf.apos]; 162 | IF secadr = 0 THEN 163 | Kernel.AllocSector(f.sechint, secadr); 164 | f.modH := TRUE; f.sec[buf.apos] := secadr; f.sechint := secadr 165 | END ; 166 | IF buf.apos = 0 THEN 167 | UpdateHeader(f, SYSTEM.VAL(FileDir.FileHeader, buf.data)); f.modH := FALSE 168 | END 169 | ELSE i := (buf.apos - STS) DIV XS; inx := f.ext[i]; 170 | IF inx = NIL THEN 171 | NEW(inx); inx.adr := 0; inx.sec[0] := 0; f.ext[i] := inx; f.modH := TRUE 172 | END ; 173 | k := (buf.apos - STS) MOD XS; secadr := inx.sec[k]; 174 | IF secadr = 0 THEN 175 | Kernel.AllocSector(f.sechint, secadr); 176 | f.modH := TRUE; inx.mod := TRUE; inx.sec[k] := secadr; f.sechint := secadr 177 | END 178 | END ; 179 | Kernel.PutSector(secadr, buf.data); buf.mod := FALSE 180 | END WriteBuf; 181 | 182 | PROCEDURE Buf(f: File; pos: INTEGER): Buffer; 183 | VAR buf: Buffer; 184 | BEGIN buf := f.firstbuf; 185 | WHILE (buf.apos # pos) & (buf.next # f.firstbuf) DO buf := buf.next END ; 186 | IF buf.apos # pos THEN buf := NIL END ; 187 | RETURN buf 188 | END Buf; 189 | 190 | PROCEDURE GetBuf(f: File; pos: INTEGER): Buffer; 191 | VAR buf: Buffer; 192 | BEGIN buf := f.firstbuf; 193 | WHILE (buf.apos # pos) & (buf.next # f.firstbuf) DO buf := buf.next END ; 194 | IF buf.apos # pos THEN 195 | IF f.nofbufs < MaxBufs THEN (*allocate new buffer*) 196 | NEW(buf); buf.next := f.firstbuf.next; f.firstbuf.next := buf; INC(f.nofbufs) 197 | ELSE (*reuse a buffer*) f.firstbuf := buf; 198 | IF buf.mod THEN WriteBuf(f, buf) END 199 | END ; 200 | IF pos <= f.aleng THEN ReadBuf(f, buf, pos) ELSE buf.apos := pos; buf.lim := 0; buf.mod := FALSE END 201 | END ; 202 | RETURN buf 203 | END GetBuf; 204 | 205 | PROCEDURE Unbuffer(f: File); 206 | VAR i, k: INTEGER; 207 | buf: Buffer; 208 | inx: Index; 209 | head: FileDir.FileHeader; 210 | BEGIN buf := f.firstbuf; 211 | REPEAT 212 | IF buf.mod THEN WriteBuf(f, buf) END ; 213 | buf := buf.next 214 | UNTIL buf = f.firstbuf; 215 | k := (f.aleng + (XS-STS)) DIV XS; i := 0; 216 | WHILE i < k DO 217 | inx := f.ext[i]; INC(i); 218 | IF inx.mod THEN 219 | IF inx.adr = 0 THEN 220 | Kernel.AllocSector(f.sechint, inx.adr); f.sechint := inx.adr; f.modH := TRUE 221 | END ; 222 | Kernel.PutSector(inx.adr, inx.sec); inx.mod := FALSE 223 | END 224 | END ; 225 | IF f.modH THEN 226 | Kernel.GetSector(f.sec[0], head); UpdateHeader(f, head); 227 | Kernel.PutSector(f.sec[0], head); f.modH := FALSE 228 | END 229 | END Unbuffer; 230 | 231 | PROCEDURE Register*(f: File); 232 | BEGIN 233 | IF (f # NIL) & (f.name[0] # 0X) THEN 234 | Unbuffer(f); 235 | IF ~f.registered THEN 236 | FileDir.Insert(f.name, f.sec[0]); f.registered := TRUE; f.next := root; root := SYSTEM.VAL(INTEGER, f) 237 | END 238 | END 239 | END Register; 240 | 241 | PROCEDURE Close*(f: File); 242 | BEGIN 243 | IF f # NIL THEN Unbuffer(f) END 244 | END Close; 245 | 246 | PROCEDURE Purge*(f: File); 247 | VAR a, i, j, k: INTEGER; 248 | ind: FileDir.IndexSector; 249 | BEGIN 250 | IF f # NIL THEN a := f.aleng + 1; f.aleng := 0; f.bleng := HS; 251 | IF a <= STS THEN i := a; 252 | ELSE i := STS; DEC(a, i); j := (a-1) MOD XS; k := (a-1) DIV XS; 253 | WHILE k >= 0 DO 254 | Kernel.GetSector(f.ext[k].adr, ind); 255 | REPEAT DEC(j); Kernel.FreeSector(ind[j]) UNTIL j = 0; 256 | Kernel.FreeSector(f.ext[k].adr); j := XS; DEC(k) 257 | END 258 | END ; 259 | REPEAT DEC(i); Kernel.FreeSector(f.sec[i]) UNTIL i = 0 260 | END 261 | END Purge; 262 | 263 | PROCEDURE Delete*(name: ARRAY OF CHAR; VAR res: INTEGER); 264 | VAR adr: DiskAdr; 265 | namebuf: FileDir.FileName; 266 | BEGIN Check(name, namebuf, res); 267 | IF res = 0 THEN 268 | FileDir.Delete(namebuf, adr); 269 | IF adr = 0 THEN res := 2 END 270 | END 271 | END Delete; 272 | 273 | PROCEDURE Rename*(old, new: ARRAY OF CHAR; VAR res: INTEGER); 274 | VAR adr: DiskAdr; 275 | oldbuf, newbuf: FileDir.FileName; 276 | head: FileDir.FileHeader; 277 | BEGIN Check(old, oldbuf, res); 278 | IF res = 0 THEN 279 | Check(new, newbuf, res); 280 | IF res = 0 THEN 281 | FileDir.Delete(oldbuf, adr); 282 | IF adr # 0 THEN 283 | FileDir.Insert(newbuf, adr); 284 | Kernel.GetSector(adr, head); head.name := newbuf; Kernel.PutSector(adr, head) 285 | ELSE res := 2 286 | END 287 | END 288 | END 289 | END Rename; 290 | 291 | PROCEDURE Length*(f: File): INTEGER; 292 | BEGIN RETURN f.aleng * SS + f.bleng - HS 293 | END Length; 294 | 295 | PROCEDURE Date*(f: File): INTEGER; 296 | BEGIN RETURN f.date 297 | END Date; 298 | 299 | (*---------------------------Read---------------------------*) 300 | 301 | PROCEDURE Set*(VAR r: Rider; f: File; pos: INTEGER); 302 | VAR a, b: INTEGER; 303 | BEGIN r.eof := FALSE; r.res := 0; 304 | IF f # NIL THEN 305 | IF pos < 0 THEN a := 0; b := HS 306 | ELSIF pos < f.aleng * SS + f.bleng - HS THEN 307 | a := (pos + HS) DIV SS; b := (pos + HS) MOD SS; 308 | ELSE a := f.aleng; b := f.bleng 309 | END ; 310 | r.file := f; r.apos := a; r.bpos := b; r.buf := f.firstbuf 311 | ELSE r.file:= NIL 312 | END 313 | END Set; 314 | 315 | PROCEDURE Pos*(VAR r: Rider): INTEGER; 316 | BEGIN RETURN r.apos * SS + r.bpos - HS 317 | END Pos; 318 | 319 | PROCEDURE Base*(VAR r: Rider): File; 320 | BEGIN RETURN r.file 321 | END Base; 322 | 323 | PROCEDURE ReadByte*(VAR r: Rider; VAR x: BYTE); 324 | VAR buf: Buffer; 325 | BEGIN 326 | IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos) END ; 327 | IF r.bpos < r.buf.lim THEN x := r.buf.data[r.bpos]; INC(r.bpos) 328 | ELSIF r.apos < r.file.aleng THEN 329 | INC(r.apos); buf := Buf(r.file, r.apos); 330 | IF buf = NIL THEN 331 | IF r.buf.mod THEN WriteBuf(r.file, r.buf) END ; 332 | ReadBuf(r.file, r.buf, r.apos) 333 | ELSE r.buf := buf 334 | END ; 335 | x := r.buf.data[0]; r.bpos := 1 336 | ELSE x := 0; r.eof := TRUE 337 | END 338 | END ReadByte; 339 | 340 | PROCEDURE ReadBytes*(VAR r: Rider; VAR x: ARRAY OF BYTE; n: INTEGER); 341 | VAR i: INTEGER; 342 | BEGIN i := 0; (*this implementation is to be improved*) 343 | WHILE i < n DO ReadByte(r, x[i]); INC(i) END 344 | END ReadBytes; 345 | 346 | PROCEDURE Read*(VAR r: Rider; VAR ch: CHAR); 347 | VAR buf: Buffer; (*same as ReadByte*) 348 | BEGIN 349 | IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos) END ; 350 | IF r.bpos < r.buf.lim THEN ch := CHR(r.buf.data[r.bpos]); INC(r.bpos) 351 | ELSIF r.apos < r.file.aleng THEN 352 | INC(r.apos); buf := Buf(r.file, r.apos); 353 | IF buf = NIL THEN 354 | IF r.buf.mod THEN WriteBuf(r.file, r.buf) END ; 355 | ReadBuf(r.file, r.buf, r.apos) 356 | ELSE r.buf := buf 357 | END ; 358 | ch := CHR(r.buf.data[0]); r.bpos := 1 359 | ELSE ch := 0X; r.eof := TRUE 360 | END 361 | END Read; 362 | 363 | PROCEDURE ReadInt*(VAR R: Rider; VAR x: INTEGER); 364 | VAR x0, x1, x2, x3: BYTE; 365 | BEGIN ReadByte(R, x0); ReadByte(R, x1); ReadByte(R, x2); ReadByte(R, x3); 366 | x := ((x3 * 100H + x2) * 100H + x1) * 100H + x0 367 | END ReadInt; 368 | 369 | PROCEDURE ReadSet*(VAR R: Rider; VAR s: SET); 370 | VAR n: INTEGER; 371 | BEGIN ReadInt(R, SYSTEM.VAL(INTEGER, s)) 372 | END ReadSet; 373 | 374 | PROCEDURE ReadReal*(VAR R: Rider; VAR x: REAL); 375 | VAR n: INTEGER; 376 | BEGIN ReadInt(R, SYSTEM.VAL(INTEGER, x)) 377 | END ReadReal; 378 | 379 | PROCEDURE ReadString*(VAR R: Rider; VAR x: ARRAY OF CHAR); 380 | VAR i: INTEGER; ch: CHAR; 381 | BEGIN i := 0; Read(R, ch); 382 | WHILE ch # 0X DO 383 | IF i < LEN(x)-1 THEN x[i] := ch; INC(i) END ; 384 | Read(R, ch) 385 | END ; 386 | x[i] := 0X 387 | END ReadString; 388 | 389 | PROCEDURE ReadNum*(VAR R: Rider; VAR x: INTEGER); 390 | VAR n, y: INTEGER; b: BYTE; 391 | BEGIN n := 32; y := 0; ReadByte(R, b); 392 | WHILE b >= 80H DO y := ROR(y + b-80H, 7); DEC(n, 7); ReadByte(R, b) END ; 393 | IF n <= 4 THEN x := ROR(y + b MOD 10H, 4) ELSE x := ASR(ROR(y + b, 7), n-7) END 394 | END ReadNum; 395 | 396 | (*---------------------------Write---------------------------*) 397 | 398 | PROCEDURE NewExt(f: File); 399 | VAR i, k: INTEGER; ext: Index; 400 | BEGIN k := (f.aleng - STS) DIV XS; 401 | NEW(ext); ext.adr := 0; ext.mod := TRUE; f.ext[k] := ext; i := XS; 402 | REPEAT DEC(i); ext.sec[i] := 0 UNTIL i = 0 403 | END NewExt; 404 | 405 | PROCEDURE WriteByte*(VAR r: Rider; x: BYTE); 406 | VAR f: File; buf: Buffer; 407 | BEGIN 408 | IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos); END ; 409 | IF r.bpos >= r.buf.lim THEN 410 | IF r.bpos < SS THEN 411 | INC(r.buf.lim); INC(r.file.bleng); r.file.modH := TRUE 412 | ELSE f := r.file; WriteBuf(f, r.buf); INC(r.apos); buf := Buf(r.file, r.apos); 413 | IF buf = NIL THEN 414 | IF r.apos <= f.aleng THEN ReadBuf(f, r.buf, r.apos) 415 | ELSE r.buf.apos := r.apos; r.buf.lim := 1; f.aleng := f.aleng + 1; f.bleng := 1; f.modH := TRUE; 416 | IF (f.aleng - STS) MOD XS = 0 THEN NewExt(f) END 417 | END 418 | ELSE r.buf := buf 419 | END ; 420 | r.bpos := 0 421 | END 422 | END ; 423 | r.buf.data[r.bpos] := x; INC(r.bpos); r.buf.mod := TRUE 424 | END WriteByte; 425 | 426 | PROCEDURE WriteBytes*(VAR r: Rider; x: ARRAY OF BYTE; n: INTEGER); 427 | VAR i: INTEGER; 428 | BEGIN i := 0; (*this implementation is to be improed*) 429 | WHILE i < n DO WriteByte(r, x[i]); INC(i) END 430 | END WriteBytes; 431 | 432 | PROCEDURE Write*(VAR r: Rider; ch: CHAR); 433 | VAR f: File; buf: Buffer; 434 | BEGIN (*same as WriteByte*) 435 | IF r.apos # r.buf.apos THEN r.buf := GetBuf(r.file, r.apos); END ; 436 | IF r.bpos >= r.buf.lim THEN 437 | IF r.bpos < SS THEN 438 | INC(r.buf.lim); INC(r.file.bleng); r.file.modH := TRUE 439 | ELSE f := r.file; WriteBuf(f, r.buf); INC(r.apos); buf := Buf(r.file, r.apos); 440 | IF buf = NIL THEN 441 | IF r.apos <= f.aleng THEN ReadBuf(f, r.buf, r.apos) 442 | ELSE r.buf.apos := r.apos; r.buf.lim := 1; f.aleng := f.aleng + 1; f.bleng := 1; f.modH := TRUE; 443 | IF (f.aleng - STS) MOD XS = 0 THEN NewExt(f) END 444 | END 445 | ELSE r.buf := buf 446 | END ; 447 | r.bpos := 0 448 | END 449 | END ; 450 | r.buf.data[r.bpos] := ORD(ch); INC(r.bpos); r.buf.mod := TRUE 451 | END Write; 452 | 453 | PROCEDURE WriteInt*(VAR R: Rider; x: INTEGER); 454 | BEGIN WriteByte(R, x MOD 100H); 455 | WriteByte(R, x DIV 100H MOD 100H); 456 | WriteByte(R, x DIV 10000H MOD 100H); 457 | WriteByte(R, x DIV 1000000H MOD 100H) 458 | END WriteInt; 459 | 460 | PROCEDURE WriteSet*(VAR R: Rider; s: SET); 461 | BEGIN WriteInt(R, ORD(s)) 462 | END WriteSet; 463 | 464 | PROCEDURE WriteReal*(VAR R: Rider; x: REAL); 465 | BEGIN WriteInt(R, ORD(x)) 466 | END WriteReal; 467 | 468 | PROCEDURE WriteString*(VAR R: Rider; x: ARRAY OF CHAR); 469 | VAR i: INTEGER; ch: CHAR; 470 | BEGIN i := 0; 471 | REPEAT ch := x[i]; Write(R, ch); INC(i) UNTIL ch = 0X 472 | END WriteString; 473 | 474 | PROCEDURE WriteNum*(VAR R: Rider; x: INTEGER); 475 | BEGIN 476 | WHILE (x < -40H) OR (x >= 40H) DO WriteByte(R, x MOD 80H + 80H); x := ASR(x, 7) END ; 477 | WriteByte(R, x MOD 80H) 478 | END WriteNum; 479 | 480 | (*---------------------------System use---------------------------*) 481 | 482 | PROCEDURE Init*; 483 | BEGIN root := 0; Kernel.Init; FileDir.Init 484 | END Init; 485 | 486 | PROCEDURE RestoreList*; (*after mark phase of garbage collection*) 487 | VAR f, f0: INTEGER; 488 | 489 | PROCEDURE mark(f: INTEGER): INTEGER; 490 | VAR m: INTEGER; 491 | BEGIN 492 | IF f = 0 THEN m := -1 ELSE SYSTEM.GET(f-4, m) END ; 493 | RETURN m 494 | END mark; 495 | 496 | BEGIN (*field "next" has offset 0*) 497 | WHILE mark(root) = 0 DO SYSTEM.GET(root, root) END ; 498 | f := root; 499 | WHILE f # 0 DO 500 | f0 := f; 501 | REPEAT SYSTEM.GET(f0, f0) UNTIL mark(f0) # 0; 502 | SYSTEM.PUT(f, f0); f := f0 503 | END 504 | END RestoreList; 505 | 506 | END Files. -------------------------------------------------------------------------------- /Oberon/Fonts.Mod: -------------------------------------------------------------------------------- 1 | MODULE Fonts; (*JG 18.11.90; PDR 8.6.12; NW 25.3.2013*) 2 | IMPORT SYSTEM, Files; 3 | 4 | CONST FontFileId = 0DBH; 5 | 6 | TYPE Font* = POINTER TO FontDesc; 7 | FontDesc* = RECORD 8 | name*: ARRAY 32 OF CHAR; 9 | height*, minX*, maxX*, minY*, maxY*: INTEGER; 10 | next*: Font; 11 | T: ARRAY 128 OF INTEGER; 12 | raster: ARRAY 2360 OF BYTE 13 | END ; 14 | 15 | LargeFontDesc = RECORD (FontDesc) ext: ARRAY 2560 OF BYTE END ; 16 | LargeFont = POINTER TO LargeFontDesc; 17 | 18 | (* raster sizes: Syntax8 1367, Syntax10 1628, Syntax12 1688, Syntax14 1843, Syntax14b 1983, 19 | Syntax16 2271, Syntax20 3034, Syntac24 4274, Syntax24b 4302 *) 20 | 21 | VAR Default*, root*: Font; 22 | 23 | PROCEDURE GetPat*(fnt: Font; ch: CHAR; VAR dx, x, y, w, h, patadr: INTEGER); 24 | VAR pa: INTEGER; dxb, xb, yb, wb, hb: BYTE; 25 | BEGIN pa := fnt.T[ORD(ch) MOD 80H]; patadr := pa; 26 | SYSTEM.GET(pa-3, dxb); SYSTEM.GET(pa-2, xb); SYSTEM.GET(pa-1, yb); SYSTEM.GET(pa, wb); SYSTEM.GET(pa+1, hb); 27 | dx := dxb; x := xb; y := yb; w := wb; h := hb; 28 | IF yb < 128 THEN y := yb ELSE y := yb - 256 END 29 | END GetPat; 30 | 31 | PROCEDURE This*(name: ARRAY OF CHAR): Font; 32 | 33 | TYPE RunRec = RECORD beg, end: BYTE END ; 34 | BoxRec = RECORD dx, x, y, w, h: BYTE END ; 35 | 36 | VAR F: Font; LF: LargeFont; 37 | f: Files.File; R: Files.Rider; 38 | NofRuns, NofBoxes: BYTE; 39 | NofBytes: INTEGER; 40 | height, minX, maxX, minY, maxY: BYTE; 41 | i, j, k, m, n: INTEGER; 42 | a, a0: INTEGER; 43 | b, beg, end: BYTE; 44 | run: ARRAY 16 OF RunRec; 45 | box: ARRAY 512 OF BoxRec; 46 | 47 | PROCEDURE RdInt16(VAR R: Files.Rider; VAR b0: BYTE); 48 | VAR b1: BYTE; 49 | BEGIN Files.ReadByte(R, b0); Files.ReadByte(R, b1) 50 | END RdInt16; 51 | 52 | BEGIN F := root; 53 | WHILE (F # NIL) & (name # F.name) DO F := F.next END; 54 | IF F = NIL THEN 55 | f := Files.Old(name); 56 | IF f # NIL THEN 57 | Files.Set(R, f, 0); Files.ReadByte(R, b); 58 | IF b = FontFileId THEN 59 | Files.ReadByte(R, b); (*abstraction*) 60 | Files.ReadByte(R, b); (*family*) 61 | Files.ReadByte(R, b); (*variant*) 62 | NEW(F); F.name := name; 63 | RdInt16(R, height); RdInt16(R, minX); RdInt16(R, maxX); RdInt16(R, minY); RdInt16(R, maxY); RdInt16(R, NofRuns); 64 | NofBoxes := 0; k := 0; 65 | WHILE k # NofRuns DO 66 | RdInt16(R, beg); 67 | run[k].beg := beg; RdInt16(R, end); 68 | run[k].end := end; NofBoxes := NofBoxes + end - beg; INC(k) 69 | END; 70 | NofBytes := 5; j := 0; 71 | WHILE j # NofBoxes DO 72 | RdInt16(R, box[j].dx); RdInt16(R, box[j].x); RdInt16(R, box[j].y); 73 | RdInt16(R, box[j].w); RdInt16(R, box[j].h); 74 | NofBytes := NofBytes + 5 + (box[j].w + 7) DIV 8 * box[j].h; 75 | INC(j) 76 | END; 77 | IF NofBytes < 2300 THEN NEW(F) ELSE NEW(LF); F := LF END ; 78 | F.name := name; 79 | F.height := height; F.minX := minX; F.maxX := maxX; F.maxY := maxY; 80 | IF minY >= 80H THEN F.minY := minY - 100H ELSE F.minY := minY END ; 81 | a0 := SYSTEM.ADR(F.raster); 82 | SYSTEM.PUT(a0, 0X); SYSTEM.PUT(a0+1, 0X); SYSTEM.PUT(a0+2, 0X); SYSTEM.PUT(a0+3, 0X); SYSTEM.PUT(a0+4, 0X); 83 | (*null pattern for characters not in a run*) 84 | INC(a0, 2); a := a0+3; j := 0; k := 0; m := 0; 85 | WHILE k < NofRuns DO 86 | WHILE (m < run[k].beg) & (m < 128) DO F.T[m] := a0; INC(m) END; 87 | WHILE (m < run[k].end) & (m < 128) DO 88 | F.T[m] := a+3; 89 | SYSTEM.PUT(a, box[j].dx); SYSTEM.PUT(a+1, box[j].x); SYSTEM.PUT(a+2, box[j].y); 90 | SYSTEM.PUT(a+3, box[j].w); SYSTEM.PUT(a+4, box[j].h); INC(a, 5); 91 | n := (box[j].w + 7) DIV 8 * box[j].h; 92 | WHILE n # 0 DO DEC(n); Files.ReadByte(R, b); SYSTEM.PUT(a, b); INC(a) END ; 93 | INC(j); INC(m) 94 | END; 95 | INC(k) 96 | END; 97 | WHILE m < 128 DO F.T[m] := a0; INC(m) END ; 98 | F.next := root; root := F 99 | ELSE (*bad file id*) F := Default 100 | END 101 | ELSE (*font file not available*) F := Default 102 | END 103 | END; 104 | RETURN F 105 | END This; 106 | 107 | PROCEDURE Free*; (*remove all but first two from font list*) 108 | VAR f: Font; 109 | BEGIN f := root.next; 110 | IF f # NIL THEN f := f.next END ; 111 | f.next := NIL 112 | END Free; 113 | 114 | BEGIN root := NIL; Default := This("Oberon10.Scn.Fnt") 115 | END Fonts. 116 | -------------------------------------------------------------------------------- /Oberon/Kernel.Mod: -------------------------------------------------------------------------------- 1 | MODULE Kernel; (*NW/PR 11.4.86 / 27.12.95 / 4.2.2014*) 2 | IMPORT SYSTEM; 3 | CONST SectorLength* = 1024; 4 | timer = -64; spiData = -48; spiCtrl = -44; 5 | CARD0 = 1; SPIFAST = 4; 6 | FSoffset = 80000H; (*256MB in 512-byte blocks*) 7 | mapsize = 10000H; (*1K sectors, 64MB*) 8 | 9 | TYPE Sector* = ARRAY SectorLength OF BYTE; 10 | 11 | VAR allocated*, NofSectors*: INTEGER; 12 | heapOrg*, heapLim*: INTEGER; 13 | stackOrg* , stackSize*, MemLim*: INTEGER; 14 | clock: INTEGER; 15 | list0, list1, list2, list3: INTEGER; (*lists of free blocks of size n*256, 128, 64, 32 bytes*) 16 | data: INTEGER; (*SPI data in*) 17 | sectorMap: ARRAY mapsize DIV 32 OF SET; 18 | 19 | (* ---------- New: heap allocation ----------*) 20 | 21 | PROCEDURE GetBlock(VAR p: LONGINT; len: LONGINT); 22 | (*len is multiple of 256*) 23 | VAR q0, q1, q2, size: LONGINT; done: BOOLEAN; 24 | BEGIN q0 := 0; q1 := list0; done := FALSE; 25 | WHILE ~done & (q1 # 0) DO 26 | SYSTEM.GET(q1, size); SYSTEM.GET(q1+8, q2); 27 | IF size < len THEN (*no fit*) q0 := q1; q1 := q2 28 | ELSIF size = len THEN (*extract -> p*) 29 | done := TRUE; p := q1; 30 | IF q0 # 0 THEN SYSTEM.PUT(q0+8, q2) ELSE list0 := q2 END 31 | ELSE (*reduce size*) 32 | done := TRUE; p := q1; q1 := q1 + len; 33 | SYSTEM.PUT(q1, size-len); SYSTEM.PUT(q1+4, -1); SYSTEM.PUT(q1+8, q2); 34 | IF q0 # 0 THEN SYSTEM.PUT(q0+8, q1) ELSE list0 := q1 END 35 | END 36 | END ; 37 | IF ~done THEN p := 0 END 38 | END GetBlock; 39 | 40 | PROCEDURE GetBlock128(VAR p: LONGINT); 41 | VAR q: LONGINT; 42 | BEGIN 43 | IF list1 # 0 THEN p := list1; SYSTEM.GET(list1+8, list1) 44 | ELSE GetBlock(q, 256); SYSTEM.PUT(q+128, 128); SYSTEM.PUT(q+132, -1); SYSTEM.PUT(q+136, list1); 45 | list1 := q + 128; p := q 46 | END 47 | END GetBlock128; 48 | 49 | PROCEDURE GetBlock64(VAR p: LONGINT); 50 | VAR q: LONGINT; 51 | BEGIN 52 | IF list2 # 0 THEN p := list2; SYSTEM.GET(list2+8, list2) 53 | ELSE GetBlock128(q); SYSTEM.PUT(q+64, 64); SYSTEM.PUT(q+68, -1); SYSTEM.PUT(q+72, list2); 54 | list2 := q + 64; p := q 55 | END 56 | END GetBlock64; 57 | 58 | PROCEDURE GetBlock32(VAR p: LONGINT); 59 | VAR q: LONGINT; 60 | BEGIN 61 | IF list3 # 0 THEN p := list3; SYSTEM.GET(list3+8, list3) 62 | ELSE GetBlock64(q); SYSTEM.PUT(q+32, 32); SYSTEM.PUT(q+36, -1); SYSTEM.PUT(q+40, list3); 63 | list3 := q + 32; p := q 64 | END 65 | END GetBlock32; 66 | 67 | PROCEDURE New*(VAR ptr: LONGINT; tag: LONGINT); 68 | (*called by NEW via MT[0]; ptr and tag are pointers*) 69 | VAR p, size, lim: LONGINT; 70 | BEGIN SYSTEM.GET(tag, size); 71 | IF size = 32 THEN GetBlock32(p) 72 | ELSIF size = 64 THEN GetBlock64(p) 73 | ELSIF size = 128 THEN GetBlock128(p) 74 | ELSE GetBlock(p, (size+255) DIV 256 * 256) 75 | END ; 76 | IF p = 0 THEN ptr := 0 77 | ELSE ptr := p+8; SYSTEM.PUT(p, tag); lim := p + size; INC(p, 4); INC(allocated, size); 78 | WHILE p < lim DO SYSTEM.PUT(p, 0); INC(p, 4) END 79 | END 80 | END New; 81 | 82 | (* ---------- Garbage collector ----------*) 83 | 84 | PROCEDURE Mark*(pref: LONGINT); 85 | VAR pvadr, offadr, offset, tag, p, q, r: LONGINT; 86 | BEGIN SYSTEM.GET(pref, pvadr); (*pointers < heapOrg considered NIL*) 87 | WHILE pvadr # 0 DO 88 | SYSTEM.GET(pvadr, p); SYSTEM.GET(p-4, offadr); 89 | IF (p >= heapOrg) & (offadr = 0) THEN q := p; (*mark elements in data structure with root p*) 90 | REPEAT SYSTEM.GET(p-4, offadr); 91 | IF offadr = 0 THEN SYSTEM.GET(p-8, tag); offadr := tag + 16 ELSE INC(offadr, 4) END ; 92 | SYSTEM.PUT(p-4, offadr); SYSTEM.GET(offadr, offset); 93 | IF offset # -1 THEN (*down*) 94 | SYSTEM.GET(p+offset, r); SYSTEM.GET(r-4, offadr); 95 | IF (r >= heapOrg) & (offadr = 0) THEN SYSTEM.PUT(p+offset, q); q := p; p := r END 96 | ELSE (*up*) SYSTEM.GET(q-4, offadr); SYSTEM.GET(offadr, offset); 97 | IF p # q THEN SYSTEM.GET(q+offset, r); SYSTEM.PUT(q+offset, p); p := q; q := r END 98 | END 99 | UNTIL (p = q) & (offset = -1) 100 | END ; 101 | INC(pref, 4); SYSTEM.GET(pref, pvadr) 102 | END 103 | END Mark; 104 | 105 | PROCEDURE Scan*; 106 | VAR p, q, mark, tag, size: LONGINT; 107 | BEGIN p := heapOrg; 108 | REPEAT SYSTEM.GET(p+4, mark); q := p; 109 | WHILE mark = 0 DO 110 | SYSTEM.GET(p, tag); SYSTEM.GET(tag, size); INC(p, size); SYSTEM.GET(p+4, mark) 111 | END ; 112 | size := p - q; DEC(allocated, size); (*size of free block*) 113 | IF size > 0 THEN 114 | IF size MOD 64 # 0 THEN 115 | SYSTEM.PUT(q, 32); SYSTEM.PUT(q+4, -1); SYSTEM.PUT(q+8, list3); list3 := q; INC(q, 32); DEC(size, 32) 116 | END ; 117 | IF size MOD 128 # 0 THEN 118 | SYSTEM.PUT(q, 64); SYSTEM.PUT(q+4, -1); SYSTEM.PUT(q+8, list2); list2 := q; INC(q, 64); DEC(size, 64) 119 | END ; 120 | IF size MOD 256 # 0 THEN 121 | SYSTEM.PUT(q, 128); SYSTEM.PUT(q+4, -1); SYSTEM.PUT(q+8, list1); list1 := q; INC(q, 128); DEC(size, 128) 122 | END ; 123 | IF size > 0 THEN 124 | SYSTEM.PUT(q, size); SYSTEM.PUT(q+4, -1); SYSTEM.PUT(q+8, list0); list0 := q; INC(q, size) 125 | END 126 | END ; 127 | IF mark > 0 THEN SYSTEM.GET(p, tag); SYSTEM.GET(tag, size); SYSTEM.PUT(p+4, 0); INC(p, size) 128 | ELSE (*free*) SYSTEM.GET(p, size); INC(p, size) 129 | END 130 | UNTIL p >= heapLim 131 | END Scan; 132 | 133 | (* ---------- Disk storage management ----------*) 134 | 135 | PROCEDURE SPIIdle(n: INTEGER); (*send n FFs slowly with no card selected*) 136 | BEGIN SYSTEM.PUT(spiCtrl, 0); 137 | WHILE n > 0 DO DEC(n); SYSTEM.PUT(spiData, -1); 138 | REPEAT UNTIL SYSTEM.BIT(spiCtrl, 0); 139 | SYSTEM.GET(spiData, data) 140 | END 141 | END SPIIdle; 142 | 143 | PROCEDURE SPI(n: INTEGER); (*send&rcv byte slowly with card selected*) 144 | BEGIN SYSTEM.PUT(spiCtrl, CARD0); SYSTEM.PUT(spiData, n); 145 | REPEAT UNTIL SYSTEM.BIT(spiCtrl, 0); 146 | SYSTEM.GET(spiData, data) 147 | END SPI; 148 | 149 | PROCEDURE SPICmd(n, arg: INTEGER); 150 | VAR i, crc: INTEGER; 151 | BEGIN (*send cmd*) 152 | REPEAT SPIIdle(1) UNTIL data = 255; (*flush while unselected*) 153 | REPEAT SPI(255) UNTIL data = 255; (*flush while selected*) 154 | IF n = 8 THEN crc := 135 ELSIF n = 0 THEN crc := 149 ELSE crc := 255 END; 155 | SPI(n MOD 64 + 64); (*send command*) 156 | FOR i := 24 TO 0 BY -8 DO SPI(ROR(arg, i)) END; (*send arg*) 157 | SPI(crc); i := 32; 158 | REPEAT SPI(255); DEC(i) UNTIL (data < 80H) OR (i = 0) 159 | END SPICmd; 160 | 161 | PROCEDURE SDShift(VAR n: INTEGER); 162 | VAR data: INTEGER; 163 | BEGIN SPICmd(58, 0); (*CMD58 get card capacity bit*) 164 | SYSTEM.GET(spiData, data); SPI(-1); 165 | IF (data # 0) OR ~SYSTEM.BIT(spiData, 6) THEN n := n * 512 END ; (*non-SDHC card*) 166 | SPI(-1); SPI(-1); SPIIdle(1) (*flush response*) 167 | END SDShift; 168 | 169 | PROCEDURE ReadSD(src, dst: INTEGER); 170 | VAR i: INTEGER; 171 | BEGIN SDShift(src); SPICmd(17, src); ASSERT(data = 0); (*CMD17 read one block*) 172 | i := 0; (*wait for start data marker*) 173 | REPEAT SPI(-1); INC(i) UNTIL data = 254; 174 | SYSTEM.PUT(spiCtrl, SPIFAST + CARD0); 175 | FOR i := 0 TO 508 BY 4 DO 176 | SYSTEM.PUT(spiData, -1); 177 | REPEAT UNTIL SYSTEM.BIT(spiCtrl, 0); 178 | SYSTEM.GET(spiData, data); SYSTEM.PUT(dst, data); INC(dst, 4) 179 | END; 180 | SPI(255); SPI(255); SPIIdle(1) (*may be a checksum; deselect card*) 181 | END ReadSD; 182 | 183 | PROCEDURE WriteSD(dst, src: INTEGER); 184 | VAR i, n: INTEGER; x: BYTE; 185 | BEGIN SDShift(dst); SPICmd(24, dst); ASSERT(data = 0); (*CMD24 write one block*) 186 | SPI(254); (*write start data marker*) 187 | SYSTEM.PUT(spiCtrl, SPIFAST + CARD0); 188 | FOR i := 0 TO 508 BY 4 DO 189 | SYSTEM.GET(src, n); INC(src, 4); SYSTEM.PUT(spiData, n); 190 | REPEAT UNTIL SYSTEM.BIT(spiCtrl, 0) 191 | END; 192 | SPI(255); SPI(255); (*dummy checksum*) i := 0; 193 | REPEAT SPI(-1); INC(i); UNTIL (data MOD 32 = 5) OR (i = 10000); 194 | ASSERT(data MOD 32 = 5); SPIIdle(1) (*deselect card*) 195 | END WriteSD; 196 | 197 | PROCEDURE InitSecMap*; 198 | VAR i: INTEGER; 199 | BEGIN NofSectors := 0; sectorMap[0] := {0 .. 31}; sectorMap[1] := {0 .. 31}; 200 | FOR i := 2 TO mapsize DIV 32 - 1 DO sectorMap[i] := {} END 201 | END InitSecMap; 202 | 203 | PROCEDURE MarkSector*(sec: INTEGER); 204 | BEGIN sec := sec DIV 29; ASSERT(SYSTEM.H(0) = 0); 205 | INCL(sectorMap[sec DIV 32], sec MOD 32); INC(NofSectors) 206 | END MarkSector; 207 | 208 | PROCEDURE FreeSector*(sec: INTEGER); 209 | BEGIN sec := sec DIV 29; ASSERT(SYSTEM.H(0) = 0); 210 | EXCL(sectorMap[sec DIV 32], sec MOD 32); DEC(NofSectors) 211 | END FreeSector; 212 | 213 | PROCEDURE AllocSector*(hint: INTEGER; VAR sec: INTEGER); 214 | VAR s: INTEGER; 215 | BEGIN (*find free sector, starting after hint*) 216 | hint := hint DIV 29; ASSERT(SYSTEM.H(0) = 0); s := hint; 217 | REPEAT INC(s); 218 | IF s = mapsize THEN s := 1 END ; 219 | UNTIL ~(s MOD 32 IN sectorMap[s DIV 32]); 220 | INCL(sectorMap[s DIV 32], s MOD 32); INC(NofSectors); sec := s * 29 221 | END AllocSector; 222 | 223 | PROCEDURE GetSector*(src: INTEGER; VAR dst: Sector); 224 | BEGIN src := src DIV 29; ASSERT(SYSTEM.H(0) = 0); 225 | src := src * 2 + FSoffset; 226 | ReadSD(src, SYSTEM.ADR(dst)); ReadSD(src+1, SYSTEM.ADR(dst)+512) 227 | END GetSector; 228 | 229 | PROCEDURE PutSector*(dst: INTEGER; VAR src: Sector); 230 | BEGIN dst := dst DIV 29; ASSERT(SYSTEM.H(0) = 0); 231 | dst := dst * 2 + FSoffset; 232 | WriteSD(dst, SYSTEM.ADR(src)); WriteSD(dst+1, SYSTEM.ADR(src)+512) 233 | END PutSector; 234 | 235 | (*-------- Miscellaneous procedures----------*) 236 | 237 | PROCEDURE Time*(): INTEGER; 238 | VAR t: INTEGER; 239 | BEGIN SYSTEM.GET(timer, t); RETURN t 240 | END Time; 241 | 242 | PROCEDURE Clock*(): INTEGER; 243 | BEGIN RETURN clock 244 | END Clock; 245 | 246 | PROCEDURE SetClock*(dt: INTEGER); 247 | BEGIN clock := dt 248 | END SetClock; 249 | 250 | PROCEDURE Install*(Padr, at: INTEGER); 251 | BEGIN SYSTEM.PUT(at, 0E7000000H + (Padr - at) DIV 4 -1) 252 | END Install; 253 | 254 | PROCEDURE Trap(VAR a: INTEGER; b: INTEGER); 255 | VAR u, v, w: INTEGER; 256 | BEGIN u := SYSTEM.REG(15); SYSTEM.GET(u - 4, v); w := v DIV 10H MOD 10H; (*trap number*) 257 | IF w = 0 THEN New(a, b) 258 | ELSE (*stop*) LED(w + 192); REPEAT UNTIL FALSE 259 | END 260 | END Trap; 261 | 262 | PROCEDURE Init*; 263 | BEGIN Install(SYSTEM.ADR(Trap), 20H); (*install temporary trap*) 264 | SYSTEM.GET(12, MemLim); SYSTEM.GET(24, heapOrg); 265 | stackOrg := heapOrg; stackSize := 8000H; heapLim := MemLim; 266 | list1 := 0; list2 := 0; list3 := 0; list0 := heapOrg; 267 | SYSTEM.PUT(list0, heapLim - heapOrg); SYSTEM.PUT(list0+4, -1); SYSTEM.PUT(list0+8, 0); 268 | allocated := 0; clock := 0; InitSecMap 269 | END Init; 270 | 271 | END Kernel. 272 | -------------------------------------------------------------------------------- /Oberon/MagicSquares.Mod: -------------------------------------------------------------------------------- 1 | MODULE MagicSquares; (*NW 11.8.97*) 2 | IMPORT Texts, Oberon; 3 | 4 | VAR W: Texts.Writer; 5 | 6 | PROCEDURE Generate*; (*magic square of order 3, 5, 7, ... *) 7 | VAR i, j, x, nx, nsq, n: INTEGER; 8 | M: ARRAY 13, 13 OF INTEGER; 9 | S: Texts.Scanner; 10 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 11 | IF S.class = Texts.Int THEN 12 | n := S.i; nsq := n*n; x := 0; 13 | i := n DIV 2; j := n-1; 14 | WHILE x < nsq DO 15 | nx := n + x; j := (j-1) MOD n; INC(x); M[i, j] := x; 16 | WHILE x < nx DO 17 | i := (i+1) MOD n; j := (j+1) MOD n; 18 | INC(x); M[i, j] := x 19 | END 20 | END ; 21 | FOR i := 0 TO n-1 DO 22 | FOR j := 0 TO n-1 DO Texts.WriteInt(W, M[i, j], 6) END ; 23 | Texts.WriteLn(W) 24 | END ; 25 | Texts.Append(Oberon.Log, W.buf) 26 | END 27 | END Generate; 28 | 29 | BEGIN Texts.OpenWriter(W) 30 | END MagicSquares. 31 | -------------------------------------------------------------------------------- /Oberon/Modules.Mod: -------------------------------------------------------------------------------- 1 | MODULE Modules; (*Link and load on RISC; NW 20.10.2013 / 9.4.2016*) 2 | IMPORT SYSTEM, Files; 3 | CONST versionkey = 1X; MT = 12; DescSize = 80; 4 | 5 | TYPE Module* = POINTER TO ModDesc; 6 | Command* = PROCEDURE; 7 | ModuleName* = ARRAY 32 OF CHAR; 8 | 9 | ModDesc* = RECORD 10 | name*: ModuleName; 11 | next*: Module; 12 | key*, num*, size*, refcnt*: INTEGER; 13 | data*, code*, imp*, cmd*, ent*, ptr*, unused: INTEGER (*addresses*) 14 | END ; 15 | 16 | VAR root*, M: Module; 17 | MTOrg*, AllocPtr*, res*: INTEGER; 18 | importing*, imported*: ModuleName; 19 | limit: INTEGER; 20 | 21 | PROCEDURE ThisFile(name: ARRAY OF CHAR): Files.File; 22 | VAR i: INTEGER; 23 | filename: ModuleName; 24 | BEGIN i := 0; 25 | WHILE name[i] # 0X DO filename[i] := name[i]; INC(i) END ; 26 | filename[i] := "."; filename[i+1] := "r"; filename[i+2] := "s"; filename[i+3] := "c"; filename[i+4] := 0X; 27 | RETURN Files.Old(filename) 28 | END ThisFile; 29 | 30 | PROCEDURE error(n: INTEGER; name: ARRAY OF CHAR); 31 | BEGIN res := n; importing := name 32 | END error; 33 | 34 | PROCEDURE Check(s: ARRAY OF CHAR); 35 | VAR i: INTEGER; ch: CHAR; 36 | BEGIN ch := s[0]; res := 1; i := 1; 37 | IF (ch >= "A") & (ch <= "Z") OR (ch >= "a") & (ch <= "z") THEN 38 | REPEAT ch := s[i]; INC(i) 39 | UNTIL ~((ch >= "0") & (ch <= "9") OR (ch >= "A") & (ch <= "Z") 40 | OR (ch >= "a") & (ch <= "z") OR (ch = ".")) OR (i = 32); 41 | IF (i < 32) & (ch = 0X) THEN res := 0 END 42 | END 43 | END Check; 44 | 45 | PROCEDURE Load*(name: ARRAY OF CHAR; VAR newmod: Module); 46 | (*search module in list; if not found, load module. 47 | res = 0: already present or loaded; res = 2: file not available; res = 3: key conflict; 48 | res = 4: bad file version; res = 5: corrupted file; res = 7: no space*) 49 | VAR mod, impmod: Module; 50 | i, n, key, impkey, mno, nofimps, size: INTEGER; 51 | p, u, v, w: INTEGER; (*addresses*) 52 | ch: CHAR; 53 | body: Command; 54 | fixorgP, fixorgD, fixorgT: INTEGER; 55 | disp, adr, inst, pno, vno, dest, offset: INTEGER; 56 | name1, impname: ModuleName; 57 | F: Files.File; R: Files.Rider; 58 | import: ARRAY 16 OF Module; 59 | BEGIN mod := root; res := 0; nofimps := 0; 60 | WHILE (mod # NIL) & (name # mod.name) DO mod := mod.next END ; 61 | IF mod = NIL THEN (*load*) 62 | Check(name); 63 | IF res = 0 THEN F := ThisFile(name) ELSE F := NIL END ; 64 | IF F # NIL THEN 65 | Files.Set(R, F, 0); Files.ReadString(R, name1); Files.ReadInt(R, key); Files.Read(R, ch); 66 | Files.ReadInt(R, size); importing := name1; 67 | IF ch = versionkey THEN 68 | Files.ReadString(R, impname); (*imports*) 69 | WHILE (impname[0] # 0X) & (res = 0) DO 70 | Files.ReadInt(R, impkey); 71 | Load(impname, impmod); import[nofimps] := impmod; importing := name1; 72 | IF res = 0 THEN 73 | IF impmod.key = impkey THEN INC(impmod.refcnt); INC(nofimps) 74 | ELSE error(3, name1); imported := impname 75 | END 76 | END ; 77 | Files.ReadString(R, impname) 78 | END 79 | ELSE error(2, name1) 80 | END 81 | ELSE error(1, name) 82 | END ; 83 | IF res = 0 THEN (*search for a hole in the list allocate and link*) 84 | INC(size, DescSize); mod := root; 85 | WHILE (mod # NIL) & ~((mod.name[0] = 0X) & (mod.size >= size)) DO mod := mod.next END ; 86 | IF mod = NIL THEN (*no large enough hole was found*) 87 | IF AllocPtr + size < limit THEN (*allocate*) 88 | p := AllocPtr; mod := SYSTEM.VAL(Module, p); 89 | AllocPtr := (p + size + 100H) DIV 20H * 20H; mod.size := AllocPtr - p; mod.num := root.num + 1; 90 | mod.next := root; root := mod 91 | ELSE error(7, name1) 92 | END 93 | ELSE (*fill hole*) p := SYSTEM.VAL(INTEGER, mod) 94 | END 95 | END ; 96 | IF res = 0 THEN (*read file*) 97 | INC(p, DescSize); (*allocate descriptor*) 98 | mod.name := name; mod.key := key; mod.refcnt := 0; 99 | mod.data := p; (*data*) 100 | SYSTEM.PUT(mod.num * 4 + MTOrg, p); (*module table entry*) 101 | Files.ReadInt(R, n); 102 | WHILE n > 0 DO Files.ReadInt(R, w); SYSTEM.PUT(p, w); INC(p, 4); DEC(n, 4) END ; (*type descriptors*) 103 | Files.ReadInt(R, n); 104 | WHILE n > 0 DO SYSTEM.PUT(p, 0); INC(p, 4); DEC(n, 4) END ; (*variable space*) 105 | Files.ReadInt(R, n); 106 | WHILE n > 0 DO Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p); DEC(n) END ; (*strings*) 107 | mod.code := p; (*program*) 108 | Files.ReadInt(R, n); 109 | WHILE n > 0 DO Files.ReadInt(R, w); SYSTEM.PUT(p, w); INC(p, 4); DEC(n) END ; (*program code*) 110 | mod.imp := p; (*copy imports*) 111 | i := 0; 112 | WHILE i < nofimps DO 113 | SYSTEM.PUT(p, import[i]); INC(p, 4); INC(i) 114 | END ; 115 | mod.cmd := p; (*commands*) Files.Read(R, ch); 116 | WHILE ch # 0X DO 117 | REPEAT SYSTEM.PUT(p, ch); INC(p); Files.Read(R, ch) UNTIL ch = 0X; 118 | REPEAT SYSTEM.PUT(p, 0X); INC(p) UNTIL p MOD 4 = 0; 119 | Files.ReadInt(R, n); SYSTEM.PUT(p, n); INC(p, 4); Files.Read(R, ch) 120 | END ; 121 | REPEAT SYSTEM.PUT(p, 0X); INC(p) UNTIL p MOD 4 = 0; 122 | mod.ent := p; (*entries*) 123 | Files.ReadInt(R, n); 124 | WHILE n > 0 DO Files.ReadInt(R, w); SYSTEM.PUT(p, w); INC(p, 4); DEC(n) END ; 125 | mod.ptr := p; (*pointer references*) 126 | Files.ReadInt(R, w); 127 | WHILE w >= 0 DO SYSTEM.PUT(p, mod.data + w); INC(p, 4); Files.ReadInt(R, w) END ; 128 | SYSTEM.PUT(p, 0); INC(p, 4); 129 | Files.ReadInt(R, fixorgP); Files.ReadInt(R, fixorgD); Files.ReadInt(R, fixorgT); 130 | Files.ReadInt(R, w); body := SYSTEM.VAL(Command, mod.code + w); 131 | Files.Read(R, ch); 132 | IF ch # "O" THEN (*corrupted file*) mod := NIL; error(4, name) END 133 | END ; 134 | IF res = 0 THEN (*fixup of BL*) 135 | adr := mod.code + fixorgP*4; 136 | WHILE adr # mod.code DO 137 | SYSTEM.GET(adr, inst); 138 | mno := inst DIV 100000H MOD 10H; 139 | pno := inst DIV 1000H MOD 100H; 140 | disp := inst MOD 1000H; 141 | SYSTEM.GET(mod.imp + (mno-1)*4, impmod); 142 | SYSTEM.GET(impmod.ent + pno*4, dest); dest := dest + impmod.code; 143 | offset := (dest - adr - 4) DIV 4; 144 | SYSTEM.PUT(adr, (offset MOD 1000000H) + 0F7000000H); 145 | adr := adr - disp*4 146 | END ; 147 | (*fixup of LDR/STR/ADD*) 148 | adr := mod.code + fixorgD*4; 149 | WHILE adr # mod.code DO 150 | SYSTEM.GET(adr, inst); 151 | mno := inst DIV 100000H MOD 10H; 152 | disp := inst MOD 1000H; 153 | IF mno = 0 THEN (*global*) 154 | SYSTEM.PUT(adr, (inst DIV 1000000H * 10H + MT) * 100000H + mod.num * 4) 155 | ELSE (*import*) 156 | SYSTEM.GET(mod.imp + (mno-1)*4, impmod); v := impmod.num; 157 | SYSTEM.PUT(adr, (inst DIV 1000000H * 10H + MT) * 100000H + v*4); 158 | SYSTEM.GET(adr+4, inst); vno := inst MOD 100H; 159 | SYSTEM.GET(impmod.ent + vno*4, offset); 160 | IF ODD(inst DIV 100H) THEN offset := offset + impmod.code - impmod.data END ; 161 | SYSTEM.PUT(adr+4, inst DIV 10000H * 10000H + offset) 162 | END ; 163 | adr := adr - disp*4 164 | END ; 165 | (*fixup of type descriptors*) 166 | adr := mod.data + fixorgT*4; 167 | WHILE adr # mod.data DO 168 | SYSTEM.GET(adr, inst); 169 | mno := inst DIV 1000000H MOD 10H; 170 | vno := inst DIV 1000H MOD 1000H; 171 | disp := inst MOD 1000H; 172 | IF mno = 0 THEN (*global*) inst := mod.data + vno 173 | ELSE (*import*) 174 | SYSTEM.GET(mod.imp + (mno-1)*4, impmod); 175 | SYSTEM.GET(impmod.ent + vno*4, offset); 176 | inst := impmod.data + offset 177 | END ; 178 | SYSTEM.PUT(adr, inst); adr := adr - disp*4 179 | END ; 180 | body (*initialize module*) 181 | ELSIF res = 3 THEN importing := name; 182 | WHILE nofimps > 0 DO DEC(nofimps); DEC(import[nofimps].refcnt) END 183 | END 184 | END ; 185 | newmod := mod 186 | END Load; 187 | 188 | PROCEDURE ThisCommand*(mod: Module; name: ARRAY OF CHAR): Command; 189 | VAR k, adr, w: INTEGER; ch: CHAR; 190 | s: ARRAY 32 OF CHAR; 191 | BEGIN res := 5; w := 0; 192 | IF mod # NIL THEN 193 | adr := mod.cmd; SYSTEM.GET(adr, ch); 194 | WHILE (ch # 0X) & (res # 0) DO k := 0; (*read command name*) 195 | REPEAT s[k] := ch; INC(k); INC(adr); SYSTEM.GET(adr, ch) UNTIL ch = 0X; 196 | s[k] := 0X; 197 | REPEAT INC(adr) UNTIL adr MOD 4 = 0; 198 | SYSTEM.GET(adr, k); INC(adr, 4); 199 | IF s = name THEN res := 0; w := mod.code + k ELSE SYSTEM.GET(adr, ch) END 200 | END 201 | END 202 | RETURN SYSTEM.VAL(Command, w) 203 | END ThisCommand; 204 | 205 | PROCEDURE Free*(name: ARRAY OF CHAR); 206 | VAR mod, imp: Module; p, q: INTEGER; 207 | BEGIN mod := root; res := 0; 208 | WHILE (mod # NIL) & (mod.name # name) DO mod := mod.next END ; 209 | IF mod # NIL THEN 210 | IF mod.refcnt = 0 THEN 211 | mod.name[0] := 0X; p := mod.imp; q := mod.cmd; 212 | WHILE p < q DO SYSTEM.GET(p, imp); DEC(imp.refcnt); INC(p, 4) END ; 213 | ELSE res := 1 214 | END 215 | END 216 | END Free; 217 | 218 | PROCEDURE Init*; 219 | BEGIN Files.Init; MTOrg := SYSTEM.REG(MT); 220 | SYSTEM.GET(16, AllocPtr); SYSTEM.GET(20, root); SYSTEM.GET(24, limit); DEC(limit, 8000H) 221 | END Init; 222 | 223 | BEGIN Init; Load("Oberon", M); 224 | LED(res); REPEAT UNTIL FALSE (*only if load fails*) 225 | END Modules. 226 | -------------------------------------------------------------------------------- /Oberon/ORS.Mod: -------------------------------------------------------------------------------- 1 | MODULE ORS; (* NW 19.9.93 / 15.2.2016 Scanner in Oberon-07*) 2 | IMPORT SYSTEM, Texts, Oberon; 3 | 4 | (* Oberon Scanner does lexical analysis. Input is Oberon-Text, output is 5 | sequence of symbols, i.e identifiers, numbers, strings, and special symbols. 6 | Recognises all Oberon keywords and skips comments. The keywords are 7 | recorded in a table. 8 | Get(sym) delivers next symbol from input text with Reader R. 9 | Mark(msg) records error and delivers error message with Writer W. 10 | If Get delivers ident, then the identifier (a string) is in variable id, if int or char 11 | in ival, if real in rval, and if string in str (and slen) *) 12 | 13 | CONST IdLen* = 32; 14 | NKW = 34; (*nof keywords*) 15 | maxExp = 38; stringBufSize = 256; 16 | 17 | (*lexical symbols*) 18 | null = 0; times* = 1; rdiv* = 2; div* = 3; mod* = 4; 19 | and* = 5; plus* = 6; minus* = 7; or* = 8; eql* = 9; 20 | neq* = 10; lss* = 11; leq* = 12; gtr* = 13; geq* = 14; 21 | in* = 15; is* = 16; arrow* = 17; period* = 18; 22 | char* = 20; int* = 21; real* = 22; false* = 23; true* = 24; 23 | nil* = 25; string* = 26; not* = 27; lparen* = 28; lbrak* = 29; 24 | lbrace* = 30; ident* = 31; 25 | if* = 32; while* = 34; repeat* = 35; case* = 36; for* = 37; 26 | comma* = 40; colon* = 41; becomes* = 42; upto* = 43; rparen* = 44; 27 | rbrak* = 45; rbrace* = 46; then* = 47; of* = 48; do* = 49; 28 | to* = 50; by* = 51; semicolon* = 52; end* = 53; bar* = 54; 29 | else* = 55; elsif* = 56; until* = 57; return* = 58; 30 | array* = 60; record* = 61; pointer* = 62; const* = 63; type* = 64; 31 | var* = 65; procedure* = 66; begin* = 67; import* = 68; module* = 69; eot = 70; 32 | 33 | TYPE Ident* = ARRAY IdLen OF CHAR; 34 | 35 | VAR ival*, slen*: LONGINT; (*results of Get*) 36 | rval*: REAL; 37 | id*: Ident; (*for identifiers*) 38 | str*: ARRAY stringBufSize OF CHAR; 39 | errcnt*: INTEGER; 40 | 41 | ch: CHAR; (*last character read*) 42 | errpos: LONGINT; 43 | R: Texts.Reader; 44 | W: Texts.Writer; 45 | k: INTEGER; 46 | KWX: ARRAY 10 OF INTEGER; 47 | keyTab: ARRAY NKW OF 48 | RECORD sym: INTEGER; id: ARRAY 12 OF CHAR END; 49 | 50 | PROCEDURE CopyId*(VAR ident: Ident); 51 | BEGIN ident := id 52 | END CopyId; 53 | 54 | PROCEDURE Pos*(): LONGINT; 55 | BEGIN RETURN Texts.Pos(R) - 1 56 | END Pos; 57 | 58 | PROCEDURE Mark*(msg: ARRAY OF CHAR); 59 | VAR p: LONGINT; 60 | BEGIN p := Pos(); 61 | IF (p > errpos) & (errcnt < 25) THEN 62 | Texts.WriteLn(W); Texts.WriteString(W, " pos "); Texts.WriteInt(W, p, 1); Texts.Write(W, " "); 63 | Texts.WriteString(W, msg); Texts.Append(Oberon.Log, W.buf) 64 | END ; 65 | INC(errcnt); errpos := p + 4 66 | END Mark; 67 | 68 | PROCEDURE Identifier(VAR sym: INTEGER); 69 | VAR i, k: INTEGER; 70 | BEGIN i := 0; 71 | REPEAT 72 | IF i < IdLen-1 THEN id[i] := ch; INC(i) END ; 73 | Texts.Read(R, ch) 74 | UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "Z") & (ch < "a") OR (ch > "z"); 75 | id[i] := 0X; 76 | IF i < 10 THEN k := KWX[i-1]; (*search for keyword*) 77 | WHILE (id # keyTab[k].id) & (k < KWX[i]) DO INC(k) END ; 78 | IF k < KWX[i] THEN sym := keyTab[k].sym ELSE sym := ident END 79 | ELSE sym := ident 80 | END 81 | END Identifier; 82 | 83 | PROCEDURE String; 84 | VAR i: INTEGER; 85 | BEGIN i := 0; Texts.Read(R, ch); 86 | WHILE ~R.eot & (ch # 22X) DO 87 | IF ch >= " " THEN 88 | IF i < stringBufSize-1 THEN str[i] := ch; INC(i) ELSE Mark("string too long") END ; 89 | END ; 90 | Texts.Read(R, ch) 91 | END ; 92 | str[i] := 0X; INC(i); Texts.Read(R, ch); slen := i 93 | END String; 94 | 95 | PROCEDURE HexString; 96 | VAR i, m, n: INTEGER; 97 | BEGIN i := 0; Texts.Read(R, ch); 98 | WHILE ~R.eot & (ch # "$") DO 99 | WHILE (ch = " ") OR (ch = 9X) OR (ch = 0DX) DO Texts.Read(R, ch) END ; (*skip*) 100 | IF ("0" <= ch) & (ch <= "9") THEN m := ORD(ch) - 30H 101 | ELSIF ("A" <= ch) & (ch <= "F") THEN m := ORD(ch) - 37H 102 | ELSE m := 0; Mark("hexdig expected") 103 | END ; 104 | Texts.Read(R, ch); 105 | IF ("0" <= ch) & (ch <= "9") THEN n := ORD(ch) - 30H 106 | ELSIF ("A" <= ch) & (ch <= "F") THEN n := ORD(ch) - 37H 107 | ELSE n := 0; Mark("hexdig expected") 108 | END ; 109 | IF i < stringBufSize THEN str[i] := CHR(m*10H + n); INC(i) ELSE Mark("string too long") END ; 110 | Texts.Read(R, ch) 111 | END ; 112 | Texts.Read(R, ch); slen := i (*no 0X appended!*) 113 | END HexString; 114 | 115 | PROCEDURE Ten(e: LONGINT): REAL; 116 | VAR x, t: REAL; 117 | BEGIN x := 1.0; t := 10.0; 118 | WHILE e > 0 DO 119 | IF ODD(e) THEN x := t * x END ; 120 | t := t * t; e := e DIV 2 121 | END ; 122 | RETURN x 123 | END Ten; 124 | 125 | PROCEDURE Number(VAR sym: INTEGER); 126 | CONST max = 2147483647 (*2^31 - 1*); 127 | VAR i, k, e, n, s, h: LONGINT; x: REAL; 128 | d: ARRAY 16 OF INTEGER; 129 | negE: BOOLEAN; 130 | BEGIN ival := 0; i := 0; n := 0; k := 0; 131 | REPEAT 132 | IF n < 16 THEN d[n] := ORD(ch)-30H; INC(n) ELSE Mark("too many digits"); n := 0 END ; 133 | Texts.Read(R, ch) 134 | UNTIL (ch < "0") OR (ch > "9") & (ch < "A") OR (ch > "F"); 135 | IF (ch = "H") OR (ch = "R") OR (ch = "X") THEN (*hex*) 136 | REPEAT h := d[i]; 137 | IF h >= 10 THEN h := h-7 END ; 138 | k := k*10H + h; INC(i) (*no overflow check*) 139 | UNTIL i = n; 140 | IF ch = "X" THEN sym := char; 141 | IF k < 100H THEN ival := k ELSE Mark("illegal value"); ival := 0 END 142 | ELSIF ch = "R" THEN sym := real; rval := SYSTEM.VAL(REAL, k) 143 | ELSE sym := int; ival := k 144 | END ; 145 | Texts.Read(R, ch) 146 | ELSIF ch = "." THEN 147 | Texts.Read(R, ch); 148 | IF ch = "." THEN (*double dot*) ch := 7FX; (*decimal integer*) 149 | REPEAT 150 | IF d[i] < 10 THEN 151 | IF k <= (max-d[i]) DIV 10 THEN k := k *10 + d[i] ELSE Mark("too large"); k := 0 END 152 | ELSE Mark("bad integer") 153 | END ; 154 | INC(i) 155 | UNTIL i = n; 156 | sym := int; ival := k 157 | ELSE (*real number*) x := 0.0; e := 0; 158 | REPEAT (*integer part*) x := x * 10.0 + FLT(d[i]); INC(i) UNTIL i = n; 159 | WHILE (ch >= "0") & (ch <= "9") DO (*fraction*) 160 | x := x * 10.0 + FLT(ORD(ch) - 30H); DEC(e); Texts.Read(R, ch) 161 | END ; 162 | IF (ch = "E") OR (ch = "D") THEN (*scale factor*) 163 | Texts.Read(R, ch); s := 0; 164 | IF ch = "-" THEN negE := TRUE; Texts.Read(R, ch) 165 | ELSE negE := FALSE; 166 | IF ch = "+" THEN Texts.Read(R, ch) END 167 | END ; 168 | IF (ch >= "0") & (ch <= "9") THEN 169 | REPEAT s := s*10 + ORD(ch)-30H; Texts.Read(R, ch) 170 | UNTIL (ch < "0") OR (ch >"9"); 171 | IF negE THEN e := e-s ELSE e := e+s END 172 | ELSE Mark("digit?") 173 | END 174 | END ; 175 | IF e < 0 THEN 176 | IF e >= -maxExp THEN x := x / Ten(-e) ELSE x := 0.0 END 177 | ELSIF e > 0 THEN 178 | IF e <= maxExp THEN x := Ten(e) * x ELSE x := 0.0; Mark("too large") END 179 | END ; 180 | sym := real; rval := x 181 | END 182 | ELSE (*decimal integer*) 183 | REPEAT 184 | IF d[i] < 10 THEN 185 | IF k <= (max-d[i]) DIV 10 THEN k := k*10 + d[i] ELSE Mark("too large"); k := 0 END 186 | ELSE Mark("bad integer") 187 | END ; 188 | INC(i) 189 | UNTIL i = n; 190 | sym := int; ival := k 191 | END 192 | END Number; 193 | 194 | PROCEDURE comment; 195 | BEGIN Texts.Read(R, ch); 196 | REPEAT 197 | WHILE ~R.eot & (ch # "*") DO 198 | IF ch = "(" THEN Texts.Read(R, ch); 199 | IF ch = "*" THEN comment END 200 | ELSE Texts.Read(R, ch) 201 | END 202 | END ; 203 | WHILE ch = "*" DO Texts.Read(R, ch) END 204 | UNTIL (ch = ")") OR R.eot; 205 | IF ~R.eot THEN Texts.Read(R, ch) ELSE Mark("unterminated comment") END 206 | END comment; 207 | 208 | PROCEDURE Get*(VAR sym: INTEGER); 209 | BEGIN 210 | REPEAT 211 | WHILE ~R.eot & (ch <= " ") DO Texts.Read(R, ch) END; 212 | IF R.eot THEN sym := eot 213 | ELSIF ch < "A" THEN 214 | IF ch < "0" THEN 215 | IF ch = 22X THEN String; sym := string 216 | ELSIF ch = "#" THEN Texts.Read(R, ch); sym := neq 217 | ELSIF ch = "$" THEN HexString; sym := string 218 | ELSIF ch = "&" THEN Texts.Read(R, ch); sym := and 219 | ELSIF ch = "(" THEN Texts.Read(R, ch); 220 | IF ch = "*" THEN sym := null; comment ELSE sym := lparen END 221 | ELSIF ch = ")" THEN Texts.Read(R, ch); sym := rparen 222 | ELSIF ch = "*" THEN Texts.Read(R, ch); sym := times 223 | ELSIF ch = "+" THEN Texts.Read(R, ch); sym := plus 224 | ELSIF ch = "," THEN Texts.Read(R, ch); sym := comma 225 | ELSIF ch = "-" THEN Texts.Read(R, ch); sym := minus 226 | ELSIF ch = "." THEN Texts.Read(R, ch); 227 | IF ch = "." THEN Texts.Read(R, ch); sym := upto ELSE sym := period END 228 | ELSIF ch = "/" THEN Texts.Read(R, ch); sym := rdiv 229 | ELSE Texts.Read(R, ch); (* ! % ' *) sym := null 230 | END 231 | ELSIF ch < ":" THEN Number(sym) 232 | ELSIF ch = ":" THEN Texts.Read(R, ch); 233 | IF ch = "=" THEN Texts.Read(R, ch); sym := becomes ELSE sym := colon END 234 | ELSIF ch = ";" THEN Texts.Read(R, ch); sym := semicolon 235 | ELSIF ch = "<" THEN Texts.Read(R, ch); 236 | IF ch = "=" THEN Texts.Read(R, ch); sym := leq ELSE sym := lss END 237 | ELSIF ch = "=" THEN Texts.Read(R, ch); sym := eql 238 | ELSIF ch = ">" THEN Texts.Read(R, ch); 239 | IF ch = "=" THEN Texts.Read(R, ch); sym := geq ELSE sym := gtr END 240 | ELSE (* ? @ *) Texts.Read(R, ch); sym := null 241 | END 242 | ELSIF ch < "[" THEN Identifier(sym) 243 | ELSIF ch < "a" THEN 244 | IF ch = "[" THEN sym := lbrak 245 | ELSIF ch = "]" THEN sym := rbrak 246 | ELSIF ch = "^" THEN sym := arrow 247 | ELSE (* _ ` *) sym := null 248 | END ; 249 | Texts.Read(R, ch) 250 | ELSIF ch < "{" THEN Identifier(sym) ELSE 251 | IF ch = "{" THEN sym := lbrace 252 | ELSIF ch = "}" THEN sym := rbrace 253 | ELSIF ch = "|" THEN sym := bar 254 | ELSIF ch = "~" THEN sym := not 255 | ELSIF ch = 7FX THEN sym := upto 256 | ELSE sym := null 257 | END ; 258 | Texts.Read(R, ch) 259 | END 260 | UNTIL sym # null 261 | END Get; 262 | 263 | PROCEDURE Init*(T: Texts.Text; pos: LONGINT); 264 | BEGIN errpos := pos; errcnt := 0; Texts.OpenReader(R, T, pos); Texts.Read(R, ch) 265 | END Init; 266 | 267 | PROCEDURE EnterKW(sym: INTEGER; name: ARRAY OF CHAR); 268 | BEGIN keyTab[k].id := name; keyTab[k].sym := sym; INC(k) 269 | END EnterKW; 270 | 271 | BEGIN Texts.OpenWriter(W); k := 0; KWX[0] := 0; KWX[1] := 0; 272 | EnterKW(if, "IF"); 273 | EnterKW(do, "DO"); 274 | EnterKW(of, "OF"); 275 | EnterKW(or, "OR"); 276 | EnterKW(to, "TO"); 277 | EnterKW(in, "IN"); 278 | EnterKW(is, "IS"); 279 | EnterKW(by, "BY"); 280 | KWX[2] := k; 281 | EnterKW(end, "END"); 282 | EnterKW(nil, "NIL"); 283 | EnterKW(var, "VAR"); 284 | EnterKW(div, "DIV"); 285 | EnterKW(mod, "MOD"); 286 | EnterKW(for, "FOR"); 287 | KWX[3] := k; 288 | EnterKW(else, "ELSE"); 289 | EnterKW(then, "THEN"); 290 | EnterKW(true, "TRUE"); 291 | EnterKW(type, "TYPE"); 292 | EnterKW(case, "CASE"); 293 | KWX[4] := k; 294 | EnterKW(elsif, "ELSIF"); 295 | EnterKW(false, "FALSE"); 296 | EnterKW(array, "ARRAY"); 297 | EnterKW(begin, "BEGIN"); 298 | EnterKW(const, "CONST"); 299 | EnterKW(until, "UNTIL"); 300 | EnterKW(while, "WHILE"); 301 | KWX[5] := k; 302 | EnterKW(record, "RECORD"); 303 | EnterKW(repeat, "REPEAT"); 304 | EnterKW(return, "RETURN"); 305 | EnterKW(import, "IMPORT"); 306 | EnterKW(module, "MODULE"); 307 | KWX[6] := k; 308 | EnterKW(pointer, "POINTER"); 309 | KWX[7] := k; KWX[8] := k; 310 | EnterKW(procedure, "PROCEDURE"); 311 | KWX[9] := k 312 | END ORS. 313 | -------------------------------------------------------------------------------- /Oberon/ORTool.Mod: -------------------------------------------------------------------------------- 1 | MODULE ORTool; (*NW 18.2.2013*) 2 | IMPORT SYSTEM, Files, Texts, Oberon, ORB; 3 | VAR W: Texts.Writer; 4 | Form: INTEGER; (*result of ReadType*) 5 | mnemo0, mnemo1: ARRAY 16, 4 OF CHAR; (*mnemonics*) 6 | 7 | PROCEDURE Read(VAR R: Files.Rider; VAR n: INTEGER); 8 | VAR b: BYTE; 9 | BEGIN Files.ReadByte(R, b); 10 | IF b < 80H THEN n := b ELSE n := b - 100H END 11 | END Read; 12 | 13 | PROCEDURE ReadType(VAR R: Files.Rider); 14 | VAR key, len, lev, size, off: INTEGER; 15 | ref, mno, class, form, readonly: INTEGER; 16 | name, modname: ARRAY 32 OF CHAR; 17 | BEGIN Read(R, ref); Texts.Write(W, " "); Texts.Write(W, "["); 18 | IF ref < 0 THEN Texts.Write(W, "^"); Texts.WriteInt(W, -ref, 1) 19 | ELSE Texts.WriteInt(W, ref, 1); 20 | Read(R, form); Texts.WriteString(W, " form = "); Texts.WriteInt(W, form, 1); 21 | IF form = ORB.Pointer THEN ReadType(R) 22 | ELSIF form = ORB.Array THEN 23 | ReadType(R); Files.ReadNum(R, len); Files.ReadNum(R, size); 24 | Texts.WriteString(W, " len = "); Texts.WriteInt(W, len, 1); 25 | Texts.WriteString(W, " size = "); Texts.WriteInt(W, size, 1) 26 | ELSIF form = ORB.Record THEN 27 | ReadType(R); (*base type*) 28 | Files.ReadNum(R, off); Texts.WriteString(W, " exno = "); Texts.WriteInt(W, off, 1); 29 | Files.ReadNum(R, off); Texts.WriteString(W, " extlev = "); Texts.WriteInt(W, off, 1); 30 | Files.ReadNum(R, size); Texts.WriteString(W, " size = "); Texts.WriteInt(W, size, 1); 31 | Texts.Write(W, " "); Texts.Write(W, "{"); Read(R, class); 32 | WHILE class # 0 DO (*fields*) 33 | Files.ReadString(R, name); 34 | IF name[0] # 0X THEN Texts.Write(W, " "); Texts.WriteString(W, name); ReadType(R) 35 | ELSE Texts.WriteString(W, " --") 36 | END ; 37 | Files.ReadNum(R, off); Texts.WriteInt(W, off, 4); Read(R, class) 38 | END ; 39 | Texts.Write(W, "}") 40 | ELSIF form = ORB.Proc THEN 41 | ReadType(R); Texts.Write(W, "("); Read(R, class); 42 | WHILE class # 0 DO 43 | Texts.WriteString(W, " class = "); Texts.WriteInt(W, class, 1); Read(R, readonly); 44 | IF readonly = 1 THEN Texts.Write(W, "#") END ; 45 | ReadType(R); Read(R, class) 46 | END ; 47 | Texts.Write(W, ")") 48 | END ; 49 | Files.ReadString(R, modname); 50 | IF modname[0] # 0X THEN 51 | Files.ReadInt(R, key); Files.ReadString(R, name); 52 | Texts.Write(W, " "); Texts.WriteString(W, modname); Texts.Write(W, "."); Texts.WriteString(W, name); 53 | Texts.WriteHex(W, key) 54 | END 55 | END ; 56 | Form := form; Texts.Write(W, "]") 57 | END ReadType; 58 | 59 | PROCEDURE DecSym*; (*decode symbol file*) 60 | VAR class, typno, k: INTEGER; 61 | name: ARRAY 32 OF CHAR; 62 | F: Files.File; R: Files.Rider; 63 | S: Texts.Scanner; 64 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 65 | IF S.class = Texts.Name THEN 66 | Texts.WriteString(W, "OR-decode "); Texts.WriteString(W, S.s); 67 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); 68 | F := Files.Old(S.s); 69 | IF F # NIL THEN 70 | Files.Set(R, F, 0); Files.ReadInt(R, k); Files.ReadInt(R, k); 71 | Files.ReadString(R, name); Texts.WriteString(W, name); Texts.WriteHex(W, k); 72 | Read(R, class); Texts.WriteInt(W, class, 3); (*sym file version*) 73 | IF class = ORB.versionkey THEN 74 | Texts.WriteLn(W); Read(R, class); 75 | WHILE class # 0 DO 76 | Texts.WriteInt(W, class, 4); Files.ReadString(R, name); Texts.Write(W, " "); Texts.WriteString(W, name); 77 | ReadType(R); 78 | IF class = ORB.Typ THEN 79 | Texts.Write(W, "("); Read(R, class); 80 | WHILE class # 0 DO (*pointer base fixup*) 81 | Texts.WriteString(W, " ->"); Texts.WriteInt(W, class, 4); Read(R, class) 82 | END ; 83 | Texts.Write(W, ")") 84 | ELSIF (class = ORB.Const) OR (class = ORB.Var) THEN 85 | Files.ReadNum(R, k); Texts.WriteInt(W, k, 5); (*Reals, Strings!*) 86 | END ; 87 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); 88 | Read(R, class) 89 | END 90 | ELSE Texts.WriteString(W, " bad symfile version") 91 | END 92 | ELSE Texts.WriteString(W, " not found") 93 | END ; 94 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf) 95 | END 96 | END DecSym; 97 | 98 | (* ---------------------------------------------------*) 99 | 100 | PROCEDURE WriteReg(r: LONGINT); 101 | BEGIN Texts.Write(W, " "); 102 | IF r < 12 THEN Texts.WriteString(W, " R"); Texts.WriteInt(W, r MOD 10H, 1) 103 | ELSIF r = 12 THEN Texts.WriteString(W, "MT") 104 | ELSIF r = 13 THEN Texts.WriteString(W, "SB") 105 | ELSIF r = 14 THEN Texts.WriteString(W, "SP") 106 | ELSE Texts.WriteString(W, "LNK") 107 | END 108 | END WriteReg; 109 | 110 | PROCEDURE opcode(w: LONGINT); 111 | VAR k, op, u, a, b, c: LONGINT; 112 | BEGIN 113 | k := w DIV 40000000H MOD 4; 114 | a := w DIV 1000000H MOD 10H; 115 | b := w DIV 100000H MOD 10H; 116 | op := w DIV 10000H MOD 10H; 117 | u := w DIV 20000000H MOD 2; 118 | IF k = 0 THEN 119 | Texts.WriteString(W, mnemo0[op]); 120 | IF u = 1 THEN Texts.Write(W, "'") END ; 121 | WriteReg(a); WriteReg(b); WriteReg(w MOD 10H) 122 | ELSIF k = 1 THEN 123 | Texts.WriteString(W, mnemo0[op]); 124 | IF u = 1 THEN Texts.Write(W, "'") END ; 125 | WriteReg(a); WriteReg(b); w := w MOD 10000H; 126 | IF w >= 8000H THEN w := w - 10000H END ; 127 | Texts.WriteInt(W, w, 7) 128 | ELSIF k = 2 THEN (*LDR/STR*) 129 | IF u = 1 THEN Texts.WriteString(W, "STR ") ELSE Texts.WriteString(W, "LDR") END ; 130 | WriteReg(a); WriteReg(b); w := w MOD 100000H; 131 | IF w >= 80000H THEN w := w - 100000H END ; 132 | Texts.WriteInt(W, w, 8) 133 | ELSIF k = 3 THEN (*Branch instr*) 134 | Texts.Write(W, "B"); 135 | IF ODD(w DIV 10000000H) THEN Texts.Write(W, "L") END ; 136 | Texts.WriteString(W, mnemo1[a]); 137 | IF u = 0 THEN WriteReg(w MOD 10H) ELSE 138 | w := w MOD 100000H; 139 | IF w >= 80000H THEN w := w - 100000H END ; 140 | Texts.WriteInt(W, w, 8) 141 | END 142 | END 143 | END opcode; 144 | 145 | PROCEDURE Sync(VAR R: Files.Rider); 146 | VAR ch: CHAR; 147 | BEGIN Files.Read(R, ch); Texts.WriteString(W, "Sync "); Texts.Write(W, ch); Texts.WriteLn(W) 148 | END Sync; 149 | 150 | PROCEDURE Write(VAR R: Files.Rider; x: INTEGER); 151 | BEGIN Files.WriteByte(R, x) (* -128 <= x < 128 *) 152 | END Write; 153 | 154 | PROCEDURE DecObj*; (*decode object file*) 155 | VAR class, i, n, key, size, fix, adr, data, len: INTEGER; 156 | ch: CHAR; 157 | name: ARRAY 32 OF CHAR; 158 | F: Files.File; R: Files.Rider; 159 | S: Texts.Scanner; 160 | BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S); 161 | IF S.class = Texts.Name THEN 162 | Texts.WriteString(W, "decode "); Texts.WriteString(W, S.s); F := Files.Old(S.s); 163 | IF F # NIL THEN 164 | Files.Set(R, F, 0); Files.ReadString(R, name); Texts.WriteLn(W); Texts.WriteString(W, name); 165 | Files.ReadInt(R, key); Texts.WriteHex(W, key); Read(R, class); Texts.WriteInt(W, class, 4); (*version*) 166 | Files.ReadInt(R, size); Texts.WriteInt(W, size, 6); Texts.WriteLn(W); 167 | Texts.WriteString(W, "imports:"); Texts.WriteLn(W); Files.ReadString(R, name); 168 | WHILE name[0] # 0X DO 169 | Texts.Write(W, 9X); Texts.WriteString(W, name); 170 | Files.ReadInt(R, key); Texts.WriteHex(W, key); Texts.WriteLn(W); 171 | Files.ReadString(R, name) 172 | END ; 173 | (* Sync(R); *) 174 | Texts.WriteString(W, "type descriptors"); Texts.WriteLn(W); 175 | Files.ReadInt(R, n); n := n DIV 4; i := 0; 176 | WHILE i < n DO Files.ReadInt(R, data); Texts.WriteHex(W, data); INC(i) END ; 177 | Texts.WriteLn(W); 178 | Texts.WriteString(W, "data"); Files.ReadInt(R, data); Texts.WriteInt(W, data, 6); Texts.WriteLn(W); 179 | Texts.WriteString(W, "strings"); Texts.WriteLn(W); 180 | Files.ReadInt(R, n); i := 0; 181 | WHILE i < n DO Files.Read(R, ch); Texts.Write(W, ch); INC(i) END ; 182 | Texts.WriteLn(W); 183 | Texts.WriteString(W, "code"); Texts.WriteLn(W); 184 | Files.ReadInt(R, n); i := 0; 185 | WHILE i < n DO 186 | Files.ReadInt(R, data); Texts.WriteInt(W, i, 4); Texts.Write(W, 9X); Texts.WriteHex(W, data); 187 | Texts.Write(W, 9X); opcode(data); Texts.WriteLn(W); INC(i) 188 | END ; 189 | (* Sync(R); *) 190 | Texts.WriteString(W, "commands:"); Texts.WriteLn(W); 191 | Files.ReadString(R, name); 192 | WHILE name[0] # 0X DO 193 | Texts.Write(W, 9X); Texts.WriteString(W, name); 194 | Files.ReadInt(R, adr); Texts.WriteInt(W, adr, 5); Texts.WriteLn(W); 195 | Files.ReadString(R, name) 196 | END ; 197 | (* Sync(R); *) 198 | Texts.WriteString(W, "entries"); Texts.WriteLn(W); 199 | Files.ReadInt(R, n); i := 0; 200 | WHILE i < n DO 201 | Files.ReadInt(R, adr); Texts.WriteInt(W, adr, 6); INC(i) 202 | END ; 203 | Texts.WriteLn(W); 204 | (* Sync(R); *) 205 | Texts.WriteString(W, "pointer refs"); Texts.WriteLn(W); Files.ReadInt(R, adr); 206 | WHILE adr # -1 DO Texts.WriteInt(W, adr, 6); Files.ReadInt(R, adr) END ; 207 | Texts.WriteLn(W); 208 | (* Sync(R); *) 209 | Files.ReadInt(R, data); Texts.WriteString(W, "fixP = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W); 210 | Files.ReadInt(R, data); Texts.WriteString(W, "fixD = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W); 211 | Files.ReadInt(R, data); Texts.WriteString(W, "fixT = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W); 212 | Files.ReadInt(R, data); Texts.WriteString(W, "entry = "); Texts.WriteInt(W, data, 8); Texts.WriteLn(W); 213 | Files.Read(R, ch); 214 | IF ch # "O" THEN Texts.WriteString(W, "format eror"); Texts.WriteLn(W) END 215 | (* Sync(R); *) 216 | ELSE Texts.WriteString(W, " not found"); Texts.WriteLn(W) 217 | END ; 218 | Texts.Append(Oberon.Log, W.buf) 219 | END 220 | END DecObj; 221 | 222 | BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "ORTool 18.2.2013"); 223 | Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); 224 | mnemo0[0] := "MOV"; 225 | mnemo0[1] := "LSL"; 226 | mnemo0[2] := "ASR"; 227 | mnemo0[3] := "ROR"; 228 | mnemo0[4] := "AND"; 229 | mnemo0[5] := "ANN"; 230 | mnemo0[6] := "IOR"; 231 | mnemo0[7] := "XOR"; 232 | mnemo0[8] := "ADD"; 233 | mnemo0[9] := "SUB"; 234 | mnemo0[10] := "MUL"; 235 | mnemo0[11] := "DIV"; 236 | mnemo0[12] := "FAD"; 237 | mnemo0[13] := "FSB"; 238 | mnemo0[14] := "FML"; 239 | mnemo0[15] := "FDV"; 240 | mnemo1[0] := "MI "; 241 | mnemo1[8] := "PL"; 242 | mnemo1[1] := "EQ "; 243 | mnemo1[9] := "NE "; 244 | mnemo1[2] := "LS "; 245 | mnemo1[10] := "HI "; 246 | mnemo1[5] := "LT "; 247 | mnemo1[13] := "GE "; 248 | mnemo1[6] := "LE "; 249 | mnemo1[14] := "GT "; 250 | mnemo1[15] := "NO "; 251 | END ORTool. 252 | -------------------------------------------------------------------------------- /Oberon/Oberon.Mod: -------------------------------------------------------------------------------- 1 | MODULE Oberon; (*JG 6.9.90 / 23.9.93 / 13.8.94 / NW 14.4.2013 / 22.12.2015*) 2 | IMPORT SYSTEM, Kernel, Files, Modules, Input, Display, Viewers, Fonts, Texts; 3 | 4 | CONST (*message ids*) 5 | consume* = 0; track* = 1; defocus* = 0; neutralize* = 1; mark* = 2; 6 | off = 0; idle = 1; active = 2; (*task states*) 7 | BasicCycle = 20; 8 | ESC = 1BX; SETSTAR = 1AX; 9 | 10 | TYPE Painter* = PROCEDURE (x, y: INTEGER); 11 | Marker* = RECORD Fade*, Draw*: Painter END; 12 | 13 | Cursor* = RECORD 14 | marker*: Marker; on*: BOOLEAN; X*, Y*: INTEGER 15 | END; 16 | 17 | InputMsg* = RECORD (Display.FrameMsg) 18 | id*: INTEGER; 19 | keys*: SET; 20 | X*, Y*: INTEGER; 21 | ch*: CHAR; 22 | fnt*: Fonts.Font; 23 | col*, voff*: INTEGER 24 | END; 25 | 26 | SelectionMsg* = RECORD (Display.FrameMsg) 27 | time*: LONGINT; 28 | text*: Texts.Text; 29 | beg*, end*: LONGINT 30 | END; 31 | 32 | ControlMsg* = RECORD (Display.FrameMsg) 33 | id*, X*, Y*: INTEGER 34 | END; 35 | 36 | CopyMsg* = RECORD (Display.FrameMsg) 37 | F*: Display.Frame 38 | END; 39 | 40 | Task* = POINTER TO TaskDesc; 41 | 42 | Handler* = PROCEDURE; 43 | 44 | TaskDesc* = RECORD 45 | state, nextTime, period*: INTEGER; 46 | next: Task; 47 | handle: Handler 48 | END; 49 | 50 | VAR User*: ARRAY 8 OF CHAR; Password*: LONGINT; 51 | Arrow*, Star*: Marker; 52 | Mouse, Pointer: Cursor; 53 | FocusViewer*: Viewers.Viewer; 54 | Log*: Texts.Text; 55 | 56 | Par*: RECORD 57 | vwr*: Viewers.Viewer; 58 | frame*: Display.Frame; 59 | text*: Texts.Text; 60 | pos*: LONGINT 61 | END; 62 | 63 | CurFnt*: Fonts.Font; 64 | CurCol*, CurOff*: INTEGER; 65 | NofTasks*: INTEGER; 66 | 67 | CurTask: Task; 68 | DW, DH, CL: INTEGER; 69 | ActCnt: INTEGER; (*action count for GC*) 70 | Mod: Modules.Module; 71 | 72 | (*user identification*) 73 | 74 | PROCEDURE Code(VAR s: ARRAY OF CHAR): LONGINT; 75 | VAR i: INTEGER; a, b, c: LONGINT; 76 | BEGIN 77 | a := 0; b := 0; i := 0; 78 | WHILE s[i] # 0X DO 79 | c := b; b := a; a := (c MOD 509 + 1) * 127 + ORD(s[i]); 80 | INC(i) 81 | END; 82 | IF b >= 32768 THEN b := b - 65536 END; 83 | RETURN b * 65536 + a 84 | END Code; 85 | 86 | PROCEDURE SetUser* (VAR user, password: ARRAY OF CHAR); 87 | BEGIN User := user; Password := Code(password) 88 | END SetUser; 89 | 90 | PROCEDURE Clock*(): LONGINT; 91 | BEGIN RETURN Kernel.Clock() 92 | END Clock; 93 | 94 | PROCEDURE SetClock* (d: LONGINT); 95 | BEGIN Kernel.SetClock(d) 96 | END SetClock; 97 | 98 | PROCEDURE Time*(): LONGINT; 99 | BEGIN RETURN Kernel.Time() 100 | END Time; 101 | 102 | (*cursor handling*) 103 | 104 | PROCEDURE FlipArrow (X, Y: INTEGER); 105 | BEGIN 106 | IF X < CL THEN 107 | IF X > DW - 15 THEN X := DW - 15 END 108 | ELSE 109 | IF X > CL + DW - 15 THEN X := CL + DW - 15 END 110 | END; 111 | IF Y < 14 THEN Y := 14 ELSIF Y > DH THEN Y := DH END; 112 | Display.CopyPattern(Display.white, Display.arrow, X, Y - 14, Display.invert) 113 | END FlipArrow; 114 | 115 | PROCEDURE FlipStar (X, Y: INTEGER); 116 | BEGIN 117 | IF X < CL THEN 118 | IF X < 7 THEN X := 7 ELSIF X > DW - 8 THEN X := DW - 8 END 119 | ELSE 120 | IF X < CL + 7 THEN X := CL + 7 ELSIF X > CL + DW - 8 THEN X := CL + DW - 8 END 121 | END ; 122 | IF Y < 7 THEN Y := 7 ELSIF Y > DH - 8 THEN Y := DH - 8 END; 123 | Display.CopyPattern(Display.white, Display.star, X - 7, Y - 7, Display.invert) 124 | END FlipStar; 125 | 126 | PROCEDURE OpenCursor(VAR c: Cursor); 127 | BEGIN c.on := FALSE; c.X := 0; c.Y := 0 128 | END OpenCursor; 129 | 130 | PROCEDURE FadeCursor(VAR c: Cursor); 131 | BEGIN IF c.on THEN c.marker.Fade(c.X, c.Y); c.on := FALSE END 132 | END FadeCursor; 133 | 134 | PROCEDURE DrawCursor(VAR c: Cursor; m: Marker; x, y: INTEGER); 135 | BEGIN 136 | IF c.on & ((x # c.X) OR (y # c.Y) OR (m.Draw # c.marker.Draw)) THEN 137 | c.marker.Fade(c.X, c.Y); c.on := FALSE 138 | END; 139 | IF ~c.on THEN 140 | m.Draw(x, y); c.marker := m; c.X := x; c.Y := y; c.on := TRUE 141 | END 142 | END DrawCursor; 143 | 144 | PROCEDURE DrawMouse*(m: Marker; x, y: INTEGER); 145 | BEGIN DrawCursor(Mouse, m, x, y) 146 | END DrawMouse; 147 | 148 | PROCEDURE DrawMouseArrow*(x, y: INTEGER); 149 | BEGIN DrawCursor(Mouse, Arrow, x, y) 150 | END DrawMouseArrow; 151 | 152 | PROCEDURE FadeMouse*; 153 | BEGIN FadeCursor(Mouse) 154 | END FadeMouse; 155 | 156 | PROCEDURE DrawPointer*(x, y: INTEGER); 157 | BEGIN DrawCursor(Pointer, Star, x, y) 158 | END DrawPointer; 159 | 160 | (*display management*) 161 | 162 | PROCEDURE RemoveMarks* (X, Y, W, H: INTEGER); 163 | BEGIN 164 | IF (Mouse.X > X - 16) & (Mouse.X < X + W + 16) & (Mouse.Y > Y - 16) & (Mouse.Y < Y + H + 16) THEN 165 | FadeCursor(Mouse) 166 | END; 167 | IF (Pointer.X > X - 8) & (Pointer.X < X + W + 8) & (Pointer.Y > Y - 8) & (Pointer.Y < Y + H + 8) THEN 168 | FadeCursor(Pointer) 169 | END 170 | END RemoveMarks; 171 | 172 | PROCEDURE HandleFiller (V: Display.Frame; VAR M: Display.FrameMsg); 173 | BEGIN 174 | CASE M OF 175 | InputMsg: IF M.id = track THEN DrawCursor(Mouse, Arrow, M.X, M.Y) END | 176 | ControlMsg: IF M.id = mark THEN DrawCursor(Pointer, Star, M.X, M.Y) END | 177 | Viewers.ViewerMsg: 178 | IF (M.id = Viewers.restore) & (V.W > 0) & (V.H > 0) THEN 179 | RemoveMarks(V.X, V.Y, V.W, V.H); 180 | Display.ReplConst(Display.black, V.X, V.Y, V.W, V.H, Display.replace) 181 | ELSIF (M.id = Viewers.modify) & (M.Y < V.Y) THEN 182 | RemoveMarks(V.X, M.Y, V.W, V.Y - M.Y); 183 | Display.ReplConst(Display.black, V.X, M.Y, V.W, V.Y - M.Y, Display.replace) 184 | END 185 | END 186 | END HandleFiller; 187 | 188 | PROCEDURE OpenDisplay* (UW, SW, H: INTEGER); 189 | VAR Filler: Viewers.Viewer; 190 | BEGIN 191 | Input.SetMouseLimits(Viewers.curW + UW + SW, H); 192 | Display.ReplConst(Display.black, Viewers.curW, 0, UW + SW, H, Display.replace); 193 | NEW(Filler); Filler.handle := HandleFiller; 194 | Viewers.InitTrack(UW, H, Filler); (*init user track*) 195 | NEW(Filler); Filler.handle := HandleFiller; 196 | Viewers.InitTrack(SW, H, Filler) (*init system track*) 197 | END OpenDisplay; 198 | 199 | PROCEDURE DisplayWidth* (X: INTEGER): INTEGER; 200 | BEGIN RETURN DW 201 | END DisplayWidth; 202 | 203 | PROCEDURE DisplayHeight* (X: INTEGER): INTEGER; 204 | BEGIN RETURN DH 205 | END DisplayHeight; 206 | 207 | PROCEDURE OpenTrack* (X, W: INTEGER); 208 | VAR Filler: Viewers.Viewer; 209 | BEGIN 210 | NEW(Filler); Filler.handle := HandleFiller; 211 | Viewers.OpenTrack(X, W, Filler) 212 | END OpenTrack; 213 | 214 | PROCEDURE UserTrack* (X: INTEGER): INTEGER; 215 | BEGIN RETURN X DIV DW * DW 216 | END UserTrack; 217 | 218 | PROCEDURE SystemTrack* (X: INTEGER): INTEGER; 219 | BEGIN RETURN X DIV DW * DW + DW DIV 8 * 5 220 | END SystemTrack; 221 | 222 | PROCEDURE UY (X: INTEGER): INTEGER; 223 | VAR h: INTEGER; 224 | fil, bot, alt, max: Display.Frame; 225 | BEGIN 226 | Viewers.Locate(X, 0, fil, bot, alt, max); 227 | IF fil.H >= DH DIV 8 THEN h := DH ELSE h := max.Y + max.H DIV 2 END ; 228 | RETURN h 229 | END UY; 230 | 231 | PROCEDURE AllocateUserViewer* (DX: INTEGER; VAR X, Y: INTEGER); 232 | BEGIN 233 | IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y 234 | ELSE X := DX DIV DW * DW; Y := UY(X) 235 | END 236 | END AllocateUserViewer; 237 | 238 | PROCEDURE SY (X: INTEGER): INTEGER; 239 | VAR H0, H1, H2, H3, y: INTEGER; 240 | fil, bot, alt, max: Display.Frame; 241 | BEGIN H3 := DH - DH DIV 3; 242 | H2 := H3 - H3 DIV 2; H1 := DH DIV 5; H0 := DH DIV 10; 243 | Viewers.Locate(X, DH, fil, bot, alt, max); 244 | IF fil.H >= DH DIV 8 THEN y := DH 245 | ELSIF max.H >= DH - H0 THEN y := max.Y + H3 246 | ELSIF max.H >= H3 - H0 THEN y := max.Y + H2 247 | ELSIF max.H >= H2 - H0 THEN y := max.Y + H1 248 | ELSIF max # bot THEN y := max.Y + max.H DIV 2 249 | ELSIF bot.H >= H1 THEN y := bot.H DIV 2 250 | ELSE y := alt.Y + alt.H DIV 2 251 | END ; 252 | RETURN y 253 | END SY; 254 | 255 | PROCEDURE AllocateSystemViewer* (DX: INTEGER; VAR X, Y: INTEGER); 256 | BEGIN 257 | IF Pointer.on THEN X := Pointer.X; Y := Pointer.Y 258 | ELSE X := DX DIV DW * DW + DW DIV 8 * 5; Y := SY(X) 259 | END 260 | END AllocateSystemViewer; 261 | 262 | PROCEDURE MarkedViewer* (): Viewers.Viewer; 263 | BEGIN RETURN Viewers.This(Pointer.X, Pointer.Y) 264 | END MarkedViewer; 265 | 266 | PROCEDURE PassFocus* (V: Viewers.Viewer); 267 | VAR M: ControlMsg; 268 | BEGIN M.id := defocus; FocusViewer.handle(FocusViewer, M); FocusViewer := V 269 | END PassFocus; 270 | 271 | PROCEDURE OpenLog*(T: Texts.Text); 272 | BEGIN Log := T 273 | END OpenLog; 274 | 275 | (*command interpretation*) 276 | PROCEDURE SetPar*(F: Display.Frame; T: Texts.Text; pos: LONGINT); 277 | BEGIN Par.vwr := Viewers.This(F.X, F.Y); Par.frame := F; Par.text := T; Par.pos := pos 278 | END SetPar; 279 | 280 | PROCEDURE Call* (name: ARRAY OF CHAR; VAR res: INTEGER); 281 | VAR mod: Modules.Module; P: Modules.Command; 282 | i, j: INTEGER; ch: CHAR; 283 | Mname, Cname: ARRAY 32 OF CHAR; 284 | BEGIN i := 0; ch := name[0]; 285 | WHILE (ch # ".") & (ch # 0X) DO Mname[i] := ch; INC(i); ch := name[i] END ; 286 | IF ch = "." THEN 287 | Mname[i] := 0X; INC(i); 288 | Modules.Load(Mname, mod); res := Modules.res; 289 | IF Modules.res = 0 THEN 290 | j := 0; ch := name[i]; INC(i); 291 | WHILE ch # 0X DO Cname[j] := ch; INC(j); ch := name[i]; INC(i) END ; 292 | Cname[j] := 0X; 293 | P := Modules.ThisCommand(mod, Cname); res := Modules.res; 294 | IF Modules.res = 0 THEN P END 295 | END 296 | ELSE res := 5 297 | END 298 | END Call; 299 | 300 | PROCEDURE GetSelection* (VAR text: Texts.Text; VAR beg, end, time: LONGINT); 301 | VAR M: SelectionMsg; 302 | BEGIN 303 | M.time := -1; Viewers.Broadcast(M); time := M.time; 304 | IF time >= 0 THEN text := M.text; beg := M.beg; end := M.end END 305 | END GetSelection; 306 | 307 | PROCEDURE GC; 308 | VAR mod: Modules.Module; 309 | BEGIN 310 | IF (ActCnt <= 0) OR (Kernel.allocated >= Kernel.heapLim - Kernel.heapOrg - 10000H) THEN 311 | mod := Modules.root; LED(21H); 312 | WHILE mod # NIL DO 313 | IF mod.name[0] # 0X THEN Kernel.Mark(mod.ptr) END ; 314 | mod := mod.next 315 | END ; 316 | LED(23H); 317 | Files.RestoreList; LED(27H); 318 | Kernel.Scan; LED(20H); 319 | ActCnt := BasicCycle 320 | END 321 | END GC; 322 | 323 | PROCEDURE NewTask*(h: Handler; period: INTEGER): Task; 324 | VAR t: Task; 325 | BEGIN NEW(t); t.state := off; t.next := t; t.handle := h; t.period := period; RETURN t 326 | END NewTask; 327 | 328 | PROCEDURE Install* (T: Task); 329 | BEGIN 330 | IF T.state = off THEN 331 | T.next := CurTask.next; CurTask.next := T; T.state := idle; T.nextTime := 0; INC(NofTasks) 332 | END 333 | END Install; 334 | 335 | PROCEDURE Remove* (T: Task); 336 | VAR t: Task; 337 | BEGIN 338 | IF T.state # off THEN t := T; 339 | WHILE t.next # T DO t := t.next END ; 340 | t.next := T.next; T.state := off; T.next := NIL; CurTask := t; DEC(NofTasks) 341 | END 342 | END Remove; 343 | 344 | PROCEDURE Collect* (count: INTEGER); 345 | BEGIN ActCnt := count 346 | END Collect; 347 | 348 | PROCEDURE SetFont* (fnt: Fonts.Font); 349 | BEGIN CurFnt := fnt 350 | END SetFont; 351 | 352 | PROCEDURE SetColor* (col: INTEGER); 353 | BEGIN CurCol := col 354 | END SetColor; 355 | 356 | PROCEDURE SetOffset* (voff: INTEGER); 357 | BEGIN CurOff := voff 358 | END SetOffset; 359 | 360 | PROCEDURE Loop*; 361 | VAR V: Viewers.Viewer; M: InputMsg; N: ControlMsg; 362 | prevX, prevY, X, Y, t: INTEGER; keys: SET; ch: CHAR; 363 | BEGIN 364 | REPEAT 365 | Input.Mouse(keys, X, Y); 366 | IF Input.Available() > 0 THEN Input.Read(ch); 367 | IF ch = ESC THEN 368 | N.id := neutralize; Viewers.Broadcast(N); FadeCursor(Pointer); LED(0) 369 | ELSIF ch = SETSTAR THEN 370 | N.id := mark; N.X := X; N.Y := Y; V := Viewers.This(X, Y); V.handle(V, N) 371 | ELSE M.id := consume; M.ch := ch; M.fnt := CurFnt; M.col := CurCol; M.voff := CurOff; 372 | FocusViewer.handle(FocusViewer, M); DEC(ActCnt) 373 | END 374 | ELSIF keys # {} THEN 375 | M.id := track; M.X := X; M.Y := Y; M.keys := keys; 376 | REPEAT V := Viewers.This(M.X, M.Y); V.handle(V, M); Input.Mouse(M.keys, M.X, M.Y) 377 | UNTIL M.keys = {}; 378 | DEC(ActCnt) 379 | ELSE 380 | IF (X # prevX) OR (Y # prevY) OR ~Mouse.on THEN 381 | M.id := track; M.X := X; 382 | IF Y >= Display.Height THEN Y := Display.Height END ; 383 | M.Y := Y; M.keys := keys; V := Viewers.This(X, Y); V.handle(V, M); prevX := X; prevY := Y 384 | END; 385 | CurTask := CurTask.next; t := Kernel.Time(); 386 | IF t >= CurTask.nextTime THEN 387 | CurTask.nextTime := t + CurTask.period; CurTask.state := active; CurTask.handle; CurTask.state := idle 388 | END 389 | END 390 | UNTIL FALSE 391 | END Loop; 392 | 393 | PROCEDURE Reset*; 394 | BEGIN 395 | IF CurTask.state = active THEN Remove(CurTask) END ; 396 | SYSTEM.LDREG(14, Kernel.stackOrg); (*reset stack pointer*) Loop 397 | END Reset; 398 | 399 | BEGIN User[0] := 0X; 400 | Arrow.Fade := FlipArrow; Arrow.Draw := FlipArrow; 401 | Star.Fade := FlipStar; Star.Draw := FlipStar; 402 | OpenCursor(Mouse); OpenCursor(Pointer); 403 | 404 | DW := Display.Width; DH := Display.Height; CL := DW; 405 | OpenDisplay(DW DIV 8 * 5, DW DIV 8 * 3, DH); 406 | FocusViewer := Viewers.This(0, 0); 407 | CurFnt := Fonts.Default; CurCol := Display.white; CurOff := 0; 408 | 409 | ActCnt := 0; CurTask := NewTask(GC, 1000); Install(CurTask); 410 | Modules.Load("System", Mod); Mod := NIL; Loop 411 | END Oberon. -------------------------------------------------------------------------------- /Oberon/Oberon10.Scn.Fnt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/pdewacht/project-norebo/0e4731bc2c2551c907b7cba96079efd1316e92d6/Oberon/Oberon10.Scn.Fnt -------------------------------------------------------------------------------- /Oberon/RS232.Mod: -------------------------------------------------------------------------------- 1 | MODULE RS232; (*NW 3.1.2012*) 2 | IMPORT SYSTEM; 3 | CONST data = -56; stat = -52; 4 | 5 | PROCEDURE Send*(x: INTEGER); 6 | BEGIN 7 | REPEAT UNTIL SYSTEM.BIT(stat, 1); 8 | SYSTEM.PUT(data, x) 9 | END Send; 10 | 11 | PROCEDURE Rec*(VAR x: INTEGER); 12 | BEGIN 13 | REPEAT UNTIL SYSTEM.BIT(stat, 0); 14 | SYSTEM.GET(data, x) 15 | END Rec; 16 | 17 | PROCEDURE SendInt*(x: INTEGER); 18 | VAR i: INTEGER; 19 | BEGIN Send(1); i := 4; 20 | REPEAT i := i-1; Send(x); x := ROR(x, 8) UNTIL i = 0 21 | END SendInt; 22 | 23 | PROCEDURE SendHex*(x: INTEGER); 24 | VAR i: INTEGER; 25 | BEGIN Send(2); i := 4; 26 | REPEAT i := i-1; Send(x); x := ROR(x, 8) UNTIL i = 0 27 | END SendHex; 28 | 29 | PROCEDURE SendReal*(x: REAL); 30 | VAR i, u: INTEGER; 31 | BEGIN Send(3); u := ORD(x); i := 4; 32 | REPEAT i := i-1; Send(u); u := ROR(u, 8) UNTIL i = 0 33 | END SendReal; 34 | 35 | PROCEDURE SendStr*(x: ARRAY OF CHAR); 36 | VAR i, k: INTEGER; 37 | BEGIN Send(4); i := 0; 38 | REPEAT k := ORD(x[i]); Send(k); INC(i) UNTIL k = 0 39 | END SendStr; 40 | 41 | PROCEDURE RecInt*(VAR x: INTEGER); 42 | VAR i, x0, y: INTEGER; 43 | BEGIN i := 4; x0 := 0; 44 | REPEAT i := i-1; Rec(y); x0 := ROR(x0+y, 8) UNTIL i = 0; 45 | x := x0 46 | END RecInt; 47 | 48 | PROCEDURE RecReal*(VAR x: REAL); 49 | VAR i, x0, y: INTEGER; 50 | BEGIN i := 4; x0 := 0; 51 | REPEAT i := i-1; Rec(y); x0 := ROR(x0+y, 8) UNTIL i = 0; 52 | x := SYSTEM.VAL(REAL, x0) 53 | END RecReal; 54 | 55 | PROCEDURE RecStr*(VAR x: ARRAY OF CHAR); 56 | VAR i, k: INTEGER; 57 | BEGIN i := 0; 58 | REPEAT Rec(k); x[i] := CHR(k); INC(i) UNTIL k = 0 59 | END RecStr; 60 | 61 | PROCEDURE Line*; 62 | BEGIN Send(6) 63 | END Line; 64 | 65 | PROCEDURE End*; 66 | BEGIN Send(7) 67 | END End; 68 | 69 | BEGIN END RS232. 70 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Project Norebo 2 | 3 | Norebo is a hack to run some _Project Oberon 2013_ software on the 4 | Unix command line. Programs that use the GUI obviously won't work, but 5 | e.g. the compiler runs. 6 | 7 | I probably won't be maintaining this project, so feel free to fork 8 | if you want to develop it further. 9 | 10 | ## Contents 11 | 12 | * `Runtime/` RISC5 emulator and operating system interface. 13 | * `Oberon/` Unmodified source code from Project Oberon 2013. 14 | * `Norebo/` Norebo-specific and new modules. 15 | * `Bootstrap/` Pre-compiled modules to bootstrap Norebo. 16 | * `build.sh` Script to rebuild Norebo. See Norebo in action. 17 | 18 | ## PO2013 image build tools 19 | 20 | This repository also contains tools to build fresh PO2013 filesystem 21 | images. Use it like so: 22 | 23 | ./fetch-sources.py upstream 24 | ./build-image.py upstream 25 | 26 | ...where `upstream` is the name of the directory where the sources 27 | should live. (Replace it with the name of your choice.) This will 28 | download the project sources, compile them, create runnable disk image 29 | `build/Oberon.dsk`. The CSV build manifest controls which set of 30 | files should define the resulting system. The disk image can be run 31 | on the [Project Oberon RISC emulator]. 32 | 33 | Supporting Oberon modules are stored in `Norebo`: a virtual file 34 | system (`VDiskUtil`/`VFile`) and a static linker for the Inner Core. 35 | All this is based on code from PO2013. 36 | 37 | ## File handling 38 | 39 | New files are always created in the current directory. Old files are 40 | first looked up in the current directory and if they are not found, 41 | they are searched for in the path defined by the `OBERON_PATH` 42 | environment variable. Files found via `OBERON_PATH` are always opened 43 | read-only. 44 | 45 | ## Bugs 46 | 47 | Probably many. 48 | 49 | Files are not integrated with the garbage collector. If you don't 50 | close a file, it will remain open until Norebo exits. 51 | 52 | Most runtime errors do not print a diagnostic message. Here's a table 53 | of exit codes: 54 | 55 | Exit code | Meaning 56 | ----------:|:------------------------------ 57 | 1..7 | possibly a Modules error 58 | 5 | (also) unknown command 59 | 101 | array index out of range 60 | 102 | type guard failure 61 | 103 | array or string copy overflow 62 | 104 | access via NIL pointer 63 | 105 | illegal procedure call 64 | 106 | integer division by zero 65 | 107 | assertion violated 66 | 67 | [Project Oberon RISC emulator]: https://github.com/pdewacht/oberon-risc-emu 68 | -------------------------------------------------------------------------------- /Runtime/norebo.c: -------------------------------------------------------------------------------- 1 | #define _GNU_SOURCE 2 | #include 3 | #include 4 | #include 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | #include 11 | #include 12 | #include 13 | #include 14 | #include 15 | #include 16 | #include "risc-cpu.h" 17 | 18 | #define PathEnv "NOREBO_PATH" 19 | #define InnerCore "InnerCore" 20 | 21 | #define MemBytes (8 * 1024 * 1024) 22 | #define StackOrg 0x80000 23 | #define MaxFiles 500 24 | #define NameLength 32 25 | 26 | struct File { 27 | FILE *f; 28 | char name[NameLength]; 29 | bool registered; 30 | }; 31 | 32 | static uint8_t mem[MemBytes]; 33 | static uint32_t sysarg[3], sysres; 34 | static uint32_t nargc; 35 | static char **nargv; 36 | static struct File files[MaxFiles]; 37 | static DIR *dir; 38 | 39 | /* Memory access */ 40 | 41 | static uint32_t le32_to_host(uint8_t *ptr) { 42 | return ptr[0] | (ptr[1] << 8) | (ptr[2] << 16) | (ptr[3] << 24); 43 | } 44 | 45 | static uint32_t mem_read_word(uint32_t adr) { 46 | if (adr >= MemBytes - 3) { 47 | errx(1, "Memory read out of bounds (address %#08x)", adr); 48 | } 49 | return le32_to_host(mem + adr); 50 | } 51 | 52 | static uint8_t mem_read_byte(uint32_t adr) { 53 | if (adr >= MemBytes) { 54 | errx(1, "Memory read out of bounds (address %#08x)", adr); 55 | } 56 | return mem[adr]; 57 | } 58 | 59 | static void mem_write_word(uint32_t adr, uint32_t val) { 60 | if (adr >= MemBytes - 3) { 61 | errx(1, "Memory write out of bounds (address %#08x)", adr); 62 | } 63 | uint8_t *ptr = mem + adr; 64 | ptr[0] = (uint8_t)val; 65 | ptr[1] = (uint8_t)(val >> 8); 66 | ptr[2] = (uint8_t)(val >> 16); 67 | ptr[3] = (uint8_t)(val >> 24); 68 | } 69 | 70 | static void mem_write_byte(uint32_t adr, uint32_t val) { 71 | if (adr >= MemBytes) { 72 | errx(1, "Memory read out of bounds (address %#08x)", adr); 73 | } 74 | mem[adr] = (uint8_t)val; 75 | } 76 | 77 | static void mem_check_range(uint32_t adr, uint32_t siz, const char *proc) { 78 | if (adr >= MemBytes || MemBytes - adr < siz) { 79 | errx(1, "%s: Memory access out of bounds", proc); 80 | } 81 | } 82 | 83 | /* Norebo module */ 84 | 85 | static uint32_t norebo_halt(uint32_t ec, uint32_t _2, uint32_t _3) { 86 | exit(ec); 87 | } 88 | 89 | static uint32_t norebo_argc(uint32_t _1, uint32_t _2, uint32_t _3) { 90 | return nargc; 91 | } 92 | 93 | static uint32_t norebo_argv(uint32_t idx, uint32_t adr, uint32_t siz) { 94 | mem_check_range(adr, siz, "Norebo.Argv"); 95 | if (idx < nargc) { 96 | if (siz > 0) { 97 | strncpy((char *)mem + adr, nargv[idx], siz - 1); 98 | mem[adr + siz - 1] = 0; 99 | } 100 | return (uint32_t)strlen(nargv[idx]); 101 | } else { 102 | return -1; 103 | } 104 | } 105 | 106 | static bool files_get_name(char *name, uint32_t adr); 107 | 108 | static uint32_t norebo_trap(uint32_t trap, uint32_t name_adr, uint32_t pos) { 109 | char message[100]; 110 | switch (trap) { 111 | case 1: strcpy(message, "array index out of range"); break; 112 | case 2: strcpy(message, "type guard failure"); break; 113 | case 3: strcpy(message, "array or string copy overflow"); break; 114 | case 4: strcpy(message, "access via NIL pointer"); break; 115 | case 5: strcpy(message, "illegal procedure call"); break; 116 | case 6: strcpy(message, "integer division by zero"); break; 117 | case 7: strcpy(message, "assertion violated"); break; 118 | default: sprintf(message, "unknown trap %d", trap); break; 119 | } 120 | char name[NameLength]; 121 | if (!files_get_name(name, name_adr)) { 122 | strcpy(name, "(unknown)"); 123 | } 124 | errx(100 + trap, "%s at %s pos %d", message, name, pos); 125 | } 126 | 127 | /* Files module */ 128 | 129 | static FILE *path_fopen(const char *path, const char *filename, const char *mode) { 130 | if (!path) { 131 | errno = ENOENT; 132 | return NULL; 133 | } 134 | const char *sep = strchr(path, ';') ? ";" : ":"; 135 | FILE *f = NULL; 136 | do { 137 | size_t part_len = strcspn(path, sep); 138 | if (part_len == 0) { 139 | f = fopen(filename, mode); 140 | } else { 141 | char *buf = NULL; 142 | int r = asprintf(&buf, "%.*s/%s", (int)part_len, path, filename); 143 | if (r < 0) { 144 | err(1, NULL); 145 | } 146 | f = fopen(buf, mode); 147 | free(buf); 148 | } 149 | path += part_len + 1; 150 | } while (f == NULL && errno == ENOENT && path[-1] != 0); 151 | return f; 152 | } 153 | 154 | static bool files_check_name(char *name) { 155 | for (int i = 0; i < NameLength; ++i) { 156 | char ch = name[i]; 157 | if (ch == 0) { 158 | return true; 159 | } else if (! ((ch >= 'A' && ch <= 'Z') || 160 | (ch >= 'a' && ch <= 'z') || 161 | (i > 0 && (ch == '.' || (ch >= '0' && ch <= '9'))))) { 162 | return false; 163 | } 164 | } 165 | return false; 166 | } 167 | 168 | static bool files_get_name(char *name, uint32_t adr) { 169 | mem_check_range(adr, NameLength, "Files.GetName"); 170 | memcpy(name, mem + adr, NameLength); 171 | return files_check_name(name); 172 | } 173 | 174 | static int files_allocate(const char *name, bool registered) { 175 | for (int h = 0; h < MaxFiles; ++h) { 176 | if (!files[h].f) { 177 | strncpy(files[h].name, name, NameLength); 178 | files[h].registered = registered; 179 | return h; 180 | } 181 | } 182 | errx(1, "Files.Allocate: Too many open files"); 183 | } 184 | 185 | static void files_check_handle(int h, const char *proc) { 186 | if (h < 0 || h >= MaxFiles || !files[h].f) { 187 | errx(1, "%s: Invalid file handle", proc); 188 | } 189 | } 190 | 191 | static uint32_t files_new(uint32_t adr, uint32_t _2, uint32_t _3) { 192 | char name[NameLength]; 193 | if (!files_get_name(name, adr)) { 194 | return -1; 195 | } 196 | int h = files_allocate(name, false); 197 | files[h].f = tmpfile(); 198 | if (!files[h].f) { 199 | err(1, "Files.New: %s", name); 200 | } 201 | return h; 202 | } 203 | 204 | static uint32_t files_old(uint32_t adr, uint32_t _2, uint32_t _3) { 205 | char name[NameLength]; 206 | if (!files_get_name(name, adr)) { 207 | return -1; 208 | } 209 | int h = files_allocate(name, true); 210 | files[h].f = fopen(name, "r+b"); 211 | if (!files[h].f) { 212 | files[h].f = path_fopen(getenv(PathEnv), name, "rb"); 213 | } 214 | if (!files[h].f) { 215 | files[h] = (struct File){0}; 216 | return -1; 217 | } 218 | return h; 219 | } 220 | 221 | static uint32_t files_register(uint32_t h, uint32_t _2, uint32_t _3) { 222 | files_check_handle(h, "Files.Register"); 223 | if (!files[h].registered && files[h].name[0]) { 224 | FILE *old = files[h].f; 225 | files[h].f = fopen(files[h].name, "w+b"); 226 | if (!files[h].f) { 227 | err(1, "Can't create file %s", files[h].name); 228 | } 229 | errno = 0; 230 | fseek(old, 0, SEEK_SET); 231 | char buf[8192]; 232 | size_t in = fread(buf, 1, sizeof(buf), old); 233 | while (in != 0) { 234 | size_t out = fwrite(buf, 1, in, files[h].f); 235 | if (in != out) { 236 | err(1, "Can't write file %s", files[h].name); 237 | } 238 | in = fread(buf, 1, sizeof(buf), old); 239 | } 240 | fclose(old); 241 | if (fflush(files[h].f) != 0) { 242 | err(1, "Can't flush file %s", files[h].name); 243 | } 244 | files[h].registered = true; 245 | } 246 | return 0; 247 | } 248 | 249 | static uint32_t files_close(uint32_t h, uint32_t _2, uint32_t _3) { 250 | files_check_handle(h, "Files.Close"); 251 | fclose(files[h].f); 252 | files[h] = (struct File){0}; 253 | return 0; 254 | } 255 | 256 | static uint32_t files_seek(uint32_t h, uint32_t pos, uint32_t whence) { 257 | files_check_handle(h, "Files.Seek"); 258 | return fseek(files[h].f, pos, whence); 259 | } 260 | 261 | static uint32_t files_tell(uint32_t h, uint32_t _2, uint32_t _3) { 262 | files_check_handle(h, "Files.Tell"); 263 | return (uint32_t)ftell(files[h].f); 264 | } 265 | 266 | static uint32_t files_read(uint32_t h, uint32_t adr, uint32_t siz) { 267 | files_check_handle(h, "Files.Read"); 268 | mem_check_range(adr, siz, "Files.Read"); 269 | size_t r = fread(mem + adr, 1, siz, files[h].f); 270 | memset(mem + adr + r, 0, siz - r); 271 | return (uint32_t)r; 272 | } 273 | 274 | static uint32_t files_write(uint32_t h, uint32_t adr, uint32_t siz) { 275 | files_check_handle(h, "Files.Write"); 276 | mem_check_range(adr, siz, "Files.Write"); 277 | return (uint32_t)fwrite(mem + adr, 1, siz, files[h].f); 278 | } 279 | 280 | static uint32_t files_length(uint32_t h, uint32_t _2, uint32_t _3) { 281 | files_check_handle(h, "Files.Length"); 282 | fflush(files[h].f); 283 | struct stat s; 284 | int r = fstat(fileno(files[h].f), &s); 285 | if (r < 0) { err(1, "Files.Length"); } 286 | return (uint32_t)s.st_size; 287 | } 288 | 289 | static uint32_t time_to_oberon(time_t t) { 290 | struct tm tm = {0}; 291 | localtime_r(&t, &tm); 292 | return ((tm.tm_year % 100) * 0x4000000) | 293 | (tm.tm_mon * 0x400000) | 294 | (tm.tm_mday * 0x20000) | 295 | (tm.tm_hour * 0x1000) | 296 | (tm.tm_min * 0x40) | 297 | tm.tm_sec; 298 | } 299 | 300 | static uint32_t files_date(uint32_t h, uint32_t _2, uint32_t _3) { 301 | files_check_handle(h, "Files.Date"); 302 | fflush(files[h].f); 303 | if (files[h].registered) { 304 | struct stat s; 305 | int r = fstat(fileno(files[h].f), &s); 306 | if (r < 0) { err(1, "Files.Date"); } 307 | return time_to_oberon(s.st_mtime); 308 | } else { 309 | return time_to_oberon(time(NULL)); 310 | } 311 | } 312 | 313 | static uint32_t files_delete(uint32_t adr, uint32_t _2, uint32_t _3) { 314 | char name[NameLength]; 315 | if (!files_get_name(name, adr) || !name[0]) { 316 | return -1; 317 | } 318 | if (remove(name) < 0) { 319 | return -1; 320 | } 321 | return 0; 322 | } 323 | 324 | static uint32_t files_purge(uint32_t h, uint32_t _2, uint32_t _3) { 325 | errx(1, "Files.Purge not implemented"); 326 | } 327 | 328 | static uint32_t files_rename(uint32_t adr_old, uint32_t adr_new, uint32_t _3) { 329 | char old_name[NameLength], new_name[NameLength]; 330 | if (!files_get_name(old_name, adr_old) || !old_name[0] || 331 | !files_get_name(new_name, adr_new) || !new_name[0]) { 332 | return -1; 333 | } 334 | if (rename(old_name, new_name) < 0) { 335 | return -1; 336 | } 337 | return 0; 338 | } 339 | 340 | /* FileDir module */ 341 | 342 | static uint32_t filedir_enumerate_begin(uint32_t _1, uint32_t _2, uint32_t _3) { 343 | if (dir) { 344 | closedir(dir); 345 | } 346 | dir = opendir("."); 347 | if (!dir) { 348 | err(1, "FileDir.BeginEnumerate"); 349 | } 350 | return 0; 351 | } 352 | 353 | static uint32_t filedir_enumerate_next(uint32_t adr, uint32_t _2, uint32_t _3) { 354 | mem_check_range(adr, NameLength, "FileDir.EnumerateNext"); 355 | struct dirent *ent = NULL; 356 | if (dir) { 357 | do { 358 | ent = readdir(dir); 359 | } while (ent && !files_check_name(ent->d_name)); 360 | } 361 | if (!ent) { 362 | mem_write_byte(adr, 0); 363 | return -1; 364 | } 365 | assert(strlen(ent->d_name) < NameLength); 366 | strncpy((char *)mem + adr, ent->d_name, NameLength); 367 | return 0; 368 | } 369 | 370 | static uint32_t filedir_enumerate_end(uint32_t _1, uint32_t _2, uint32_t _3) { 371 | if (dir) { 372 | closedir(dir); 373 | dir = NULL; 374 | } 375 | return 0; 376 | } 377 | 378 | /* I/O dispatch */ 379 | 380 | typedef uint32_t (* sysreq_fn)(uint32_t, uint32_t, uint32_t); 381 | 382 | static sysreq_fn sysreq_table[] = { 383 | [ 1] = norebo_halt, 384 | [ 2] = norebo_argc, 385 | [ 3] = norebo_argv, 386 | [ 4] = norebo_trap, 387 | 388 | [11] = files_new, 389 | [12] = files_old, 390 | [13] = files_register, 391 | [14] = files_close, 392 | [15] = files_seek, 393 | [16] = files_tell, 394 | [17] = files_read, 395 | [18] = files_write, 396 | [19] = files_length, 397 | [20] = files_date, 398 | [21] = files_delete, 399 | [22] = files_purge, 400 | [23] = files_rename, 401 | 402 | [31] = filedir_enumerate_begin, 403 | [32] = filedir_enumerate_next, 404 | [33] = filedir_enumerate_end, 405 | }; 406 | 407 | static const uint32_t sysreq_cnt = sizeof(sysreq_table) / sizeof(sysreq_table[0]); 408 | 409 | static uint32_t sysreq_exec(uint32_t n) { 410 | if (n >= sysreq_cnt || !sysreq_table[n]) { 411 | errx(1, "Unimplemented sysreq %d\n", n); 412 | } 413 | return sysreq_table[n](sysarg[0], sysarg[1], sysarg[2]); 414 | } 415 | 416 | static uint32_t risc_time(void) { 417 | struct timeval tv = {0}; 418 | gettimeofday(&tv, NULL); 419 | return (uint32_t)(tv.tv_sec * 1000 + tv.tv_usec / 1000); 420 | } 421 | 422 | static void risc_leds(uint32_t n) { 423 | static char buf[] = "[LEDs: 76543210]\n"; 424 | for (int i = 0; i < 8; ++i) { 425 | buf[14 - i] = (n & (1 << i)) ? (char)('0' + i) : '-'; 426 | } 427 | fputs(buf, stderr); 428 | } 429 | 430 | static uint32_t io_read_word(uint32_t adr) { 431 | switch (-adr / 4) { 432 | /* carried over from oberon */ 433 | case 64/4: 434 | return risc_time(); 435 | case 56/4: 436 | return getchar(); 437 | case 52/4: 438 | return 3; 439 | /* norebo interface */ 440 | case 16/4: 441 | return sysarg[2]; 442 | case 12/4: 443 | return sysarg[1]; 444 | case 8/4: 445 | return sysarg[0]; 446 | case 4/4: 447 | return sysres; 448 | default: 449 | errx(1, "Unimplemented read of I/O address %d", adr); 450 | } 451 | } 452 | 453 | static void io_write_word(uint32_t adr, uint32_t val) { 454 | switch (-adr / 4) { 455 | /* carried over from oberon */ 456 | case 60/4: 457 | risc_leds(val); 458 | break; 459 | case 56/4: 460 | putchar(val); 461 | break; 462 | /* norebo interface */ 463 | case 16/4: 464 | sysarg[2] = val; 465 | break; 466 | case 12/4: 467 | sysarg[1] = val; 468 | break; 469 | case 8/4: 470 | sysarg[0] = val; 471 | break; 472 | case 4/4: 473 | sysres = sysreq_exec(val); 474 | //printf("%d(%d,%d,%d)=>%d\n",val,sysarg[0],sysarg[1],sysarg[2],sysres); 475 | break; 476 | default: 477 | errx(1, "Unimplemented write of I/O address %d", adr); 478 | } 479 | } 480 | 481 | /* CPU glue */ 482 | 483 | static uint32_t cpu_read_program(struct RISC *cpu, uint32_t adr) { 484 | return mem_read_word(adr * 4); 485 | } 486 | 487 | static uint32_t cpu_read_word(struct RISC *cpu, uint32_t adr) { 488 | return (int32_t)adr >= 0 ? mem_read_word(adr) : io_read_word(adr); 489 | } 490 | 491 | static uint32_t cpu_read_byte(struct RISC *cpu, uint32_t adr) { 492 | return (int32_t)adr >= 0 ? mem_read_byte(adr) : io_read_word(adr); 493 | } 494 | 495 | static void cpu_write_word(struct RISC *cpu, uint32_t adr, uint32_t val) { 496 | (int32_t)adr >= 0 ? mem_write_word(adr, val) : io_write_word(adr, val); 497 | } 498 | 499 | static void cpu_write_byte(struct RISC *cpu, uint32_t adr, uint32_t val) { 500 | (int32_t)adr >= 0 ? mem_write_byte(adr, val) : io_write_word(adr, val); 501 | } 502 | 503 | /* Boot */ 504 | 505 | static bool read_uint32(uint32_t *v, FILE *f) { 506 | uint8_t buf[4]; 507 | if (fread(&buf, 1, 4, f) != 4) { 508 | return false; 509 | } 510 | *v = le32_to_host(buf); 511 | return true; 512 | } 513 | 514 | static void load_inner_core(void) { 515 | FILE *f = fopen(InnerCore, "rb"); 516 | if (!f) { 517 | f = path_fopen(getenv(PathEnv), InnerCore, "rb"); 518 | } 519 | if (!f) { 520 | err(1, "Can't load " InnerCore); 521 | } 522 | 523 | uint32_t siz, adr; 524 | if (!read_uint32(&siz, f)) { 525 | goto fail; 526 | } 527 | while (siz != 0) { 528 | if (!read_uint32(&adr, f)) { 529 | goto fail; 530 | } 531 | mem_check_range(adr, siz, InnerCore); 532 | if (fread(mem + adr, 1, siz, f) != siz) { 533 | goto fail; 534 | } 535 | if (!read_uint32(&siz, f)) { 536 | goto fail; 537 | } 538 | } 539 | fclose(f); 540 | return; 541 | 542 | fail: 543 | if (feof(f)) { 544 | errx(1, "Unexpected end of file while reading " InnerCore); 545 | } 546 | err(1, "Error while reading " InnerCore); 547 | } 548 | 549 | int main(int argc, char *argv[]) { 550 | nargc = argc - 1; 551 | nargv = argv + 1; 552 | 553 | load_inner_core(); 554 | mem_write_word(12, MemBytes); 555 | mem_write_word(24, StackOrg); 556 | static const struct RISC_IO io = { 557 | .read_program = cpu_read_program, 558 | .read_word = cpu_read_word, 559 | .read_byte = cpu_read_byte, 560 | .write_word = cpu_write_word, 561 | .write_byte = cpu_write_byte, 562 | }; 563 | struct RISC cpu = { 564 | .PC = 0, 565 | .R[12] = 0x20, 566 | .R[14] = StackOrg, 567 | }; 568 | risc_run(&io, &cpu); 569 | return 0; 570 | } 571 | -------------------------------------------------------------------------------- /Runtime/risc-cpu.c: -------------------------------------------------------------------------------- 1 | #include 2 | #include 3 | #include 4 | #include "risc-cpu.h" 5 | 6 | enum { 7 | MOV, LSL, ASR, ROR, 8 | AND, ANN, IOR, XOR, 9 | ADD, SUB, MUL, DIV, 10 | FAD, FSB, FML, FDV, 11 | }; 12 | 13 | static void risc_single_step(const struct RISC_IO *risc_io, struct RISC *risc); 14 | static void risc_set_register(struct RISC *risc, int reg, uint32_t value); 15 | static uint32_t fp_add(uint32_t x, uint32_t y, bool u, bool v); 16 | static uint32_t fp_mul(uint32_t x, uint32_t y); 17 | static uint32_t fp_div(uint32_t x, uint32_t y); 18 | static struct idiv { uint32_t quot, rem; } idiv(uint32_t x, uint32_t y, bool signed_div); 19 | 20 | 21 | void risc_run(const struct RISC_IO *io, struct RISC *risc) { 22 | for (;;) { 23 | risc_single_step(io, risc); 24 | } 25 | } 26 | 27 | static void risc_single_step(const struct RISC_IO *io, struct RISC *risc) { 28 | uint32_t ir = io->read_program(risc, risc->PC); 29 | risc->PC++; 30 | 31 | const uint32_t pbit = 0x80000000; 32 | const uint32_t qbit = 0x40000000; 33 | const uint32_t ubit = 0x20000000; 34 | const uint32_t vbit = 0x10000000; 35 | 36 | if ((ir & pbit) == 0) { 37 | // Register instructions 38 | uint32_t a = (ir & 0x0F000000) >> 24; 39 | uint32_t b = (ir & 0x00F00000) >> 20; 40 | uint32_t op = (ir & 0x000F0000) >> 16; 41 | uint32_t im = ir & 0x0000FFFF; 42 | uint32_t c = ir & 0x0000000F; 43 | 44 | uint32_t a_val, b_val, c_val; 45 | b_val = risc->R[b]; 46 | if ((ir & qbit) == 0) { 47 | c_val = risc->R[c]; 48 | } else if ((ir & vbit) == 0) { 49 | c_val = im; 50 | } else { 51 | c_val = 0xFFFF0000 | im; 52 | } 53 | 54 | switch (op) { 55 | case MOV: { 56 | if ((ir & ubit) == 0) { 57 | a_val = c_val; 58 | } else if ((ir & qbit) != 0) { 59 | a_val = c_val << 16; 60 | } else if ((ir & vbit) != 0) { 61 | a_val = 0xD0 | // ??? 62 | (risc->N * 0x80000000U) | 63 | (risc->Z * 0x40000000U) | 64 | (risc->C * 0x20000000U) | 65 | (risc->V * 0x10000000U); 66 | } else { 67 | a_val = risc->H; 68 | } 69 | break; 70 | } 71 | case LSL: { 72 | a_val = b_val << (c_val & 31); 73 | break; 74 | } 75 | case ASR: { 76 | a_val = ((int32_t)b_val) >> (c_val & 31); 77 | break; 78 | } 79 | case ROR: { 80 | a_val = (b_val >> (c_val & 31)) | (b_val << (-c_val & 31)); 81 | break; 82 | } 83 | case AND: { 84 | a_val = b_val & c_val; 85 | break; 86 | } 87 | case ANN: { 88 | a_val = b_val & ~c_val; 89 | break; 90 | } 91 | case IOR: { 92 | a_val = b_val | c_val; 93 | break; 94 | } 95 | case XOR: { 96 | a_val = b_val ^ c_val; 97 | break; 98 | } 99 | case ADD: { 100 | a_val = b_val + c_val; 101 | if ((ir & ubit) != 0) { 102 | a_val += risc->C; 103 | } 104 | risc->C = a_val < b_val; 105 | risc->V = ((a_val ^ c_val) & (a_val ^ b_val)) >> 31; 106 | break; 107 | } 108 | case SUB: { 109 | a_val = b_val - c_val; 110 | if ((ir & ubit) != 0) { 111 | a_val -= risc->C; 112 | } 113 | risc->C = a_val > b_val; 114 | risc->V = ((b_val ^ c_val) & (a_val ^ b_val)) >> 31; 115 | break; 116 | } 117 | case MUL: { 118 | uint64_t tmp; 119 | if ((ir & ubit) == 0) { 120 | tmp = (int64_t)(int32_t)b_val * (int64_t)(int32_t)c_val; 121 | } else { 122 | tmp = (uint64_t)b_val * (uint64_t)c_val; 123 | } 124 | a_val = (uint32_t)tmp; 125 | risc->H = (uint32_t)(tmp >> 32); 126 | break; 127 | } 128 | case DIV: { 129 | if ((int32_t)c_val > 0) { 130 | if ((ir & ubit) == 0) { 131 | a_val = (int32_t)b_val / (int32_t)c_val; 132 | risc->H = (int32_t)b_val % (int32_t)c_val; 133 | if ((int32_t)risc->H < 0) { 134 | a_val--; 135 | risc->H += c_val; 136 | } 137 | } else { 138 | a_val = b_val / c_val; 139 | risc->H = b_val % c_val; 140 | } 141 | } else { 142 | struct idiv q = idiv(b_val, c_val, ir & ubit); 143 | a_val = q.quot; 144 | risc->H = q.rem; 145 | } 146 | break; 147 | } 148 | case FAD: { 149 | a_val = fp_add(b_val, c_val, ir & ubit, ir & vbit); 150 | break; 151 | } 152 | case FSB: { 153 | a_val = fp_add(b_val, c_val ^ 0x80000000, ir & ubit, ir & vbit); 154 | break; 155 | } 156 | case FML: { 157 | a_val = fp_mul(b_val, c_val); 158 | break; 159 | } 160 | case FDV: { 161 | a_val = fp_div(b_val, c_val); 162 | break; 163 | } 164 | default: { 165 | abort(); // unreachable 166 | } 167 | } 168 | risc_set_register(risc, a, a_val); 169 | } 170 | else if ((ir & qbit) == 0) { 171 | // Memory instructions 172 | uint32_t a = (ir & 0x0F000000) >> 24; 173 | uint32_t b = (ir & 0x00F00000) >> 20; 174 | int32_t off = ir & 0x000FFFFF; 175 | off = (off ^ 0x00080000) - 0x00080000; // sign-extend 176 | 177 | uint32_t address = risc->R[b] + off; 178 | if ((ir & ubit) == 0) { 179 | uint32_t a_val; 180 | if ((ir & vbit) == 0) { 181 | a_val = io->read_word(risc, address); 182 | } else { 183 | a_val = io->read_byte(risc, address); 184 | } 185 | risc_set_register(risc, a, a_val); 186 | } else { 187 | if ((ir & vbit) == 0) { 188 | io->write_word(risc, address, risc->R[a]); 189 | } else { 190 | io->write_byte(risc, address, (uint8_t)risc->R[a]); 191 | } 192 | } 193 | } 194 | else { 195 | // Branch instructions 196 | bool t = (ir >> 27) & 1; 197 | switch ((ir >> 24) & 7) { 198 | case 0: t ^= risc->N; break; 199 | case 1: t ^= risc->Z; break; 200 | case 2: t ^= risc->C; break; 201 | case 3: t ^= risc->V; break; 202 | case 4: t ^= risc->C | risc->Z; break; 203 | case 5: t ^= risc->N ^ risc->V; break; 204 | case 6: t ^= (risc->N ^ risc->V) | risc->Z; break; 205 | case 7: t ^= true; break; 206 | default: abort(); // unreachable 207 | } 208 | if (t) { 209 | if ((ir & vbit) != 0) { 210 | risc_set_register(risc, 15, risc->PC * 4); 211 | } 212 | if ((ir & ubit) == 0) { 213 | uint32_t c = ir & 0x0000000F; 214 | risc->PC = risc->R[c] / 4; 215 | } else { 216 | int32_t off = ir & 0x00FFFFFF; 217 | off = (off ^ 0x00800000) - 0x00800000; // sign-extend 218 | risc->PC = risc->PC + off; 219 | } 220 | } 221 | } 222 | } 223 | 224 | static void risc_set_register(struct RISC *risc, int reg, uint32_t value) { 225 | risc->R[reg] = value; 226 | risc->Z = value == 0; 227 | risc->N = (int32_t)value < 0; 228 | } 229 | 230 | 231 | static uint32_t fp_add(uint32_t x, uint32_t y, bool u, bool v) { 232 | bool xs = (x & 0x80000000) != 0; 233 | uint32_t xe; 234 | int32_t x0; 235 | if (!u) { 236 | xe = (x >> 23) & 0xFF; 237 | uint32_t xm = ((x & 0x7FFFFF) << 1) | 0x1000000; 238 | x0 = (int32_t)(xs ? -xm : xm); 239 | } else { 240 | xe = 150; 241 | x0 = (int32_t)(x & 0x00FFFFFF) << 8 >> 7; 242 | } 243 | 244 | bool ys = (y & 0x80000000) != 0; 245 | uint32_t ye = (y >> 23) & 0xFF; 246 | uint32_t ym = ((y & 0x7FFFFF) << 1); 247 | if (!u && !v) ym |= 0x1000000; 248 | int32_t y0 = (int32_t)(ys ? -ym : ym); 249 | 250 | uint32_t e0; 251 | int32_t x3, y3; 252 | if (ye > xe) { 253 | uint32_t shift = ye - xe; 254 | e0 = ye; 255 | x3 = shift > 31 ? x0 >> 31 : x0 >> shift; 256 | y3 = y0; 257 | } else { 258 | uint32_t shift = xe - ye; 259 | e0 = xe; 260 | x3 = x0; 261 | y3 = shift > 31 ? y0 >> 31 : y0 >> shift; 262 | } 263 | 264 | uint32_t sum = ((xs << 26) | (xs << 25) | (x3 & 0x01FFFFFF)) 265 | + ((ys << 26) | (ys << 25) | (y3 & 0x01FFFFFF)); 266 | 267 | uint32_t s = (((sum & (1 << 26)) ? -sum : sum) + 1) & 0x07FFFFFF; 268 | 269 | uint32_t e1 = e0 + 1; 270 | uint32_t t3 = s >> 1; 271 | if ((s & 0x3FFFFFC) != 0) { 272 | while ((t3 & (1<<24)) == 0) { 273 | t3 <<= 1; 274 | e1--; 275 | } 276 | } else { 277 | t3 <<= 24; 278 | e1 -= 24; 279 | } 280 | 281 | if (v) { 282 | return (int32_t)(sum << 5) >> 6; 283 | } else if ((x & 0x7FFFFFFF) == 0) { 284 | return !u ? y : 0; 285 | } else if ((y & 0x7FFFFFFF) == 0) { 286 | return x; 287 | } else if ((t3 & 0x01FFFFFF) == 0 || (e1 & 0x100) != 0) { 288 | return 0; 289 | } else { 290 | return ((sum & 0x04000000) << 5) | (e1 << 23) | ((t3 >> 1) & 0x7FFFFF); 291 | } 292 | } 293 | 294 | static uint32_t fp_mul(uint32_t x, uint32_t y) { 295 | uint32_t sign = (x ^ y) & 0x80000000; 296 | uint32_t xe = (x >> 23) & 0xFF; 297 | uint32_t ye = (y >> 23) & 0xFF; 298 | 299 | uint32_t xm = (x & 0x7FFFFF) | 0x800000; 300 | uint32_t ym = (y & 0x7FFFFF) | 0x800000; 301 | uint64_t m = (uint64_t)xm * ym; 302 | 303 | uint32_t e1 = (xe + ye) - 127; 304 | uint32_t z0; 305 | if ((m & (1ULL << 47)) != 0) { 306 | e1++; 307 | z0 = ((m >> 23) + 1) & 0xFFFFFF; 308 | } else { 309 | z0 = ((m >> 22) + 1) & 0xFFFFFF; 310 | } 311 | 312 | if (xe == 0 || ye == 0) { 313 | return 0; 314 | } else if ((e1 & 0x100) == 0) { 315 | return sign | ((e1 & 0xFF) << 23) | (z0 >> 1); 316 | } else if ((e1 & 0x80) == 0) { 317 | return sign | (0xFF << 23) | (z0 >> 1); 318 | } else { 319 | return 0; 320 | } 321 | } 322 | 323 | static uint32_t fp_div(uint32_t x, uint32_t y) { 324 | uint32_t sign = (x ^ y) & 0x80000000; 325 | uint32_t xe = (x >> 23) & 0xFF; 326 | uint32_t ye = (y >> 23) & 0xFF; 327 | 328 | uint32_t xm = (x & 0x7FFFFF) | 0x800000; 329 | uint32_t ym = (y & 0x7FFFFF) | 0x800000; 330 | uint32_t q1 = (uint32_t)(xm * (1ULL << 25) / ym); 331 | 332 | uint32_t e1 = (xe - ye) + 126; 333 | uint32_t q2; 334 | if ((q1 & (1 << 25)) != 0) { 335 | e1++; 336 | q2 = (q1 >> 1) & 0xFFFFFF; 337 | } else { 338 | q2 = q1 & 0xFFFFFF; 339 | } 340 | uint32_t q3 = q2 + 1; 341 | 342 | if (xe == 0) { 343 | return 0; 344 | } else if (ye == 0) { 345 | return sign | (0xFF << 23); 346 | } else if ((e1 & 0x100) == 0) { 347 | return sign | ((e1 & 0xFF) << 23) | (q3 >> 1); 348 | } else if ((e1 & 0x80) == 0) { 349 | return sign | (0xFF << 23) | (q2 >> 1); 350 | } else { 351 | return 0; 352 | } 353 | } 354 | 355 | static struct idiv idiv(uint32_t x, uint32_t y, bool signed_div) { 356 | bool sign = ((int32_t)x < 0) & signed_div; 357 | uint32_t x0 = sign ? -x : x; 358 | 359 | uint64_t RQ = x0; 360 | for (int S = 0; S < 32; ++S) { 361 | uint32_t w0 = (uint32_t)(RQ >> 31); 362 | uint32_t w1 = w0 - y; 363 | if ((int32_t)w1 < 0) { 364 | RQ = ((uint64_t)w0 << 32) | ((RQ & 0x7FFFFFFFU) << 1); 365 | } else { 366 | RQ = ((uint64_t)w1 << 32) | ((RQ & 0x7FFFFFFFU) << 1) | 1; 367 | } 368 | } 369 | 370 | struct idiv d = { (uint32_t)RQ, (uint32_t)(RQ >> 32) }; 371 | if (sign) { 372 | d.quot = -d.quot; 373 | if (d.rem) { 374 | d.quot -= 1; 375 | d.rem = y - d.rem; 376 | } 377 | } 378 | return d; 379 | } 380 | -------------------------------------------------------------------------------- /Runtime/risc-cpu.h: -------------------------------------------------------------------------------- 1 | #ifndef RISC_CPU_H 2 | #define RISC_CPU_H 3 | 4 | struct RISC { 5 | uint32_t PC; 6 | uint32_t R[16]; 7 | uint32_t H; 8 | bool Z, N, C, V; 9 | }; 10 | 11 | struct RISC_IO { 12 | uint32_t (*read_program)(struct RISC *risc, uint32_t adr); 13 | uint32_t (*read_word)(struct RISC *risc, uint32_t adr); 14 | uint32_t (*read_byte)(struct RISC *risc, uint32_t adr); 15 | void (*write_word)(struct RISC *risc, uint32_t adr, uint32_t val); 16 | void (*write_byte)(struct RISC *risc, uint32_t adr, uint32_t val); 17 | }; 18 | 19 | void risc_run(const struct RISC_IO *io, struct RISC *risc); 20 | 21 | #endif // RISC_CPU_H 22 | -------------------------------------------------------------------------------- /build-image.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | import sys, os, os.path, argparse, logging, csv, subprocess 3 | 4 | NOREBO_ROOT = os.path.dirname(os.path.realpath(__file__)) 5 | FILE_LIST = list(csv.DictReader(open(os.path.join(NOREBO_ROOT, 'manifest.csv')))) 6 | 7 | def bulk_delete(dir, ext): 8 | for fn in os.listdir(dir): 9 | parts = fn.split('.') 10 | if parts[-1] == ext: 11 | os.remove(os.path.join(dir, fn)) 12 | 13 | def bulk_rename(dir, old_ext, new_ext): 14 | for fn in os.listdir(dir): 15 | parts = fn.split('.') 16 | if parts[-1] == old_ext: 17 | parts[-1] = new_ext 18 | os.rename(os.path.join(dir, fn), 19 | os.path.join(dir, '.'.join(parts))) 20 | 21 | def mksubdir(parent, subdir): 22 | fn = os.path.join(parent, subdir) 23 | os.mkdir(fn) 24 | return fn 25 | 26 | 27 | def norebo(args, working_directory='.', search_path=()): 28 | norebo = os.path.join(NOREBO_ROOT, 'norebo') 29 | norebo_path = os.pathsep.join(search_path) 30 | os.environ['NOREBO_PATH'] = norebo_path 31 | logging.debug('Running norebo\n\tCWD = %s\n\tPATH = %s\n\t%s', 32 | working_directory, norebo_path, ' '.join(args)) 33 | subprocess.check_call([norebo] + list(args), cwd=working_directory) 34 | 35 | def compile(modules, **kwargs): 36 | norebo(['ORP.Compile'] + [m+'/s' for m in modules], **kwargs) 37 | 38 | 39 | def build_norebo(target_dir): 40 | compile(['Norebo.Mod', 'Kernel.Mod', 'FileDir.Mod', 'Files.Mod', 41 | 'Modules.Mod', 'Fonts.Mod', 'Texts.Mod', 'RS232.Mod', 'Oberon.Mod', 42 | 'ORS.Mod', 'ORB.Mod', 'ORG.Mod', 'ORP.Mod', 'CoreLinker.Mod', 43 | 'VDisk.Mod', 'VFileDir.Mod', 'VFiles.Mod', 'VDiskUtil.Mod'], 44 | working_directory=target_dir, 45 | search_path=[os.path.join(NOREBO_ROOT, 'Norebo'), 46 | os.path.join(NOREBO_ROOT, 'Oberon'), 47 | os.path.join(NOREBO_ROOT, 'Bootstrap')]) 48 | 49 | bulk_rename(target_dir, 'rsc', 'rsx') 50 | norebo(['CoreLinker.LinkSerial', 'Modules', 'InnerCore'], 51 | working_directory=target_dir, 52 | search_path=[os.path.join(NOREBO_ROOT, 'Norebo'), 53 | os.path.join(NOREBO_ROOT, 'Bootstrap')]) 54 | bulk_rename(target_dir, 'rsx', 'rsc') 55 | 56 | 57 | def build_image(sources_dir): 58 | sources_dir = os.path.realpath(sources_dir) 59 | 60 | target_dir = os.path.join(NOREBO_ROOT, 'build') 61 | os.mkdir(target_dir) 62 | norebo_dir = mksubdir(target_dir, 'norebo') 63 | compiler_dir = mksubdir(target_dir, 'compiler') 64 | oberon_dir = mksubdir(target_dir, 'oberon') 65 | 66 | logging.info('Building norebo') 67 | build_norebo(norebo_dir) 68 | 69 | logging.info('Building a cross-compiler') 70 | compile(['ORS.Mod', 'ORB.Mod', 'ORG.Mod', 'ORP.Mod'], 71 | working_directory=compiler_dir, 72 | search_path=[sources_dir, compiler_dir, norebo_dir]) 73 | 74 | # Delete all symbol files, so that we don't accidentally link against Norebo. 75 | bulk_delete(norebo_dir, 'smb') 76 | bulk_delete(compiler_dir, 'smb') 77 | 78 | logging.info('Compiling the complete Project Oberon 2013') 79 | compile([fi['filename'] for fi in FILE_LIST if fi['mode'] == 'source'], 80 | working_directory=oberon_dir, 81 | search_path=[sources_dir, compiler_dir, norebo_dir]) 82 | 83 | logging.info('Linking the Inner Core') 84 | # Hide the rsc files, Norebo can't use them (CoreLinker knows to expect this extension) 85 | bulk_rename(oberon_dir, 'rsc', 'rsx') 86 | norebo(['CoreLinker.LinkDisk', 'Modules', 'Oberon.dsk'], 87 | working_directory=target_dir, 88 | search_path=[oberon_dir, norebo_dir]) 89 | 90 | logging.info('Installing files') 91 | 92 | def copy(src, dst): 93 | return '%s=>%s' % (src, dst) 94 | 95 | install_args = ['Oberon.dsk'] 96 | install_args.extend( 97 | copy(fn, fn) 98 | for fn in sorted(os.listdir(sources_dir)) 99 | if not fn.startswith(".")) 100 | 101 | for fi in FILE_LIST: 102 | if fi['mode'] == 'source': 103 | smb = fi['filename'].replace('.Mod', '.smb') 104 | rsx = fi['filename'].replace('.Mod', '.rsx') 105 | rsc = fi['filename'].replace('.Mod', '.rsc') 106 | install_args.append(copy(smb, smb)) 107 | install_args.append(copy(rsx, rsc)) 108 | 109 | norebo(['VDiskUtil.InstallFiles'] + install_args, 110 | working_directory=target_dir, 111 | search_path=[oberon_dir, sources_dir, norebo_dir]) 112 | 113 | logging.info('All done! Finished disk image is %s', os.path.join(target_dir, 'Oberon.dsk')) 114 | 115 | 116 | def main(): 117 | parser = argparse.ArgumentParser() 118 | parser.add_argument( 119 | '-d', '--debug', dest='debug', action='store_true', help='enable debug log output' 120 | ) 121 | parser.add_argument('SOURCES') 122 | args = parser.parse_args() 123 | log_level = logging.DEBUG if args.debug else logging.INFO 124 | logging.basicConfig(format='%(levelname)s: %(message)s', level=log_level) 125 | if not os.path.exists(args.SOURCES): 126 | logging.error("%s: '%s': No such file or directory", __file__, args.SOURCES) 127 | sys.exit(1) 128 | elif not os.path.isdir(args.SOURCES): 129 | logging.error("%s: '%s': Not a directory", __file__, args.SOURCES) 130 | sys.exit(1) 131 | build_image(args.SOURCES) 132 | 133 | 134 | if __name__ == '__main__': 135 | main() 136 | -------------------------------------------------------------------------------- /build.sh: -------------------------------------------------------------------------------- 1 | #!/bin/bash 2 | set -e 3 | make 4 | 5 | ROOT="$PWD" 6 | 7 | if [ -e build1 ] || [ -e build2 ] || [ -e build3 ]; then 8 | echo >&2 "Build directories already exist, delete them using 'make clean' first." 9 | exit 1 10 | fi 11 | mkdir build1 build2 build3 12 | 13 | function rename { 14 | for i in *.$1; do 15 | mv $i ${i%.$1}.$2 16 | done 17 | } 18 | 19 | function compile_everything { 20 | ../norebo ORP.Compile \ 21 | Norebo.Mod/s \ 22 | Kernel.Mod/s \ 23 | FileDir.Mod/s \ 24 | Files.Mod/s \ 25 | Modules.Mod/s \ 26 | Fonts.Mod/s \ 27 | Texts.Mod/s \ 28 | RS232.Mod/s \ 29 | Oberon.Mod/s \ 30 | CoreLinker.Mod/s \ 31 | ORS.Mod/s \ 32 | ORB.Mod/s \ 33 | ORG.Mod/s \ 34 | ORP.Mod/s \ 35 | ORTool.Mod/s 36 | rename rsc rsx 37 | ../norebo CoreLinker.LinkSerial Modules InnerCore 38 | rename rsx rsc 39 | } 40 | 41 | echo '=== Stage 1 ===' 42 | cd build1 43 | export NOREBO_PATH="$ROOT/Norebo:$ROOT/Oberon:$ROOT/Bootstrap" 44 | compile_everything 45 | rename smb smx 46 | cd .. 47 | 48 | echo 49 | echo '=== Stage 2 ===' 50 | cd build2 51 | export NOREBO_PATH="$ROOT/Norebo:$ROOT/Oberon:$ROOT/build1" 52 | compile_everything 53 | rename smb smx 54 | cd .. 55 | 56 | echo 57 | echo '=== Stage 3 ===' 58 | cd build3 59 | export NOREBO_PATH="$ROOT/Norebo:$ROOT/Oberon:$ROOT/build2" 60 | compile_everything 61 | cd .. 62 | 63 | # Unhide the symbol files 64 | cd build2 65 | rename smx smb 66 | cd .. 67 | 68 | echo 69 | echo '=== Verification === ' 70 | diff -r build2 build3 && echo 'OK: Stage 2 and Stage 3 are identical.' 71 | -------------------------------------------------------------------------------- /fetch-sources.py: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env python3 2 | import sys, os.path, logging, re, csv, zipfile, io, requests 3 | 4 | NOREBO_ROOT = os.path.dirname(os.path.realpath(__file__)) 5 | FILE_LIST = list(csv.DictReader(open(os.path.join(NOREBO_ROOT, 'manifest.csv')))) 6 | 7 | 8 | def download_files(upstream_dir): 9 | upstream_dir = os.path.realpath(upstream_dir) 10 | os.mkdir(upstream_dir) 11 | 12 | with requests.Session() as session: 13 | session.headers.update({'User-Agent': 'project-norebo/1.0'}) 14 | for fi in FILE_LIST: 15 | resp = session.get(fi['url']) 16 | resp.raise_for_status() 17 | data = resp.content 18 | if fi['mode'] in ('text', 'source'): 19 | data = re.sub(b'\r?\n', b'\r', data) 20 | with open(os.path.join(upstream_dir, fi['filename']), 'wb') as f: 21 | f.write(data) 22 | elif fi['mode'] == 'archive': 23 | fi['members'] = [] 24 | with zipfile.ZipFile(io.BytesIO(data)) as zf: 25 | for member in zf.infolist(): 26 | fn = os.path.basename(member.filename) 27 | if not fn.endswith('.txt'): 28 | with open(os.path.join(upstream_dir, fn), 'wb') as f: 29 | f.write(zf.read(member)) 30 | fi['members'].append(fn) 31 | 32 | 33 | def main(): 34 | logging.basicConfig(format='%(levelname)s: %(message)s', level=logging.INFO) 35 | if len(sys.argv) != 2 or os.path.exists(sys.argv[1]): 36 | logging.error("Usage: %s UPSTREAM_DIR", __file__) 37 | logging.error(" (UPSTREAM_DIR must not already exist.)") 38 | sys.exit(1) 39 | download_files(sys.argv[1]) 40 | 41 | 42 | if __name__ == '__main__': 43 | main() 44 | -------------------------------------------------------------------------------- /license.txt: -------------------------------------------------------------------------------- 1 | Project Oberon, Revised Edition 2013 2 | 3 | Book copyright (C)2013 Niklaus Wirth and Juerg Gutknecht; 4 | software copyright (C)2013 Niklaus Wirth (NW), Juerg Gutknecht (JG), Paul 5 | Reed (PR/PDR). 6 | 7 | Permission to use, copy, modify, and/or distribute this software and its 8 | accompanying documentation (the "Software") for any purpose with or 9 | without fee is hereby granted, provided that the above copyright notice 10 | and this permission notice appear in all copies. 11 | 12 | THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHORS DISCLAIM ALL WARRANTIES 13 | WITH REGARD TO THE SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF 14 | MERCHANTABILITY, FITNESS AND NONINFRINGEMENT. IN NO EVENT SHALL THE 15 | AUTHORS BE LIABLE FOR ANY CLAIM, SPECIAL, DIRECT, INDIRECT, OR 16 | CONSEQUENTIAL DAMAGES OR ANY DAMAGES OR LIABILITY WHATSOEVER, WHETHER IN 17 | AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN 18 | CONNECTION WITH THE DEALINGS IN OR USE OR PERFORMANCE OF THE SOFTWARE. 19 | -------------------------------------------------------------------------------- /manifest.csv: -------------------------------------------------------------------------------- 1 | mode,filename,url 2 | source,Kernel.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Kernel.Mod.txt 3 | source,FileDir.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/FileDir.Mod.txt 4 | source,Files.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Files.Mod.txt 5 | source,Modules.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Modules.Mod.txt 6 | text,Input.Orig.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Input.Mod.txt 7 | source,Input.Mod,https://raw.githubusercontent.com/pdewacht/oberon-risc-emu/master/Mods/Input.Mod 8 | text,Display.Orig.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Display.Mod.txt 9 | source,Display.Mod,https://raw.githubusercontent.com/pdewacht/oberon-risc-emu/master/Mods/Display.Mod 10 | source,Viewers.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Viewers.Mod.txt 11 | source,Fonts.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Fonts.Mod.txt 12 | source,Texts.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Texts.Mod.txt 13 | source,Oberon.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Oberon.Mod.txt 14 | source,MenuViewers.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/MenuViewers.Mod.txt 15 | source,TextFrames.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/TextFrames.Mod.txt 16 | source,System.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/System.Mod.txt 17 | source,Edit.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Edit.Mod.txt 18 | text,System.Tool,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/System.Tool.txt 19 | source,SCC.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/SCC.Mod.txt 20 | text,Net.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Net.Mod.txt 21 | source,ORS.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/ORS.Mod.txt 22 | source,ORB.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/ORB.Mod.txt 23 | source,ORG.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/ORG.Mod.txt 24 | source,ORP.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/ORP.Mod.txt 25 | source,ORTool.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/ORTool.Mod.txt 26 | source,Graphics.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Graphics.Mod.txt 27 | source,GraphicFrames.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/GraphicFrames.Mod.txt 28 | source,Draw.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Draw.Mod.txt 29 | source,GraphTool.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/GraphTool.Mod.txt 30 | source,Rectangles.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Rectangles.Mod.txt 31 | source,Curves.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Curves.Mod.txt 32 | text,Draw.Tool,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Draw.Tool.txt 33 | source,Blink.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Blink.Mod.txt 34 | text,BootLoad.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/BootLoad.Mod.txt 35 | source,Checkers.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Checkers.Mod.txt 36 | source,EBNF.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/EBNF.Mod.txt 37 | source,Hilbert.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Hilbert.Mod.txt 38 | source,MacroTool.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/MacroTool.Mod.txt 39 | source,Math.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Math.Mod.txt 40 | text,OberonSyntax.Text,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/OberonSyntax.Text.txt 41 | text,ORC.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/ORC.Mod.txt 42 | source,PCLink1.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/PCLink1.Mod.txt 43 | text,PIO.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/PIO.Mod.txt 44 | text,RISC.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/RISC.Mod.txt 45 | source,RS232.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/RS232.Mod.txt 46 | source,Sierpinski.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Sierpinski.Mod.txt 47 | text,SmallPrograms.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/SmallPrograms.Mod.txt 48 | source,Stars.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Stars.Mod.txt 49 | source,Tools.Mod,https://www.inf.ethz.ch/personal/wirth/ProjectOberon/Sources/Tools.Mod.txt 50 | archive,systools.zip,http://www.paddedcell.com/projectoberon/wirth/Sources/systools.zip 51 | archive,apptools.zip,http://www.paddedcell.com/projectoberon/wirth/Sources/apptools.zip 52 | source,Clipboard.Mod,https://raw.githubusercontent.com/pdewacht/oberon-risc-emu/master/Mods/Clipboard.Mod 53 | --------------------------------------------------------------------------------