ref: 1018d7a7091fd5e0433f501a3474cdc3fec322cc
dir: /appl/wm/rt.b/
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]); }