[Oberon] ORX.WriteFile
Andreas Pirklbauer
andreas_pirklbauer at yahoo.com
Thu Oct 17 20:30:16 CEST 2019
> There sure are loads of ways! The approach we used with Astrobe was to
> modify ORG so it always outputs a .mem text file directly from the code
> array if a Module* is being compiled:
>
> IF version = 0 THEN WriteHexFile(modid) END
>
> Regards,
> Chris Burrows
Good idea! Below is one possible implementation of such an ORG.Close (and the diff), in case
someone is interested. One could also add an option /m to ORP.Compile if one really wanted to.
-ap
---------------------------------------------------------------------------------------
PROCEDURE WriteHex(VAR R: Files.Rider; x: LONGINT); (*write a 4 byte LONGINT in 8 digit hex format*)
VAR i: INTEGER; y: LONGINT;
a: ARRAY 10 OF CHAR;
BEGIN i := 0;
REPEAT y := x MOD 10H;
IF y < 10 THEN a[i] := CHR(y + 30H) ELSE a[i] := CHR(y + 37H) END ;
x := x DIV 10H; INC(i)
UNTIL i = 8;
REPEAT DEC(i); Files.Write(R, a[i]) UNTIL i = 0
END WriteHex;
PROCEDURE Close*(VAR modid: ORS.Ident; key, nofent: LONGINT);
CONST CR = 0DX;
VAR obj: ORB.Object;
i, comsize, nofimps, nofptrs, size: LONGINT;
name: ORS.Ident;
F, F1: Files.File; R, R1: Files.Rider;
BEGIN (*exit code*)
IF version = 0 THEN Put1(Mov, 0, 0, 0); Put3(BR, 7, 0) (*RISC-0*)
ELSE Put2(Ldr, LNK, SP, 0); Put1(Add, SP, SP, 4); Put3(BR, 7, LNK)
END ;
obj := ORB.topScope.next; nofimps := 0; comsize := 4; nofptrs := 0;
WHILE obj # NIL DO
IF (obj.class = ORB.Mod) & (obj.dsc # ORB.system) THEN INC(nofimps) (*count imports*)
ELSIF (obj.exno # 0) & (obj.class = ORB.Const) & (obj.type.form = ORB.Proc)
& (obj.type.nofpar = 0) & (obj.type.base = ORB.noType) THEN i := 0; (*count commands*)
WHILE obj.name[i] # 0X DO INC(i) END ;
i := (i+4) DIV 4 * 4; INC(comsize, i+4)
ELSIF obj.class = ORB.Var THEN INC(nofptrs, NofPtrs(obj.type)) (*count pointers*)
END ;
obj := obj.next
END ;
size := varsize + strx + comsize + (pc + nofimps + nofent + nofptrs + 1)*4; (*varsize includes type descriptors*)
ORB.MakeFileName(name, modid, ".rsc"); F := Files.New(name); Files.Set(R, F, 0); (*write code file*)
IF version = 0 THEN (*write PROM file*)
ORB.MakeFileName(name, modid, ".mem"); F1 := Files.New(name); Files.Set(R1, F1, 0)
END ;
Files.WriteString(R, modid); Files.WriteInt(R, key); Files.Write(R, CHR(version));
Files.WriteInt(R, size);
obj := ORB.topScope.next;
WHILE (obj # NIL) & (obj.class = ORB.Mod) DO (*imports*)
IF obj.dsc # ORB.system THEN Files.WriteString(R, obj(ORB.Module).orgname); Files.WriteInt(R, obj.val) END ;
obj := obj.next
END ;
Files.Write(R, 0X);
Files.WriteInt(R, tdx*4);
i := 0;
WHILE i < tdx DO Files.WriteInt(R, data[i]); INC(i) END ; (*type descriptors*)
Files.WriteInt(R, varsize - tdx*4); (*data*)
Files.WriteInt(R, strx);
FOR i := 0 TO strx-1 DO Files.Write(R, str[i]) END ; (*strings*)
Files.WriteInt(R, pc); (*code len*)
FOR i := 0 TO pc-1 DO Files.WriteInt(R, code[i]); (*program*)
IF version = 0 THEN WriteHex(R1, code[i]); Files.Write(R1, CR) END (*hexcode*)
END ;
IF version = 0 THEN i := pc;
WHILE i MOD 512 # 0 DO WriteHex(R1, 0); Files.Write(R1, CR); INC(i) END
END ;
obj := ORB.topScope.next;
WHILE obj # NIL DO (*commands*)
IF (obj.exno # 0) & (obj.class = ORB.Const) & (obj.type.form = ORB.Proc) &
(obj.type.nofpar = 0) & (obj.type.base = ORB.noType) THEN
Files.WriteString(R, obj.name); Files.WriteInt(R, obj.val)
END ;
obj := obj.next
END ;
Files.Write(R, 0X);
Files.WriteInt(R, nofent); Files.WriteInt(R, entry);
obj := ORB.topScope.next;
WHILE obj # NIL DO (*entries*)
IF obj.exno # 0 THEN
IF (obj.class = ORB.Const) & (obj.type.form = ORB.Proc) OR (obj.class = ORB.Var) THEN
Files.WriteInt(R, obj.val);
ELSIF obj.class = ORB.Typ THEN
IF obj.type.form = ORB.Record THEN Files.WriteInt(R, obj.type.len MOD 10000H)
ELSIF (obj.type.form = ORB.Pointer) & ((obj.type.base.typobj = NIL) OR (obj.type.base.typobj.exno = 0)) THEN
Files.WriteInt(R, obj.type.base.len MOD 10000H)
END
END
END ;
obj := obj.next
END ;
obj := ORB.topScope.next;
WHILE obj # NIL DO (*pointer variables*)
IF obj.class = ORB.Var THEN FindPtrs(R, obj.type, obj.val) END ;
obj := obj.next
END ;
Files.WriteInt(R, -1);
Files.WriteInt(R, fixorgP); Files.WriteInt(R, fixorgD); Files.WriteInt(R, fixorgT); Files.WriteInt(R, entry);
Files.Write(R, "O"); Files.Register(F);
IF version = 0 THEN Files.Register(F1) END
END Close;
And the diff:
----------------
1045a1046,1056
> PROCEDURE WriteHex(VAR R: Files.Rider; x: LONGINT); (*write a 4 byte LONGINT in 8 digit hex format*)
> VAR i: INTEGER; y: LONGINT;
> a: ARRAY 10 OF CHAR;
> BEGIN i := 0;
> REPEAT y := x MOD 10H;
> IF y < 10 THEN a[i] := CHR(y + 30H) ELSE a[i] := CHR(y + 37H) END ;
> x := x DIV 10H; INC(i)
> UNTIL i = 8;
> REPEAT DEC(i); Files.Write(R, a[i]) UNTIL i = 0
> END WriteHex;
>
1046a1058
> CONST CR = 0DX;
1050c1062
< F: Files.File; R: Files.Rider;
---
> F, F1: Files.File; R, R1: Files.Rider;
1068,1069c1080,1084
< ORB.MakeFileName(name, modid, ".rsc"); (*write code file*)
< F := Files.New(name); Files.Set(R, F, 0); Files.WriteString(R, modid); Files.WriteInt(R, key); Files.Write(R, CHR(version));
---
> ORB.MakeFileName(name, modid, ".rsc"); F := Files.New(name); Files.Set(R, F, 0); (*write code file*)
> IF version = 0 THEN (*write PROM file*)
> ORB.MakeFileName(name, modid, ".mem"); F1 := Files.New(name); Files.Set(R1, F1, 0)
> END ;
> Files.WriteString(R, modid); Files.WriteInt(R, key); Files.Write(R, CHR(version));
1084c1099,1104
< FOR i := 0 TO pc-1 DO Files.WriteInt(R, code[i]) END ; (*program*)
---
> FOR i := 0 TO pc-1 DO Files.WriteInt(R, code[i]); (*program*)
> IF version = 0 THEN WriteHex(R1, code[i]); Files.Write(R1, CR) END (*hexcode*)
> END ;
> IF version = 0 THEN i := pc;
> WHILE i MOD 512 # 0 DO WriteHex(R1, 0); Files.Write(R1, CR); INC(i) END
> END ;
1116c1136,1137
< Files.Write(R, "O"); Files.Register(F)
---
> Files.Write(R, "O"); Files.Register(F);
> IF version = 0 THEN Files.Register(F1) END
More information about the Oberon
mailing list