path: root/devel/debug/1/src/disa

PACKET dis DEFINES disasm, disa, proc head,   (* Autor: G.Szalay *)
                   set proc heads:            (* Stand: 87-04-23 *)

LET INSTR = STRUCT (TEXT mnem, INT length, class),
    clear to eop = ""4"", stdds = 0, no of lines = 4, beep = ""7"";
INT VAR first word, opcode, cur x, cur y;
INT CONST right 2 := -2;

ROW 31 INSTR CONST primary list :: ROW 31 INSTR:
 ( INSTR: ("LN      -    ",1,10),
   INSTR: ("LN1     -    ",1,10),
   INSTR: ("MOV     i-   ",2,0),
   INSTR: ("INC1    I    ",1,0),
   INSTR: ("DEC1    I    ",1,0),
   INSTR: ("INC     Ii   ",2,0),
   INSTR: ("DEC     Ii   ",2,0),
   INSTR: ("ADD     iiI  ",3,0),
   INSTR: ("SUB     iiI  ",3,0),
   INSTR: ("CLEAR   I    ",1,0),
   INSTR: ("TEST    i    ",1,1),
   INSTR: ("EQU     ii   ",2,1),
   INSTR: ("LSEQ    ii   ",2,1),
   INSTR: ("FMOV    r-   ",2,0),
   INSTR: ("FADD    rrR  ",3,0),
   INSTR: ("FSUB    rrR  ",3,0),
   INSTR: ("FMUL    rrR  ",3,0),
   INSTR: ("FDIV    rrR  ",3,0),
   INSTR: ("FLSEQ   rr   ",2,1),
   INSTR: ("TMOV    t-   ",2,0),
   INSTR: ("TEQU    tt   ",2,1),
   INSTR: ("ULSEQ   ii   ",2,1),
   INSTR: ("DSACC   dE   ",2,0),
   INSTR: ("REF     a-   ",2,0),
   INSTR: ("SUBS    vviaE",5,0),
   INSTR: ("SEL     avE  ",3,0),
   INSTR: ("PPV     -i   ",2,9),
   INSTR: ("PP      a    ",1,9),
   INSTR: ("B       -    ",1,2),
   INSTR: ("B1      -    ",1,2),
   INSTR: ("CALL    -    ",1,4) );

ROW 6 INSTR CONST special list :: ROW 6 INSTR:
 ( INSTR: ("EQUIM   vi   ",2,1),
   INSTR: ("MOVX    vh-  ",3,0),
   INSTR: ("GETW    ihI  ",3,0),
   INSTR: ("MOVI    vI   ",2,0),
   INSTR: ("PUTW    vhi  ",3,0),
   INSTR: ("PENTER  v    ",1,8) );

ROW 157 INSTR CONST secondary list :: ROW 157 INSTR:
 ( INSTR: ("RTN          ",1,7),
   INSTR: ("RTNT         ",1,7),
   INSTR: ("RTNF         ",1,7),
   INSTR: ("RESTART      ",1,0),
   INSTR: ("STOP         ",1,11),
   (* INSTR: ("*057F*       ",0,0), *)
      INSTR: ("LBAS    H    ",2,0),
   INSTR: ("KE           ",1,12),
   (* INSTR: ("*077F*       ",0,0), *)
      INSTR: ("DSGETW  dhhH ",5,0),
   INSTR: ("BCRD    iI   ",3,0),
   INSTR: ("CRD     II   ",3,0),
   INSTR: ("ECWR    Iii  ",4,0),
   INSTR: ("CWR     IIi  ",4,0),
   INSTR: ("CTT     iE   ",3,0),
   INSTR: ("GETC    tII  ",4,1),
   INSTR: ("FNONBL  ItI  ",4,1),
   INSTR: ("DREM256 Ii   ",3,0),
   INSTR: ("AMUL256 Ii   ",3,0),
   (* INSTR: ("*117F*       ",0,0), *)
      INSTR: ("DSPUTW  dhhh ",5,0),
   INSTR: ("ISDIG   i    ",2,1),
   INSTR: ("ISLD    i    ",2,1),
   INSTR: ("ISLC    i    ",2,1),
   INSTR: ("ISUC    i    ",2,1),
   INSTR: ("GADDR   -iI  ",4,0),
   INSTR: ("GCADDR  iiI  ",4,1),
   INSTR: ("ISSHA   a    ",2,1),
   INSTR: ("SYSG         ",1,0),
   INSTR: ("GETTAB       ",1,0),
   INSTR: ("PUTTAB       ",1,0),
   INSTR: ("ERTAB        ",1,0),
   INSTR: ("EXEC    -    ",2,5),
   INSTR: ("PPROC   -    ",2,9),
   INSTR: ("PCALL   -    ",2,6),
   INSTR: ("BRCOMP  iv   ",3,3),
   INSTR: ("MOVXX   vh-  ",4,0),
   INSTR: ("ALIAS   vdD  ",4,0),
   INSTR: ("MOVII   vI   ",3,0),
   INSTR: ("FEQU    rr   ",3,1),
   INSTR: ("TLSEQ   tt   ",3,1),
   INSTR: ("FNEG    rR   ",3,0),
   INSTR: ("NEG     iI   ",3,0),
   INSTR: ("IMULT   iiI  ",4,0),
   INSTR: ("MUL     iiI  ",4,0),
   INSTR: ("DIV     iiI  ",4,0),
   INSTR: ("MOD     iiI  ",4,0),
   INSTR: ("ITSUB   tiI  ",4,0),
   INSTR: ("ITRPL   Tii  ",4,0),
   INSTR: ("DECOD   tI   ",3,0),
   INSTR: ("ENCOD   iT   ",3,0),
   INSTR: ("SUBT1   tiT  ",4,0),
   INSTR: ("SUBTFT  tiiT ",5,0),
   INSTR: ("SUBTF   tiT  ",4,0),
   INSTR: ("REPLAC  Tit  ",4,0),
   INSTR: ("CAT     Tt   ",3,0),
   INSTR: ("TLEN    tI   ",3,0),
   INSTR: ("POS     ttI  ",4,0),
   INSTR: ("POSF    ttiI ",5,0),
   INSTR: ("POSFT   ttiiI",6,0),
   INSTR: ("STRAN   -iitiiI",8,0),
   INSTR: ("POSIF   tiiiI",6,0),
   INSTR: ("*3B7F*       ",0,0),
   INSTR: ("OUT     t    ",2,0),
   INSTR: ("COUT    i    ",2,0),
   INSTR: ("OUTF    ti   ",3,0),
   INSTR: ("OUTFT   tii  ",4,0),
   INSTR: ("INCHAR  T    ",2,0),
   INSTR: ("INCETY  T    ",2,0),
   INSTR: ("PAUSE   i    ",2,0),
   INSTR: ("GCPOS   II   ",3,0),
   INSTR: ("CATINP  TT   ",3,0),
   INSTR: ("NILDS   D    ",2,0),
   INSTR: ("DSCOPY  Dd   ",3,0),
   INSTR: ("DSFORG  d    ",2,0),
   INSTR: ("DSWTYP  di   ",3,0),
   INSTR: ("DSRTYP  dI   ",3,0),
   INSTR: ("DSHPSIZ dI   ",3,0),
   INSTR: ("ESTOP        ",1,11),
   INSTR: ("DSTOP        ",1,11),
   INSTR: ("SETERR  i    ",2,0),
   INSTR: ("ISERR        ",1,1),
   INSTR: ("CLRERR       ",1,13),
   INSTR: ("RPCB    iI   ",3,0),
   INSTR: ("INFOPW  ttI  ",4,0),
   INSTR: ("TWCPU   pr   ",3,0),
   INSTR: ("ROTATE  Hi   ",3,0),
   INSTR: ("IOCNTL  iiiI ",5,0),
   INSTR: ("BLKOUT  diiiI",6,0),
   INSTR: ("BLKIN   diiiI",6,0),
   INSTR: ("BLKNXT  diI  ",4,0),
   INSTR: ("DSSTOR  dpI  ",4,0),
   INSTR: ("STORAGE II   ",3,0),
   INSTR: ("SYSOP   i    ",2,0),
   INSTR: ("ARITS        ",1,0),
   INSTR: ("ARITU        ",1,0),
   INSTR: ("HPSIZE  I    ",2,0),
   INSTR: ("GARB         ",1,0),
   INSTR: ("TCREATE ppia ",5,0),
   INSTR: ("FSLD    iRI  ",4,0),
   INSTR: ("GEXP    rI   ",3,0),
   INSTR: ("SEXP    iR   ",3,0),
   INSTR: ("FLOOR   rR   ",3,0),
   INSTR: ("RTSUB   tiR  ",4,0),
   INSTR: ("RTRPL   Tir  ",4,0),
   INSTR: ("CLOCK   iR   ",3,0),
   INSTR: ("SETNOW  r    ",2,0),
   INSTR: ("TRPCB   piI  ",4,0),
   INSTR: ("TWPCB   pii  ",4,0),
   INSTR: ("TCPU    pR   ",3,0),
   INSTR: ("TSTAT   pI   ",3,0),
   INSTR: ("ACT     p    ",2,0),
   INSTR: ("DEACT   p    ",2,0),
   INSTR: ("THALT   p    ",2,0),
   INSTR: ("TBEGIN  pa   ",3,0),
   INSTR: ("TEND    p    ",2,0),
   INSTR: ("SEND    pidI ",5,0),
   INSTR: ("WAIT    DIP  ",4,0),
   INSTR: ("SWCALL  piDI ",5,0),
   INSTR: ("CDBINT  hI   ",3,0),
   INSTR: ("CDBTXT  hT   ",3,0),
   INSTR: ("PNACT   P    ",2,0),
   INSTR: ("PW      hhi  ",4,0),
   INSTR: ("GW      hhI  ",4,0),
   INSTR: ("BITXOR  hhH  ",4,0),
   INSTR: ("SNDWT   piDI ",5,0),
   INSTR: ("TEXIST  p    ",2,1),
   INSTR: ("BITAND  hhH  ",4,0),
   INSTR: ("BITOR   hhH  ",4,0),
   INSTR: ("SESSION I    ",2,0),
   INSTR: ("SNDFROM ppiDI",6,0),
   INSTR: ("DEFCOLL i    ",2,0),
   INSTR: ("IDENT   iI   ",3,0),
   INSTR: ("*827F*       ",0,0),
   INSTR: ("*837F*       ",0,0),
   INSTR: ("*847F*       ",0,0),
   INSTR: ("*857F*       ",0,0),
   INSTR: ("*867F*       ",0,0),
   INSTR: ("*877F*       ",0,0),
   INSTR: ("*887F*       ",0,0),
   INSTR: ("*897F*       ",0,0),
   INSTR: ("*8a7F*       ",0,0),
   INSTR: ("*8b7F*       ",0,0),
   INSTR: ("*8c7F*       ",0,0),
   INSTR: ("*8d7F*       ",0,0),
   INSTR: ("*8e7F*       ",0,0),
   INSTR: ("*8f7F*       ",0,0),
   INSTR: ("*907F*       ",0,0),
   INSTR: ("*917F*       ",0,0),
   INSTR: ("*927F*       ",0,0),
   INSTR: ("*937F*       ",0,0),
   INSTR: ("*947F*       ",0,0),
   INSTR: ("*957F*       ",0,0),
   INSTR: ("*967F*       ",0,0),
   INSTR: ("*977F*       ",0,0),
   INSTR: ("*987F*       ",0,0),
   INSTR: ("*997F*       ",0,0),
   INSTR: ("DSGETW  dhhH ",5,0),
   INSTR: ("DSPUTW  dhhh ",5,0),
   INSTR: ("LBAS    H    ",2,0) );


PROC disa (INT CONST icount h, icount l,
             TEXT VAR mnemonic, oplist,
             INT VAR instr length, instr class) :
  fetch first instr word;
  fetch opcode;
  IF   primary THEN process primary
  ELIF secondary THEN process secondary
  ELIF longprim THEN process longprim
  ELSE process special
  FI;
  oplist := subtext (mnemonic, 9);
  mnemonic := subtext (mnemonic, 1, 8).

fetch first instr word:
  first word := dsgetw (stdds, icount h, icount l).

fetch opcode:
  opcode := first word;
  rotate (opcode,8);
  opcode := opcode AND 255.

primary: (opcode AND 124) <> 124.

secondary: opcode = 127.

longprim: opcode = 255.

process primary:
  opcode := opcode AND 124;
  rotate (opcode, right 2);
  mnemonic := primary list (opcode+1) . mnem;
  instr length := primary list (opcode+1) . length;
  instr class := primary list (opcode+1) . class.

process secondary:
  opcode := first word AND 255;
  IF opcode <= 156
  THEN mnemonic := secondary list (opcode+1) . mnem;
       instr length := secondary list (opcode+1) . length;
       instr class := secondary list (opcode+1) . class
  ELSE mnemonic := "wrongopc";
       instr length := 0; instr class := -1
  FI.

process longprim:
  opcode := first word AND 255;
  IF (opcode AND 124) = opcode
  THEN rotate (opcode, -2);
       mnemonic := primary list (opcode+1) . mnem;
       instr length := primary list (opcode+1) . length + 1;
       instr class := primary list (opcode+1) . class
  ELSE mnemonic := "wrongopc";
       instr length := 0; instr class := -1
  FI.

process special:
  IF opcode < 128
  THEN opcode := (opcode AND 3) + 1
  ELSE opcode := (opcode AND 3) + 4
  FI;
  mnemonic := special list (opcode) .mnem;
  instr length := special list (opcode) .length;
  instr class := special list (opcode) . class.

END PROC disa;

(*********************************************************************)

LET max modno = 3071;
INT VAR word1, modno;
TEXT VAR buf, mod decr;
BOOL VAR proc heads file exists := FALSE;
INITFLAG VAR initflag := FALSE;
BOUND ROW max modno TEXT VAR proc heads;

PROC set proc heads (TEXT CONST proc heads filename):
  proc heads file exists := FALSE;
  IF proc heads filename <> "" AND exists (proc heads filename)
  THEN proc heads := old (proc heads filename);
       put (proc heads (max modno)); (*to test type*)
       proc heads file exists := TRUE
  FI
END PROC set proc heads;

TEXT PROC proc head (INT CONST module no):
  IF NOT initialized (initflag)
  THEN provide proc heads file
  FI;
  INT VAR modno := module no;
  IF modno >= 10000 THEN modno DECR 10000 FI;
  IF proc heads file exists AND modno <= max modno
  THEN IF modno = 0
       THEN "(* mod no 0 *)"
       ELSE buf := proc heads (modno);
            IF subtext (buf, 1, 2) = "+>"
            THEN mod decr := subtext (buf, 3);
                 buf := "(* " CT mod decr CT " +> "
                    CT proc head (modno - integ (mod decr)) CT " *)"
            FI;
            buf
       FI
  ELSE ""
  FI.

provide proc heads file:
  IF NOT exists ("procheads")
  THEN disable stop;
       command dialogue (FALSE);
       fetch ("procheads");
       IF is error
       THEN putline ("(*** proc heads file missing ***)");
            out (beep); clear error
       ELSE set proc heads ("procheads")
       FI;
       command dialogue (TRUE)
  FI
ENDPROC proc head;

(***********************************************************************)

INT VAR ic h:=2, ic l:=0, ilen, iclass, i, cmd, maxlines:=12, lines;
INT CONST mask 8000 := dec ("8000"),
          mask 7fff := dec ("7fff"),
          mask 0400 := dec ("0400"),
          bf mask1  := dec ("0040"),
       opcode mask0 := dec ("83ff");
BOOL VAR step mode := TRUE, quit;
TEXT VAR iname, ioplist, char, input;

PROC disasm :
  out (""13"");
  disasm (ic h, ic l)

ENDPROC disasm;

PROC disasm (INT CONST startaddr hi, startaddr lo):
  ic h := startaddr hi;
  ic l := startaddr lo;
  lines := 0;
  quit := FALSE;
  REP
    IF NOT (ic h = 3 OR ic h = 2)
    THEN out ("*** icount out of code area ***"); line; out (beep);
         step mode := TRUE
    ELSE disa (ic h, ic l, iname, ioplist, ilen, iclass);
         put icount mnemonic and instr words;
         put proc head for call;
         line; lines INCR 1;
         IF iclass = 1 THEN put cond branch instr FI;
    FI;
    process command if necessary
  UNTIL quit PER.

put icount mnemonic and instr words:
  put icount;
  out (iname);
  out (" ");
  IF ilen > 0
  THEN IF iclass = 4 THEN word1 := dsgetw (stdds, ic h, ic l) FI;
       FOR i FROM 1 UPTO ilen REP
         out (hex (dsget2b (stdds, ic h, ic l))); out (" ");
         incl (ic h, ic l, 1)
       PER
  ELSE out (hex (dsget2b (stdds, ic h, ic l))); out (""7"");
       incl (ic h, ic l, 1);
       step mode := TRUE
  FI.

put cond branch instr:
  put icount;
  word1 := dsget2b (stdds, ic h, ic l);
  IF (word1 AND bf mask1) <> 0
  THEN out ("BF       ")
  ELSE out ("BT       ")
  FI;
  putline (hex (word1));
  lines INCR 1;
  incl (ic h, ic l, 1).

put icount:
  out (txt (ic h));
  out (hex (ic l));
  out (": ").

put proc head for call:
  IF iclass = 4
  THEN eval module no;
       out ("  ");
       out (proc head (mod no))
  FI.

eval module no:
  mod no := word1 AND opcode mask0;
  IF (mod no AND mask 8000) <> 0
  THEN mod no := mod no AND mask 7fff OR mask 0400
  FI.

process command if necessary:
  IF step mode OR incharety <> "" OR lines >= maxlines
  THEN process command;
       lines := 0
  FI.

process command :
  REP putline (""15"DISASM: step, more, address, lines, info, or quit"14"");
      inchar (char);
      cmd := pos ("smaliq",char);
      IF cmd > 0
      THEN SELECT cmd OF
             CASE 1: step mode := TRUE; point to previous line
             CASE 2: step mode := FALSE; point to previous line
             CASE 3: set new ic
             CASE 4: set new linecount
             CASE 5: info (stdds, ic h, ic l, no of lines)
             CASE 6: quit := TRUE
           ENDSELECT
      FI
  UNTIL char <> "i" PER.

point to previous line:
  get cursor (cur x, cur y); cursor (1, cur y - 1); out (clear to eop).

set new line count:
  out ("lines="); gethex (buf); maxlines := dec (buf).

set new ic :
  REP
    put ("type new ic (20000...3ffff)");
    gethex (input);
    input := "0000" CT input;
    ic l := dec (subtext (input, LENGTH input-3));
    ic h := dec (subtext (input, LENGTH input-7, LENGTH input-4));
    IF ic h = 2 OR ic h = 3 THEN LEAVE set new ic FI;
    out (beep); putline ("*** icount out of code area ***")
  PER.

ENDPROC disasm;

(* disasm *)      (*for test only*).

END PACKET dis;