[Oberon] PO2013 - SD Image Tool
Andreas Pirklbauer
andreas_pirklbauer at yahoo.com
Sat May 16 18:43:40 CEST 2020
> I never used this serial link stuff. No Oberon-0, no PClink... Much too much hassle.
Just as an FYI: When using an emulator and when simulating the serial link using
two Unix-style pipes, building an entire Oberon system takes about 2-3 seconds.
So not all that much hassle and (practically) fully automated.
But on “real” FPGA hardware with a “real” serial link, it’s more painful of course..
-ap
--------------------------------------------------------------
#!/bin/sh
# buildtarget.sh -- simulate building an Oberon system on a target machine
# create two pipes (one for each direction) linking the host and the target system
mkfifo pipe1 pipe2 2>/dev/null
# delete any old disk images for the host and the "target" system (optional)
rm -f ob1.dsk ob2.dsk
# make a copy of a valid Oberon disk image to be used for the "host" system
cp S3RISCinstall/RISC.img ob1.dsk
# create an "empty" disk image for the target system (will be "filled" later)
touch ob2.dsk
# start the "target" system over the serial link (connected to the host system)
./risc --serial-in pipe2 --serial-out pipe1 ob2.dsk --boot-from-serial &
sleep 3
# start the "host" system from a local disk
./risc --serial-in pipe1 --serial-out pipe2 ob1.dsk &
--------------------------------------------------------------
Then, in the window running the host system execute these commands:
ORP.Compile Kernel.Mod FileDir.Mod Files.Mod Modules.Mod ~
ORP.Compile RS232.Mod PCLink0.Mod Oberon0.Mod ~
ORP.Compile ORL.Mod/s ORC.Mod/s ~
ORL.Link Modules ~ # generate a pre-linked binary file of the "regular" boot file (Modules.bin)
ORL.Link Oberon0 ~ # generate a pre-linked binary file of the "build-up" boot file (Oberon0.bin)
ORC.Load Oberon0.bin # load the Oberon-0 command interpreter over the data link to the target system AND start it
ORC.SR 101 ~ # clear the file directory on the target system
ORC.Send Modules.bin Oberon10.Scn.Fnt System.Tool
Input.rsc Display.rsc Viewers.rsc
Fonts.rsc Texts.rsc Oberon.rsc
MenuViewers.rsc TextFrames.rsc System.rsc
BootLoadDisk.rsc ORL.rsc
RS232.rsc PCLink0.rsc
Oberon0.rsc Oberon0Tool.rsc
Edit.rsc PCLink1.rsc
ORP.rsc ORG.rsc
ORB.rsc ORS.rsc ORTool.rsc ~ # send the required (plus some additional) files to the target system
ORC.SR 100 Modules.bin ~ # load the "regular" boot file onto the boot area of the local disk of the target system
ORC.SR 102 BootLoadDisk.rsc ~ # reboot the target system from the local disk (i.e. initiate the "regular" boot process)
In total, it takes 2-3 seconds until the target system is built AND restarted (in the second window)
--------------------------------------------------------------
Source code: See http://github.com/andreaspirklbauer/Oberon-building-tools
MODULE Oberon0; (*Oberon-0 command interpreter / AP 7.4.20*)
IMPORT SYSTEM, Kernel, FileDir, Files, Modules, RS232, PCLink0;
CONST swi = -60; (*switches*)
stat = -52; (*RS-232*)
REQ = 20H; REC = 21H; SND = 22H; ACK = 10H;
screenbase = 0E7F00H; screensize = 1024 * 768 DIV 8; (*1024 x 768 pixel monocolor display*)
BootSec = 2; maxCode = 8000; noerr = 0; badfile = 4; nospace = 7;
VAR pat: ARRAY 32 OF CHAR;
PROCEDURE Mirror; (*n - mirror integer n*)
VAR n: INTEGER;
BEGIN RS232.RecInt(n); RS232.SendStr("Mirror "); RS232.SendInt(n)
END Mirror;
PROCEDURE Inspect; (*a, n - show (in hex) M[a], M[a+4], ..., M[a+(n-1)*4]*)
VAR m, n, adr, data: INTEGER;
BEGIN RS232.RecInt(adr); RS232.RecInt(n); RS232.SendStr("Inspect");
adr := adr DIV 20H * 20H;
WHILE n > 0 DO DEC(n, 8);
RS232.Line; RS232.SendHex(adr); RS232.SendStr(" "); m := 8;
REPEAT SYSTEM.GET(adr, data); INC(adr, 4); RS232.SendHex(data); DEC(m) UNTIL m = 0
END
END Inspect;
PROCEDURE FillDisplay; (*w - fill display with words w*)
VAR w, adr: INTEGER;
BEGIN RS232.RecInt(w); RS232.SendStr("FillDisplay");
FOR adr := screenbase TO screenbase + screensize BY 4 DO SYSTEM.PUT(adr, w) END
END FillDisplay;
PROCEDURE Sector; (*secno - show disk sector*)
VAR k, m, n, secno: INTEGER;
buf: ARRAY 256 OF INTEGER;
BEGIN RS232.RecInt(secno); RS232.SendStr("Sector"); n := 32;
Kernel.GetSector(secno*29, buf); k := 0;
REPEAT DEC(n); m := 8; RS232.Line; RS232.SendHex(k*4); RS232.SendStr(" ");
REPEAT RS232.SendHex(buf[k]); INC(k); DEC(m) UNTIL m = 0
UNTIL n = 0
END Sector;
PROCEDURE ShowFile; (*filename - show file in hex format*)
VAR x, n: INTEGER;
name: ARRAY 32 OF CHAR;
F: Files.File; R: Files.Rider;
BEGIN RS232.RecStr(name); RS232.SendStr("ShowFile");
F := Files.Old(name);
IF F # NIL THEN
n := 0; Files.Set(R, F, 0); Files.ReadInt(R, x);
WHILE ~R.eof DO
IF n MOD 20H = 0 THEN RS232.Line; RS232.SendHex(n); RS232.SendStr(" ") END ;
RS232.SendHex(x); INC(n, 4); Files.ReadInt(R, x)
END ;
RS232.SendHex(x)
ELSE RS232.SendStr(" not found")
END
END ShowFile;
PROCEDURE Watch; (*show allocation, nof sectors, switches, and timer*)
VAR s: LONGINT;
BEGIN RS232.SendStr("Watch"); RS232.Line;
RS232.SendStr(" Modules space (bytes)"); RS232.SendInt(Modules.AllocPtr);
RS232.SendInt(Modules.AllocPtr * 100 DIV Kernel.heapOrg); RS232.SendStr("%"); RS232.Line;
RS232.SendStr(" Heap speace"); RS232.SendInt(Kernel.allocated);
RS232.SendInt(Kernel.allocated * 100 DIV (Kernel.heapLim - Kernel.heapOrg)); RS232.SendStr("%"); RS232.Line;
RS232.SendStr(" Disk sectors "); RS232.SendInt(Kernel.NofSectors);
RS232.SendInt(Kernel.NofSectors * 100 DIV 10000H); RS232.SendStr("%"); RS232.Line;
RS232.SendStr(" Switches: swi0 = "); SYSTEM.GET(swi, s); RS232.Send(5);
IF SYSTEM.BIT(swi, 0) THEN RS232.Send(ORD("0")) ELSE RS232.Send(ORD("1")) END ;
RS232.SendStr(", swi1 = "); RS232.Send(5);
IF SYSTEM.BIT(swi, 1) THEN RS232.Send(ORD("0")) ELSE RS232.Send(ORD("1")) END ;
RS232.Line; RS232.SendStr(" Time "); s := Kernel.Time(); RS232.SendInt(s)
END Watch;
PROCEDURE ShowModules; (*list modules*)
VAR M: Modules.Module;
BEGIN RS232.SendStr("ShowModules");
M := Modules.root;
WHILE M # NIL DO RS232.Line;
IF M.name[0] # 0X THEN
RS232.SendStr(M.name); RS232.SendInt(M.num); RS232.SendStr(" ");
RS232.SendHex(ORD(M)); RS232.SendHex(M.code); RS232.SendInt(M.refcnt)
ELSE RS232.SendStr("---")
END ;
M := M.next
END
END ShowModules;
PROCEDURE ShowCommands; (*modname - list commands*)
VAR M: Modules.Module;
comadr: LONGINT; i: INTEGER;
name, cmd: ARRAY 32 OF CHAR; ch: CHAR;
BEGIN RS232.RecStr(name); RS232.SendStr("ShowCommands");
Modules.Load(name, M);
IF M # NIL THEN
comadr := M.cmd; SYSTEM.GET(comadr, ch); INC(comadr);
WHILE ch # 0X DO
RS232.Line; RS232.SendStr(name); cmd[0] := "."; i := 1;
REPEAT cmd[i] := ch; SYSTEM.GET(comadr, ch); INC(comadr); INC(i) UNTIL ch = 0X;
cmd[i] := 0X; RS232.SendStr(cmd);
WHILE comadr MOD 4 # 0 DO INC(comadr) END ;
INC(comadr, 4); SYSTEM.GET(comadr, ch); INC(comadr)
END
ELSE RS232.SendStr("module not found")
END
END ShowCommands;
PROCEDURE List(name: FileDir.FileName; adr: LONGINT; VAR cont: BOOLEAN);
VAR i0, i, j0, j: INTEGER; hp: FileDir.FileHeader;
BEGIN i := 0;
WHILE (pat[i] > "*") & (pat[i] = name[i]) DO INC(i) END ;
IF (pat[i] = 0X) & (name[i] = 0X) THEN i0 := i; j0 := i
ELSIF pat[i] = "*" THEN
i0 := i; j0 := i+1;
WHILE name[i0] # 0X DO
i := i0; j := j0;
WHILE (name[i] # 0X) & (name[i] = pat[j]) DO INC(i); INC(j) END ;
IF pat[j] = 0X THEN
IF name[i] = 0X THEN (*match*) j0 := j ELSE INC(i0) END
ELSIF pat[j] = "*" THEN i0 := i; j0 := j+1
ELSE INC(i0)
END
END
END ;
IF (name[i0] = 0X) & (pat[j0] = 0X) THEN (*found*)
RS232.Line; RS232.SendStr(name);
IF pat[j0+1] = "!" THEN (*option*)
Kernel.GetSector(adr, hp); RS232.SendStr(" ");
RS232.SendInt(hp.aleng*FileDir.SectorSize + hp.bleng - FileDir.HeaderSize); (*length*)
RS232.SendStr(" "); RS232.SendHex(adr)
END
END
END List;
PROCEDURE Directory; (*prefix - list files matching the prefix (enumerate directory)*)
VAR i, x: INTEGER; ch: CHAR;
pre: ARRAY 32 OF CHAR;
BEGIN RS232.Rec(x); ch := CHR(x);
WHILE ch = " " DO RS232.Rec(x); ch := CHR(x) END ; (*spaces*)
i := 0;
WHILE ch > " " DO (*pattern*)
IF ch = "!" THEN pat[i] := 0X; INC(i) END ; (*directory option*)
pat[i] := ch; INC(i);
RS232.Rec(x); ch := CHR(x)
END ;
WHILE ch # 0X DO RS232.Rec(x); ch := CHR(x) END ;
WHILE i < LEN(pat) DO pat[i] := 0X; INC(i) END ;
i := 0;
WHILE pat[i] > "*" DO pre[i] := pat[i]; INC(i) END ; (*prefix*)
WHILE i < LEN(pre) DO pre[i] := 0X; INC(i) END ;
RS232.SendStr("Directory"); FileDir.Enumerate(pre, List)
END Directory;
PROCEDURE Delete; (*filename - delete file*)
VAR res: INTEGER; name: ARRAY 32 OF CHAR;
BEGIN RS232.RecStr(name); RS232.SendStr("Delete "); Files.Delete(name, res); RS232.SendInt(res)
END Delete;
PROCEDURE Load; (*modname - load module*)
VAR M: Modules.Module;
name: ARRAY 32 OF CHAR;
BEGIN RS232.RecStr(name); RS232.SendStr("Load "); Modules.Load(name, M); RS232.SendInt(Modules.res)
END Load;
PROCEDURE Unload; (*modname - unload module*)
VAR name: ARRAY 32 OF CHAR;
BEGIN RS232.RecStr(name); RS232.SendStr("Unload "); Modules.Free(name); RS232.SendInt(Modules.res)
END Unload;
PROCEDURE Call; (*name - call command*)
VAR mod: Modules.Module; P: Modules.Command;
i, j, res: INTEGER; ch: CHAR;
Mname, Cname: ARRAY 32 OF CHAR;
BEGIN RS232.RecStr(Mname); RS232.SendStr("Call");
i := 0; ch := Mname[0];
WHILE (ch # ".") & (ch # 0X) DO INC(i); ch := Mname[i] END ;
IF ch = "." THEN
Mname[i] := 0X; INC(i);
Modules.Load(Mname, mod); res := Modules.res;
IF Modules.res = 0 THEN
j := 0; ch := Mname[i]; INC(i);
WHILE ch # 0X DO Cname[j] := ch; INC(j); ch := Mname[i]; INC(i) END ;
Cname[j] := 0X;
P := Modules.ThisCommand(mod, Cname); res := Modules.res;
IF res = 0 THEN P END
END
ELSE res := 6
END ;
IF res > 0 THEN
RS232.SendStr(" error: "); RS232.SendStr(Mname);
IF res = 1 THEN RS232.SendStr(" module not found")
ELSIF res = 2 THEN RS232.SendStr(" bad version")
ELSIF res = 3 THEN RS232.SendStr(" imports ");
RS232.SendStr(Modules.imported); RS232.SendStr(" with bad key")
ELSIF res = 4 THEN RS232.SendStr(" corrupted obj file")
ELSIF res = 5 THEN RS232.SendStr(" command not found")
ELSIF res = 6 THEN RS232.SendStr(" invalid command")
ELSIF res = 7 THEN RS232.SendStr(" insufficient space")
END
ELSE RS232.SendStr(" done")
END
END Call;
PROCEDURE WriteMemory; (*adr, n, list of n values (words) - write memory*)
VAR m, n, adr: INTEGER;
BEGIN RS232.RecInt(adr); RS232.RecInt(n);
adr := adr DIV 20H * 20H;
WHILE n > 0 DO DEC(n); RS232.RecInt(m); SYSTEM.PUT(adr, m); INC(adr, 4) END ;
RS232.SendStr("WriteMemory")
END WriteMemory;
PROCEDURE ClearMemory; (*a, n - clear memory (n words)*)
VAR n, adr: INTEGER;
BEGIN RS232.RecInt(adr); RS232.RecInt(n); RS232.SendStr("ClearMemory");
adr := adr DIV 20H * 20H;
WHILE n > 0 DO DEC(n); SYSTEM.PUT(adr, 0); INC(adr, 4) END
END ClearMemory;
PROCEDURE WriteSector; (*secno, n, list of n values (words) - write sector*)
VAR k, m, n, secno: INTEGER;
buf: ARRAY 256 OF INTEGER;
BEGIN RS232.RecInt(secno); RS232.RecInt(n);
Kernel.GetSector(secno*29, buf); k := 0;
WHILE k < n DO RS232.RecInt(m); buf[k] := m; INC(k) END ;
RS232.SendStr("WriteSector"); Kernel.PutSector(secno*29, buf)
END WriteSector;
PROCEDURE ClearSector; (*secno, n - clear sector (n words)*)
VAR k, n, secno: INTEGER;
buf: ARRAY 256 OF INTEGER;
BEGIN RS232.RecInt(secno); RS232.RecInt(n); RS232.SendStr("ClearSector");
Kernel.GetSector(secno*29, buf); k := 0;
WHILE k < n DO buf[k] := 0; INC(k) END ;
Kernel.PutSector(secno*29, buf)
END ClearSector;
PROCEDURE LoadBoot; (*filename - load boot file onto the boot area of the local disk*)
VAR i, secno: INTEGER; b: BYTE;
F: Files.File; R: Files.Rider;
buf: ARRAY Kernel.SectorLength OF BYTE;
name: ARRAY 32 OF CHAR;
BEGIN RS232.RecStr(name); RS232.SendStr("LoadBoot ");
F := Files.Old(name);
IF F # NIL THEN RS232.SendInt(Files.Length(F)); (*success*)
secno := BootSec; i := 0; Files.Set(R, F, 0); Files.ReadByte(R, b);
WHILE ~R.eof DO buf[i] := b; INC(i);
IF i = Kernel.SectorLength THEN Kernel.PutSector(secno*29, buf); INC(secno); i := 0 END ;
Files.ReadByte(R, b)
END ;
IF i > 0 THEN
WHILE i < Kernel.SectorLength DO buf[i] := 0; INC(i) END ;
Kernel.PutSector(secno*29, buf)
END
ELSE RS232.SendInt(-1) (*file not found*)
END
END LoadBoot;
PROCEDURE ClearDirectory; (*clear file directory (root page)*)
VAR i: INTEGER;
u: FileDir.DirEntry; a: FileDir.DirPage;
BEGIN RS232.SendStr("ClearDirectory");
a.mark := FileDir.DirMark; a.m := 0; a.p0 := 0; u.adr := 0; u.p := 0;
FOR i := 0 TO FileDir.FnLength-1 DO u.name[i] := 0X END ;
FOR i := 0 TO FileDir.DirPgSize-1 DO a.e[i] := u END ;
Kernel.PutSector(FileDir.DirRootAdr, a)
END ClearDirectory;
PROCEDURE ExtractCode(F: Files.File; VAR code: ARRAY OF LONGINT; VAR codelen, entry, res: INTEGER);
VAR n, data: INTEGER; ch: CHAR; b: BYTE; (*codelen in words, entry in bytes*)
R: Files.Rider;
name: ARRAY 32 OF CHAR;
BEGIN Files.Set(R, F, 0); Files.ReadString(R, name); Files.ReadInt(R, data); (*key*)
Files.ReadByte(R, b); (*version*) Files.ReadInt(R, data); (*size*)
Files.ReadString(R, name); (*imports*)
WHILE name[0] # 0X DO Files.ReadInt(R, data); (*key*) Files.ReadString(R, name) END ;
Files.ReadInt(R, n); Files.Set(R, F, Files.Pos(R) + n); (*type descriptors*)
Files.ReadInt(R, n); (*variable space*)
Files.ReadInt(R, n); Files.Set(R, F, Files.Pos(R) + n); (*strings*)
Files.ReadInt(R, codelen);
IF codelen > LEN(code) THEN res := nospace
ELSE n := 0;
WHILE n < codelen DO Files.ReadInt(R, data); code[n] := data; INC(n) END ; (*code*)
Files.ReadString(R, name);
WHILE name[0] # 0X DO Files.ReadInt(R, data); Files.ReadString(R, name) END ; (*commands*)
Files.ReadInt(R, n); Files.Set(R, F, Files.Pos(R) + n*4); (*entries*)
Files.ReadInt(R, data);
WHILE data >= 0 DO Files.ReadInt(R, data) END ; (*pointer references*)
Files.ReadInt(R, data); (*fixorgP*) Files.ReadInt(R, data); (*fixorgD*)
Files.ReadInt(R, data); (*fixorgT*) Files.ReadInt(R, entry);
Files.Read(R, ch);
IF ch # "O" THEN res := badfile ELSE res := noerr END
END
END ExtractCode;
PROCEDURE Execute; (*filename - execute standalone program M.rsc*)
VAR code: ARRAY maxCode OF LONGINT;
codelen, entry, res: INTEGER;
name: ARRAY 32 OF CHAR;
body: Modules.Command;
F: Files.File;
BEGIN RS232.RecStr(name); RS232.SendStr("Execute "); RS232.SendStr(name);
F := Files.Old(name);
IF F # NIL THEN ExtractCode(F, code, codelen, entry, res);
IF res = noerr THEN RS232.SendStr(" done");
body := SYSTEM.VAL(Modules.Command, SYSTEM.ADR(code) + entry); body
ELSIF res = badfile THEN RS232.SendStr(" input file format error")
ELSIF res = nospace THEN RS232.SendStr(" program too long")
END
ELSE RS232.SendStr(" failed")
END
END Execute;
(*------------ Oberon-0 command interpreter ------------*)
PROCEDURE Task*;
VAR i, code, y: INTEGER; end: BOOLEAN;
BEGIN
IF SYSTEM.BIT(stat, 0) THEN (*byte available*)
RS232.Rec(code);
IF code = REQ THEN RS232.Send(ACK)
ELSIF code = REC THEN PCLink0.Receive (*filename*)
ELSIF code = SND THEN PCLink0.Send (*filename*)
ELSIF code > 0 THEN (*Oberon-0 commands*) end := TRUE;
code := ROR(code, 8); i := 3;
REPEAT DEC(i); RS232.Rec(y); code := ROR(code+y, 8) UNTIL i = 0;
IF code = 1 THEN Inspect (*a, n*)
ELSIF code = 2 THEN FillDisplay (*w*)
ELSIF code = 3 THEN Sector (*secno*)
ELSIF code = 4 THEN ShowFile (*filename*)
ELSIF code = 7 THEN Watch
ELSIF code = 8 THEN Mirror (*n*)
ELSIF code = 10 THEN ShowModules
ELSIF code = 11 THEN ShowCommands (*modname*)
ELSIF code = 12 THEN Directory (*prefix*)
ELSIF code = 13 THEN Delete (*filename*)
ELSIF code = 20 THEN Load (*modname*)
ELSIF code = 21 THEN Unload (*modname*)
ELSIF code = 22 THEN Call (*name*)
ELSIF code = 50 THEN WriteMemory (*adr, n, list of n values*)
ELSIF code = 51 THEN ClearMemory (*adr, n*)
ELSIF code = 52 THEN WriteSector (*secno, n, list of n values*)
ELSIF code = 53 THEN ClearSector (*secno, n*)
ELSIF code = 100 THEN LoadBoot (*filename*)
ELSIF code = 101 THEN ClearDirectory
ELSIF code = 102 THEN Execute (*filename*)
ELSE end := FALSE
END ;
IF end THEN RS232.End END
END
END
END Task;
PROCEDURE Loop*;
BEGIN REPEAT Task UNTIL FALSE
END Loop;
(*------------ initialization ------------*)
PROCEDURE Init*; (*establish a working file system (root page) if necessary*)
VAR a: FileDir.DirPage;
BEGIN Kernel.GetSector(FileDir.DirRootAdr, a);
IF a.mark # FileDir.DirMark THEN
a.mark := FileDir.DirMark; a.m := 0; a.p0 := 0;
Kernel.PutSector(FileDir.DirRootAdr, a)
END
END Init;
BEGIN IF Modules.importing # "Oberon0" THEN (*loaded by the boot loader*) Init; Modules.Init; Loop END
END Oberon0.
--------------------------------------------------------------
MODULE PCLink0; (*AP 7.2.20*)
IMPORT Files, RS232;
CONST BlkLen = 255; (*packet size for Send and Receive*)
ACK = 10H; NAK = 11H;
PROCEDURE Receive*; (*filename - receive file*)
VAR x, n, i: INTEGER;
name: ARRAY 32 OF CHAR;
F: Files.File; R: Files.Rider;
buf: ARRAY 256 OF BYTE;
BEGIN RS232.RecStr(name); F := Files.New(name);
IF F # NIL THEN
Files.Set(R, F, 0); RS232.Send(ACK);
REPEAT (*receive packet*)
RS232.Rec(n); i := 0;
WHILE i < n DO RS232.Rec(x); buf[i] := x; INC(i) END ;
i := 0;
WHILE i < n DO Files.WriteByte(R, buf[i]); INC(i) END ;
RS232.Send(ACK)
UNTIL n < BlkLen;
Files.Register(F); RS232.Send(ACK)
ELSE RS232.Send(NAK)
END
END Receive;
PROCEDURE Send*; (*filename - send file*)
VAR ch: CHAR;
x, n, i, L: INTEGER;
name: ARRAY 32 OF CHAR;
F: Files.File; R: Files.Rider;
BEGIN RS232.RecStr(name); F := Files.Old(name);
IF F # NIL THEN
RS232.Send(ACK); L := Files.Length(F); Files.Set(R, F, 0);
REPEAT (*send packet*)
IF L > BlkLen THEN n := BlkLen ELSE n := L END ;
RS232.Send(n); DEC(L, n); i := 0;
WHILE i < n DO Files.Read(R, ch); RS232.Send(ORD(ch)); INC(i) END ;
RS232.Rec(x);
IF x # ACK THEN n := 0 END
UNTIL n < BlkLen;
RS232.Rec(x)
ELSE RS232.Send(NAK)
END
END Send;
END PCLink0.
--------------------------------------------------------------
MODULE ORC; (*Connection to RISC; NW 11.11.2013 / AP 7.2.20*)
IMPORT SYSTEM, Files, Texts, Oberon, RS232;
CONST stat = -52; BlkLen = 255;
REQ = 20H; REC = 21H; SND = 22H; ACK = 10H;
Tout = 1000;
VAR W: Texts.Writer;
PROCEDURE Rec(VAR x: INTEGER); (*receive 1 byte with timeout*)
VAR T: LONGINT;
BEGIN T := Oberon.Time() + Tout;
REPEAT UNTIL SYSTEM.BIT(stat, 0) OR (Oberon.Time() >= T);
IF Oberon.Time() < T THEN RS232.Rec(x) ELSE x := 0 END
END Rec;
PROCEDURE RecInt(VAR x: INTEGER); (*receive 4 bytes with timeout*)
VAR i, x0, y: INTEGER;
BEGIN i := 4; x0 := 0;
REPEAT DEC(i); Rec(y); x0 := ROR(x0+y, 8) UNTIL i = 0;
x := x0
END RecInt;
PROCEDURE SendInt(x: INTEGER);
VAR i: INTEGER;
BEGIN i := 4;
REPEAT DEC(i); RS232.Send(x); x := ROR(x, 8) UNTIL i = 0
END SendInt;
PROCEDURE SendName(x: ARRAY OF CHAR);
VAR i, k: INTEGER;
BEGIN i := 0;
REPEAT k := ORD(x[i]); RS232.Send(k); INC(i) UNTIL k = 0
END SendName;
PROCEDURE Flush*; (*flush with timeout*)
VAR x: INTEGER; T: LONGINT;
BEGIN T := Oberon.Time() + Tout;
WHILE SYSTEM.BIT(stat, 0) & (Oberon.Time() < T) DO RS232.Rec(x) END
END Flush;
PROCEDURE TestReq*;
VAR x: INTEGER;
BEGIN RS232.Send(REQ); Rec(x); Texts.WriteInt(W, x, 4);
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END TestReq;
(*------------ load prelinked build-up boot file ------------*)
PROCEDURE Load*;
VAR i, m, n, w: LONGINT;
F: Files.File; R: Files.Rider;
S: Texts.Scanner;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN (*input file name*)
Texts.WriteString(W, S.s); F := Files.Old(S.s);
IF F # NIL THEN Files.Set(R, F, 0);
n := Files.Length(F); n := n DIV 4; (*size in words*) m := 0; (*address*)
Texts.WriteString(W, " loading "); Texts.Append(Oberon.Log, W.buf);
i := 0; SendInt(n*4); SendInt(m);
WHILE i < n DO
IF i + 1024 < n THEN m := i + 1024 ELSE m := n END ;
WHILE i < m DO Files.ReadInt(R, w); SendInt(w); INC(i); END ;
Texts.Write(W, "."); Texts.Append(Oberon.Log, W.buf)
END ;
SendInt(0); Texts.WriteInt(W, n*4, 6)
ELSE Texts.WriteString(W, " not found")
END ;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END ;
Flush
END Load;
(*------------ send and receive files ------------*)
PROCEDURE Send*;
VAR ch: CHAR;
n, n0, L, LL: LONGINT;
code: INTEGER;
F: Files.File; R: Files.Rider;
S: Texts.Scanner;
BEGIN RS232.Send(REQ); Rec(code);
IF code = ACK THEN
Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
WHILE S.class = Texts.Name DO
Texts.WriteString(W, S.s); F := Files.Old(S.s);
IF F # NIL THEN
RS232.Send(REC); SendName(S.s); RS232.Rec(code);
IF code = ACK THEN
Texts.WriteString(W, " sending ");
L := Files.Length(F); Files.Set(R, F, 0); LL := 0;
REPEAT (*send packet*)
IF L > BlkLen THEN n := BlkLen ELSE n := L END ;
n0 := n; RS232.Send(n); DEC(L, n);
WHILE n > 0 DO Files.Read(R, ch); RS232.Send(ORD(ch)); DEC(n) END ;
RS232.Rec(code); LL := LL + n0;
IF code = ACK THEN Texts.Write(W, ".") ELSE Texts.Write(W, "*"); n := 0 END ;
Texts.Append(Oberon.Log, W.buf)
UNTIL n0 < BlkLen;
RS232.Rec(code);
IF code = ACK THEN Texts.WriteInt(W, LL, 6) ELSE Texts.WriteString(W, "failed") END
ELSE Texts.WriteString(W, " no response"); Texts.WriteInt(W, ORD(code), 4)
END
ELSE Texts.WriteString(W, " not found")
END ;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); Texts.Scan(S)
END
ELSE Texts.WriteString(W, " connection not open");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END Send;
PROCEDURE Receive*;
VAR ch: CHAR;
code, x: INTEGER;
n, L, LL: LONGINT;
F: Files.File; R: Files.Rider;
orgname: ARRAY 32 OF CHAR;
S: Texts.Scanner;
BEGIN RS232.Send(REQ); Rec(code);
IF code = ACK THEN
Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
WHILE S.class = Texts.Name DO
Texts.WriteString(W, S.s); orgname := S.s;
F := Files.New(S.s); Files.Set(R, F, 0); LL := 0;
RS232.Send(SND); SendName(S.s); RS232.Rec(code);
IF code = ACK THEN
Texts.WriteString(W, " receiving ");
REPEAT (*receive packet*)
RS232.Rec(x); L := x; n := L;
WHILE n > 0 DO RS232.Rec(x); Files.Write(R, CHR(x)); DEC(n) END ;
RS232.Send(ACK); LL := LL + L; Texts.Write(W, "."); Texts.Append(Oberon.Log, W.buf)
UNTIL L < BlkLen;
RS232.Send(ACK);
Files.Register(F); Texts.WriteInt(W, LL, 6)
ELSE Texts.WriteString(W, " no response"); Texts.WriteInt(W, ORD(code), 4)
END ;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); Texts.Scan(S)
END
ELSE Texts.WriteString(W, " connection not open");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END
END Receive;
(*------------ Oberon-0 commands ------------*)
PROCEDURE SR*; (*send, then receive sequence of items*)
VAR S: Texts.Scanner; i, k: LONGINT; ch: CHAR; x, y: INTEGER;
BEGIN Texts.WriteString(W, "ORC.SR ");
Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
WHILE (S.class # Texts.Char) & (S.c # "~") DO
IF S.class = Texts.Int THEN Texts.WriteInt(W, S.i, 6); SendInt(S.i)
ELSIF S.class = Texts.Real THEN
Texts.WriteReal(W, S.x, 12); SendInt(SYSTEM.VAL(LONGINT, S.x))
ELSIF S.class IN {Texts.Name, Texts.String} THEN
Texts.Write(W, " "); Texts.WriteString(W, S.s); SendName(S.s)
ELSIF S.class = Texts.Char THEN Texts.Write(W, S.c)
ELSE Texts.WriteString(W, "bad value")
END ;
Texts.Scan(S)
END ;
Texts.WriteString(W, " | "); Texts.Append(Oberon.Log, W.buf);
(*receive input*)
REPEAT Rec(x);
IF x = 0 THEN Texts.WriteString(W, " timeout"); Flush
ELSIF x = 1 THEN (*Int*) RecInt(k); Texts.WriteInt(W, k, 6)
ELSIF x = 2 THEN (*Hex*) RecInt(k); Texts.WriteHex(W, k)
ELSIF x = 3 THEN (*Real*) RecInt(k); Texts.WriteReal(W, SYSTEM.VAL(REAL, k), 15)
ELSIF x = 4 THEN (*String*) RS232.Rec(y); ch := CHR(y);
WHILE ch > 0X DO Texts.Write(W, ch); RS232.Rec(y); ch := CHR(y) END
ELSIF x = 5 THEN (*Char*) RS232.Rec(x); ch := CHR(x); Texts.Write(W, ch)
ELSIF x = 6 THEN (*Line*) Texts.WriteLn(W)
ELSIF x = 7 THEN (*End*) x := 0
ELSIF x = 8 THEN RS232.Rec(k); Texts.WriteInt(W, k, 4)
ELSE x := 0
END ;
Texts.Append(Oberon.Log, W.buf)
UNTIL x = 0;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END SR;
BEGIN Texts.OpenWriter(W)
END ORC.
--------------------------------------------------------------
MODULE ORL; (*Oberon boot linker/loader for RISC / AP 14.3.20*)
IMPORT SYSTEM, Kernel, Files, Modules, Texts, Oberon;
CONST versionkey = 1X; versionkey0 = 0X; MT = 12; DescSize = 80; MnLength = 32;
noerr* = 0; nofile* = 1; badversion* = 2; badkey* = 3; badfile* = 4; nospace* = 5;
BootSec = 2; DestAdr = 8; MemAdr = 12; AllocAdr = 16; RootAdr = 20; StackAdr = 24; FPrintAdr = 28; MTAdr = 32; ModOrg = 256;
C4 = 10H; C6 = 40H; C8 = 100H; C10 = 400H; C12 = 1000H; C14 = 4000H; C16 = 10000H;
C18 = 40000H; C20 = 100000H; C22 = 400000H; C24 = 1000000H; BC = 0E7000000H; BL = 0F7000000H;
TYPE (*copied from Modules for use as cross linker/loader*)
Module* = POINTER TO ModDesc;
Command* = PROCEDURE;
ModuleName* = ARRAY MnLength OF CHAR;
ModDesc* = RECORD
name*: ModuleName;
next*: Module;
key*, num*, size*, refcnt*: INTEGER;
data*, code*, imp*, cmd*, ent*, ptr*, unused: INTEGER (*addresses*)
END ;
VAR root: Module;
MTOrg, AllocPtr, Start, limit, res*: INTEGER;
importing*, imported*: ModuleName;
W: Texts.Writer;
PROCEDURE MakeFileName(VAR FName: ARRAY OF CHAR; name, ext: ARRAY OF CHAR);
VAR i, j: INTEGER;
BEGIN i := 0; j := 0; (*assume name suffix less than 4 characters*)
WHILE (i < MnLength-5) & (name[i] > 0X) DO FName[i] := name[i]; INC(i) END ;
REPEAT FName[i]:= ext[j]; INC(i); INC(j) UNTIL ext[j] = 0X;
FName[i] := 0X
END MakeFileName;
PROCEDURE ThisFile(name: ARRAY OF CHAR): Files.File;
VAR F: Files.File;
filename: ModuleName;
BEGIN MakeFileName(filename, name, ".rsc"); F := Files.Old(filename); RETURN F
END ThisFile;
PROCEDURE error(n: INTEGER; name: ARRAY OF CHAR);
BEGIN res := n; importing := name
END error;
PROCEDURE Check(s: ARRAY OF CHAR);
VAR i: INTEGER; ch: CHAR;
BEGIN ch := s[0]; res := 1; i := 1;
IF (ch >= "A") & (ch <= "Z") OR (ch >= "a") & (ch <= "z") THEN
REPEAT ch := s[i]; INC(i)
UNTIL ~((ch >= "0") & (ch <= "9") OR (ch >= "A") & (ch <= "Z")
OR (ch >= "a") & (ch <= "z") OR (ch = ".")) OR (i = MnLength);
IF (i < MnLength) & (ch = 0X) THEN res := 0 END
END
END Check;
PROCEDURE LinkOne(name: ARRAY OF CHAR; VAR newmod: Module);
(*search module in list; if not found, link module.
res = noerr: already present or linked;
res = nofile: file not available;
res = badversion: bad file version;
res = badkey: key conflict;
res = badfile: corrupted file;
res = nospace: insufficient space*)
VAR mod, impmod: Module;
i, n, key, impkey, mno, nofimps, size: INTEGER;
p, u, v, w: INTEGER; (*addresses*)
ch: CHAR;
body: Command;
fixorgP, fixorgD, fixorgT: INTEGER;
disp, adr, inst, pno, vno, dest, offset: INTEGER;
name1, impname: ModuleName;
F: Files.File; R: Files.Rider;
import: ARRAY 16 OF Module;
BEGIN mod := root; error(noerr, name); nofimps := 0;
WHILE (mod # NIL) & (name # mod.name) DO mod := mod.next END ;
IF mod = NIL THEN (*link*)
Check(name);
IF res = noerr THEN F := ThisFile(name) ELSE F := NIL END ;
IF F # NIL THEN
Files.Set(R, F, 0); Files.ReadString(R, name1); Files.ReadInt(R, key); Files.Read(R, ch);
Files.ReadInt(R, size); importing := name1;
IF (ch = versionkey) (*regular module*) OR (ch = versionkey0) (*standalone program*) THEN
Files.ReadString(R, impname); (*imports*)
WHILE (impname[0] # 0X) & (res = noerr) DO
Files.ReadInt(R, impkey);
LinkOne(impname, impmod); import[nofimps] := impmod; importing := name1;
IF res = noerr THEN
IF impmod.key = impkey THEN INC(impmod.refcnt); INC(nofimps)
ELSE error(badkey, name1); imported := impname
END
END ;
Files.ReadString(R, impname)
END
ELSE error(badversion, name1)
END
ELSE error(nofile, name)
END ;
IF res = noerr THEN
INC(size, DescSize);
IF AllocPtr + size < limit THEN (*allocate*)
p := AllocPtr; mod := SYSTEM.VAL(Module, p);
AllocPtr := (p + size + 3) DIV 4 * 4; mod.size := AllocPtr - p;
IF root = NIL THEN mod.num := 1 ELSE mod.num := root.num + 1 END ;
mod.next := root; root := mod
ELSE error(nospace, name1)
END
END ;
IF res = noerr THEN (*read file*)
INC(p, DescSize); (*allocate descriptor*)
mod.name := name; mod.key := key; mod.refcnt := 0;
mod.data := p; (*data*)
SYSTEM.PUT(mod.num * 4 + MTOrg, p); (*module table entry*)
Files.ReadInt(R, n);
WHILE n > 0 DO Files.ReadInt(R, w); SYSTEM.PUT(p, w); INC(p, 4); DEC(n, 4) END ; (*type descriptors*)
Files.ReadInt(R, n);
WHILE n > 0 DO SYSTEM.PUT(p, 0); INC(p, 4); DEC(n, 4) END ; (*variable space*)
Files.ReadInt(R, n);
WHILE n > 0 DO Files.Read(R, ch); SYSTEM.PUT(p, ch); INC(p); DEC(n) END ; (*strings*)
mod.code := p; (*program*)
Files.ReadInt(R, n);
WHILE n > 0 DO Files.ReadInt(R, w); SYSTEM.PUT(p, w); INC(p, 4); DEC(n) END ; (*program code*)
mod.imp := p; (*copy imports*)
i := 0;
WHILE i < nofimps DO
SYSTEM.PUT(p, import[i]); INC(p, 4); INC(i)
END ;
mod.cmd := p; (*commands*) Files.Read(R, ch);
WHILE ch # 0X DO
REPEAT SYSTEM.PUT(p, ch); INC(p); Files.Read(R, ch) UNTIL ch = 0X;
REPEAT SYSTEM.PUT(p, 0X); INC(p) UNTIL p MOD 4 = 0;
Files.ReadInt(R, n); SYSTEM.PUT(p, n); INC(p, 4); Files.Read(R, ch)
END ;
REPEAT SYSTEM.PUT(p, 0X); INC(p) UNTIL p MOD 4 = 0;
mod.ent := p; (*entries*)
Files.ReadInt(R, n);
WHILE n > 0 DO Files.ReadInt(R, w); SYSTEM.PUT(p, w); INC(p, 4); DEC(n) END ;
mod.ptr := p; (*pointer references*)
Files.ReadInt(R, w);
WHILE w >= 0 DO SYSTEM.PUT(p, mod.data + w - Start); INC(p, 4); Files.ReadInt(R, w) END ;
SYSTEM.PUT(p, 0); INC(p, 4);
Files.ReadInt(R, fixorgP); Files.ReadInt(R, fixorgD); Files.ReadInt(R, fixorgT);
Files.ReadInt(R, w); body := SYSTEM.VAL(Command, mod.code + w - Start);
Files.Read(R, ch);
IF ch # "O" THEN mod := NIL; error(badfile, name) END
END ;
IF res = noerr THEN (*fixup of BL*)
adr := mod.code + fixorgP*4;
WHILE adr # mod.code DO
SYSTEM.GET(adr, inst);
mno := inst DIV C20 MOD C4;
pno := inst DIV C12 MOD C8;
disp := inst MOD C12;
SYSTEM.GET(mod.imp + (mno-1)*4, impmod);
SYSTEM.GET(impmod.ent + pno*4, dest); dest := dest + impmod.code;
offset := (dest - adr - 4) DIV 4;
SYSTEM.PUT(adr, (offset MOD C24) + BL);
adr := adr - disp*4
END ;
(*fixup of LDR/STR/ADD*)
adr := mod.code + fixorgD*4;
WHILE adr # mod.code DO
SYSTEM.GET(adr, inst);
mno := inst DIV C20 MOD C4;
disp := inst MOD C12;
IF mno = 0 THEN (*global*)
SYSTEM.PUT(adr, (inst DIV C24 * C4 + MT) * C20 + mod.num * 4)
ELSE (*import*)
SYSTEM.GET(mod.imp + (mno-1)*4, impmod); v := impmod.num;
SYSTEM.PUT(adr, (inst DIV C24 * C4 + MT) * C20 + v*4);
SYSTEM.GET(adr+4, inst); vno := inst MOD C8;
SYSTEM.GET(impmod.ent + vno*4, offset);
IF ODD(inst DIV C8) THEN offset := offset + impmod.code - impmod.data END ;
SYSTEM.PUT(adr+4, inst DIV C16 * C16 + offset)
END ;
adr := adr - disp*4
END ;
(*fixup of type descriptors*)
adr := mod.data + fixorgT*4;
WHILE adr # mod.data DO
SYSTEM.GET(adr, inst);
mno := inst DIV C24 MOD C4;
vno := inst DIV C12 MOD C12;
disp := inst MOD C12;
IF mno = 0 THEN (*global*) inst := mod.data - Start + vno
ELSE (*import*)
SYSTEM.GET(mod.imp + (mno-1)*4, impmod);
SYSTEM.GET(impmod.ent + vno*4, offset);
inst := impmod.data - Start + offset
END ;
SYSTEM.PUT(adr, inst); adr := adr - disp*4
END ;
SYSTEM.PUT(Start, body) (*module initialization body*)
ELSIF res >= badkey THEN importing := name;
WHILE nofimps > 0 DO DEC(nofimps); DEC(import[nofimps].refcnt) END
END
END ;
newmod := mod
END LinkOne;
PROCEDURE Link*; (*link multiple object files together and create a single boot file M.bin from them*)
VAR i, x: INTEGER;
F: Files.File; R: Files.Rider;
S: Texts.Scanner;
M, p: Module;
name: ModuleName;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
root := NIL; Start := Modules.AllocPtr; MTOrg := Start + 32; AllocPtr := Start + 256; i := Start;
WHILE i < AllocPtr DO SYSTEM.PUT(i, 0); INC(i, 4) END ;
REPEAT LinkOne(S.s, M); Texts.Scan(S) UNTIL (S.class # Texts.Name) OR (res # noerr);
IF res = noerr THEN p := root; Texts.WriteString(W, " linking");
WHILE p # NIL DO (*fixup*) Texts.Write(W, " "); Texts.WriteString(W, p.name);
M := p; p := p.next;
IF p # NIL THEN M.next := SYSTEM.VAL(Module, SYSTEM.VAL(INTEGER, p) - Start) END ;
M.data := M.data - Start;
SYSTEM.PUT(M.num * 4 + MTOrg, M.data); (*module table entry*)
M.code := M.code - Start;
i := M.imp;
WHILE i < M.cmd DO SYSTEM.GET(i, x); SYSTEM.PUT(i, x - Start); INC(i, 4) END ;
M.imp := M.imp - Start;
M.cmd := M.cmd - Start;
M.ent := M.ent - Start;
M.ptr := M.ptr - Start
END ;
SYSTEM.GET(Start, x); (*address of initialization body of the top module relative to Start*)
SYSTEM.PUT(Start, BC + (x DIV 4) - 1); (*branch instruction to the initialization body of the top module*)
SYSTEM.PUT(Start + DestAdr, 0); (*destination address of the prelinked, executable binary*)
SYSTEM.PUT(Start + MemAdr, Kernel.MemLim); (*limit of available memory, typically overwritten by the boot loader*)
SYSTEM.PUT(Start + AllocAdr, AllocPtr - Start); (*address of the end of the module space loaded*)
SYSTEM.PUT(Start + RootAdr, SYSTEM.VAL(INTEGER, root) - Start); (*current root of the links of loaded modules*)
SYSTEM.PUT(Start + StackAdr, Kernel.stackOrg); (*current limit of the module area, typically overwritten by the boot loader*)
SYSTEM.PUT(Start + FPrintAdr, 12345678H); (*fingerprint*)
MakeFileName(name, S.s, ".bin"); F := Files.New(name); Files.Set(R, F, 0); i := Start;
WHILE i < AllocPtr DO SYSTEM.GET(i, x); Files.WriteInt(R, x); INC(i, 4) END ;
Texts.WriteInt(W, AllocPtr - Start, 7); Files.Register(F)
ELSE
Texts.WriteString(W, "Link error: "); Texts.WriteString(W, importing);
IF res = nofile THEN Texts.WriteString(W, " module not found")
ELSIF res = badversion THEN Texts.WriteString(W, " bad version")
ELSIF res = badkey THEN Texts.WriteString(W, " imports ");
Texts.WriteString(W, imported); Texts.WriteString(W, " with bad key")
ELSIF res = badfile THEN Texts.WriteString(W, " corrupted obj file")
ELSIF res = nospace THEN Texts.WriteString(W, " insufficient space")
END
END
ELSE Texts.WriteString(W, "Usage: ORL.Link [module...] topmodule")
END ;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); root := NIL
END Link;
PROCEDURE Load*; (*load prelinked boot file M.bin onto the boot area of the local disk*)
VAR i, secno: LONGINT; b: BYTE;
F: Files.File; R: Files.Rider;
S: Texts.Scanner;
buf: ARRAY Kernel.SectorLength OF BYTE;
BEGIN Texts.OpenScanner(S, Oberon.Par.text, Oberon.Par.pos); Texts.Scan(S);
IF S.class = Texts.Name THEN
Texts.WriteString(W, " loading "); Texts.WriteString(W, S.s); F := Files.Old(S.s);
IF F # NIL THEN Texts.WriteString(W, " onto boot area"); Texts.WriteInt(W, Files.Length(F), 7);
secno := BootSec; i := 0; Files.Set(R, F, 0); Files.ReadByte(R, b);
WHILE ~R.eof DO buf[i] := b; INC(i);
IF i = Kernel.SectorLength THEN Kernel.PutSector(secno*29, buf); INC(secno); i := 0 END ;
Files.ReadByte(R, b)
END ;
IF i > 0 THEN
WHILE i < Kernel.SectorLength DO buf[i] := 0; INC(i) END ;
Kernel.PutSector(secno*29, buf)
END
ELSE Texts.WriteString(W, " not found")
END
ELSE Texts.WriteString(W, "Usage: ORL.Load M.bin")
END ;
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf)
END Load;
BEGIN Texts.OpenWriter(W); Texts.WriteString(W, "OR Boot linker/loader AP 14.3.20");
Texts.WriteLn(W); Texts.Append(Oberon.Log, W.buf); limit := Kernel.stackOrg - Kernel.stackSize
END ORL.
More information about the Oberon
mailing list