summaryrefslogtreecommitdiff
path: root/appl/wm/rt.b
diff options
context:
space:
mode:
Diffstat (limited to 'appl/wm/rt.b')
-rw-r--r--appl/wm/rt.b701
1 files changed, 701 insertions, 0 deletions
diff --git a/appl/wm/rt.b b/appl/wm/rt.b
new file mode 100644
index 00000000..4bf26463
--- /dev/null
+++ b/appl/wm/rt.b
@@ -0,0 +1,701 @@
+implement WmRt;
+
+include "sys.m";
+ sys: Sys;
+ sprint: import sys;
+
+include "bufio.m";
+ bufio: Bufio;
+ Iobuf: import bufio;
+
+include "draw.m";
+
+include "tk.m";
+ tk: Tk;
+ Toplevel: import tk;
+
+include "tkclient.m";
+ tkclient: Tkclient;
+
+include "dialog.m";
+ dialog: Dialog;
+
+include "selectfile.m";
+ selectfile: Selectfile;
+
+include "dis.m";
+ dis: Dis;
+ Inst, Type, Data, Link, Mod: import dis;
+ XMAGIC: import Dis;
+ MUSTCOMPILE, DONTCOMPILE: import Dis;
+ AMP, AFP, AIMM, AXXX, AIND, AMASK: import Dis;
+ ARM, AXNON, AXIMM, AXINF, AXINM: import Dis;
+ DEFB, DEFW, DEFS, DEFF, DEFA, DIND, DAPOP, DEFL: import Dis;
+
+WmRt: module
+{
+ init: fn(ctxt: ref Draw->Context, argv: list of string);
+};
+
+gctxt: ref Draw->Context;
+t: ref Toplevel;
+disfile: string;
+
+TK: con 1;
+
+m: ref Mod;
+rt := 0;
+ss := -1;
+
+rt_cfg := array[] of {
+ "frame .m",
+ "menubutton .m.open -text File -menu .file",
+ "menubutton .m.prop -text Properties -menu .prop",
+ "menubutton .m.view -text View -menu .view",
+ "label .m.l",
+ "pack .m.open .m.view .m.prop -side left",
+ "pack .m.l -side right",
+ "frame .b",
+ "text .b.t -width 12c -height 7c -yscrollcommand {.b.s set} -bg white",
+ "scrollbar .b.s -command {.b.t yview}",
+ "pack .b.s -fill y -side left",
+ "pack .b.t -fill both -expand 1",
+ "pack .m -anchor w -fill x",
+ "pack .b -fill both -expand 1",
+ "pack propagate . 0",
+ "update",
+
+ "menu .prop",
+ ".prop add checkbutton -text {Must compile} -command {send cmd must}",
+ ".prop add checkbutton -text {Don't compile} -command {send cmd dont}",
+ ".prop add separator",
+ ".prop add command -text {Set stack extent} -command {send cmd stack}",
+ ".prop add command -text {Sign module} -command {send cmd sign}",
+
+ "menu .view",
+ ".view add command -text {Header} -command {send cmd hdr}",
+ ".view add command -text {Code segment} -command {send cmd code}",
+ ".view add command -text {Data segment} -command {send cmd data}",
+ ".view add command -text {Type descriptors} -command {send cmd type}",
+ ".view add command -text {Link descriptors} -command {send cmd link}",
+ ".view add command -text {Import descriptors} -command {send cmd imports}",
+ ".view add command -text {Exception handlers} -command {send cmd handlers}",
+
+ "menu .file",
+ ".file add command -text {Open module} -command {send cmd open}",
+ ".file add separator",
+ ".file add command -text {Write .dis module} -command {send cmd save}",
+ ".file add command -text {Write .s file} -command {send cmd list}",
+};
+
+init(ctxt: ref Draw->Context, nil: list of string)
+{
+ sys = load Sys Sys->PATH;
+ if (ctxt == nil) {
+ sys->fprint(sys->fildes(2), "rt: no window context\n");
+ raise "fail:bad context";
+ }
+ tk = load Tk Tk->PATH;
+ tkclient = load Tkclient Tkclient->PATH;
+ dialog = load Dialog Dialog->PATH;
+ selectfile = load Selectfile Selectfile->PATH;
+
+ sys->pctl(Sys->NEWPGRP, nil);
+
+ tkclient->init();
+ dialog->init();
+ selectfile->init();
+
+ gctxt = ctxt;
+
+ menubut: chan of string;
+ (t, menubut) = tkclient->toplevel(ctxt, "", "Dis Module Manager", Tkclient->Appl);
+
+ cmd := chan of string;
+
+ tk->namechan(t, cmd, "cmd");
+ tkcmds(t, rt_cfg);
+ tkclient->onscreen(t, nil);
+ tkclient->startinput(t, "kbd"::"ptr"::nil);
+
+ dis = load Dis Dis->PATH;
+ if(dis == nil) {
+ dialog->prompt(ctxt, t.image, "error -fg red", "Load Module",
+ "wmrt requires Dis",
+ 0, "Exit"::nil);
+ return;
+ }
+ dis->init();
+
+ for(;;) alt {
+ s := <-t.ctxt.kbd =>
+ tk->keyboard(t, s);
+ s := <-t.ctxt.ptr =>
+ tk->pointer(t, *s);
+ s := <-t.ctxt.ctl or
+ s = <-t.wreq =>
+ tkclient->wmctl(t, s);
+ menu := <-menubut =>
+ if(menu == "exit")
+ return;
+ tkclient->wmctl(t, menu);
+ s := <-cmd =>
+ case s {
+ "open" =>
+ openfile(ctxt);
+ "save" =>
+ writedis();
+ "list" =>
+ writeasm();
+ "hdr" =>
+ hdr();
+ "code" =>
+ das(TK);
+ "data" =>
+ dat(TK);
+ "type" =>
+ desc(TK);
+ "link" =>
+ link(TK);
+ "imports" =>
+ imports(TK);
+ "handlers" =>
+ handlers(TK);
+ "must" =>
+ rt ^= MUSTCOMPILE;
+ "dont" =>
+ rt ^= DONTCOMPILE;
+ "stack" =>
+ spawn stack(ctxt);
+ "sign" =>
+ dialog->prompt(ctxt, t.image, "error -fg red", "Signed Modules",
+ "not implemented",
+ 0, "Continue"::nil);
+ }
+ }
+}
+
+stack_cfg := array[] of {
+ "scale .s -length 200 -to 32768 -resolution 128 -orient horizontal",
+ "frame .f",
+ "pack .s .f -pady 5 -fill x -expand 1",
+};
+
+stack(ctxt: ref Draw->Context)
+{
+ # (s, sbut) := tkclient->toplevel(ctxt, tkclient->geom(t), "Dis Stack", 0);
+ (s, sbut) := tkclient->toplevel(ctxt, "", "Dis Stack", 0);
+
+ cmd := chan of string;
+ tk->namechan(s, cmd, "cmd");
+ tkcmds(s, stack_cfg);
+ tk->cmd(s, ".s set " + string ss);
+ tk->cmd(s, "update");
+ tkclient->onscreen(s, nil);
+ tkclient->startinput(s, "kbd"::"ptr"::nil);
+
+ for(;;) alt {
+ c := <-s.ctxt.kbd =>
+ tk->keyboard(s, c);
+ c := <-s.ctxt.ptr =>
+ tk->pointer(s, *c);
+ c := <-s.ctxt.ctl or
+ c = <-s.wreq =>
+ tkclient->wmctl(s, c);
+ wmctl := <-sbut =>
+ if(wmctl == "exit") {
+ ss = int tk->cmd(s, ".s get");
+ return;
+ }
+ tkclient->wmctl(s, wmctl);
+ }
+}
+
+openfile(ctxt: ref Draw->Context)
+{
+ pattern := list of {
+ "*.dis (Dis VM module)",
+ "* (All files)"
+ };
+
+ for(;;) {
+ disfile = selectfile->filename(ctxt, t.image, "Dis file", pattern, nil);
+ if(disfile == "")
+ break;
+
+ s: string;
+ (m, s) = dis->loadobj(disfile);
+ if(s == nil) {
+ ss = m.ssize;
+ rt = m.rt;
+ tk->cmd(t, ".m.l configure -text {"+m.name+"}");
+ das(TK);
+ return;
+ }
+
+ r := dialog->prompt(ctxt, t.image, "error -fg red", "Open Dis File",
+ s,
+ 0, "Retry" :: "Abort" :: nil);
+ if(r == 1)
+ return;
+ }
+}
+
+writedis()
+{
+ if(m == nil || m.magic == 0) {
+ dialog->prompt(gctxt, t.image, "error -fg red", "Write .dis",
+ "no module loaded",
+ 0, "Continue"::nil);
+ return;
+ }
+ if(rt < 0)
+ rt = m.rt;
+ if(ss < 0)
+ ss = m.ssize;
+ if(rt == m.rt && ss == m.ssize)
+ return;
+ while((fd := sys->open(disfile, Sys->OREAD)) == nil){
+ if(dialog->prompt(gctxt, t.image, "error -fg red", "Open Dis File", "open failed: "+sprint("%r"),
+ 0, "Retry" :: "Abort" :: nil))
+ return;
+ }
+ if(len discona(rt) == len discona(m.rt) && len discona(ss) == len discona(m.ssize)){
+ sys->seek(fd, big 4, Sys->SEEKSTART); # skip magic
+ discon(fd, rt);
+ discon(fd, ss);
+ m.rt = rt;
+ m.ssize = ss;
+ return;
+ }
+ # rt and ss representations changed in length: read the file in,
+ # make a copy and update rt and ss when copying
+ (ok, d) := sys->fstat(fd);
+ if(ok < 0){
+ ioerror("Reading Dis file "+disfile, "can't find file length: "+sprint("%r"));
+ return;
+ }
+ length := int d.length;
+ disbuf := array[length] of byte;
+ if(sys->read(fd, disbuf, length) != length){
+ ioerror("Reading Dis file "+disfile, "read error: "+sprint("%r"));
+ return;
+ }
+ outbuf := array[length+2*4] of byte; # could avoid this buffer if required, by writing portions of disbuf
+ (magic, i) := operand(disbuf, 0);
+ o := putoperand(outbuf, magic);
+ if(magic == Dis->SMAGIC){
+ ns: int;
+ (ns, i) = operand(disbuf, i);
+ o += putoperand(outbuf[o:], ns);
+ sign := disbuf[i:i+ns];
+ i += ns;
+ outbuf[o:] = sign;
+ o += ns;
+ }
+ (nil, i) = operand(disbuf, i);
+ (nil, i) = operand(disbuf, i);
+ if(i < 0){
+ ioerror("Reading Dis file "+disfile, "Dis header too short");
+ return;
+ }
+ o += putoperand(outbuf[o:], rt);
+ o += putoperand(outbuf[o:], ss);
+ outbuf[o:] = disbuf[i:];
+ o += len disbuf - i;
+ fd = sys->create(disfile, Sys->OWRITE, 8r666);
+ if(fd == nil){
+ ioerror("Rewriting "+disfile, sys->sprint("can't create %s: %r",disfile));
+ return;
+ }
+ if(sys->write(fd, outbuf, o) != o)
+ ioerror("Rewriting "+disfile, "write error: "+sprint("%r"));
+ m.rt = rt;
+ m.ssize = ss;
+}
+
+ioerror(title: string, err: string)
+{
+ dialog->prompt(gctxt, t.image, "error -fg red", title, err, 0, "Dismiss" :: nil);
+}
+
+putoperand(out: array of byte, v: int): int
+{
+ a := discona(v);
+ out[0:] = a;
+ return len a;
+}
+
+discona(val: int): array of byte
+{
+ if(val >= -64 && val <= 63)
+ return array[] of { byte(val & ~16r80) };
+ else if(val >= -8192 && val <= 8191)
+ return array[] of { byte((val>>8) & ~16rC0 | 16r80), byte val };
+ else
+ return array[] of { byte(val>>24 | 16rC0), byte(val>>16), byte(val>>8), byte val };
+}
+
+discon(fd: ref Sys->FD, val: int)
+{
+ a := discona(val);
+ sys->write(fd, a, len a);
+}
+
+operand(disobj: array of byte, o: int): (int, int)
+{
+ if(o >= len disobj)
+ return (-1, -1);
+ b := int disobj[o++];
+ case b & 16rC0 {
+ 16r00 =>
+ return (b, o);
+ 16r40 =>
+ return (b | ~16r7F, o);
+ 16r80 =>
+ if(o >= len disobj)
+ return (-1, -1);
+ if(b & 16r20)
+ b |= ~16r3F;
+ else
+ b &= 16r3F;
+ b = (b<<8) | int disobj[o++];
+ return (b, o);
+ 16rC0 =>
+ if(o+2 >= len disobj)
+ return (-1, -1);
+ if(b & 16r20)
+ b |= ~16r3F;
+ else
+ b &= 16r3F;
+ b = b<<24 |
+ (int disobj[o]<<16) |
+ (int disobj[o+1]<<8)|
+ int disobj[o+2];
+ o += 3;
+ return (b, o);
+ }
+ return (0, -1); # can't happen
+}
+
+fasm: ref Iobuf;
+
+writeasm()
+{
+ if(m == nil || m.magic == 0) {
+ dialog->prompt(gctxt, t.image, "error -fg red", "Write .s",
+ "no module loaded",
+ 0, "Continue"::nil);
+ return;
+ }
+
+ bufio = load Bufio Bufio->PATH;
+ if(bufio == nil) {
+ dialog->prompt(gctxt, t.image, "error -fg red", "Write .s",
+ "Bufio load failed: "+sprint("%r"),
+ 0, "Exit"::nil);
+ return;
+ }
+
+ for(;;) {
+ asmfile: string;
+ if(len disfile > 4 && disfile[len disfile-4:] == ".dis")
+ asmfile = disfile[0:len disfile-3] + "s";
+ else
+ asmfile = disfile + ".s";
+ fasm = bufio->create(asmfile, Sys->OWRITE|Sys->OTRUNC, 8r666);
+ if(fasm != nil)
+ break;
+ r := dialog->prompt(gctxt, t.image, "error -fg red", "Create .s file",
+ "open failed: "+sprint("%r"),
+ 0, "Retry" :: "Abort" :: nil);
+ if(r == 0)
+ continue;
+ else
+ return;
+ }
+ das(!TK);
+ fasm.puts("\tentry\t" + string m.entry + "," + string m.entryt + "\n");
+ desc(!TK);
+ dat(!TK);
+ fasm.puts("\tmodule\t" + m.name + "\n");
+ link(!TK);
+ imports(!TK);
+ handlers(!TK);
+ fasm.close();
+}
+
+link(flag: int)
+{
+ if(m == nil || m.magic == 0) {
+ dialog->prompt(gctxt, t.image, "error -fg red", "Link Descriptors",
+ "no module loaded",
+ 0, "Continue"::nil);
+ return;
+ }
+
+ if(flag == TK)
+ tk->cmd(t, ".b.t delete 1.0 end");
+
+ for(i := 0; i < m.lsize; i++) {
+ l := m.links[i];
+ s := sprint(" link %d,%d, 0x%ux, \"%s\"\n",
+ l.desc, l.pc, l.sig, l.name);
+ if(flag == TK)
+ tk->cmd(t, ".b.t insert end '"+s);
+ else
+ fasm.puts(s);
+ }
+ if(flag == TK)
+ tk->cmd(t, ".b.t see 1.0; update");
+}
+
+imports(flag: int)
+{
+ if(m == nil || m.magic == 0) {
+ dialog->prompt(gctxt, t.image, "error -fg red", "Import Descriptors",
+ "no module loaded",
+ 0, "Continue"::nil);
+ return;
+ }
+
+ if(flag == TK)
+ tk->cmd(t, ".b.t delete 1.0 end");
+
+ mi := m.imports;
+ for(i := 0; i < len mi; i++) {
+ a := mi[i];
+ for(j := 0; j < len a; j++) {
+ ai := a[j];
+ s := sprint(" import 0x%ux, \"%s\"\n", ai.sig, ai.name);
+ if(flag == TK)
+ tk->cmd(t, ".b.t insert end '"+s);
+ else
+ fasm.puts(s);
+ }
+ }
+ if(flag == TK)
+ tk->cmd(t, ".b.t see 1.0; update");
+}
+
+handlers(flag: int)
+{
+ if(m == nil || m.magic == 0) {
+ dialog->prompt(gctxt, t.image, "error -fg red", "Exception Handlers",
+ "no module loaded",
+ 0, "Continue"::nil);
+ return;
+ }
+
+ if(flag == TK)
+ tk->cmd(t, ".b.t delete 1.0 end");
+
+ hs := m.handlers;
+ for(i := 0; i < len hs; i++) {
+ h := hs[i];
+ tt := -1;
+ for(j := 0; j < len m.types; j++) {
+ if(h.t == m.types[j]) {
+ tt = j;
+ break;
+ }
+ }
+ s := sprint(" %d-%d, o=%d, e=%d t=%d\n", h.pc1, h.pc2, h.eoff, h.ne, tt);
+ if(flag == TK)
+ tk->cmd(t, ".b.t insert end '"+s);
+ else
+ fasm.puts(s);
+ et := h.etab;
+ for(j = 0; j < len et; j++) {
+ e := et[j];
+ if(e.s == nil)
+ s = sprint(" %d *\n", e.pc);
+ else
+ s = sprint(" %d \"%s\"\n", e.pc, e.s);
+ if(flag == TK)
+ tk->cmd(t, ".b.t insert end '"+s);
+ else
+ fasm.puts(s);
+ }
+ }
+ if(flag == TK)
+ tk->cmd(t, ".b.t see 1.0; update");
+}
+
+desc(flag: int)
+{
+ if(m == nil || m.magic == 0) {
+ dialog->prompt(gctxt, t.image, "error -fg red", "Type Descriptors",
+ "no module loaded",
+ 0, "Continue"::nil);
+ return;
+ }
+
+ if(flag == TK)
+ tk->cmd(t, ".b.t delete 1.0 end");
+
+ for(i := 0; i < m.tsize; i++) {
+ h := m.types[i];
+ s := sprint(" desc $%d, %d, \"", i, h.size);
+ for(j := 0; j < h.np; j++)
+ s += sprint("%.2ux", int h.map[j]);
+ s += "\"\n";
+ if(flag == TK)
+ tk->cmd(t, ".b.t insert end '"+s);
+ else
+ fasm.puts(s);
+ }
+ if(flag == TK)
+ tk->cmd(t, ".b.t see 1.0; update");
+}
+
+hdr()
+{
+ if(m == nil || m.magic == 0) {
+ dialog->prompt(gctxt, t.image, "error -fg red", "Header",
+ "no module loaded",
+ 0, "Continue"::nil);
+ return;
+ }
+
+ tk->cmd(t, ".b.t delete 1.0 end");
+
+ s := sprint("%.8ux Version %d Dis VM\n", m.magic, m.magic - XMAGIC + 1);
+ s += sprint("%.8ux Runtime flags %s\n", m.rt, rtflag(m.rt));
+ s += sprint("%8d bytes per stack extent\n\n", m.ssize);
+
+
+ s += sprint("%8d instructions\n", m.isize);
+ s += sprint("%8d data size\n", m.dsize);
+ s += sprint("%8d heap type descriptors\n", m.tsize);
+ s += sprint("%8d link directives\n", m.lsize);
+ s += sprint("%8d entry pc\n", m.entry);
+ s += sprint("%8d entry type descriptor\n\n", m.entryt);
+
+ if(m.sign == nil)
+ s += "Module is Insecure\n";
+
+ tk->cmd(t, ".b.t insert end '"+s);
+ tk->cmd(t, ".b.t see 1.0; update");
+}
+
+rtflag(flag: int): string
+{
+ if(flag == 0)
+ return "";
+
+ s := "[";
+
+ if(flag & MUSTCOMPILE)
+ s += "MustCompile";
+ if(flag & DONTCOMPILE) {
+ if(flag & MUSTCOMPILE)
+ s += "|";
+ s += "DontCompile";
+ }
+ s[len s] = ']';
+
+ return s;
+}
+
+das(flag: int)
+{
+ if(m == nil || m.magic == 0) {
+ dialog->prompt(gctxt, t.image, "error -fg red", "Assembly",
+ "no module loaded",
+ 0, "Continue"::nil);
+ return;
+ }
+
+ if(flag == TK)
+ tk->cmd(t, ".b.t delete 1.0 end");
+
+ for(i := 0; i < m.isize; i++) {
+ prefix := "";
+ if(flag == TK)
+ prefix = sprint(".b.t insert end '%4d ", i);
+ else {
+ if(i % 10 == 0)
+ fasm.puts("#" + string i + "\n");
+ prefix = sprint("\t");
+ }
+ s := prefix + dis->inst2s(m.inst[i]) + "\n";
+
+ if(flag == TK)
+ tk->cmd(t, s);
+ else
+ fasm.puts(s);
+ }
+ if(flag == TK)
+ tk->cmd(t, ".b.t see 1.0; update");
+}
+
+dat(flag: int)
+{
+ if(m == nil || m.magic == 0) {
+ dialog->prompt(gctxt, t.image, "error -fg red", "Module Data",
+ "no module loaded",
+ 0, "Continue"::nil);
+ return;
+ }
+ s := sprint(" var @mp, %d\n", m.types[0].size);
+ if(flag == TK) {
+ tk->cmd(t, ".b.t delete 1.0 end");
+ tk->cmd(t, ".b.t insert end '"+s);
+ } else
+ fasm.puts(s);
+
+ s = "";
+ for(d := m.data; d != nil; d = tl d) {
+ pick dat := hd d {
+ Bytes =>
+ s = sprint("\tbyte @mp+%d", dat.off);
+ for(n := 0; n < dat.n; n++)
+ s += sprint(",%d", int dat.bytes[n]);
+ Words =>
+ s = sprint("\tword @mp+%d", dat.off);
+ for(n := 0; n < dat.n; n++)
+ s += sprint(",%d", dat.words[n]);
+ String =>
+ s = sprint("\tstring @mp+%d, \"%s\"", dat.off, mapstr(dat.str));
+ Reals =>
+ s = sprint("\treal @mp+%d", dat.off);
+ for(n := 0; n < dat.n; n++)
+ s += sprint(", %g", dat.reals[n]);
+ break;
+ Array =>
+ s = sprint("\tarray @mp+%d,$%d,%d", dat.off, dat.typex, dat.length);
+ Aindex =>
+ s = sprint("\tindir @mp+%d,%d", dat.off, dat.index);
+ Arestore =>
+ s = "\tapop";
+ break;
+ Bigs =>
+ s = sprint("\tlong @mp+%d", dat.off);
+ for(n := 0; n < dat.n; n++)
+ s += sprint(", %bd", dat.bigs[n]);
+ }
+ if(flag == TK)
+ tk->cmd(t, ".b.t insert end '"+s+"\n");
+ else
+ fasm.puts(s+"\n");
+ }
+
+ if(flag == TK)
+ tk->cmd(t, ".b.t see 1.0; update");
+}
+
+mapstr(s: string): string
+{
+ for(i := 0; i < len s; i++) {
+ if(s[i] == '\n')
+ s = s[0:i] + "\\n" + s[i+1:];
+ }
+ return s;
+}
+
+tkcmds(t: ref Toplevel, cfg: array of string)
+{
+ for(i := 0; i < len cfg; i++)
+ tk->cmd(t, cfg[i]);
+}
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-10 15:19:31 +0000