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;